lib/TWiki/Store/RcsWrap.pm
changeset 0 414e01d06fd5
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 # Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
       
     2 #
       
     3 # Copyright (C) 2002 John Talintyre, john.talintyre@btinternet.com
       
     4 # Copyright (C) 2002-2007 Peter Thoeny, peter@thoeny.org
       
     5 # and TWiki Contributors. All Rights Reserved. TWiki Contributors
       
     6 # are listed in the AUTHORS file in the root of this distribution.
       
     7 # NOTE: Please extend that file, not this notice.
       
     8 #
       
     9 # This program is free software; you can redistribute it and/or
       
    10 # modify it under the terms of the GNU General Public License
       
    11 # as published by the Free Software Foundation; either version 2
       
    12 # of the License, or (at your option) any later version. For
       
    13 # more details read LICENSE in the root of this distribution.
       
    14 #
       
    15 # This program is distributed in the hope that it will be useful,
       
    16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
       
    18 #
       
    19 # As per the GPL, removal of this notice is prohibited.
       
    20 
       
    21 =pod
       
    22 
       
    23 ---+ package TWiki::Store::RcsWrap
       
    24 
       
    25 This package does not publish any methods. It implements the
       
    26 virtual methods of the [[TWikiStoreRcsFileDotPm][TWiki::Store::RcsFile]] superclass.
       
    27 
       
    28 Wrapper around the RCS commands required by TWiki.
       
    29 There is one of these object for each file stored under RCS.
       
    30 
       
    31 =cut
       
    32 
       
    33 package TWiki::Store::RcsWrap;
       
    34 use base 'TWiki::Store::RcsFile';
       
    35 
       
    36 use strict;
       
    37 use Assert;
       
    38 
       
    39 require TWiki::Store;
       
    40 require TWiki::Sandbox;
       
    41 
       
    42 # implements RcsFile
       
    43 sub new {
       
    44     return shift->SUPER::new( @_ );
       
    45 }
       
    46 
       
    47 =begin twiki
       
    48 
       
    49 ---++ ObjectMethod finish()
       
    50 Break circular references.
       
    51 
       
    52 =cut
       
    53 
       
    54 # Note to developers; please undef *all* fields in the object explicitly,
       
    55 # whether they are references or not. That way this method is "golden
       
    56 # documentation" of the live fields in the object.
       
    57 sub finish {
       
    58     my $this = shift;
       
    59     $this->SUPER::finish();
       
    60     undef $this->{binary};
       
    61 }
       
    62 
       
    63 # implements RcsFile
       
    64 sub initBinary {
       
    65     my( $this ) = @_;
       
    66 
       
    67     $this->{binary} = 1;
       
    68 
       
    69     TWiki::Store::RcsFile::mkPathTo( $this->{file} );
       
    70 
       
    71     return if -e $this->{rcsFile};
       
    72 
       
    73     my ( $rcsOutput, $exit ) =
       
    74       $TWiki::sandbox->sysCommand(
       
    75           $TWiki::cfg{RCS}{initBinaryCmd}, FILENAME => $this->{file} );
       
    76     if( $exit ) {
       
    77         throw Error::Simple( $TWiki::cfg{RCS}{initBinaryCmd}.
       
    78                                ' of '.$this->hidePath($this->{file}).
       
    79                                  ' failed: '.$rcsOutput );
       
    80     } elsif( ! -e $this->{rcsFile} ) {
       
    81         # Sometimes (on Windows?) rcs file not formed, so check for it
       
    82         throw Error::Simple( $TWiki::cfg{RCS}{initBinaryCmd}.
       
    83                                ' of '.$this->hidePath($this->{rcsFile}).
       
    84                                  ' failed to create history file');
       
    85     }
       
    86 }
       
    87 
       
    88 # implements RcsFile
       
    89 sub initText {
       
    90     my( $this ) = @_;
       
    91 
       
    92     $this->{binary} = 0;
       
    93 
       
    94     TWiki::Store::RcsFile::mkPathTo( $this->{file} );
       
    95 
       
    96     return if -e $this->{rcsFile};
       
    97 
       
    98     my ( $rcsOutput, $exit ) =
       
    99       $TWiki::sandbox->sysCommand
       
   100         ( $TWiki::cfg{RCS}{initTextCmd},
       
   101           FILENAME => $this->{file} );
       
   102     if( $exit ) {
       
   103         $rcsOutput ||= '';
       
   104         throw Error::Simple( $TWiki::cfg{RCS}{initTextCmd}.
       
   105                                ' of '.$this->hidePath($this->{file}).
       
   106                                  ' failed: '.$rcsOutput );
       
   107     } elsif( ! -e $this->{rcsFile} ) {
       
   108         # Sometimes (on Windows?) rcs file not formed, so check for it
       
   109         throw Error::Simple( $TWiki::cfg{RCS}{initTextCmd}.
       
   110                                ' of '.$this->hidePath($this->{rcsFile}).
       
   111                                  ' failed to create history file');
       
   112     }
       
   113 }
       
   114 
       
   115 # implements RcsFile
       
   116 sub addRevisionFromText {
       
   117     my( $this, $text, $comment, $user, $date ) = @_;
       
   118     $this->init();
       
   119 
       
   120     unless( -e $this->{rcsFile} ) {
       
   121         _lock( $this );
       
   122         _ci( $this, $comment, $user, $date );
       
   123     }
       
   124     TWiki::Store::RcsFile::saveFile( $this, $this->{file}, $text );
       
   125     _lock( $this );
       
   126     _ci( $this, $comment, $user, $date );
       
   127 }
       
   128 
       
   129 # implements RcsFile
       
   130 sub addRevisionFromStream {
       
   131     my( $this, $stream, $comment, $user, $date ) = @_;
       
   132     $this->init();
       
   133 
       
   134     _lock( $this );
       
   135     TWiki::Store::RcsFile::saveStream( $this, $stream );
       
   136     _ci( $this, $comment, $user, $date );
       
   137 }
       
   138 
       
   139 # implements RcsFile
       
   140 sub replaceRevision {
       
   141     my( $this, $text, $comment, $user, $date ) = @_;
       
   142 
       
   143     my $rev = $this->numRevisions();
       
   144 
       
   145     $comment ||= 'none';
       
   146 
       
   147     # update repository with same userName and date
       
   148     if( $rev == 1 ) {
       
   149         # initial revision, so delete repository file and start again
       
   150         unlink $this->{rcsFile};
       
   151     } else {
       
   152         _deleteRevision( $this, $rev );
       
   153     }
       
   154 
       
   155     TWiki::Store::RcsFile::saveFile( $this, $this->{file}, $text );
       
   156     require TWiki::Time;
       
   157 	$date = TWiki::Time::formatTime( $date , '$rcs', 'gmtime');
       
   158 
       
   159     _lock( $this );
       
   160     my ($rcsOut, $exit) =
       
   161       $TWiki::sandbox->sysCommand(
       
   162           $TWiki::cfg{RCS}{ciDateCmd},
       
   163           DATE => $date,
       
   164           USERNAME => $user,
       
   165           FILENAME => $this->{file},
       
   166           COMMENT => $comment );
       
   167     if( $exit ) {
       
   168         $rcsOut = $TWiki::cfg{RCS}{ciDateCmd}."\n".$rcsOut;
       
   169         return $rcsOut;
       
   170     }
       
   171     chmod( $TWiki::cfg{RCS}{filePermission}, $this->{file} );
       
   172 }
       
   173 
       
   174 # implements RcsFile
       
   175 sub deleteRevision {
       
   176     my( $this ) = @_;
       
   177     my $rev = $this->numRevisions();
       
   178     return undef if( $rev <= 1 );
       
   179     return _deleteRevision( $this, $rev );
       
   180 }
       
   181 
       
   182 sub _deleteRevision {
       
   183     my( $this, $rev ) = @_;
       
   184 
       
   185     # delete latest revision (unlock (may not be needed), delete revision)
       
   186     my ($rcsOut, $exit) =
       
   187       $TWiki::sandbox->sysCommand(
       
   188           $TWiki::cfg{RCS}{unlockCmd},
       
   189           FILENAME => $this->{file} );
       
   190 
       
   191     chmod( $TWiki::cfg{RCS}{filePermission}, $this->{file} );
       
   192 
       
   193     ($rcsOut, $exit) = $TWiki::sandbox->sysCommand(
       
   194         $TWiki::cfg{RCS}{delRevCmd},
       
   195         REVISION => '1.'.$rev,
       
   196         FILENAME => $this->{file} );
       
   197 
       
   198     if( $exit ) {
       
   199         throw Error::Simple( $TWiki::cfg{RCS}{delRevCmd}.
       
   200                                ' of '.$this->hidePath($this->{file}).
       
   201                                  ' failed: '.$rcsOut );
       
   202     }
       
   203 
       
   204     # Update the checkout
       
   205     $rev--;
       
   206     ($rcsOut, $exit) = $TWiki::sandbox->sysCommand(
       
   207         $TWiki::cfg{RCS}{coCmd},
       
   208         REVISION => '1.'.$rev,
       
   209         FILENAME => $this->{file} );
       
   210 
       
   211     if( $exit ) {
       
   212         throw Error::Simple( $TWiki::cfg{RCS}{coCmd}.
       
   213                                ' of '.$this->hidePath($this->{file}).
       
   214                                  ' failed: '.$rcsOut );
       
   215     }
       
   216     TWiki::Store::RcsFile::saveFile( $this, $this->{file}, $rcsOut );
       
   217 }
       
   218 
       
   219 # implements RcsFile
       
   220 sub getRevision {
       
   221     my( $this, $version ) = @_;
       
   222 
       
   223     unless( $version && -e $this->{rcsFile} ) {
       
   224         return $this->SUPER::getRevision( $version );
       
   225     }
       
   226 
       
   227     my $tmpfile = '';
       
   228     my $tmpRevFile = '';
       
   229     my $coCmd = $TWiki::cfg{RCS}{coCmd};
       
   230     my $file = $this->{file};
       
   231     if( $TWiki::cfg{RCS}{coMustCopy} ) {
       
   232         # SMELL: is this really necessary? What evidence is there?
       
   233         # Need to take temporary copy of topic, check it out to file,
       
   234         # then read that
       
   235         # Need to put RCS into binary mode to avoid extra \r appearing and
       
   236         # read from binmode file rather than stdout to avoid early file
       
   237         # read termination
       
   238         $tmpfile = TWiki::Store::RcsFile::mkTmpFilename( $this );
       
   239         $tmpRevFile = $tmpfile.',v';
       
   240         copy( $this->{rcsFile}, $tmpRevFile );
       
   241         my ($tmp, $status) = $TWiki::sandbox->sysCommand(
       
   242             $TWiki::cfg{RCS}{tmpBinaryCmd},
       
   243             FILENAME => $tmpRevFile );
       
   244         $file = $tmpfile;
       
   245         $coCmd =~ s/-p%REVISION/-r%REVISION/;
       
   246     }
       
   247     my ($text, $status) = $TWiki::sandbox->sysCommand(
       
   248         $coCmd,
       
   249         REVISION => '1.'.$version,
       
   250         FILENAME => $file );
       
   251 
       
   252     if( $tmpfile ) {
       
   253         $text = TWiki::Store::RcsFile::readFile( $this, $tmpfile );
       
   254         # SMELL: Is untainting really necessary here?
       
   255         unlink TWiki::Sandbox::untaintUnchecked( $tmpfile );
       
   256         unlink TWiki::Sandbox::untaintUnchecked( $tmpRevFile );
       
   257     }
       
   258 
       
   259     return $text;
       
   260 }
       
   261 
       
   262 # implements RcsFile
       
   263 sub numRevisions {
       
   264     my( $this ) = @_;
       
   265 
       
   266     unless( -e $this->{rcsFile}) {
       
   267         return 1 if( -e $this->{file} );
       
   268         return 0;
       
   269     }
       
   270 
       
   271     my ($rcsOutput, $exit) =
       
   272       $TWiki::sandbox->sysCommand
       
   273         ( $TWiki::cfg{RCS}{histCmd},
       
   274           FILENAME => $this->{rcsFile} );
       
   275     if( $exit ) {
       
   276         throw Error::Simple( 'RCS: '.$TWiki::cfg{RCS}{histCmd}.
       
   277                                ' of '.$this->hidePath($this->{rcsFile}).
       
   278                                  ' failed: '.$rcsOutput );
       
   279     }
       
   280     if( $rcsOutput =~ /head:\s+\d+\.(\d+)\n/ ) {
       
   281         return $1;
       
   282     }
       
   283     if( $rcsOutput =~ /total revisions: (\d+)\n/ ) {
       
   284         return $1;
       
   285     }
       
   286     return 1;
       
   287 }
       
   288 
       
   289 # implements RcsFile
       
   290 sub getRevisionInfo {
       
   291     my( $this, $version ) = @_;
       
   292 
       
   293     if( -e $this->{rcsFile} ) {
       
   294         if( !$version || $version > $this->numRevisions()) {
       
   295             $version = $this->numRevisions();
       
   296         }
       
   297         my( $rcsOut, $exit ) = $TWiki::sandbox->sysCommand
       
   298           ( $TWiki::cfg{RCS}{infoCmd},
       
   299             REVISION => '1.'.$version,
       
   300             FILENAME => $this->{rcsFile} );
       
   301         if( ! $exit ) {
       
   302             if( $rcsOut =~ /^.*?date: ([^;]+);  author: ([^;]*);[^\n]*\n([^\n]*)\n/s ) {
       
   303                 my $user = $2;
       
   304                 my $comment = $3;
       
   305                 require TWiki::Time;
       
   306                 my $date = TWiki::Time::parseTime( $1 );
       
   307                 my $rev = $version;
       
   308                 if( $rcsOut =~ /revision 1.([0-9]*)/ ) {
       
   309                     $rev = $1;
       
   310                     return( $rev, $date, $user, $comment );
       
   311                 }
       
   312             }
       
   313         }
       
   314     }
       
   315 
       
   316     return $this->SUPER::getRevisionInfo( $version );
       
   317 }
       
   318 
       
   319 # implements RcsFile
       
   320 sub revisionDiff {
       
   321     my( $this, $rev1, $rev2, $contextLines ) = @_;
       
   322     my $tmp = '';
       
   323     my $exit;
       
   324     if ( $rev1 eq '1' && $rev2 eq '1' ) {
       
   325         my $text = $this->getRevision(1);
       
   326         $tmp = "1a1\n";
       
   327         foreach( split( /\r?\n/, $text ) ) {
       
   328             $tmp = "$tmp> $_\n";
       
   329         }
       
   330     } else {
       
   331         $contextLines = 3 unless defined($contextLines);
       
   332         ( $tmp, $exit ) = $TWiki::sandbox->sysCommand(
       
   333             $TWiki::cfg{RCS}{diffCmd},
       
   334             REVISION1 => '1.'.$rev1,
       
   335             REVISION2 => '1.'.$rev2,
       
   336             FILENAME => $this->{rcsFile},
       
   337             CONTEXT => $contextLines );
       
   338         # comment out because we get a non-zero status for a good result!
       
   339         #if( $exit ) {
       
   340         #    throw Error::Simple( 'RCS: '.$TWiki::cfg{RCS}{diffCmd}.
       
   341         #                           ' failed: '.$! );
       
   342         #}
       
   343     }
       
   344 	
       
   345     return parseRevisionDiff( $tmp );
       
   346 }
       
   347 
       
   348 =pod
       
   349 
       
   350 ---++ StaticMethod parseRevisionDiff( $text ) -> \@diffArray
       
   351 
       
   352 | Description: | parse the text into an array of diff cells |
       
   353 | #Description: | unlike Algorithm::Diff I concatinate lines of the same diffType that are sqential (this might be something that should be left up to the renderer) |
       
   354 | Parameter: =$text= | currently unified or rcsdiff format |
       
   355 | Return: =\@diffArray= | reference to an array of [ diffType, $right, $left ] |
       
   356 | TODO: | move into RcsFile and add indirection in Store |
       
   357 
       
   358 =cut
       
   359 
       
   360 sub parseRevisionDiff {
       
   361     my( $text ) = @_;
       
   362 
       
   363     my ( $diffFormat ) = 'normal'; #or rcs, unified...
       
   364     my ( @diffArray ) = ();
       
   365 
       
   366     $diffFormat = 'unified' if ( $text =~ /^---/s );
       
   367 
       
   368     $text =~ s/\r//go;  # cut CR
       
   369 
       
   370     my $lineNumber=1;
       
   371     if ( $diffFormat eq 'unified' ) {
       
   372         foreach( split( /\r?\n/, $text ) ) {
       
   373             if ( $lineNumber > 2 ) {   #skip the first 2 lines (filenames)
       
   374                 if ( /@@ [-+]([0-9]+)([,0-9]+)? [-+]([0-9]+)(,[0-9]+)? @@/ ) {
       
   375 	    	        #line number
       
   376                     push @diffArray, ['l', $1, $3];
       
   377                 } elsif( /^\-(.*)$/ ) {
       
   378                     push @diffArray, ['-', $1, ''];
       
   379                 } elsif( /^\+(.*)$/ ) {
       
   380                     push @diffArray, ['+', '', $1];
       
   381                 } else {
       
   382                     s/^ (.*)$/$1/go;
       
   383                     push @diffArray, ['u', $_, $_];
       
   384                 }
       
   385             }
       
   386             $lineNumber++;
       
   387         }
       
   388     } else {
       
   389         #'normal' rcsdiff output
       
   390         foreach( split( /\r?\n/, $text ) ) {
       
   391     	    if ( /^([0-9]+)[0-9\,]*([acd])([0-9]+)/ ) {
       
   392     	        #line number
       
   393                 push @diffArray, ['l', $1, $3];
       
   394             } elsif( /^< (.*)$/ ) {
       
   395 	            push @diffArray, ['-', $1, ''];
       
   396             } elsif( /^> (.*)$/ ) {
       
   397 	            push @diffArray, ['+', '', $1];
       
   398             } else {
       
   399                 #push @diffArray, ['u', '', ''];
       
   400             }
       
   401         }
       
   402     }
       
   403     return \@diffArray;
       
   404 }
       
   405 
       
   406 sub _ci {
       
   407     my( $this, $comment, $user, $date ) = @_;
       
   408 
       
   409     $comment = 'none' unless $comment;
       
   410 
       
   411     my( $cmd, $rcsOutput, $exit );
       
   412     if( defined( $date )) {
       
   413         require TWiki::Time;
       
   414         $date = TWiki::Time::formatTime( $date , '$rcs', 'gmtime');
       
   415         $cmd = $TWiki::cfg{RCS}{ciDateCmd};
       
   416         ($rcsOutput, $exit)= $TWiki::sandbox->sysCommand(
       
   417             $cmd,
       
   418             USERNAME => $user,
       
   419             FILENAME => $this->{file},
       
   420             COMMENT => $comment,
       
   421             DATE => $date );
       
   422     } else {
       
   423         $cmd = $TWiki::cfg{RCS}{ciCmd};
       
   424         ($rcsOutput, $exit)= $TWiki::sandbox->sysCommand(
       
   425             $cmd,
       
   426             USERNAME => $user,
       
   427             FILENAME => $this->{file},
       
   428             COMMENT => $comment );
       
   429     }
       
   430     $rcsOutput ||= '';
       
   431 
       
   432     if( $exit ) {
       
   433         throw Error::Simple($cmd.' of '.$this->hidePath($this->{file}).
       
   434                               ' failed: '.$exit.' '.$rcsOutput );
       
   435     }
       
   436 
       
   437     chmod( $TWiki::cfg{RCS}{filePermission}, $this->{file} );
       
   438 }
       
   439 
       
   440 sub _lock {
       
   441     my $this = shift;
       
   442 
       
   443     return unless -e $this->{rcsFile};
       
   444 
       
   445     # Try and get a lock on the file
       
   446     my ($rcsOutput, $exit) = $TWiki::sandbox->sysCommand(
       
   447         $TWiki::cfg{RCS}{lockCmd}, FILENAME => $this->{file} );
       
   448 
       
   449     if( $exit ) {
       
   450         # if the lock has been set more than 24h ago, let's try to break it
       
   451         # and then retry.  Should not happen unless in Cairo upgrade
       
   452         # scenarios - see Item2102
       
   453         if ((time - (stat($this->{rcsFile}))[9]) > 3600) {
       
   454             warn 'Automatic recovery: breaking lock for ' . $this->{file} ;
       
   455             $TWiki::sandbox->sysCommand(
       
   456                 $TWiki::cfg{RCS}{breaklockCmd}, FILENAME => $this->{file} );
       
   457         ($rcsOutput, $exit) = $TWiki::sandbox->sysCommand(
       
   458                 $TWiki::cfg{RCS}{lockCmd}, FILENAME => $this->{file} );
       
   459         }
       
   460        if ( $exit ) {
       
   461            # still no luck - bailing out
       
   462            $rcsOutput ||= '';
       
   463            throw Error::Simple( 'RCS: '.$TWiki::cfg{RCS}{lockCmd}.
       
   464                                 ' failed: '.$rcsOutput );
       
   465        }
       
   466     }
       
   467     chmod( $TWiki::cfg{RCS}{filePermission}, $this->{file} );
       
   468 }
       
   469 
       
   470 # implements RcsFile
       
   471 sub getRevisionAtTime {
       
   472     my( $this, $date ) = @_;
       
   473 
       
   474     if ( !-e $this->{rcsFile} ) {
       
   475         return undef;
       
   476     }
       
   477     require TWiki::Time;
       
   478 	$date = TWiki::Time::formatTime( $date , '$rcs', 'gmtime');
       
   479     my ($rcsOutput, $exit) = $TWiki::sandbox->sysCommand(
       
   480         $TWiki::cfg{RCS}{rlogDateCmd},
       
   481         DATE => $date,
       
   482         FILENAME => $this->{file} );
       
   483 
       
   484     if ( $rcsOutput =~ m/revision \d+\.(\d+)/ ) {
       
   485         return $1;
       
   486     }
       
   487     return 1;
       
   488 }
       
   489 
       
   490 1;