1 rizwank 1.1 # Support functionality for the TWiki Collaboration Platform, http://TWiki.org/
2 #
3 #
4 # Jul 2004 - copied almost completely from Sven's updateTopics.pl script:
5 # put in a package and made a subroutine to work with UpgradeTWiki
6 # by Martin "GreenAsJade" Gregory.
7
8 # This version ignores symlinks in the existing wiki data: it creates a new
9 # wiki data tree updating the topics in the existing wiki data, even the
10 # linked-in topics, but does not create new links like the old ones.
11
12 package UpdateTopics;
13
14 use strict;
15
16 use File::Find;
17 use File::Copy;
18 use File::Basename;
19 use Text::Diff;
20
21 # Try to upgrade an installation's TWikiTopics using the rcs info in it.
22 rizwank 1.1
23 use vars qw($CurrentDataDir $NewReleaseDataDir $DestinationDataDir $BaseDir $debug @DefaultWebTopics %LinkedDirPathsInWiki $RcsLogFile $TempDir);
24
25 sub UpdateTopics
26 {
27 $CurrentDataDir = shift or die "UpdateTopics not provided with existing data directory!\n";
28
29 $NewReleaseDataDir = shift or die "UpdateTopics not provided with new data directory!\n";
30
31 $DestinationDataDir = (shift or "$BaseDir/newData");
32
33 my $whoCares = `which rcsdiff`; # we should use File::Which to do this, except that would mean
34 # getting yet another .pm into lib, which seems like hard work?
35 ($? >> 8 == 0) or die "Uh-oh - couldn't see an rcs executable on your path! I really need one of those!\n";
36
37 $whoCares = `which patch`;
38
39 ($? >> 8 == 0) or die "Uh-oh - couldn't see a patch executable on your path! I really need one of those!\n";
40
41 $BaseDir = `pwd`;
42 chomp ($BaseDir);
43 rizwank 1.1
44 $TempDir = "$BaseDir/tmp";
45
46 while (-d $TempDir ) { $TempDir .= 'p' } # we want our own previously non-existing directory!
47
48 mkdir $TempDir or die "Uhoh - couldn't make a temporary directory called $TempDir: $!\n";
49
50 #Set if you want to see the debug output
51 #$debug = "yes";
52
53 if ($debug) {print "$CurrentDataDir, $NewReleaseDataDir\n"; }
54
55 if ((! -d $CurrentDataDir ) || (! -d $NewReleaseDataDir)) {
56 print "\nUsage: UpdateTopics <CurrentDataDir> <NewReleaseDataDir> [<DestinationDataDir]>\n";
57 exit;
58 }
59
60 print "\n";
61 print "\t...new upgraded data will be put in $DestinationDataDir\n";
62 print "\t there will be no changes made to either the source data directory or $NewReleaseDataDir.\n\n";
63 print "\t This progam will attempt to use the rcs versioning information to upgrade the\n";
64 rizwank 1.1 print "\t contents of your distributed topics in $CurrentDataDir to the content in $NewReleaseDataDir.\n\n";
65 print "Output:\n";
66 print "\tFor each file that has no versioning information in your existing twiki a _v_ will be printed\n";
67 print "\tFor each file that has no changes from the previous release a _c_ will be printed\n";
68 print "\tFor each file that has no changes made in your existing release, a _u_ will be printed\n";
69 print "\tFor each file where no commonality could be found, your existing one is used, and a _C_ will be printed\n";
70 print "\tFor each file that has changes and a patch is generated a _p_ will be printed\n";
71 print "\tFor each file that is new in the NewReleaseDataDir a _+_ will be printed\n";
72 print "\t When the script has attempted to patch the $NewReleaseDataDir,
73 \t *.rej files will contain the failed merges\n";
74 print "\t although many of these rejected chages will be discardable,
75 \t please check them to see if your configuration is still ok\n\n";
76
77 sussoutDefaultWebTopics();
78
79 mkdir $DestinationDataDir;
80
81 #redirect stderr into a file (rcs dumps out heaps of info)
82
83 $RcsLogFile = $BaseDir."/rcs.log";
84
85 rizwank 1.1 unlink($RcsLogFile); # let's have just the messages from this session!
86
87 open(PATCH, "> $DestinationDataDir/patchTopics");
88
89 print "\n\n ...checking existing files from $CurrentDataDir\n";
90 #TODO: need to find a way to detect non-Web directories so we don't make a mess of them..
91 # (should i just ignore Dirs without any ,v files?) - i can't upgrade tehm anyway..
92 #upgrade templates..?
93
94 my %findOptions;
95
96 $findOptions{'wanted'} = \&getRLog;
97 $findOptions{'follow_fast'} = 1; # surely the user hasn't put loops of links etc in their data!?
98
99 find(\%findOptions, $CurrentDataDir);
100
101 close(PATCH);
102
103 #do a find through $NewReleaseDataDir and copy all missing files & dirs
104 print "\n\n ... checking for new files in $NewReleaseDataDir";
105 find(\©NewTopics, $NewReleaseDataDir);
106 rizwank 1.1
107 #run `patch patchTopics` in $DestinationDataDir
108 print "\nPatching topics (manually check the rejected patch (.rej) files)";
109 chdir($DestinationDataDir);
110 `patch -p0 < patchTopics > patch.log`;
111 #TODO: examing the .rej files to remove the ones that have already been applied
112 find(\&listRejects, ".");
113 #TODO: run `ci` in $DestinationDataDir
114
115 print "\n\n";
116
117 rmdir($TempDir);
118 chdir($BaseDir); # seems the kind thing to do :-)
119 }
120
121 # ============================================
122 sub listRejects
123 {
124 my ( $filename ) = @_;
125
126 $filename = $File::Find::name;
127 rizwank 1.1
128 if ($filename =~ /.rej$/ ) {
129 print "\nPatch rejected: $filename";
130 }
131 }
132
133 # ============================================
134 sub copyNewTopics
135 {
136 my ( $filename ) = $File::Find::name;
137
138 my $destinationFilename = $filename;
139 $destinationFilename =~ s/$NewReleaseDataDir/$DestinationDataDir/g;
140
141 # Sven had these commeted out, so I've left them here commented out.
142 # return if $filename =~ /,v$/;
143 # return if $filename =~ /.lock$/;
144 # return if $filename =~ /~$/;
145
146 if ( -d $filename) {
147 print "\nprocessing directory $filename";
148 rizwank 1.1 if ( !-d $destinationFilename ) {
149 print " (creating $destinationFilename)";
150 mkdir($destinationFilename);
151 }
152 print "\n";
153 return;
154 }
155
156 if (! -e $destinationFilename ) {
157 print "\nadding $filename (new in this release)" if ($debug);
158 print "+" if (!$debug);
159 copy( $filename, $destinationFilename);
160 }
161
162 }
163
164 # ============================================
165 sub getRLog
166 {
167 my ( $filename ) = $File::Find::name;
168
169 rizwank 1.1 # (see above)
170 # my ( $filename ) = @_;
171 # $filename = $BaseDir."/".$File::Find::name if (! $filename );
172
173 my ( $newFilename ) = $filename;
174 if (!$filename =~ /^$CurrentDataDir/)
175 {
176 die "getRLog found $filename that appears not to be in $CurrentDataDir tree! That's not supposed to happen: sorry!\n";
177 }
178
179 $newFilename =~ s/$CurrentDataDir/$NewReleaseDataDir/g;
180 print "\n$filename -> $newFilename : " if ( $debug);
181
182 my $destinationFilename = $filename;
183 $destinationFilename =~ s/$CurrentDataDir/$DestinationDataDir/g;
184
185 if ($filename =~ /,v$/ or $filename =~ /.lock$/ or $filename =~ /~$/) {
186 print "skipping\n" if $debug;
187 return;
188 }
189
190 rizwank 1.1 if ( -d $filename ) {
191 print "\nprocessing directory (creating $destinationFilename)\n";
192 mkdir($destinationFilename);
193 return;
194 }
195
196 # if ( isFromDefaultWeb($filename) )
197 # {
198 # $newFilename =~ s|^(.*)/[^/]*/([^/]*)|$1/_default/$2|g;
199 # print "\n$filename appears to have been generated from from _default - merging with $newFilename from the new distribution" if ($debug);
200 # }
201
202 if (! -e $filename.",v" )
203 {
204 if ( $filename =~ /.txt$/ ) {
205 # here we defer making an RCS file for this file to someone else :-)
206 # (probably the process that checks all the new wiki files back in)
207 print "\nWarning: $filename does not have any rcs information" if ($debug);
208 print "v" if (! $debug);
209 }
210 copy( $filename, $destinationFilename);
211 rizwank 1.1 return;
212 }
213
214 # make it easy for debugging to turn on or off the business about
215 # checking in the existing files before rcsdiffing them
216 # this is necessary, because you have to make changes in two places to make
217 # this switch, and if you forget the second one you're gunna delete lots of files
218 # you wanted to keep!
219
220 my $doCiCo = 1;
221 # my $doCiCo = 0;
222
223 # Now - the main business: if we're looking at a file that has a new version in
224 # the new distribution then we have to try merging etc...
225
226 if ( -e $newFilename ) {
227 # file that may need upgrading
228
229 my $workingFilename;
230
231 if (!$doCiCo)
232 rizwank 1.1 {
233 $workingFilename = $filename;
234 }
235 else
236 {
237 $workingFilename = "$TempDir/". basename($filename);
238
239 print "Working file: $workingFilename\n" if ($debug);
240
241 copy ( $filename, $workingFilename)
242 or die "Couldn't make copy of $filename at $workingFilename: $!\n";
243
244 copy ( "$filename,v", "$workingFilename,v")
245 or die "Couldn't make copy of $filename,v at $workingFilename,v: $!\n";
246
247 # This procedure copied from UI::Manage.pm
248 # could be perhaps performed in less steps, but who cares...
249 # break lock
250 system("rcs -q -u -M $workingFilename 2>>$RcsLogFile");
251 # relock
252 system("rcs -q -l $workingFilename 2>>$RcsLogFile");
253 rizwank 1.1 # check outstanding changes in (note that -t- option should never be used, but it's there for completeness,
254 # and since it was in Manage.pm)
255 system("ci -u -mUpdateTopics -t-missing_v $workingFilename 2>>RcsLogFile");
256 }
257
258 my $highestCommonRevision = findHighestCommonRevision( $workingFilename, $newFilename);
259
260 # is it the final version of $filename?
261 # (in which case:
262 #TODO: what about manually updated files?
263
264 if ( $highestCommonRevision =~ /\d*\.\d*/ )
265 {
266 my $diff = doDiffToHead( $workingFilename, $highestCommonRevision );
267
268 $diff = removeVersionChangeDiff($diff);
269 patchFile( $filename, $destinationFilename, $diff );
270
271 print "\npatching $newFilename from $filename ($highestCommonRevision)" if ($debug);
272 print "\n$newFilename: p\n" if (!$debug);
273 copy( $newFilename, $destinationFilename);
274 rizwank 1.1 copy( $newFilename.",v", $destinationFilename.",v");
275 } elsif ($highestCommonRevision eq "head" ) {
276 # This uses the existing file rather than the new one, in case they manually
277 # changed the exisiting one without using RCS.
278 print "\nhighest common revision is final revision in oldTopic (using new Version)" if ($debug);
279 print "u" if (!$debug);
280 copy( $newFilename, $destinationFilename);
281 copy( $newFilename.",v", $destinationFilename.",v");
282 } else {
283 #no common versions - this might be a user created file,
284 #or a manual attempt at creating a topic off twiki.org?raw=on
285 #TODO: do something nicer about this.. I think i need to do lots of diffs
286 #to see if there is any commonality
287 print "\nWarning: copying $filename (no common versions)" if ($debug);
288 print "\nNo common versions for $filename: C\n" if (!$debug);
289 copy( $filename, $destinationFilename);
290 copy( $filename.",v", $destinationFilename.",v");
291 }
292
293 if ( $doCiCo )
294 {
295 rizwank 1.1 unlink ($workingFilename, "$workingFilename,v") or
296 warn "Couldn't remove temporary files $workingFilename, $workingFilename,v: $! Could be trouble ahead...\n";
297 }
298
299 } else {
300 #new file created by users
301 #TODO: this will include topics copied using ManagingWebs (createWeb)
302 print "\ncopying $filename (new user's file)" if ($debug);
303 print "c" if (!$debug);
304 copy( $filename, $destinationFilename);
305 copy( $filename.",v", $destinationFilename.",v");
306 }
307 }
308
309 # ==============================================
310 sub isFromDefaultWeb
311 {
312 my ($filename) = @_;
313
314 my $topic = basename($filename);
315 return $topic if grep(/^$topic$/, @DefaultWebTopics);
316 rizwank 1.1 }
317
318 sub sussoutDefaultWebTopics
319 {
320 opendir(DEFAULTWEB, './data/_default') or die "Yikes - couldn't open ./data/_default: $! ... not safe to proceed!\n";
321 @DefaultWebTopics = grep(/.txt$/, readdir(DEFAULTWEB));
322 if ($debug)
323 {
324 print "_default topics in new distro: @DefaultWebTopics\n";
325 }
326 }
327
328 # ==============================================
329 sub doDiffToHead
330 {
331 my ( $filename, $highestCommonRevision ) = @_;
332
333 # print "$highestCommonRevision to ".getHeadRevisionNumber($filename)."\n";
334 # print "\n----------------\n".getRevision($filename, $highestCommonRevision);
335 # print "\n----------------\n".getRevision($filename, getHeadRevisionNumber($filename)) ;
336 # return diff ( getRevision($filename, $highestCommonRevision), getRevision($filename, getHeadRevisionNumber($filename)) );
337 rizwank 1.1
338 my $cmd = "rcsdiff -r".$highestCommonRevision." -r".getHeadRevisionNumber($filename)." $filename";
339 print "\n----------------\n".$cmd if ($debug);
340 my $diffs = `$cmd 2>>$RcsLogFile`;
341 return $diffs;
342 }
343
344 # ==============================================
345 sub patchFile
346 {
347 my ( $oldFilename, $destinationFilename, $diff ) = @_;
348
349
350 # Here's where we do a total hack to get WIKIWEBLIST right.
351 # we have to check every stinkin line of diff just to intercept this one :-(
352
353 my @diff;
354
355 @diff = split(/\n/, $diff);
356
357 my $i;
358 rizwank 1.1
359 for($i = 0; $i < @diff ; $i++)
360 {
361 if ($diff[$i] =~ m/<\s*\* Set WIKIWEBLIST = /)
362 {
363 # come to mama
364 # this had better be the value in the distribution!...
365 $diff[$i] = '< * Set WIKIWEBLIST = [[%MAINWEB%.%HOMETOPIC%][%MAINWEB%]] %SEP% [[%TWIKIWEB%.%HOMETOPIC%][%TWIKIWEB%]] %SEP% [[Sandbox.%HOMETOPIC%][Sandbox]]
';
366 last;
367 }
368 }
369
370 $diff = join("\n", @diff);
371
372 # this looks odd: it's just telling patch to apply the patch to $destinationFilename
373 # perhaps only one file name line would do, but better safe than sorry!
374 # (diffs always seem to have two lines)
375 print(PATCH "--- $destinationFilename\n");
376 print(PATCH "--- $destinationFilename\n");
377
378 print(PATCH "$diff\n");
379 rizwank 1.1
380 # print(PATCH, "");
381
382 #patch ($newFilename, $diff);
383 # and then do an rcs ci (check-in)
384 }
385
386 # ==============================================
387 sub getHeadRevisionNumber
388 {
389 my ( $filename ) = @_;
390
391 my ( $cmd ) = "rlog ".$filename.",v";
392
393 my $line;
394
395 my @response = `$cmd 2>>$RcsLogFile`;
396 foreach $line (@response) {
397 next unless $line =~ /^head: (\d*\.\d*)/;
398 return $1;
399 }
400 rizwank 1.1 return "";
401 }
402
403 # ==============================================
404 #returns, as a string, the highest revision number common to both files
405 #Note: we return nothing if the highestcommon verison is also the last version of $filename
406 #TODO: are teh rcs versions always 1.xxx ? if not, how do we know?
407 sub findHighestCommonRevision
408 {
409 my ( $filename, $newFilename) = @_;
410
411 my $rev = 1;
412 my $commonRev = "";
413
414 my $oldContent = "qwer";
415 my $newContent = "qwer";
416 while ( ( $oldContent ne "" ) & ($newContent ne "") ) {
417 print "\ncomparing $filename and $newFilename revision 1.$rev " if ($debug);
418 $oldContent = getRevision( $filename, "1.".$rev);
419 $newContent = getRevision( $newFilename, "1.".$rev);
420 if ( ( $oldContent ne "" ) & ($newContent ne "") ) {
421 rizwank 1.1 my $diffs = diff( \$oldContent, \$newContent, {STYLE => "Unified"} );
422 # print "\n-----------------------|".$diffs."|-------------------\n";
423 # print "\n-------------------[".$oldContent."]----|".$diffs."|-------[".$newContent."]--------------\n";
424 if ( $diffs eq "" ) {
425 #same!!
426 $commonRev = "1.".$rev;
427 }
428 }
429 $rev = $rev + 1;
430 }
431
432 print "\nlastCommon = $commonRev (head = ".getHeadRevisionNumber( $filename).")" if ($debug);
433
434 if ( $commonRev eq getHeadRevisionNumber( $filename) ) {
435 return "head";
436 }
437
438 return $commonRev;
439 }
440
441 # ==============================================
442 rizwank 1.1 #returns an empty string if the version does not exist
443 sub getRevision
444 {
445 my ( $filename, $rev ) = @_;
446
447 # use rlog to test if the revision exists..
448 my ( $cmd ) = "rlog -r".$rev." ".$filename;
449
450 #print $cmd."\n";
451 my @response = `$cmd 2>>$RcsLogFile`;
452
453 my $revision;
454 my $line;
455 foreach $line (@response) {
456 next unless $line =~ /^revision (\d*\.\d*)/;
457 $revision = $1;
458 }
459
460 my $content = "";
461
462 if ( $revision and ($revision eq $rev) ) {
463 rizwank 1.1 $cmd = "co -p".$rev." ".$filename;
464 $content = `$cmd 2>>$RcsLogFile`;
465 }
466
467 return $content;
468 }
469
470 # $diff is assumed to contain the diff between two similar TWiki topics
471 # TWiki topics should, as a rule, differ in the first line with respect to
472 # their version number. This routine gets rid of that component of the diff.
473 # It could be more rigorous (like testing if the 1c1 change relates to %META).
474 # The diff is assumed not to contain the preamble.
475
476 sub removeVersionChangeDiff
477 {
478 my ($diff) = @_;
479
480 my @diff = split( /\n/, $diff);
481
482 if ($diff[0] eq '1c1')
483 {
484 rizwank 1.1 splice(@diff, 0, 4);
485 }
486
487 $diff = join "\n", @diff;
488
489 # print "rVCD returning: \n$diff\n";
490
491 return $diff;
492 }
493
494 1;
|
Return to
UpdateTopics.pm
CVS log
Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki / Upgrade