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
9 *** THIS IS AN ENTIRELY UNTESTED VERSION WITH CODE TO SHOW WHAT NEEDS TO
10 HAPPEN IF WE NEED TO FOLLOW SYMLINKS MANUALLY, WHICH IS THE CASE IF WE
11 WANT TO AUTOMATICALLY RE-CREATE THEM FOR THE USER
12
13 *** THIS IS SO UNTESTED THAT THESE COMMENTS ARE NOT COMMENTED, SO YOU
14 CANT ACCIDENTALLY THINK IT SHOULD COMPLILE.
15
16 package UpdateTopics;
17
18 use strict;
19
20 use File::Find;
21 use File::Copy;
22 rizwank 1.1 use Text::Diff;
23
24 # Try to upgrade an installation's TWikiTopics using the rcs info in it.
25
26 use vars qw($CurrentDataDir $NewReleaseDataDir $DestinationDataDir $BaseDir $debug @DefaultWebTopics %LinkedDirPathsInWiki);
27
28 sub UpdateTopics
29 {
30 $CurrentDataDir = shift or die "UpdateTopics not provided with existing data directory!\n";
31
32 $NewReleaseDataDir = shift or die "UpdateTopics not provided with new data directory!\n";
33
34 $DestinationDataDir = (shift or "$BaseDir/newData");
35
36 my $whoCares = `which rcs`; # we should use File::Which to do this, except that would mean
37 # getting yet another .pm into lib, which seems like hard work?
38 ($? >> 8 == 0) or die "Uh-oh - couldn't see an rcs executable on your path! I really need one of those!\n";
39
40 $whoCares = `which patch`;
41
42 ($? >> 8 == 0) or die "Uh-oh - couldn't see a patch executable on your path! I really need one of those!\n";
43 rizwank 1.1
44 $BaseDir = `pwd`;
45 chomp ($BaseDir);
46
47 #Set if you want to see the debug output
48 #$debug = "yes";
49
50 if ($debug) {print "$CurrentDataDir, $NewReleaseDataDir\n"; }
51
52 if ((! -d $CurrentDataDir ) || (! -d $NewReleaseDataDir)) {
53 print "\nUsage: UpdateTopics <sourceDataDir> <NewReleaseDataDir>\n";
54 exit;
55 }
56
57 print "\n\t...new upgraded data will be put in ./data\n";
58 print "\tthere will be no changes made to either the source data directory or $NewReleaseDataDir.\n\n";
59 print "\t This progam will attempt to use the rcs versioning information to upgrade the\n";
60 print "\t contents of your distributed topics in sourceDataDir to the content in $NewReleaseDataDir.\n\n";
61 print "Output:\n";
62 print "\tFor each file that has no versioning information a _v_ will be printed\n";
63 print "\tFor each file that has no changes from the previous release a _c_ will be printed\n";
64 rizwank 1.1 print "\tFor each file that has changes and a patch is generated a _p_ will be printed\n";
65 print "\tFor each file that is new in the NewReleaseDataDir a _+_ will be printed\n";
66 print "\t When the script has attempted to patch the $NewReleaseDataDir,
67 \t *.rej files will contain the failed merges\n";
68 print "\t although many of these rejected chages will be discarable,
69 \t please check them to see if your configuration is still ok\n\n";
70
71 sussoutDefaultWebTopics();
72
73 mkdir $DestinationDataDir;
74
75 #redirect stderr into a file (rcs dumps out heaps of info)
76 my $rcsLogFile = ">".$BaseDir."/rcs.log";
77 open(STDERR, $rcsLogFile);
78
79 open(PATCH, "> $DestinationDataDir/patchTopics");
80
81 print "\n\n ...checking existing files from $CurrentDataDir\n";
82 #TODO: need to find a way to detect non-Web directories so we don't make a mess of them..
83 # (should i just ignore Dirs without any ,v files?) - i can't upgrade tehm anyway..
84 #upgrade templates..?
85 rizwank 1.1
86 find(\&getRLog, $CurrentDataDir);
87
88 # deal with any symlinked in data directories in existing data that we found...
89
90 my ($OriginalCurrentDataDir, $OriginalDestinationDataDir, $OriginalNewReleaseDataDir) =
91 ($CurrentDataDir, $DestinationDataDir, $NewReleaseDataDir);
92
93 my $linkedDir;
94
95 for $linkedDir (keys %LinkedDirPathsInWiki)
96 {
97 $CurrentDataDir = $linkedDir;
98
99 $DestinationDataDir .= $LinkedDirPathsInWiki{$linkedDir};
100 $NewReleaseDataDir .= $LinkedDirPathsInWiki{$linkedDir};
101
102 find(\&getRLog, $CurrentDataDir);
103
104 ($CurrentDataDir, $DestinationDataDir, $NewReleaseDataDir) =
105 ($OriginalCurrentDataDir, $OriginalDestinationDataDir, $OriginalNewReleaseDataDir);
106 rizwank 1.1
107 }
108
109 close(PATCH);
110
111 #do a find through $NewReleaseDataDir and copy all missing files & dirs
112 print "\n\n ... checking for new files in $NewReleaseDataDir";
113 find(\©NewTopics, $NewReleaseDataDir);
114
115 #run `patch patchTopics` in $DestinationDataDir
116 print "\nPatching topics (manually check the rejected patch (.rej) files)";
117 chdir($DestinationDataDir);
118 `patch -p2 < patchTopics > patch.log`;
119 #TODO: examing the .rej files to remove the ones that have already been applied
120 find(\&listRejects, ".");
121 #TODO: run `ci` in $DestinationDataDir
122
123 print "\n\n";
124
125 }
126
127 rizwank 1.1 # ============================================
128 sub listRejects
129 {
130 my ( $filename ) = @_;
131
132 $filename = $File::Find::name;
133
134 if ($filename =~ /.rej$/ ) {
135 print "\nPatch rejected: $filename";
136 }
137 }
138
139 # ============================================
140 sub copyNewTopics
141 {
142 my ( $filename ) = $File::Find::name;
143
144 my $destinationFilename = $filename;
145 $destinationFilename =~ s/$NewReleaseDataDir/$DestinationDataDir/g;
146
147 # Sven had these commeted out, so I've left them here commented out.
148 rizwank 1.1 # return if $filename =~ /,v$/;
149 # return if $filename =~ /.lock$/;
150 # return if $filename =~ /~$/;
151
152 if ( -d $filename) {
153 print "\nprocessing directory $filename";
154 if ( !-d $destinationFilename ) {
155 print " (creating $destinationFilename)";
156 mkdir($destinationFilename);
157 }
158 print "\n";
159 return;
160 }
161
162 if (! -e $destinationFilename ) {
163 print "\nadding $filename (new in this release)" if ($debug);
164 print "\n$destinationFilename: +\n" if (!$debug);
165 copy( $filename, $destinationFilename);
166 }
167
168 }
169 rizwank 1.1
170 # ============================================
171 sub getRLog
172 {
173 my ( $filename ) = $File::Find::name;
174
175 # (see above)
176 # my ( $filename ) = @_;
177 # $filename = $BaseDir."/".$File::Find::name if (! $filename );
178
179 my ( $newFilename ) = $filename;
180 if (!filename =~ /^$CurrentDataDir/)
181 {
182 die "getRLog found $filename that appears not to be in $CurrentDataDir tree! That's not supposed to happen: sorry!\n";
183 }
184
185 $newFilename =~ s/$CurrentDataDir/$NewReleaseDataDir/g;
186 print "\n$filename -> $newFilename : " if ( $debug);
187
188 my $destinationFilename = $filename;
189 $destinationFilename =~ s/$CurrentDataDir/$DestinationDataDir/g;
190 rizwank 1.1
191 if ($filename =~ /,v$/ or $filename =~ /.lock$/ or $filename =~ /~$/) {
192 print "skipping" if $debug;
193 return;
194 }
195
196 if ( -l $filename )
197 {
198 my $linkTarget = readlink $filename;
199
200 $linkTarget or {warn "Oooo! $filename is a symlink I can't read ($!) : ignoring\n"; return}
201
202 if ( $linkTarget !~ m|^/| )
203 { # Cant cope with relative links: too lazy to reconstruct original file path, think about
204 # implications at the moment! Should/could be done...
205 warn "Found relative link in old data: $filename ... *ignorning*\n";
206 }
207
208 if ( !-d $linkTarget )
209 { # it will be safe to just proceed and treat this one like a normal file, though they just get a normal file
210 # not a link in the merged data.
211 rizwank 1.1 warn "Found a symlink to a file under existing data: $filename. An actual file (not a link) will be created in the new data...\n";
212 }
213 else
214 {
215 my $newPathInWiki = $filename;
216
217 $newPathInWiki =~ s/$CurrentDataDir//; # take the wiki root out of filename
218
219 # Put this linked-in data on the list to be dealt with later
220 # (because File::Find is not guaranteed to be reentrant (old perl versions))
221
222 mkdir($destinationFilename); # ** OR CREATE A NEW SYMLINK, IF YOU KNEW WHERE TO PUT THE TARGET.
223
224 $LinkedDirPathsInWiki{$linkTarget} = $newPathInWiki;
225 print "Symlinked data under $filename put on list for a bit later...\n" if ($debug);
226 print "l" if (!$debug);
227 return;
228 }
229 }
230
231 if ( -d $filename ) {
232 rizwank 1.1 print "\nprocessing directory (creating $destinationFilename)\n";
233 mkdir($destinationFilename);
234 return;
235 }
236
237 if ( isFromDefaultWeb($filename) )
238 {
239 $newFilename =~ s|^(.*)/[^/]*/([^/]*)|$1/_default/$2|g;
240 print "\n$filename appears to have been generated from from _default - merging with $newFilename from the new distribution!" if ($debug);
241 }
242
243 if (! -e $filename.",v" ){
244 #TODO: maybe copy this one too (this will inclure the .htpasswd file!!)
245 if ( $filename =~ /.txt$/ ) {
246 #TODO: in interactive mode ask if they want to create this topic's rcs file..
247 print "\nError: $filename does not have any rcs information" if ($debug);
248 print "v" if (! $debug);
249 }
250 copy( $filename, $destinationFilename);
251 return;
252 }
253 rizwank 1.1
254 if ( -e $newFilename ) {
255 #file that may need upgrading
256 my $highestCommonRevision = findHighestCommonRevision( $filename, $newFilename);
257 #print "-r".$highestCommonRevision."\n";
258 #is it the final version of $filename (in which case
259 #TODO: what about manually updated files?
260 if ( $highestCommonRevision =~ /\d*\.\d*/ ) {
261 my $diff = doDiffToHead( $filename, $highestCommonRevision );
262 #print "\n========\n".$diff."\n========\n";
263 patchFile( $filename, $destinationFilename, $diff );
264 print "\npatching $newFilename from $filename ($highestCommonRevision)" if ($debug);
265 print "\n$newFilename: p\n" if (!$debug);
266 copy( $newFilename, $destinationFilename);
267 copy( $newFilename.",v", $destinationFilename.",v");
268 } elsif ($highestCommonRevision eq "head" ) {
269 print "\nhighest revision also final revision in oldTopic (using new Version)" if ($debug);
270 print "c" if (!$debug);
271 copy( $newFilename, $destinationFilename);
272 copy( $newFilename.",v", $destinationFilename.",v");
273 } else {
274 rizwank 1.1 #no common versions - this might be a user created file,
275 #or a manual attempt at creating a topic off twiki.org?raw=on
276 #TODO: do something nicer about this.. I think i need to do lots of diffs
277 #to see if there is any commonality
278 print "\nWarning: copying $filename (no common versions)" if ($debug);
279 print "c" if (!$debug);
280 copy( $filename, $destinationFilename);
281 copy( $filename.",v", $destinationFilename.",v");
282 }
283 } else {
284 #new file created by users
285 #TODO: this will include topics copied using ManagingWebs (createWeb)
286 print "\ncopying $filename (new user's file)" if ($debug);
287 print "c" if (!$debug);
288 copy( $filename, $destinationFilename);
289 copy( $filename.",v", $destinationFilename.",v");
290 }
291 }
292
293 # ==============================================
294 sub isFromDefaultWeb
295 rizwank 1.1 {
296 my ($filename) = @_;
297
298 $filename =~ /^(.*)\/[^\/]*\/([^\/]*)/;
299 my $topic = $2;
300 return $topic if grep(/^$filename$/, @DefaultWebTopics);
301 }
302
303 sub sussoutDefaultWebTopics
304 {
305 opendir(DEFAULTWEB, 'data/_default"') or die "Yikes - couldn't open ./data/_default: $! ... not safe to proceed!\n";
306 @DefaultWebTopics = grep(/.txt$/, readdir(DEAFULTWEB));
307 if ($debug)
308 {
309 print "_default topics in new distro: @DefaultWebTopics\n";
310 }
311 }
312
313 # ==============================================
314 sub doDiffToHead
315 {
316 rizwank 1.1 my ( $filename, $highestCommonRevision ) = @_;
317
318 # print "$highestCommonRevision to ".getHeadRevisionNumber($filename)."\n";
319 # print "\n----------------\n".getRevision($filename, $highestCommonRevision);
320 # print "\n----------------\n".getRevision($filename, getHeadRevisionNumber($filename)) ;
321 # return diff ( getRevision($filename, $highestCommonRevision), getRevision($filename, getHeadRevisionNumber($filename)) );
322
323 my $cmd = "rcsdiff -r".$highestCommonRevision." -r".getHeadRevisionNumber($filename)." $filename";
324 print "\n----------------\n".$cmd if ($debug);
325 return `$cmd`;
326 }
327
328 # ==============================================
329 sub patchFile
330 {
331 my ( $oldFilename, $destinationFilename, $diff ) = @_;
332
333 #make the paths relative again
334 $oldFilename =~ s/$BaseDir//g;
335 $destinationFilename =~ s/$BaseDir//g;
336
337 rizwank 1.1 print(PATCH "--- $oldFilename\n");
338 print(PATCH "--- $destinationFilename\n");
339 print(PATCH "$diff\n");
340 # print(PATCH, "");
341
342 #patch ($newFilename, $diff);
343 # and then do an rcs ci (check-in)
344 }
345
346 # ==============================================
347 sub getHeadRevisionNumber
348 {
349 my ( $filename ) = @_;
350
351 my ( $cmd ) = "rlog ".$filename.",v";
352
353 my $line;
354
355 my @response = `$cmd`;
356 foreach $line (@response) {
357 next unless $line =~ /^head: (\d*\.\d*)/;
358 rizwank 1.1 return $1;
359 }
360 return;
361 }
362
363 # ==============================================
364 #returns, as a string, the highest revision number common to both files
365 #Note: we return nothing if the highestcommon verison is also the last version of $filename
366 #TODO: are teh rcs versions always 1.xxx ? if not, how do we know?
367 sub findHighestCommonRevision
368 {
369 my ( $filename, $newFilename) = @_;
370
371 my $rev = 1;
372 my $commonRev;
373
374 my $oldContent = "qwer";
375 my $newContent = "qwer";
376 while ( ( $oldContent ne "" ) & ($newContent ne "") ) {
377 print "\ncomparing $filename and $newFilename revision 1.$rev " if ($debug);
378 $oldContent = getRevision( $filename, "1.".$rev);
379 rizwank 1.1 $newContent = getRevision( $newFilename, "1.".$rev);
380 if ( ( $oldContent ne "" ) & ($newContent ne "") ) {
381 my $diffs = diff( \$oldContent, \$newContent, {STYLE => "Unified"} );
382 # print "\n-----------------------|".$diffs."|-------------------\n";
383 # print "\n-------------------[".$oldContent."]----|".$diffs."|-------[".$newContent."]--------------\n";
384 if ( $diffs eq "" ) {
385 #same!!
386 $commonRev = "1.".$rev;
387 }
388 }
389 $rev = $rev + 1;
390 }
391
392 print "\nlastCommon = $commonRev (head = ".getHeadRevisionNumber( $filename).")" if ($debug);
393
394 if ( $commonRev eq getHeadRevisionNumber( $filename) ) {
395 return "head";
396 }
397
398 return $commonRev;
399 }
400 rizwank 1.1
401 # ==============================================
402 #returns an empty string if the version does not exist
403 sub getRevision
404 {
405 my ( $filename, $rev ) = @_;
406
407 # use rlog to test if the revision exists..
408 my ( $cmd ) = "rlog -r".$rev." ".$filename;
409
410 #print $cmd."\n";
411 my @response = `$cmd`;
412 my $revision;
413 my $line;
414 foreach $line (@response) {
415 next unless $line =~ /^revision (\d*\.\d*)/;
416 $revision = $1;
417 }
418
419 my $content;
420 if ( $revision eq $rev ) {
421 rizwank 1.1 $cmd = "co -p".$rev." ".$filename;
422 $content = `$cmd`;
423 }
424
425 return $content;
426 }
427
428 1;
|
Return to
UpdateTopicsManualSymlinks.pm
CVS log
Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki / Upgrade