{revs}[$i]->{author}; state Exp;
branches;
HERE
print $file 'next',$T;
print $file '1.',($i - 1) if( $i > 1 );
print $file ';'.$N;
}
print $file $N,$N,'desc',$N, _formatString( $this->{desc} ).$N,$N;
for( my $i = $this->{head}; $i > 0; $i--) {
print $file $N,'1.',$i,$N,
'log',$N,_formatString( $this->{revs}[$i]->{log} ),
$N,'text',$N,_formatString( $this->{revs}[$i]->{text} ),$N,$N;
}
$this->{state} = 'parsed'; # now known clean
}
# implements RcsFile
sub initBinary {
my( $this ) = @_;
# Nothing to be done but note for re-writing
$this->{expand} = 'b';
}
# implements RcsFile
sub initText {
my( $this ) = @_;
# Nothing to be done but note for re-writing
$this->{expand} = '';
}
# implements RcsFile
sub numRevisions {
my( $this ) = @_;
$this->_ensureProcessed();
# if state is nocommav, and the file exists, there is only one revision
if( $this->{state} eq 'nocommav' ) {
return 1 if( -e $this->{file} );
return 0;
}
return $this->{head};
}
# implements RcsFile
sub addRevisionFromText {
shift->_addRevision( 0, @_ );
}
sub addRevisionFromStream {
shift->_addRevision( 1, @_ );
}
sub _addRevision {
my( $this, $isStream, $data, $log, $author, $date ) = @_;
$this->_ensureProcessed();
if( $this->{state} eq 'nocommav' && -e $this->{file} ) {
# Must do this *before* saving the attachment, so we
# save the file on disc
$this->{head} = 1;
$this->{revs}[1]->{text} = $this->_readFile( $this->{file} );
$this->{revs}[1]->{log} = $log;
$this->{revs}[1]->{author} = $author;
$this->{revs}[1]->{date} = (defined $date ? $date : time());
$this->_writeMe();
}
if( $isStream ) {
$this->_saveStream( $data );
# SMELL: for big attachments, this is a dog
$data = $this->_readFile( $this->{file} );
} else {
$this->_saveFile( $this->{file}, $data );
}
my $head = $this->{head};
if( $head ) {
my $lNew = _split( $data );
my $lOld = _split( $this->{revs}[$head]->{text} );
my $delta = _diff( $lNew, $lOld );
$this->{revs}[$head]->{text} = $delta;
}
$head++;
$this->{revs}[$head]->{text} = $data;
$this->{head} = $head;
$this->{revs}[$head]->{log} = $log;
$this->{revs}[$head]->{author} = $author;
$this->{revs}[$head]->{date} = ( defined $date ? $date : time());
return $this->_writeMe();
}
sub _writeMe {
my( $this ) = @_;
my $dataError = '';
my $out = new FileHandle();
chmod( $TWiki::cfg{RCS}{filePermission}, $this->{rcsFile} );
if( !$out->open( '>'.TWiki::Sandbox::normalizeFileName( $this->{rcsFile} ))) {
throw Error::Simple('Cannot open '.$this->{rcsFile}.
' for write: '.$! );
} else {
binmode( $out );
$this->_write( $out );
close( $out );
}
chmod( $TWiki::cfg{RCS}{filePermission}, $this->{rcsFile} );
return $dataError;
}
# implements RcsFile
sub replaceRevision {
my( $this, $text, $comment, $user, $date ) = @_;
$this->_ensureProcessed();
$this->_delLastRevision();
return $this->_addRevision( 0, $text, $comment, $user, $date );
}
# implements RcsFile
sub deleteRevision {
my( $this ) = @_;
$this->_ensureProcessed();
# Can't delete revision 1
return unless $this->{head} > 1;
$this->_delLastRevision();
return $this->_writeMe();
}
sub _delLastRevision {
my( $this ) = @_;
my $numRevisions = $this->{head};
return unless $numRevisions;
$numRevisions--;
my $lastText = $this->getRevision( $numRevisions );
$this->{revs}[$numRevisions]->{text} = $lastText;
$this->{head} = $numRevisions;
$this->_saveFile( $this->{file}, $lastText );
}
# implements RcsFile
# Recovers the two revisions and uses sdiff on them. Simplest way to do
# this operation.
sub revisionDiff {
my( $this, $rev1, $rev2, $contextLines ) = @_;
my @list;
$this->_ensureProcessed();
my $text1 = $this->getRevision( $rev1 );
my $text2 = $this->getRevision( $rev2 );
my $lNew = _split( $text1 );
my $lOld = _split( $text2 );
my $diff = Algorithm::Diff::sdiff( $lNew, $lOld );
foreach my $ele ( @$diff ) {
push @list, $ele;
}
return \@list;
}
# implements RcsFile
sub getRevisionInfo {
my( $this, $version ) = @_;
$this->_ensureProcessed();
if( $this->{state} ne 'nocommav' ) {
if( !$version || $version > $this->{head} ) {
$version = $this->{head} || 1;
}
return ( $version,
$this->{revs}[$version]->{date},
$this->{revs}[$version]->{author},
$this->{revs}[$version]->{log} );
}
return $this->SUPER::getRevisionInfo( $version );
}
# Apply delta (patch) to text. Note that RCS stores reverse deltas,
# so the text for revision x is patched to produce text for revision x-1.
sub _patch {
# Both params are references to arrays
my( $text, $delta ) = @_;
my $adj = 0;
my $pos = 0;
my $max = $#$delta;
while( $pos <= $max ) {
my $d = $delta->[$pos];
if( $d =~ /^([ad])(\d+)\s(\d+)$/ ) {
my $act = $1;
my $offset = $2;
my $length = $3;
if( $act eq 'd' ) {
my $start = $offset + $adj - 1;
my @removed = splice( @$text, $start, $length );
$adj -= $length;
$pos++;
} elsif( $act eq 'a' ) {
my @toAdd = @$delta[$pos+1..$pos+$length];
# Fix for Item2957
# Check if the last element of what is to be added contains
# a valid marker. If it does, the chances are very high that
# this topic was saved using a broken version of RcsLite, and
# a line ending has been lost.
# As soon as a topic containing this problem is re-saved
# using this code, the need for this hack should go away,
# as the line endings will now be correct.
if (scalar(@toAdd) &&
$toAdd[$#toAdd] =~ /^([ad])(\d+)\s(\d+)$/ &&
$2 > $pos) {
pop(@toAdd);
push(@toAdd, <<'HERE');
WARNING: THIS TEXT WAS ADDED BY THE SYSTEM TO CORRECT A PROBABLE ERROR IN THE HISTORY OF THIS TOPIC.
HERE
$pos--; # so when we add $length we get to the right place
}
splice( @$text, $offset + $adj, 0, @toAdd );
$adj += $length;
$pos += $length + 1;
}
} else {
last;
}
}
}
# implements RcsFile
sub getRevision {
my( $this, $version ) = @_;
return $this->SUPER::getRevision($version) unless $version;
$this->_ensureProcessed();
return $this->SUPER::getRevision($version) if $this->{state} eq 'nocommav';
my $head = $this->{head};
$this->SUPER::getRevision($version) unless $head;
if( $version == $head ) {
return $this->{revs}[$version]->{text};
}
$version = $head if $version > $head;
my $headText = $this->{revs}[$head]->{text};
my $text = _split( $headText );
return $this->_patchN( $text, $head-1, $version );
}
# Apply reverse diffs until we reach our target rev
sub _patchN {
my( $this, $text, $version, $target ) = @_;
while ($version >= $target) {
my $deltaText = $this->{revs}[$version--]->{text};
my $delta = _split( $deltaText );
_patch( $text, $delta );
}
return join( "\n", @$text );
}
# Split a string on \n making sure we have all newlines. If the string
# ends with \n there will be a '' at the end of the split.
sub _split {
#my $text = shift;
my @list = ();
return \@list unless defined $_[0];
my $nl = 1;
foreach my $i ( split( /(\n)/o, $_[0] ) ) {
if( $i eq "\n" ) {
push( @list, '' ) if $nl;
$nl = 1;
} else {
push( @list, $i );
$nl = 0;
}
}
push( @list, '' ) if ($nl);
return \@list;
}
# Extract the differences between two arrays of lines, returning a string
# of differences in RCS difference format.
sub _diff {
my( $new, $old ) = @_;
my $diffs = Algorithm::Diff::diff( $new, $old );
#print STDERR "DIFF '",join('\n',@$new),"' and '",join('\n',@$old),"'\n";
# Convert the differences to RCS format
my $adj = 0;
my $out = '';
my $start = 0;
foreach my $chunk ( @$diffs ) {
my $count++;
my $chunkSign;
my @lines = ();
foreach my $line ( @$chunk ) {
my( $sign, $pos, $what ) = @$line;
#print STDERR "....$sign $pos $what\n";
if( $chunkSign && $chunkSign ne $sign ) {
$adj += _addChunk( $chunkSign, \$out, \@lines, $start, $adj );
}
if( ! @lines ) {
$start = $pos;
}
$chunkSign = $sign;
push( @lines, $what );
}
$adj += _addChunk( $chunkSign, \$out, \@lines, $start, $adj );
}
$out .= $N;
#print STDERR "CONVERTED\n",$out,"\n";
return $out;
}
# Add a hunk of differences, returning the total number of lines in the
# text
sub _addChunk {
my( $chunkSign, $out, $lines, $start, $adj ) = @_;
my $nLines = scalar( @$lines );
if( $nLines > 0 ) {
$$out .= $N if( $$out && $$out !~ /\n$/o );
if( $chunkSign eq '+' ) {
# Added $N at end to correct Item2957
$$out .= 'a'.($start-$adj).' '.$nLines.$N.join( "\n", @$lines ).$N;
} else {
$$out .= 'd'.($start+1).' '.$nLines;
$nLines *= -1;
}
@$lines = ();
}
return $nLines;
}
sub getRevisionAtTime {
my( $this, $date ) = @_;
my $version = 1;
$this->_ensureProcessed();
$version = $this->{head};
while( $version > 1 && $this->{revs}[$version]->{date} > $date) {
$version--;
}
return $version;
}
sub stringify {
my $this = shift;
my $s = $this->SUPER::stringify();
$s .= " access=$this->{access}" if $this->{access};
$s .= " symbols=$this->{symbols}" if $this->{symbols};
$s .= " comment=$this->{comment}" if $this->{comment};
$s .= " expand=$this->{expand}" if $this->{expand};
$s .= " [";
if( $this->{head} ) {
for( my $i = $this->{head}; $i > 0; $i--) {
$s .= "\tRev $i : { d=$this->{revs}[$i]->{date}";
$s .= " l=$this->{revs}[$i]->{log}";
$s .= " t=$this->{revs}[$i]->{text}}\n";
}
}
return "$s]\n";
}
1;