(file) Return to RcsWrap.pm CVS log (file) (dir) Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki / Store

  1 rizwank 1.1 # Module of TWiki Collaboration Platform, http://TWiki.org/
  2             #
  3             # Copyright (C) 1999-2003 Peter Thoeny, peter@thoeny.com
  4             # Copyright (C) 2002 John Talintyre, john.talintyre@btinternet.com
  5             #
  6             # For licensing info read license.txt file in the TWiki root.
  7             # This program is free software; you can redistribute it and/or
  8             # modify it under the terms of the GNU General Public License
  9             # as published by the Free Software Foundation; either version 2
 10             # of the License, or (at your option) any later version.
 11             #
 12             # This program is distributed in the hope that it will be useful,
 13             # but WITHOUT ANY WARRANTY; without even the implied warranty of
 14             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 15             # GNU General Public License for more details, published at 
 16             # http://www.gnu.org/copyleft/gpl.html
 17             #
 18             #
 19             # Wrapper around the RCS commands required by TWiki
 20             
 21             =begin twiki
 22 rizwank 1.1 
 23             ---+ TWiki::Store::RcsWrap Module
 24             
 25             This module calls rcs
 26             
 27             =cut
 28             
 29             package TWiki::Store::RcsWrap;
 30             
 31             use File::Copy;
 32             use TWiki::Store::RcsFile;
 33             @ISA = qw(TWiki::Store::RcsFile);
 34             
 35             use strict;
 36             
 37             ## Details of settings
 38             #
 39             # attachAsciiPath         Defines which attachments will be treated as ASCII in RCS
 40             # initBinaryCmd           RCS init command, needed when initialising a file as binary
 41             # ciCmd                   RCS check in command
 42             # coCmd                   RCS check out command
 43 rizwank 1.1 # histCmd                 RCS history command
 44             # infoCmd                 RCS history on revision command
 45             # diffCmd                 RCS revision diff command
 46             # breakLockCmd            RCS for breaking a lock
 47             # ciDateCmd               RCS check in command with date
 48             # delRevCmd               RCS delete revision command
 49             # unlockCmd               RCS unlock command
 50             # lockCmd                 RCS lock command
 51             # tagCmd                  RCS tag command
 52             #
 53             # (from RcsFile)
 54             # dataDir
 55             # pubDir
 56             # attachAsciiPath         Defines which attachments will be automatically treated as ASCII in RCS
 57             # dirPermission           File security for new directories
 58             
 59             # ======================
 60             =pod
 61             
 62             ---++ sub new (  $proto, $web, $topic, $attachment, %settings  )
 63             
 64 rizwank 1.1 Not yet documented.
 65             
 66             =cut to implementation
 67             
 68             sub new
 69             {
 70                my( $proto, $web, $topic, $attachment, %settings ) = @_;
 71                my $class = ref($proto) || $proto;
 72                my $self = TWiki::Store::RcsFile->new( $web, $topic, $attachment, %settings );
 73                bless( $self, $class );
 74                $self->_settings( %settings );
 75                $self->_init();
 76                return $self;
 77             }
 78             
 79             # ======================
 80             =pod
 81             
 82             ---++ sub _settings (  $self, %settings  )
 83             
 84             Not yet documented.
 85 rizwank 1.1 
 86             =cut to implementation
 87             
 88             sub _settings
 89             {
 90                 my( $self, %settings ) = @_;
 91                 $self->{initBinaryCmd} = $settings{initBinaryCmd};
 92                 $self->{tmpBinaryCmd}  = $settings{tmpBinaryCmd};
 93                 $self->{ciCmd}        = $settings{ciCmd};
 94                 $self->{coCmd}        = $settings{coCmd};
 95                 $self->{histCmd}      = $settings{histCmd};
 96                 $self->{infoCmd}      = $settings{infoCmd};
 97                 $self->{diffCmd}      = $settings{diffCmd};
 98                 $self->{breakLockCmd} = $settings{breakLockCmd};
 99                 $self->{ciDateCmd}    = $settings{ciDateCmd};
100                 $self->{delRevCmd}    = $settings{delRevCmd};
101                 $self->{unlockCmd}    = $settings{unlockCmd};
102                 $self->{lockCmd}      = $settings{lockCmd};
103                 $self->{tagCmd}      = $settings{tagCmd};
104             }
105             
106 rizwank 1.1 #TODO set from TWiki.cfg
107             my $cmdQuote = "'";
108             
109             # ======================
110             =pod
111             
112             ---++ sub _trace ()
113             
114             Not yet documented.
115             
116             =cut to implementation
117             
118             sub _trace
119             {
120                #my( $text ) = @_;
121                #print $text;
122             }
123             
124             # ======================
125             =pod
126             
127 rizwank 1.1 ---++ sub _traceExec ()
128             
129             Not yet documented.
130             
131             =cut to implementation
132             
133             sub _traceExec
134             {
135                #my( $cmd, $string, $exit ) = @_;
136                #if( $exit ) {
137                #    $exit = " Error: $exit";
138                #} else {
139                #    $exit = "";
140                #}
141                #TWiki::writeDebug( "Rcs: $cmd($exit): $string\n" );
142             }
143             
144             
145             # ======================
146             # Returns false if okay, otherwise an error string
147             =pod
148 rizwank 1.1 
149             ---++ sub _binaryChange (  $self  )
150             
151             Not yet documented.
152             
153             =cut to implementation
154             
155             sub _binaryChange
156             {
157                 my( $self ) = @_;
158                 if( $self->getBinary() ) {
159                     # Can only do something when changing to binary
160                     my $cmd = $self->{"initBinaryCmd"};
161                     my $file = $self->file();
162                     $cmd =~ s/%FILENAME%/$cmdQuote$file$cmdQuote/go;
163                     $cmd =~ /(.*)/;
164                     $cmd = "$1";       # safe, so untaint variable
165                     my $rcsOutput = `$cmd`;
166                     my $exit = $? >> 8;
167                     _traceExec( $cmd, $rcsOutput, $exit );
168                     if( $exit && $rcsOutput ) {
169 rizwank 1.1            $rcsOutput = "$cmd\n$rcsOutput";
170                        return $rcsOutput;
171                     }
172             
173                     # Sometimes (on Windows?) rcs file not formed, so check for it
174                     if( ! -e $file ) {
175                        return "$cmd\nFailed to create history file $file";
176                     }
177                 }
178                 return "";
179             }
180             
181             # ======================
182             =pod
183             
184             ---++ sub addRevision (  $self, $text, $comment, $userName  )
185             
186             Not yet documented.
187             
188             =cut to implementation
189             
190 rizwank 1.1 sub addRevision
191             {
192                 my( $self, $text, $comment, $userName ) = @_;
193                 
194                 # Replace file (if exists) with text
195                 $self->_save( $self->file(), \$text );
196                 return $self->_ci( $self->file(), $comment, $userName );
197             }
198             
199             # ======================
200             =pod
201             
202             ---++ sub replaceRevision (  $self, $text, $comment, $user, $date  )
203             
204             Not yet documented.
205             # Replace the top revision
206             # Return non empty string with error message if there is a problem
207             | $date | is on epoch seconds |
208             
209             =cut to implementation
210             
211 rizwank 1.1 sub replaceRevision
212             {
213                 my( $self, $text, $comment, $user, $date ) = @_;
214                 
215                 my $rev = $self->numRevisions();
216                 my $file    = $self->{file};
217                 my $rcsFile = $self->{rcsFile};
218                 my $cmd;
219                 my $rcsOut;
220                 
221                 # update repository with same userName and date
222                 if( $rev == 1 ) {
223                     # initial revision, so delete repository file and start again
224                     unlink $rcsFile;
225                 } else {
226                     $self->_deleteRevision( $rev );
227                 }
228                 $self->_saveFile( $self->file(), $text );
229                 $cmd = $self->{ciDateCmd};
230             	$date = TWiki::formatTime( $date , "\$rcs", "gmtime");
231                 $cmd =~ s/%DATE%/$date/;
232 rizwank 1.1     $cmd =~ s/%USERNAME%/$user/;
233                 $file =~ s/$TWiki::securityFilter//go;
234                 $rcsFile =~ s/$TWiki::securityFilter//go;
235                 $cmd =~ s/%FILENAME%/$cmdQuote$file$cmdQuote $cmdQuote$rcsFile$cmdQuote/;
236                 $cmd =~ /(.*)/;
237                 $cmd = $1;       # safe, so untaint variable
238                 $rcsOut = `$cmd`;
239                 my $exit = $? >> 8;
240                 _traceExec( $cmd, $rcsOut, $exit );
241                 #$rcsOut =~ s/^Warning\: missing newline.*//os; # forget warning
242                 if( $exit ) {
243                     $rcsOut = "$cmd\n$rcsOut";
244                     return $rcsOut;
245                 }
246                 return "";
247             }
248             
249             # ======================
250             # Return with empty string if only one revision
251             =pod
252             
253 rizwank 1.1 ---++ sub deleteRevision (  $self  )
254             
255             Not yet documented.
256             
257             =cut to implementation
258             
259             sub deleteRevision
260             {
261                 my( $self ) = @_;
262                 my $rev = $self->numRevisions();
263                 return "" if( $rev == 1 );
264                 return $self->_deleteRevision( $rev );
265             }
266             
267             # ======================
268             =pod
269             
270             ---++ sub _deleteRevision (  $self, $rev  )
271             
272             Not yet documented.
273             
274 rizwank 1.1 =cut to implementation
275             
276             sub _deleteRevision
277             {
278                 my( $self, $rev ) = @_;
279                 
280                 # delete latest revision (unlock, delete revision, lock)
281                 my $file    = $self->{file};
282                 my $rcsFile = $self->{rcsFile};
283                 my $cmd= $self->{unlockCmd};
284                 $cmd =~ s/%FILENAME%/$cmdQuote$file$cmdQuote $cmdQuote$rcsFile$cmdQuote/go;
285                 $cmd =~ /(.*)/;
286                 $cmd = $1;       # safe, so untaint
287                 my $rcsOut = `$cmd`; # capture stderr
288                 my $exit = $? >> 8;
289                 _traceExec( $cmd, $rcsOut, $exit );
290                 #$rcsOut =~ s/^Warning\: missing newline.*//os; # forget warning
291                 if( $exit ) {
292                     $rcsOut = "$cmd\n$rcsOut";
293                     return $rcsOut;
294                 }
295 rizwank 1.1     $cmd= $self->{delRevCmd};
296                 $cmd =~ s/%REVISION%/1.$rev/go;
297                 $cmd =~ s/%FILENAME%/$cmdQuote$file$cmdQuote $cmdQuote$rcsFile$cmdQuote/go;
298                 $cmd =~ /(.*)/;
299                 $cmd = $1;       # safe, so untaint variable
300                 $rcsOut = `$cmd`;
301                 $exit = $? >> 8;
302                 _traceExec( $cmd, $rcsOut, $exit );
303                 #$rcsOut =~ s/^Warning\: missing newline.*//os; # forget warning
304                 if( $exit ) {
305                     $rcsOut = "$cmd\n$rcsOut";
306                     return $rcsOut;
307                 }
308                 $cmd= $self->{lockCmd};
309                 $cmd =~ s/%REVISION%/$rev/go;
310                 $cmd =~ s/%FILENAME%/$cmdQuote$file$cmdQuote $cmdQuote$rcsFile$cmdQuote/go;
311                 $cmd =~ /(.*)/;
312                 $cmd = $1;       # safe, so untaint variable
313                 $rcsOut = `$cmd`;
314                 _traceExec( $cmd, $rcsOut, $exit );
315                 #$rcsOut =~ s/^Warning\: missing newline.*//os; # forget warning
316 rizwank 1.1     if( $exit ) {
317                     $rcsOut = "$cmd\n$rcsOut";
318                     return $rcsOut;
319                 }
320             }
321             
322             # ======================
323             =pod
324             
325             ---++ sub getRevision (  $self, $version  )
326             
327             Not yet documented.
328             
329             =cut to implementation
330             
331             sub getRevision
332             {
333                 my( $self, $version ) = @_;
334             
335                 my $tmpfile = "";
336                 my $tmpRevFile = "";
337 rizwank 1.1     my $cmd = $self->{"coCmd"};
338                 my $file = $self->file();
339                 if( $TWiki::OS eq "WINDOWS" ) {
340                     # Need to take temporary copy of topic, check it out to file, then read that
341                     # Need to put RCS into binary mode to avoid extra \r appearing and
342                     # read from binmode file rather than stdout to avoid early file read termination
343                     $tmpfile = $self->_mkTmpFilename();
344                     $tmpRevFile = "$tmpfile,v";
345                     copy( $self->rcsFile(), $tmpRevFile );
346                     my $cmd1 = $self->{tmpBinaryCmd};
347                     $cmd1 =~ s/%FILENAME%/$cmdQuote$tmpRevFile$cmdQuote/;
348                     $cmd1 =~ /(.*)/;
349                     $cmd1 = "$1";
350                     my $tmp = `$cmd1`;
351                     _traceExec( $cmd1, $tmp );
352                     $file = $tmpfile;
353                     $cmd =~ s/-p%REVISION%/-r%REVISION%/;
354                 }    
355                 $cmd =~ s/%REVISION%/1.$version/;
356                 $cmd =~ s/%FILENAME%/$cmdQuote$file$cmdQuote/;
357                 $cmd =~ /(.*)/;
358 rizwank 1.1     $cmd = "$1"; # untaint
359                 my $text = `$cmd`;
360                 if( $tmpfile ) {
361                     $text = $self->_readFile( $tmpfile );
362                     $tmpfile =~ /(.*)/;
363                     $tmpfile = "$1"; # untaint		
364                     unlink $tmpfile;
365                     $tmpRevFile =~ /(.*)/;
366                     $tmpRevFile = "$1"; # untaint		
367                     unlink $tmpRevFile;
368                 }
369                 _traceExec( $cmd, $text );
370                 return $text;
371             }
372             
373             # ======================
374             =pod
375             
376             ---++ sub numRevisions (  $self  )
377             
378             Not yet documented.
379 rizwank 1.1 
380             =cut to implementation
381             
382             sub numRevisions
383             {
384                 my( $self ) = @_;
385                 my $cmd= $self->{"histCmd"};
386                 my $rcsFile = $self->rcsFile();
387                 if( ! -e $rcsFile ) {
388                    return "";
389                 }
390             
391                 $cmd =~ s/%FILENAME%/$cmdQuote$rcsFile$cmdQuote/;
392                 $cmd =~ /(.*)/;
393                 $cmd = $1;       # now safe, so untaint variable
394                 my $rcsOutput = `$cmd`;
395                 _traceExec( $cmd, $rcsOutput );
396                 if( $rcsOutput =~ /head:\s+\d+\.(\d+)\n/ ) {
397                     return $1;
398                 } else {
399                     return ""; # Note this hides possible errors
400 rizwank 1.1     }
401             }
402             
403             # ======================
404             =pod
405             
406             ---++ sub getRevisionInfo (  $self, $version  )
407             
408             | FIXME | there is an inconguity here. if you ask for a revisino that does not exist, getRevisionInfo gives you 1.1, but readTopic gives you the last version |
409             Not yet documented.
410             # Date return in epoch seconds
411             # If revision file is missing, information based on actual file is returned.
412             
413             =cut to implementation
414             
415             sub getRevisionInfo
416             {
417                 my( $self, $version ) = @_;
418                 
419                 if( ! $version ) {
420                     # PTh 03 Nov 2000: comment out for performance
421 rizwank 1.1         ### $theRev = getRevisionNumber( $theTopic, $theWebName );
422                     $version = "";  # do a "rlog -r filename" to get top revision info
423                 } else {
424             		if ( $version =~ /^\d/ ) 
425             		{
426             			#if we are asking for a minor nmber, re-constitue it to Major.minor
427             			$version = "1.$version";
428             		}
429                 }
430                 
431                 my $rcsFile = $self->{rcsFile};
432                 my $rcsError = "";
433                 my( $dummy, $rev, $date, $user, $comment );
434                 if ( -e $rcsFile ) {
435                    my $cmd= $self->{infoCmd};
436                    $cmd =~ s/%REVISION%/$version/;
437                    $cmd =~ s/%FILENAME%/$cmdQuote$rcsFile$cmdQuote/;
438                    $cmd =~ /(.*)/; $cmd = $1;       # Untaint
439                    my $rcsOut = `$cmd`;
440                    my $exit = $? >> 8;
441                    _traceExec( $cmd, $cmd, $exit );
442 rizwank 1.1        $rcsError = "Error with $cmd, output: $rcsOut" if( $exit );
443                    if( ! $rcsError ) {
444                         $rcsOut =~ /date: (.*?);  author: (.*?);.*\n(.*)\n/;
445                         $date = $1 || "";
446                         $user = $2 || "";
447                         $comment = $3 || "";
448                         $date = TWiki::Store::RcsFile::_rcsDateTimeToEpoch( $date );
449                         $rcsOut =~ /revision 1.([0-9]*)/;
450                         $rev = $1 || "";
451                         $rcsError = "Rev missing from revision file $rcsFile" if( ! $rev );
452                    }
453                 } else {
454                    $rcsError = "Revision file $rcsFile is missing";
455                 }
456                 
457                 ( $dummy, $rev, $date, $user, $comment ) = $self->_getRevisionInfoDefault() if( $rcsError );
458                 
459                 return( $rcsError, $rev, $date, $user, $comment );
460             }
461             
462             # ======================
463 rizwank 1.1 # rev2 newer than rev1
464             =pod
465             
466             ---++ sub revisionDiff (  $self, $rev1, $rev2, $contextLines  )
467             
468             Not yet documented.
469             | Return: =\@diffArray= | reference to an array of [ diffType, $right, $left ] |
470             
471             =cut to implementation
472             
473             sub revisionDiff
474             {
475                 my( $self, $rev1, $rev2, $contextLines ) = @_;
476                 
477                 my $error = "";
478             
479                 my $tmp= "";
480                 if ( $rev1 eq "1" && $rev2 eq "1" ) {
481                     my $text = $self->getRevision(1);
482                     $tmp = "1a1\n";
483                     foreach( split( /\n/, $text ) ) {
484 rizwank 1.1            $tmp = "$tmp> $_\n";
485                     }
486                 } else {
487                     $tmp= $self->{"diffCmd"};
488                     $tmp =~ s/%REVISION1%/1.$rev1/;
489                     $tmp =~ s/%REVISION2%/1.$rev2/;
490                     my $rcsFile = $self->rcsFile();
491                     $rcsFile =~ s/$TWiki::securityFilter//go;
492                     $tmp =~ s/%FILENAME%/$cmdQuote$rcsFile$cmdQuote/;
493                     $tmp =~ s/%CONTEXT%/$contextLines/;
494                     $tmp =~ /(.*)/;
495                     my $cmd = $1;       # now safe, so untaint variable
496                     $tmp = `$cmd`;
497                     my $exit = $? >> 8;
498                     $error = "Error $exit when runing $cmd";
499                     _traceExec( $cmd, $tmp, $exit );       
500                     _trace( "and now $tmp" );
501                     # Avoid showing change in revision number!
502                     # I'm not too happy with this implementation, I think it may be better to filter before sending to diff command,
503                     # possibly using Algorithm::Diff from CPAN.
504             #removed as it causes erronious changes - and it _has_ to be done in Store.pm so it works for rsclite too
505 rizwank 1.1 #        $tmp =~ s/[0-9]+c[0-9]+\n[<>]\s*%META:TOPICINFO{[^}]*}%\s*\n---\n[+-<>]\s*%META:TOPICINFO{[^}]*}%\s*n//go;
506             #        $tmp =~ s/[+-<>]\s*%META:TOPICINFO{[^}]*}%\s*//go;
507                 }
508             	
509                 return ($error, parseRevisionDiff( $tmp ) );
510             }
511             
512             # =========================
513             =pod
514             
515             ---+++ parseRevisionDiff( $text ) ==> \@diffArray
516             
517             | Description: | parse the text into an array of diff cells |
518             | #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) |
519             | Parameter: =$text= | currently unified or rcsdiff format |
520             | Return: =\@diffArray= | reference to an array of [ diffType, $right, $left ] |
521             | TODO: | move into RcsFile and add indirection in Store |
522             
523             =cut
524             # -------------------------
525             sub parseRevisionDiff
526 rizwank 1.1 {
527                 my( $text ) = @_;
528             
529                 my ( $diffFormat ) = "normal"; #or rcs, unified...
530                 my ( @diffArray );
531             
532                 $diffFormat = "unified" if ( $text =~ /^---/ );
533             
534                 $text =~ s/\r//go;  # cut CR
535             
536                 my $lineNumber=1;
537                 if ( $diffFormat eq "unified" ) {
538                     foreach( split( /\n/, $text ) ) {
539             	    if ( $lineNumber > 3 ) {   #skip the first 2 lines (filenames)
540              	   	    if ( /@@ [-+]([0-9]+)([,0-9]+)? [-+]([0-9]+)(,[0-9]+)? @@/ ) {
541             	    	        #line number
542             		        push @diffArray, ["l", $1, $3];
543             		    } elsif ( /^\-/ ) {
544             		        s/^\-//go;
545             		        push @diffArray, ["-", $_, ""];
546             		    } elsif ( /^\+/ ) {
547 rizwank 1.1 		        s/^\+//go;
548             		        push @diffArray, ["+", "", $_];
549             		    } else {
550             	  		s/^ (.*)$/$1/go;
551             			push @diffArray, ["u", $_, $_];
552             		    }
553             	    }
554             	    $lineNumber = $lineNumber + 1;
555                    	 }
556                 } else {
557                     #"normal" rcsdiff output 
558                     foreach( split( /\n/, $text ) ) {
559                 	    if ( /^([0-9]+)[0-9\,]*([acd])([0-9]+)/ ) {
560                 	        #line number
561             	        push @diffArray, ["l", $1, $3];
562             	    } elsif ( /^</ ) {
563             	        s/^< //go;
564             	            push @diffArray, ["-", $_, ""];
565             	    } elsif ( /^>/ ) {
566             	        s/^> //go;
567             	            push @diffArray, ["+", "", $_];
568 rizwank 1.1 	    } else {
569             	        #empty lines and the --- selerator in the diff
570             	        #push @diffArray, ["u", "$_", $_];
571             	    }
572                     }
573                 }
574                 return \@diffArray;
575             }
576             
577             # ======================
578             =pod
579             
580             ---++ sub _ci (  $self, $file, $comment, $userName  )
581             
582             Not yet documented.
583             
584             =cut to implementation
585             
586             sub _ci
587             {
588                 my( $self, $file, $comment, $userName ) = @_;
589 rizwank 1.1 
590                 # Check that we can write the file being checked in. This won't check that
591                 # $file,v is writable, but it _will_ trap 99% of all common errors (permissions
592                 # on directory tree)
593                 return "$file is not writable" unless ( -w $file );
594             
595                 my $cmd = $self->{"ciCmd"};
596                 my $rcsOutput = "";
597                 $cmd =~ s/%USERNAME%/$userName/;
598                 $file =~ s/$TWiki::securityFilter//go;
599                 $cmd =~ s/%FILENAME%/$cmdQuote$file$cmdQuote/;
600                 $comment = "none" unless( $comment );
601                 $comment =~ s/[\"\'\`\;]//go;  # security, Codev.NoShellCharacterEscapingInFileAttachComment, MikeSmith
602                 $cmd =~ s/%COMMENT%/$comment/;
603                 $cmd =~ /(.*)/;
604                 $cmd = $1;       # safe, so untaint variable
605                 $rcsOutput = `$cmd`; # capture stderr  (S.Knutson)
606                 my $exit = $? >> 8;
607                 _traceExec( $cmd, $rcsOutput );
608                 if( $exit && $rcsOutput =~ /no lock set by/ ) {
609                       # Try and break lock, setting new one and doing ci again
610 rizwank 1.1           my $cmd = $self->{"breakLockCmd"};
611                       $cmd =~ s/%FILENAME%/$cmdQuote$file$cmdQuote/go;
612                       $cmd =~ /(.*)/;
613                       my $out = `$cmd`;
614                       _traceExec( $cmd, $out );
615                       # Assume it worked, as not sure how to trap failure
616                       $rcsOutput = `$cmd`; # capture stderr  (S.Knutson)
617                       $exit = $? >> 8;
618                       _traceExec( $cmd, $rcsOutput );
619                       if( ! $exit ) {
620                           $rcsOutput = "";
621                       }
622                 }
623                 if( $exit && $rcsOutput ) { # oops, stderr was not empty, return error
624                     $rcsOutput = "$cmd\n$rcsOutput";
625                 }
626                 return $rcsOutput;
627             }
628             
629             =pod
630             
631 rizwank 1.1 ---+++ setTopicRevisionTag( $web, $topic, $rev, $tag ) ==> $success
632             
633             | Description: | sets a names tag on the specified revision |
634             | Parameter: =$web= | webname |
635             | Parameter: =$topic= | topic name |
636             | Parameter: =$rev= | the revision we are taging |
637             | Parameter: =$tag= | the string to tag with |
638             | Return: =$success= |  |
639             | TODO: | we _need_ an error mechanism! |
640             | TODO: | NEED to check if the version exists (rcs does not) |
641             | Since: | TWiki:: (20 April 2004) |
642             
643             =cut
644             
645             sub setTopicRevisionTag
646             {
647             	my ( $self,  $web, $topic, $rev, $tag ) = @_;
648             
649                 my $file = $self->{file};
650                 if ( -e $file ) {
651                    my $cmd= $self->{tagCmd};
652 rizwank 1.1        $cmd =~ s/%REVISION%/$rev/;
653                    $cmd =~ s/%FILENAME%/$cmdQuote$file$cmdQuote/;
654                    $cmd =~ s/%TAG%/$tag/;
655             	   $cmd = $cmd."  2>> $TWiki::warningFilename";
656                    $cmd =~ /(.*)/; $cmd = $1;       # Untaint
657                    my $rcsOut = `$cmd`;
658                    my $exit = $? >> 8;
659                    _traceExec( $cmd, $cmd, $exit );
660             		if( $exit && $rcsOut ) { # oops, stderr was not empty, return error
661             			$rcsOut = "$cmd\n$$rcsOut";
662             			TWiki:writeDebug("RCSWrap::setTopicRevisionTag error - $rcsOut");
663             			return;
664             		}
665                }
666             	   
667             	return 1;#success 
668             }
669             
670             1;

Rizwan Kassim
Powered by
ViewCVS 0.9.2