###################################################################### # # EPrints::DataObj::History # ###################################################################### # # This file is part of GNU EPrints 2. # # Copyright (c) 2000-2004 University of Southampton, UK. SO17 1BJ. # # EPrints 2 is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # EPrints 2 is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with EPrints 2; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # ###################################################################### =pod =head1 NAME B<EPrints::DataObj::History> - An element in the history of the arcvhive. =head1 DESCRIPTION This class describes a single item in the history dataset. A history object describes a single action taken on a single item in another dataset. Changes to document are considered part of changes to the eprint it belongs to. =head1 METADATA =over 4 =item historyid (int) The unique numerical ID of this history event. =item userid (itemref) The id of the user who caused this event. A value of zero or undefined indicates that there was no user responsible (ie. a script did it). =item datasetid (text) The name of the dataset to which the modified item belongs. "eprint" is used for eprints, rather than the inbox, buffer etc. =item objectid (int) The numerical ID of the object in the dataset. =item revision (int) The revision of the object. This is the revision number after the action occured. Not all actions increase the revision number. =item timestamp (time) The moment at which this thing happened. =item action (set) The type of event. Provisionally, this is a subset of the new list of privilages. =item details (longtext) If this is a "rejection" then the details contain the message sent to the user. =back =head1 METHODS =over 4 =cut package EPrints::DataObj::History; @ISA = ( 'EPrints::DataObj' ); use EPrints; use Unicode::String qw(utf8 latin1); use strict; ###################################################################### =pod =item $field_info = EPrints::DataObj::History->get_system_field_info Return the metadata field configuration for this object. =cut ###################################################################### sub get_system_field_info { my( $class ) = @_; return ( { name=>"historyid", type=>"int", required=>1, }, { name=>"userid", type=>"itemref", datasetid=>"user", required=>0 }, { name=>"actor", type=>"text", text_index=>0, }, # should maybe be a set? { name=>"datasetid", type=>"text", text_index=>0, }, # is this required? { name=>"objectid", type=>"int", }, { name=>"revision", type=>"int", }, { name=>"timestamp", type=>"time", }, # TODO should be a set when I know what the actions will be { name=>"action", type=>"set", text_index=>0, options=>[qw/ create modify mail_owner move_inbox_to_buffer move_buffer_to_archive move_buffer_to_inbox move_archive_to_deletion move_archive_to_buffer move_deletion_to_archive destroy removal_request reject_request accept_request note other /], }, { name=>"details", type=>"longtext", text_index=>0, render_single_value => \&EPrints::Extras::render_preformatted_field }, ); } ###################################################################### =pod =item $history = EPrints::DataObj::History->new( $session, $historyid ) Return a history object with id $historyid, from the database. Return undef if no such object extists. =cut ###################################################################### sub new { my( $class, $session, $historyid ) = @_; return $session->get_database->get_single( $session->get_repository->get_dataset( "history" ), $historyid ); } ###################################################################### =pod =item undef = EPrints::DataObj::History->new_from_data( $session, $data ) Create a new History object from the given $data. Used to turn items from the database into objects. =cut ###################################################################### sub new_from_data { my( $class, $session, $known ) = @_; return $class->SUPER::new_from_data( $session, $known, $session->get_repository->get_dataset( "history" ) ); } ###################################################################### =pod =item $history->commit Not meaningful. History can't be altered. =cut ###################################################################### sub commit { my( $self, $force ) = @_; $self->{session}->get_repository->log( "WARNING: Called commit on a EPrints::DataObj::History object." ); return 0; } ###################################################################### =pod =item $history->remove Not meaningful. History can't be altered. =cut ###################################################################### sub remove { my( $self ) = @_; $self->{session}->get_repository->log( "WARNING: Called remove on a EPrints::DataObj::History object." ); return 0; } ###################################################################### # =pod # # =item EPrints::DataObj::History::create( $session, $data ); # # Create a new history object from this data. Unlike other create # methods this one does not return the new object as it's never # needed, and would increase the load of modifying items. # # Also, this does not queue the fields for indexing. # # =cut ###################################################################### sub create { my( $session, $data ) = @_; return EPrints::DataObj::History->create_from_data( $session, $data, $session->get_repository->get_dataset( "history" ) ); } ###################################################################### =pod =item $defaults = EPrints::DataObj::History->get_defaults( $session, $data ) Return default values for this object based on the starting data. =cut ###################################################################### sub get_defaults { my( $class, $session, $data ) = @_; $data->{historyid} = $session->get_database->counter_next( "historyid" ); $data->{timestamp} = EPrints::Time::get_iso_timestamp(); my $user; if( $data->{userid} ) { $user = EPrints::User->new( $session, $data->{userid} ); } if( defined $user ) { $data->{actor} = EPrints::Utils::tree_to_utf8( $user->render_description() ); } else { # command line or not logged in. Store script name. $data->{actor} = $0; } return $data; } ###################################################################### # # $xhtml = $history->render_citation( $style, $url ) # # This overrides the normal citation rendering and just does a full # render of the event. # ###################################################################### sub render_citation { my( $self , $style , $url ) = @_; return $self->render; } ###################################################################### =pod =item $xhtml = $history->render Render this change as XHTML DOM. =cut ###################################################################### sub render { my( $self ) = @_; my %pins = (); my $user = $self->get_user; if( defined $user ) { $pins{cause} = $user->render_description; } else { $pins{cause} = $self->{session}->make_element( "tt" ); $pins{cause}->appendChild( $self->{session}->make_text( $self->get_value( "actor" ) ) ); } $pins{when} = $self->render_value( "timestamp" ); my $action = $self->get_value( "action" ); $pins{action} = $self->render_value( "action" ); if( $action eq "modify" ) { $pins{details} = $self->render_modify; } elsif( $action =~ m/^move_/ ) { $pins{details} = $self->{session}->render_nbsp; } # no details elsif( $action eq "destroy" ) { $pins{details} = $self->{session}->render_nbsp; } # no details elsif( $action eq "create" ) { $pins{details} = $self->render_create; } elsif( $action eq "mail_owner" ) { $pins{details} = $self->render_with_details; } elsif( $action eq "note" ) { $pins{details} = $self->render_with_details; } elsif( $action eq "other" ) { $pins{details} = $self->render_with_details; } elsif( $action eq "removal_request" ) { $pins{details} = $self->render_removal_request; } else { $pins{details} = $self->{session}->make_text( "Don't know how to render history event: $action" ); } my $obj = $self->get_dataobj; if( defined $obj ) { $pins{item} = $self->{session}->make_doc_fragment; $pins{item}->appendChild( $obj->render_description ); $pins{item}->appendChild( $self->{session}->make_text( " (" ) ); my $a = $self->{session}->render_link( $obj->get_control_url ); $pins{item}->appendChild( $a ); $a->appendChild( $self->{session}->make_text( $self->get_value( "datasetid" )." ".$self->get_value("objectid" ) ) ); $pins{item}->appendChild( $self->{session}->make_text( " r".$self->get_value( "revision" ) ) ); $pins{item}->appendChild( $self->{session}->make_text( ")" ) ); } else { $pins{item} = $self->{session}->html_phrase( "lib/history:no_such_item", datasetid=>$self->{session}->make_text($self->get_value( "datasetid" ) ), objectid=>$self->{session}->make_text($self->get_value( "objectid" ) ), ); } #$pins{item}->appendChild( $self->render_value( "historyid" )); return $self->{session}->html_phrase( "lib/history:record", %pins ); } ###################################################################### =pod =item $object = $history->get_dataobj Returns the object to which this history event relates. =cut ###################################################################### sub get_dataobj { my( $self ) = @_; return unless( $self->is_set( "datasetid" ) ); my $ds = $self->{session}->get_repository->get_dataset( $self->get_value( "datasetid" ) ); return $ds->get_object( $self->{session}, $self->get_value( "objectid" ) ); } ###################################################################### =pod =item $user = $history->get_user Returns the user object of the user who caused this event. =cut ###################################################################### sub get_user { my( $self ) = @_; if( $self->is_set( "userid" ) ) { return EPrints::User->new( $self->{session}, $self->get_value( "userid" ) ); } return undef; } ###################################################################### # # methods to render various types of history event # ###################################################################### ###################################################################### # # $xhtml = $history->render_removal_request # # Render a removal request history event. # ###################################################################### sub render_removal_request { my( $self ) = @_; my $div = $self->{session}->make_element( "div" ); $div->appendChild( $self->render_value("details") ); return $div; } ###################################################################### # # $xhtml = $history->render_with_details # # Render a MAIL_OWNER history event. # ###################################################################### sub render_with_details { my( $self ) = @_; my $div = $self->{session}->make_element( "div" ); $div->appendChild( $self->render_value("details") ); return $div; } ###################################################################### # # $xhtml = $history->render_create( $action ) # # Render a CREATE history event. # ###################################################################### sub render_create { my( $self ) = @_; my $eprint = EPrints::DataObj::EPrint->new( $self->{session}, $self->get_value( "objectid" ) ); if( !defined $eprint ) { return $self->{session}->render_nbsp; } my $r_new = $self->get_value( "revision" ); my $r_file_new = $eprint->local_path."/revisions/$r_new.xml"; unless( -e $r_file_new ) { my $div = $self->{session}->make_element( "div" ); $div->appendChild( $self->{session}->html_phrase( "lib/history:no_file" ) ); return $div; } my $file_new = EPrints::XML::parse_xml( $r_file_new ); my $dom_new = $file_new->getFirstChild; my $div = $self->{session}->make_element( "div" ); $div->appendChild( $self->{session}->html_phrase( "lib/history:xmlblock", xml=>render_xml( $self->{session}, $dom_new, 0, 0, 120 ) ) ); return $div; } ###################################################################### # # $xhtml = $history->render_modify( $action ) # # Render a MODIFY history event. # ###################################################################### sub render_modify { my( $self ) = @_; my $eprint = EPrints::DataObj::EPrint->new( $self->{session}, $self->get_value( "objectid" ) ); if( !defined $eprint ) { return $self->{session}->render_nbsp; } my $r_new = $self->get_value( "revision" ); my $r_old = $r_new-1; my $r_file_old = $eprint->local_path."/revisions/$r_old.xml"; my $r_file_new = $eprint->local_path."/revisions/$r_new.xml"; unless( -e $r_file_new ) { my $div = $self->{session}->make_element( "div" ); $div->appendChild( $self->{session}->html_phrase( "lib/history:no_file" ) ); return $div; } my $file_new = EPrints::XML::parse_xml( $r_file_new ); my $dom_new = $file_new->getFirstChild; unless( -e $r_file_old ) { my $div = $self->{session}->make_element( "div" ); $div->appendChild( $self->{session}->html_phrase( "lib/history:no_earlier" ) ); $div->appendChild( $self->{session}->html_phrase( "lib/history:xmlblock", xml=>render_xml( $self->{session}, $dom_new, 0, 0, 120 ) ) ); return $div; } my $file_old = EPrints::XML::parse_xml( $r_file_old ); my $dom_old = $file_old->getFirstChild; my %fieldnames = (); my %old_nodes = (); foreach my $cnode ( $file_old->getFirstChild->getChildNodes ) { next unless EPrints::XML::is_dom( $cnode, "Element" ); $fieldnames{$cnode->nodeName}=1; $old_nodes{$cnode->nodeName}=$cnode; } my %new_nodes = (); foreach my $cnode ( $file_new->getFirstChild->getChildNodes ) { next unless EPrints::XML::is_dom( $cnode, "Element" ); $fieldnames{$cnode->nodeName}=1; $new_nodes{$cnode->nodeName}=$cnode; } my $table; my $tr; my $td; $table = $self->{session}->make_element( "table" , width=>"100%", cellspacing=>"0", cellpadding=>"0"); $tr = $self->{session}->make_element( "tr" ); $td = $self->{session}->make_element( "td", valign=>"top", width=>"50%" ); $td->appendChild( $self->{session}->html_phrase( "lib/history:before" ) ); $tr->appendChild( $td ); $td = $self->{session}->make_element( "td", valign=>"top", width=>"50%" ); $td->appendChild( $self->{session}->html_phrase( "lib/history:after" ) ); $tr->appendChild( $td ); $table->appendChild( $tr ); foreach my $fn ( keys %fieldnames ) { if( !empty_tree( $old_nodes{$fn} ) && empty_tree( $new_nodes{$fn} ) ) { my( $old, $pad ) = render_xml( $self->{session}, $old_nodes{$fn}, 0, 1, 60 ); $tr = $self->{session}->make_element( "tr" ); $td = $self->{session}->make_element( "td", valign=>"top", width=>"50%", style=>"background-color: #fcc; " ); $td->appendChild( $self->{session}->html_phrase( "lib/history:xmlblock", xml=>$old ) ); $tr->appendChild( $td ); $td = $self->{session}->make_element( "td", valign=>"top", width=>"50%" ); my $f = $self->{session}->make_doc_fragment; $f->appendChild( $self->{session}->render_nbsp ); $f->appendChild( $pad ); $td->appendChild( $self->{session}->html_phrase( "lib/history:xmlblock", xml=>$f ) ); $tr->appendChild( $td ); $table->appendChild( $tr ); } elsif( empty_tree( $old_nodes{$fn} ) && !empty_tree( $new_nodes{$fn} ) ) { my( $new, $pad ) = render_xml( $self->{session}, $new_nodes{$fn}, 0, 1, 60 ); $tr = $self->{session}->make_element( "tr" ); $td = $self->{session}->make_element( "td", valign=>"top", width=>"50%" ); my $f = $self->{session}->make_doc_fragment; $f->appendChild( $self->{session}->render_nbsp ); $f->appendChild( $pad ); $td->appendChild( $self->{session}->html_phrase( "lib/history:xmlblock", xml=>$f ) ); $tr->appendChild( $td ); $td = $self->{session}->make_element( "td", valign=>"top", width=>"50%", style=>"background-color: #cfc" ); $td->appendChild( $self->{session}->html_phrase( "lib/history:xmlblock", xml=>$new ) ); $tr->appendChild( $td ); $table->appendChild( $tr ); } elsif( diff( $old_nodes{$fn}, $new_nodes{$fn} ) ) { $tr = $self->{session}->make_element( "tr" ); my( $t1, $t2 ) = render_xml_diffs( $self->{session}, $old_nodes{$fn}, $new_nodes{$fn}, 0, 60 ); $td = $self->{session}->make_element( "td", valign=>"top", width=>"50%", style=>"background-color: #ffc" ); $td->appendChild( $self->{session}->html_phrase( "lib/history:xmlblock", xml=>$t1 ) ); $tr->appendChild( $td ); $td = $self->{session}->make_element( "td", valign=>"top", width=>"50%", style=>"background-color: #ffc" ); $td->appendChild( $self->{session}->html_phrase( "lib/history:xmlblock", xml=>$t2 ) ); $tr->appendChild( $td ); $table->appendChild( $tr ); } } return $table; } ###################################################################### # # $boolean = EPrints::DataObj::History::empty_tree( $domtree ) # # return true if there is no text in the tree other than # whitespace, # # Will maybe be moved to XML or Utils # ###################################################################### sub empty_tree { my( $domtree ) = @_; return 1 unless defined $domtree; if( EPrints::XML::is_dom( $domtree, "Text" ) ) { my $v = $domtree->nodeValue; if( $v=~m/^[\s\r\n]*$/ ) { return 1; } return 0; } if( EPrints::XML::is_dom( $domtree, "Element" ) ) { foreach my $cnode ( $domtree->getChildNodes ) { unless( empty_tree( $cnode ) ) { return 0; } } return 1; } return 1; } ###################################################################### # # $xhtml = EPrints::DataObj::History::render_xml_diffs( $tree1, $tree2, $indent, $width ) # # Render the diffs between tree1 and tree2 as XHTML # ###################################################################### sub render_xml_diffs { my( $session, $tree1, $tree2, $indent, $width ) = @_; if( EPrints::XML::is_dom( $tree1, "Text" ) && EPrints::XML::is_dom( $tree2, "Text" )) { my $v1 = $tree1->nodeValue; my $v2 = $tree2->nodeValue; $v1=~s/^[\s\r\n]*$//; $v2=~s/^[\s\r\n]*$//; if( $v1 eq "" && $v2 eq "" ) { return( $session->make_doc_fragment, $session->make_doc_fragment ); } #return $session->make_text( (" "x$indent).$v."\n" ); return( $session->make_text( (" "x$indent).$v1."\n" ), $session->make_text( (" "x$indent).$v2."\n" ) ); } unless( EPrints::XML::is_dom( $tree1, "Element" ) && EPrints::XML::is_dom( $tree2, "Element" )) { return $session->make_text( "eh?:".ref($tree1) ); } my $f1 = $session->make_doc_fragment; my $f2 = $session->make_doc_fragment; my $name1 = $tree1->nodeName; my $name2 = $tree2->nodeName; my( @list1 ) = $tree1->getChildNodes; my( @list2 ) = $tree2->getChildNodes; my $justtext = 1; my $t1 = ""; my $t2 = ""; foreach my $cnode ( @list1 ) { unless( EPrints::XML::is_dom( $cnode,"Text" ) ) { $justtext = 0; last; } $t1.=$cnode->nodeValue; } foreach my $cnode ( @list2 ) { unless( EPrints::XML::is_dom( $cnode,"Text" ) ) { $justtext = 0; last; } $t2.=$cnode->nodeValue; } if( $justtext ) { $f1->appendChild( $session->make_text( " "x$indent ) ); $f1->appendChild( $session->make_text( "<$name1>" ) ); $f2->appendChild( $session->make_text( " "x$indent ) ); $f2->appendChild( $session->make_text( "<$name2>" ) ); my $offset = $indent*2+length($name1)+2; my $endw = length($name1)+3; my $s1; my $s2; if( $t1 eq $t2 ) { $s1 = $session->make_element( "span", style=>"" ); $s1->appendChild( mktext( $session, $t1, $offset, $endw, $width ) ); $s2 = $session->make_element( "span", style=>"" ); $s2->appendChild( mktext( $session, $t2, $offset, $endw, $width ) ); } elsif( $t1 eq "" ) { $s1 = $session->make_element( "span", style=>"" ); $s1->appendChild( mkpad( $session, $t2, $offset, $endw, $width ) ); $s2 = $session->make_element( "span", style=>"background: #cfc; font: bold 15pt sans-serif" ); $s2->appendChild( mktext( $session, $t2, $offset, $endw, $width ) ); $s1->appendChild( $session->make_text("debug1")); $s2->appendChild( $session->make_text("debug1")); } elsif( $t2 eq "" ) { $s1 = $session->make_element( "span", style=>"background: #fcc" ); $s1->appendChild( mktext( $session, $t1, $offset, $endw, $width ) ); $s2 = $session->make_element( "span", style=>"" ); $s2->appendChild( mkpad( $session, $t1, $offset, $endw, $width ) ); $s1->appendChild( $session->make_text("debug3")); $s2->appendChild( $session->make_text("debug4")); } else { my $h1 = scalar _mktext( $session, $t1, $offset, $endw, $width ); my $h2 = scalar _mktext( $session, $t2, $offset, $endw, $width ); $s1 = $session->make_element( "span", style=>"background: #cc0" ); $s1->appendChild( mktext( $session, $t1, $offset, $endw, $width ) ); $s2 = $session->make_element( "span", style=>"background: #cc0" ); $s2->appendChild( mktext( $session, $t2, $offset, $endw, $width ) ); if( $h1>$h2 ) { $s2->appendChild( $session->make_text( "\n"x($h1-$h2) ) ); } if( $h2>$h1 ) { $s1->appendChild( $session->make_text( "\n"x($h2-$h1) ) ); } } $f1->appendChild( $s1 ); $f2->appendChild( $s2 ); $f1->appendChild( $session->make_text( "</$name1>\n" ) ); $f2->appendChild( $session->make_text( "</$name2>\n" ) ); return( $f1, $f2 ); } $f1->appendChild( $session->make_text( " "x$indent ) ); $f1->appendChild( $session->make_text( "<$name1>\n" ) ); $f2->appendChild( $session->make_text( " "x$indent ) ); $f2->appendChild( $session->make_text( "<$name2>\n" ) ); my $c1 = 0; my $c2 = 0; my( $r1, $r2 ); while( $c1<scalar @list1 && $c2<scalar @list2 ) { if( diff( $list1[$c1], $list2[$c2] ) ) { if( $c1+1<scalar @list1 ) { my $removedto = 0; for(my $i=$c1+1;$i<scalar @list1;++$i) { if( !diff( $list1[$i], $list2[$c2] ) ) { $removedto = $i; last; } } if( $removedto ) { $r1 = $session->make_element( "span", style=>"background: #f88" ); for(my $i=$c1;$i<$removedto;++$i) { my( $rem, $pad ) = render_xml( $session, $list1[$i], $indent+1, 1, $width ); $r1->appendChild( $rem ); $f2->appendChild( $pad ); } $f1->appendChild( $r1 ); $c1 = $removedto; next; } } if( $c2+1<scalar @list2 ) { my $addedto = 0; for(my $i=$c2+1;$i<scalar @list2;++$i) { if( !diff( $list2[$i], $list1[$c1] ) ) { $addedto = $i; last; } } if( $addedto ) { $r2 = $session->make_element( "span", style=>"background: #8f8" ); for(my $i=$c2;$i<$addedto;++$i) { my( $add, $pad ) = render_xml( $session, $list2[$i], $indent+1, 1, $width ); $r2->appendChild( $add ); $f1->appendChild( $pad ); } $f2->appendChild( $r2 ); $c2 = $addedto; next; } } ( $r1, $r2 ) = render_xml_diffs( $session, $list1[$c1], $list2[$c2], $indent+1, $width ); } else { $r1 = $session->make_element( "span" ); $r1->appendChild( render_xml( $session, $list1[$c1], $indent+1, 0, $width ) ); $r2 = $session->make_element( "span" ); $r2->appendChild( render_xml( $session, $list2[$c2], $indent+1, 0, $width ) ); } $f1->appendChild( $r1 ); $f2->appendChild( $r2 ); ++$c1; ++$c2; } # print any straglers. # any removed if( $c1<scalar @list1 ) { $r1 = $session->make_element( "span", style=>"background: #f88" ); for(my $i=$c1;$i<scalar @list1;++$i) { my( $rem, $pad ) = render_xml( $session, $list1[$i], $indent+1, 1, $width ); $r1->appendChild( $rem ); $f2->appendChild( $pad ); } $f1->appendChild( $r1 ); } # any added if( $c2<scalar @list2 ) { my $r2 = $session->make_element( "span", style=>"background: #8f8" ); for(my $i=$c2;$i<scalar @list2;++$i) { my( $add, $pad ) = render_xml( $session, $list2[$i], $indent+1, 1, $width ); $f1->appendChild( $pad ); $r2->appendChild( $add ); } $f2->appendChild( $r2 ); } $f1->appendChild( $session->make_text( " "x$indent ) ); $f1->appendChild( $session->make_text( "</$name1>\n" ) ); $f2->appendChild( $session->make_text( " "x$indent ) ); $f2->appendChild( $session->make_text( "</$name2>\n" ) ); return( $f1, $f2 ); } ###################################################################### # # ($xhtml, [$xhtml_padding]) = EPrints::DataObj::History::render_domtree( $session, $tree, $indent, $make_padded, $width ) # # Render the given tree as XHTML (showing the actual XML structure). # # If make_padded is true then also generate another element, which is # empty but the same height to be used in the other column to keep # things level. # ###################################################################### sub render_xml { my( $session,$domtree,$indent,$mkpadder,$width ) = @_; if( EPrints::XML::is_dom( $domtree, "Text" ) ) { my $v = $domtree->nodeValue; if( $v=~m/^[\s\r\n]*$/ ) { if( $mkpadder ) { return( $session->make_doc_fragment, $session->make_doc_fragment ); } return $session->make_doc_fragment; } my $r = $session->make_text( (" "x$indent).$v."\n" ); if( $mkpadder ) { return( $r, $session->make_text( "\n" ) ); } return $r; } if( EPrints::XML::is_dom( $domtree, "Element" ) ) { my $t = ''; my $justtext = 1; foreach my $cnode ( $domtree->getChildNodes ) { if( EPrints::XML::is_dom( $cnode,"Element" ) ) { $justtext = 0; last; } if( EPrints::XML::is_dom( $cnode,"Text" ) ) { $t.=$cnode->nodeValue; } } my $name = $domtree->nodeName; my $f = $session->make_doc_fragment; my $padder; if( $mkpadder ) { $padder = $session->make_doc_fragment; } if( $justtext ) { my $offset = $indent*2+length($name)+2; my $endw = length($name)+3; $f->appendChild( $session->make_text( " "x$indent ) ); $t = "" if( $t =~ m/^[\s\r\n]*$/ ); $f->appendChild( $session->make_text( "<$name>" ) ); $f->appendChild( mktext( $session, $t, $offset, $endw, $width ) ); $f->appendChild( $session->make_text( "</$name>\n" ) ); if( $mkpadder ) { $padder->appendChild( $session->make_text( "\n" ) ); $padder->appendChild( mkpad( $session, $t, $offset, $endw, $width ) ); } } else { $f->appendChild( $session->make_text( " "x$indent ) ); $f->appendChild( $session->make_text( "<$name>\n" ) ); if( $mkpadder ) { $padder->appendChild( $session->make_text( "\n" ) ); } foreach my $cnode ( $domtree->getChildNodes ) { my( $sub, $padsub ) = render_xml( $session,$cnode, $indent+1, $mkpadder, $width ); if( $mkpadder ) { $padder->appendChild( $padsub ); } $f->appendChild( $sub ); } $f->appendChild( $session->make_text( " "x$indent ) ); $f->appendChild( $session->make_text( "</$name>\n" ) ); if( $mkpadder ) { $padder->appendChild( $session->make_text( "\n" ) ); } } if( $mkpadder ) { return( $f, $padder ); } return $f; } return( $session->make_text( "eh?:".ref($domtree) ), $session->make_doc_fragment ); } ###################################################################### # # $boolean = EPrints::DataObj::History::diff( $tree1, $tree2 ) # # Return true if the XML trees are not the same, otherwise false. # ###################################################################### sub diff { my( $a, $b ) = @_; if( defined $a && !defined $b ) { return 1; } if( !defined $a && defined $b ) { return 1; } if( ref( $a ) ne ref( $b ) ) { return 1; } if( $a->nodeName ne $b->nodeName ) { return 1; } if( EPrints::XML::is_dom( $a, "Text" ) ) { my $va = $a->nodeValue; my $vb = $b->nodeValue; # both empty if( $va=~m/^[\s\r\n]*$/ && $vb=~m/^[\s\r\n]*$/ ) { return 0; } if( $va eq $vb ) { return 0; } return 1; } if( EPrints::XML::is_dom( $a, "Element" ) ) { my @alist = $a->getChildNodes; my @blist = $b->getChildNodes; return( 1 ) if( scalar @alist != scalar @blist ); for( my $i=0;$i<scalar @alist;++$i ) { return 1 if diff( $alist[$i], $blist[$i] ); } return 0; } return 0; } ###################################################################### # # @lines = EPrints::DataObj::History::_mktext( $session, $text, $offset, $endw, $width ) # # Return the $text string broken into lines which are $width long, or # less. # # Inserts a 90 degree arrow at the end of each broken line to indicate # that it has been broken. # ###################################################################### sub _mktext { my( $session, $text, $offset, $endw, $width ) = @_; return () unless length( $text ); my $lb = utf8(""); $lb->pack( 8626 ); my @bits = split(/[\r\n]/, $text ); my @b2 = (); foreach( @bits ) { my $t2 = utf8($_); while( $offset+length( $t2 ) > $width ) { my $cut = $width-1-$offset; push @b2, substr( $t2, 0, $cut ).$lb; $t2 = substr( $t2, $cut ); $offset = 0; } if( $offset+$endw+length( $t2 ) > $width ) { push @b2, $t2.$lb, ""; } else { push @b2, $t2; } } return @b2; } ###################################################################### # # $boolean = EPrints::DataObj::History::diff( $tree1, $tree2 ) # # Return true if the XML trees are not the same, otherwise false. # render $text into wrapped XML DOM. # ###################################################################### sub mktext { my( $session, $text, $offset, $endw, $width ) = @_; my @bits = _mktext( $session, $text, $offset, $endw, $width ); return $session->make_text( join( "\n", @bits ) ); } ###################################################################### # # $xhtml = EPrints::DataObj::History::mkpad( $session, $text, $offset, $endw, $width ) # # Return DOM of vertical padding equiv. to the lines that would # be needed to render $text. # ###################################################################### sub mkpad { my( $session, $text, $offset, $endw, $width ) = @_; my @bits = _mktext( $session, $text, $offset, $endw, $width ); return $session->make_text( "\n"x((scalar @bits)-1) ); } ###################################################################### 1; ###################################################################### =pod =back =cut