1#! @PERL@ 2# --------------------------------- 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2, or (at your option) 6# any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12 13########################################################################### 14# FUNCTION: 15# To recursively walk through a PVCS archive directory tree (archives 16# located in VCS/ or vcs/ subdirectories) and convert them to RCS archives. 17# The RCS archive name is the PVCS workfile name with ",v" appended. 18# 19# SYNTAX: 20# pvcs_to_rcs.pl --help 21# 22# where -l indicates the operation is to be performed only in the current 23# directory (no recursion) 24# 25# EXAMPLE: 26# pvcs_to_rcs 27# Would walk through every VCS or vcs subdir starting at the current directory, 28# and produce corresponding RCS archives one level above the VCS or vcs subdir. 29# (VCS/../RCS/) 30# 31# NOTES: 32# * This script performs little error checking and logging 33# (i.e. USE AT YOUR OWN RISK) 34# * This script was last tested using ActiveState's port of Perl 5.005_02 35# (internalcut #507) under Win95, though it does compile under Perl-5.00404 36# for Solaris 2.4 run on a Solaris 2.6 system. The script crashed 37# occasionally under ActiveState's port of Perl 5.003_07 but this stopped 38# happening with the update so if you are having problems, try updating Perl. 39# Upgrading to cut #507 also seemed to coincide with a large speed 40# improvement, so try and keep up, hey? :) It was executed from MKS's 41# UNIX tools version 6.1 for Win32's sh. ALWAYS redirect your output to 42# a log!!! 43# * PVCS archives are left intact 44# * RCS archives are created in VCS/../RCS/ (or ./RCS using '-pflat') 45# * Branch labels in this script will be attached to the CVS magic 46# revision number. For branch a.b.c of a particular file, this means 47# the label will be attached to revision a.b.0.c of the converted 48# file. If you use the TrunkTip (1.*) label, be aware that it will convert 49# to RCS revision 0.1, which is useless to RCS and CVS. You'll probably 50# have to delete these. 51# * All revisions are saved with correct "metadata" (i.e. check-in date, 52# author, and log message). Any blank log message is replaced with 53# "no comment". This is because RCS does not allow non-interactive 54# check in of a new revision without a comment string. 55# * Revision numbers are incremented by 1 during the conversion (since 56# RCS does not allow revision 1.0). 57# * All converted branch numbers are even (the CVS paradigm) 58# * Version labels are assigned to the appropriate (incremented) revision 59# numbers. PVCS allows spaces and periods in version labels while RCS 60# does not. A global search and replace converts " " and "." to "_" 61# There may be other cases that ought to be added. 62# * Any working (checked-out) copies of PVCS archives 63# within the VCS/../ or vcs/../ (or possibly ./ with '-pflat') 64# will be deleted (or overwritten) depending on your mode of 65# operation since the current ./ is used in the checkout of each revision. 66# I suppose if development continues these files could be redirected to 67# temp space rather than ./ . 68# * Locks on PVCS archives should be removed (or the workfiles should be 69# checked-in) prior to conversion, although the script will blaze through 70# the archive nonetheless (But you would lose any checked out revision(s)) 71# * The -kb option is added to the RCS archive for workfiles with the following 72# extensions: .bin .out .btl .rom .a07 .lib .exe .tco .obj .t8u .c8u .o .lku 73# .a and a few others. The %bin_ext variable holds these values in regexp 74# form. 75# * the --force-binary option can be used to convert binary files which don't 76# have proper extensions, but I'd *probably* edit the %bin_ext variable. 77# * This script will abort occasionally with the error "invalid revision 78# number". This is known to happen when a revision comment has 79# /^\s*Rev/ (Perl regexp notation) in it. Fix the comment and start over. 80# (The directory locks and existance checking make this a fairly quick 81# process.) 82# Binary files which do not have their mode set properly are likely to look 83# corrupted on initial checkout and use, but using 84# `cvs admin -kb <workfilename>' to retroactively change the RCS keyword 85# substitution mode of the file to binary (and refreshing the files in any 86# local workspaces they are checked out in: `rm <workfilename>; update' 87# should do the trick) should end any problems with the original import. 88# If anyone has checked in changes since the import, those revisions may 89# be corrupted in the imported archive and therefore those changes (commits 90# of corrupted data) may need to be backed out. 91# * This script writes lockfiles in the RCS/ directories. It will also not 92# convert an archive if it finds the RCS Archive existant in the RCS/ 93# directory. This enables the conversion to quickly pick up where it left 94# off after errors or interrupts occur. If you interrupt the script make 95# sure you delete the last RCS Archive File which was being written. 96# If you recieve the "Invalid revision number" error, then the RCS archive 97# file for that particular PVCS file will not have been created yet. 98# * This script will not create lockfiles when processing single 99# filenames passed into the script, for hopefully obvious reasons. 100# (lockfiles lock directories - DRP) 101# * Log the output to a file. That makes it real easy to grep for errors 102# later. (grep for "^[ \t]*(rcs|ci):" and be aware I might have missed 103# a few cases (get? vcs?) !!!) *** Also note that this script will 104# exibit some harmless RCS errors. Namely, it will attempt to lock 105# branches which haven't been created yet. *** 106# * I tried to keep the error and warning info up to date, but it seems 107# to mean very little. This script almost always exits with a warning 108# or an error that didn't seem to cause any harm. I didn't trace it 109# and our imported source checks out and builds... 110# It is probably happening when trying to convert empty directories 111# or read files (possibly checked out workfiles ) which are not 112# pvcs_archives. 113# * You must use the -pflat option when processing single filenames 114# passed as arguments to the script. This is probably a bug. 115# * questions, comments, additions can be sent to info-cvs@nongnu.org 116######################################################################### 117 118 119 120# 121# USER Configurables 122# 123 124# %bin_ext should be editable from the command line. 125# 126# NOTE: Each possible binary extension is listed as a Perl regexp 127# 128# The value associated with each regexp key is used to print a log 129# message when a binary file is found. 130my %bin_ext = 131 ( 132 '\.(?i)abs$' => "Absolute File", 133 '\.(?i)bin$' => "Binary", 134 '\.(?i)bit$' => "Bit File", 135 '\.(?i)ol$' => "Compiler Output", 136 '\.(?i)out$' => "Default Compiler Output", 137 '\.(?i)ln$' => "Linker Output", 138 '\.(?i)lob$' => "Lint Output", 139 '\.(?i)zob$' => "DBCO Object", 140 '\.(?i)mim$' => "MIME File", 141 '\.(?i)dwi$' => "DWI File", 142 '\.(?i)iop$' => "IOP File", 143 '\.(?i)btl$' => "", 144 '\.(?i)rom$' => "ROM File", 145 '\.(?i)a07$' => "", 146 '\.(?i)lib$' => "DOS/Wintel/Netware Compiler Library", 147 '\.(?i)lif$' => "Netware Binary File", 148 '\.(?i)(com|exe)$' => "DOS/Wintel Executable", 149 '\.(?i)tco$' => "", 150 '\.(?i)obj$' => "DOS/Wintel Compiler Object", 151 '\.(?i)res$' => "DOS/Wintel Resource File", 152 '\.(?i)ico$' => "DOS/Wintel Icon File", 153 '\.(?i)nlm$' => "Netware Loadable Module", 154 '\.(?i)t8u$' => "", 155 '\.(?i)c8u$' => "", 156 '\.(?i)lku$' => "", 157 '\.(?i)pdf$' => "Adobe Acrobat Portable Document Format", 158 '\.(?i)doc$' => "MS Word Document", 159 '\.(?i)dot$' => "MS Word Document Template", 160 '\.(?i)pps$' => "MS PowerPoint Presentation", 161 '\.(?i)xls$' => "MS Excel Spreadsheet", 162 '\.(?i)(bmp|gif|jfif|jpeg|jpg|png|tif|tiff|xbm)$' => "Image", 163 '\.(?i)(bz2|gz|tgz|zip)$' => "Compressed File", 164 '\.(?i)dll$' => "DOS/Wintel Dynamically Linked Library", 165 '\.(?i)class$' => "Compliled Java Class File", 166 '\.(?i)jar$' => "Java Archive File", 167 '\.(?i)war$' => "Java Web Archive File", 168 '\.o$' => "UNIX Compiler Object", 169 '\.a$' => "UNIX Compiler Library", 170 '\.so(\.\d+\.\d+)?$' => "UNIX Shared Library" 171 ); 172 173# The binaries this script is dependant on: 174my @bin_dependancies = ("vcs", "vlog", "rcs", "ci"); 175 176# Where we should put temporary files 177my $tmpdir = $ENV{TMPDIR} ? $ENV{TMPDIR} : "/var/tmp"; 178 179# We use these... 180use strict; 181 182use Cwd; 183use File::Basename; # For the usage message. 184use File::Copy; 185use File::Path; 186use IO::File; 187use Getopt::Long; 188 $Getopt::Long::bundling = 1; 189 190my $program = basename $0; 191my $usage = "\ 192usage: $program -h 193 $program [-lt] [-i vcsid] [-r flat|leaf] [-p flat|leaf] 194 [-x rcs_extension] [-v none|locks|exists] [options] [path...] 195"; 196 197my $help = "\ 198$usage 199 ---------------------------- ----------------------------------- 200 -h | --Help Print this text 201 202 General Settings 203 ---------------------------- ----------------------------------- 204 --Recurse Recurse through directories 205 (default) 206 -l | --NORecurse Process only . 207 --Errorfiles Save a count of conversion errors 208 in the RCS archive directory 209 (default) (unimplemented) 210 --NOErrorfiles Don't save a count of conversion 211 errors (unimplemented) 212 ( -m | --Mode ) Convert Convert PVCS files to RCS files 213 (default) 214 ( -m | --Mode ) Verify Perform verification ONLY 215 (unimplemented) 216 ( -v | --VERIfy ) None Always replace existing RCS files 217 ( -v | --VERIfy ) LOCKS Same as exists unless a #conv.done 218 file exists in the RCS directory. 219 In that case, only the #conv.done 220 file's existance is verified for 221 that directory. (default) 222 ( -v | --VERIfy ) Exists Don't replace existing RCS files 223 ( -v | --VERIfy ) LOCKDates Verify that an existing RCS file's 224 last modification date is older 225 than that of the lockfile 226 (unimplemented) 227 ( -v | --VERIfy ) Revs Verify that the PVCS archive files 228 and RCS archive file contain the 229 same number of corresponding 230 revisions. Add only new revisions 231 to the RCS file. (unimplemented) 232 ( -v | --VERIfy ) Full Perform --verify=Revs and confirm 233 that the text of the revisions is 234 identical. Add only new revisions 235 unless an error is found. Then 236 erase the RCS archive and recreate 237 it. (unimplemented) 238 -t | --Test-binaries Use 'which' to check \$PATH for 239 the binaries required by this 240 script (default) 241 --NOTest-binaries Don't check for binaries 242 --VERBose Enable verbose output 243 --NOVerbose Disable verbose output (default) 244 -w | --Warnings Print warning messages (default) 245 --NOWarnings Don't print warning messages 246 247 RCS Settings 248 ---------------------------- ----------------------------------- 249 ( -r | --RCS-Dirs ) leaf RCS files stored in ./RCS (default) 250 ( -r | --RCS-Dirs ) flat RCS files stored in . 251 (unimplemented) 252 ( -x | --RCS-Extension ) Set RCS file extension 253 (default = ',v') 254 --Force-binary Pass '-kb' to 'rcs -i' regardless 255 of the file extension 256 --NOForce-binary Only use '-kb' when the file has 257 a binary extension (default) 258 --CVS-Branch-labels Use CVS magic branch revision 259 numbers when attaching branch 260 labels (default) 261 --NOCvs-branch-labels Attach branch labels to RCS branch 262 revision numbers (unimplemented) 263 264 CVS Settings 265 ---------------------------- ----------------------------------- 266 ( -d | --CVS-Module-path) Import RCS files directly into this 267 destination directory rather than 268 converting in place 269 270 PVCS Settings 271 ---------------------------- ----------------------------------- 272 ( -p | --Pvcs-dirs ) leaf PVCS files expected in ./VCS 273 (default) 274 ( -p | --Pvcs-dirs ) flat PVCS files expected in . 275 ( -i | --VCsid ) vcsid Use vcsid instead of \$VCSID 276 277 -------------------------------------------------------------------------- 278 The optional path argument should contain the name of a file or directory 279 to convert. If not given, it will default to '.'. 280 -------------------------------------------------------------------------- 281"; 282 283 284 285# 286# Initialize globals 287# 288 289my ($errors, $warnings) = (0, 0); 290my ($curlevel, $maxlevel); 291my ($rcs_base_command, $ci_base_command); 292my ($donefile_name, $errorfile_name); 293my @rel_dirs = (); # list of relative directory names up to current dir 294 295 296# set up the default options 297my %options = ( 298 'recurse' => 1, 299 'mode' => "convert", 300 'errorfiles' => 1, 301 'rcs-dirs' => "leaf", 302 'rcs-extension' => ",v", 303 'force-binary' => 0, 304 'cvs-branch-labels' => 1, 305 'cvs-module-path' => undef, 306 'pvcs-dirs' => "leaf", 307 'verify' => "locks", 308 'test-binaries' => 1, 309 'vcsid' => $ENV{VCSID} || "", 310 'verbose' => 0, 311 'debug' => 0, 312 'warnings' => 1 313 ); 314 315 316 317# This is untested except under Solaris 2.4 or 2.6 and 318# may not be portable 319# 320# I think the readline lib or some such has an interface 321# which may enable this now. The perl installer sure looks 322# like it's testing this kind of thing, anyhow. 323sub hit_any_key 324 { 325 STDOUT->autoflush; 326 system "stty", "-icanon", "min", "1"; 327 328 print "Hit any key to continue..."; 329 getc; 330 331 system "stty", "icanon", "min", "0"; 332 STDOUT->autoflush (0); 333 334 print "\nI always wondered where that key was...\n"; 335 } 336 337 338 339# print the usage 340sub print_usage 341 { 342 my $fh = shift; 343 unless (ref $fh) 344 { 345 my $fdn = $fh ? $fh : "STDERR"; 346 $fh = new IO::File; 347 $fh->fdopen ($fdn, "w"); 348 } 349 350 $fh->print ($usage); 351 } 352 353# print the help 354sub print_help 355 { 356 my $fh = shift; 357 unless (ref $fh) 358 { 359 my $fdn = $fh ? $fh : "STDOUT"; 360 $fh = new IO::File; 361 $fh->fdopen ($fdn, "w"); 362 } 363 364 $fh->print ($help); 365 } 366 367# print the help and exit $_[0] || 0 368sub exit_help 369 { 370 print_help; 371 exit shift || 0; 372 } 373 374sub error_count 375 { 376 my $type = shift 377 or die "$0: error - error_count usage: error_count type [, ref] [, LIST]\n"; 378 my $error_count_ref; 379 my $outstring; 380 381 if (ref ($_[0]) && ref ($_[0]) == "SCALAR") 382 { 383 $error_count_ref = shift; 384 } 385 else 386 { 387 $error_count_ref = \$errors; 388 } 389 $$error_count_ref++; 390 391 push @_, "something wrong.\n" unless ( @_ > 0 ); 392 393 $outstring = sprintf "$0: $type - " . join ("", @_); 394 $outstring .= sprintf " - $!\n" unless ($outstring =~ /\n$/); 395 396 print STDERR $outstring; 397 398 if ($options{errorfiles}) 399 { 400 my $fh = new IO::File ">>$errorfile_name" or new IO::File ">$errorfile_name"; 401 if ($fh) 402 { 403 $fh->print ($$error_count_ref . "\n"); 404 $fh->print ($outstring); 405 $fh->close; 406 } 407 else 408 { 409 my $cd = cwd; 410 print STDERR "$0: error - failed to open errorfile $cd/$errorfile_name - $!\n" 411 if ($options{debug}); 412 } 413 } 414 415 return $$error_count_ref; 416 } 417 418 419 420# the main procedure that is run once in each directory 421sub execdir 422 { 423 my $dir = shift; 424 my ($errors, $warnings) = (0, 0); # We return these error counters 425 my $old_dir = cwd; 426 427 local ($_, @_); 428 429 my $i; # Generic counter 430 my ($pvcsarchive, $workfile, $rcsarchive); # .??v, checked out file, and ,v files, 431 # respectively 432 my ($rev_count, $first_vl, $last_vl, $description, 433 $rev_index, @rev_num, %checked_in, %author, 434 $relative_comment_index, @comment_string, 435 %comment); 436 my ($num_version_labels, $label_index, @label_revision, $label, 437 @new_label, $rcs_rev); 438 my ($revision, %rcs_rev_num); 439 my @remainder; 440 my ($get_output, $rcs_output, $ci_output, $mv_output); 441 my ($ci_command, $rcs_command, $wtr); 442 my @hits; 443 my ($num_fields); 444 my $skipdirlock; # if true, don't write conv.out 445 # used only for single file operations 446 # at the moment 447 my $cd; 448 my $cvs_dir; 449 450 my @filenames; 451 # We may have recieved a single file name to process... 452 if ( -d $dir ) 453 { 454 # change into the directory to be processed 455 # open the current directory for listing 456 # initialize the list of filenames 457 # and set filenames equal to directory listing 458 unless ( ( chdir $dir ) and ( opendir CURDIR, "." ) and ( @filenames = readdir CURDIR ) ) 459 { 460 $cd = cwd; 461 error_count 'error', \$errors, "skipping directory $dir from $cd"; 462 chdir $old_dir or die "Failed to restore original directory ($old_dir): ", $!, ", stopped"; 463 return ($errors, $warnings); 464 } 465 466 # clean up by closing the directory 467 closedir(CURDIR); 468 469 if ($options{'rcs-dirs-flat'} && $options{'cvs-module-path'}) 470 { 471 my @cur_dir_names = split qr{[/\\]}, cwd; 472 my $rel_cd = $cur_dir_names[-1]; 473 push @rel_dirs, $rel_cd; 474 $cvs_dir = "$options{'cvs-module-path'}/" 475 . join "/", @rel_dirs; 476 if (!-d $cvs_dir) 477 { 478 print "Creating directory \`$cvs_dir'\n"; 479 if (!mkpath ($cvs_dir)) 480 { 481 pop @rel_dirs; 482 error_count 'error', \$errors, 483"failed to make directory \`$cvs_dir' - skipping directory \`$cd'"; 484 chdir $old_dir or die 485"Failed to restore original directory (\`$old_dir'): ", $!, ", stopped"; 486 return ($errors, $warnings); 487 # after all, we have nowhere to put 488 # them... 489 } 490 } 491 } 492 493 } 494 elsif ( -f $dir ) # we recieved a single file 495 { 496 push @filenames, $dir; 497 $skipdirlock = 1; 498 } 499 else 500 { 501 $cd = cwd; 502 error_count 'error', \$errors, "no such directory/file $dir from $cd\n"; 503 chdir $old_dir or die 504"Failed to restore original directory ($old_dir): ", $!, ", stopped"; 505 return ($errors, $warnings); 506 } 507 508 # save the current directory 509 $cd = cwd; 510 511 # increment the global $curlevel variable 512 $curlevel = $curlevel +1; 513 514 # initialize a list for any subdirectories and any files 515 # we need to process 516 my $vcsdir = ""; 517 my (@subdirs, $fn, $file, @files, @pvcsarchives); 518 519 # print "$cd: " . join (", ", @filenames) . "\n"; 520 # hit_any_key; 521 522 (@files, @pvcsarchives) = ( (), () ); 523 # begin a for loop to execute on each filename in the list @filename 524 foreach $fn (@filenames) 525 { 526 # if the file is a directory... 527 if (-d $fn) 528 { 529 # then if we are not expecting a flat arrangement of pvcs files 530 # and we found a vcs directory add its files to @pvcsarchives 531 if (!$options{'pvcs-dirs-flat'} and $fn =~ /^vcs$/i) 532 { 533 if ($options{verify} =~ /^locks$/ ) { 534 if ( -f $donefile_name ) { 535 print "Verified existence of lockfile $cd/$donefile_name." 536 . ( ($options{mode} =~ /^convert$/) ? " Skipping directory." : "" ) 537 . "\n" if ($options{verbose}); 538 next; 539 } elsif ( $options{mode} =~ /^verify$/ ) { 540 print "No lockfile found for $cd .\n"; 541 next; 542 } 543 } 544 545 # else add the files in the vcs dir to our list of files to process 546 error_count 'warning', \$warnings, "Found two vcs dirs in directory $cd.\n" 547 if ($vcsdir and $options{warnings}); 548 549 $vcsdir = $fn; 550 551 unless ( ( opendir VCSDIR, $vcsdir ) and ( @files = readdir VCSDIR ) ) 552 { 553 error_count 'error', \$errors, "skipping directory &cd/$fn"; 554 next; 555 } 556 closedir VCSDIR; 557 558 # and so we don't need to worry about where these 559 # files came from later... 560 foreach $file (@files) 561 { 562 push @pvcsarchives, "$vcsdir/$file" if (-f "$vcsdir/$file"); 563 } 564 565 # don't want recursion here... 566 @pvcsarchives = grep !/^\.\.?$/, @pvcsarchives; 567 } 568 elsif ($fn !~ /^\.\.?$/) 569 { 570 next if (!$options{'rcs-dirs-flat'} and $fn =~ /^rcs$/i); 571 # include it in @subdir if it's not a parent directory 572 push(@subdirs,$fn); 573 } 574 } 575 # else if we are processing a flat arrangement of pvcs files... 576 elsif ($options{'pvcs-dirs-flat'} and -f $fn) 577 { 578 if ($options{verify} =~ /^locks$/) { 579 if ( -f $donefile_name) { 580 print "Found lockfile $cd/$donefile_name." 581 . ( ($options{mode} =~ /^convert$/) ? " Skipping directory." : "" ) 582 . "\n" if ($options{verbose}); 583 last; 584 } elsif ($options{mode} =~ /^verify$/) { 585 print "No lockfile found for $cd .\n"; 586 last; 587 } 588 } 589 # else add this to the list of files to process 590 push (@pvcsarchives, $fn); 591 } 592 } 593 594 # print "pvcsarchives: " . join (", ", @pvcsarchives) . "\n"; 595 # print "subdirs: " . join (", ", @subdirs) . "\n"; 596 # hit_any_key; 597 598 # for loop of subdirs 599 foreach (@subdirs) 600 { 601 # run execdir on each sub dir 602 if ($maxlevel >= $curlevel) 603 { 604 my ($e, $w) = execdir ($_); 605 $errors += $e; 606 $warnings += $w; 607 } 608 } 609 610 # Print output header for each directory 611 print("Directory: $cd\n"); 612 613 # the @files variable should already contain the list of files 614 # we should attempt to process 615 if ( @pvcsarchives && ( $options{mode} =~ /^convert$/ ) ) 616 { 617 # create an RCS directory in parent to store RCS files in 618 if ( !( $options{'rcs-dirs-flat'} or (-d "RCS") or mkpath ( "RCS" ) ) ) 619 { 620 error_count 'error', \$errors, "failed to make directory $cd/RCS - skipping directory $cd"; 621 @pvcsarchives = (); 622 # after all, we have nowhere to put them... 623 } 624 } 625 626 # begin a for loop to execute on each filename in the list @files 627 foreach $pvcsarchive (@pvcsarchives) 628 { 629 my $got_workfile = 0; 630 my $got_version_labels = 0; 631 my $got_description = 0; 632 my $got_rev_count = 0; 633 634 my $abs_file = $cd . "/" . $pvcsarchive; 635 636 print("Verifying $abs_file...\n") if ($options{verbose}); 637 638 print "vlog $pvcsarchive\n"; 639 # FIXME: Quoting this is better than no quotes, but quotes in 640 # filenames remain unquoted. 641 my $vlog_output = `vlog \"$pvcsarchive\"`; 642 643 # Split the vcs status output into individual lines 644 my @vlog_strings = split /\n/, $vlog_output; 645 my $num_vlog_strings = @vlog_strings; 646 $_ = $vlog_strings[0]; 647 if ( /^\s*$/ || /^vlog: warning/ ) 648 { 649 error_count 'warning', \$warnings, "$abs_file is NOT a valid PVCS archive!!!\n"; 650 next; 651 } 652 653 my $num; 654 # Collect all vlog output into appropriate variables 655 # 656 # This will ignore at the very least the /^\s*Archive:\s*/ field 657 # and maybe more. This should not be a problem. 658 for ( $num = 0; $num < $num_vlog_strings; $num++ ) 659 { 660 # print("$vlog_strings[$num]\n"); 661 $_ = $vlog_strings[$num]; 662 663 if( ( /^Workfile:\s*/ ) && (!$got_workfile ) ) 664 { 665 my $num_fields; 666 667 $got_workfile = 1; 668 # get the string to the right of the above search (with any path stripped) 669 $workfile = $'; 670 $num_fields = split /[\/\\]/, $workfile; 671 if ( $num_fields > 1 ) 672 { 673 $workfile = $_[$num_fields - 1 ]; 674 } 675 676 $rcsarchive = $options{'rcs-dirs-flat'} ? "" : "RCS/"; 677 $rcsarchive .= $workfile; 678 $rcsarchive .= $options{'rcs-extension'} if ($options{'rcs-extension'}); 679 print "Workfile is $workfile\n" if ($options{debug}); 680 } 681 682 elsif ( ( /^Rev count:\s*/ ) && (!$got_rev_count ) ) 683 { 684 $got_rev_count = 1; 685 # get the string to the right of the above search 686 $rev_count = $'; 687 print "Revision count is $rev_count\n"; 688 } 689 690 elsif ( ( /^Version labels:\s*/ ) && (!$got_version_labels ) ) 691 { 692 $got_version_labels = 1; 693 $first_vl = $num+1; 694 print "Version labels start at $first_vl\n" if ($options{debug}); 695 } 696 697 elsif ( ( /^Description:\s*/ ) && (!$got_description ) ) 698 { 699 $got_description = 1; 700 $description = $vlog_strings[$num+1]; 701 print "Description is `$description'\n" if ($options{debug}); 702 $last_vl = $num++ - 1; 703 } 704 705 elsif ( /^Rev\s+/ ) # get all the revision information at once 706 { 707 $rev_index = 0; 708 @rev_num = (); 709 while ( $rev_index < $rev_count ) 710 { 711 $_ = $vlog_strings[$num]; 712 /^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/; 713 $rev_num[$rev_index] = $1; 714 print "Found revision: $rev_num[$rev_index]\n" if ($options{debug}); 715 die "Not a valid revision ($rev_num[$rev_index]).\n" 716 if ($rev_num[$rev_index] !~ /^(\d+\.)(\d+\.\d+\.)*\d+$/); 717 718 $_ = $vlog_strings[$num+1]; 719 /^\s*Locked\s*/ and $num++; 720 721 $_ = $vlog_strings[$num+1]; 722 /^\s*Checked in:\s*/; 723 $checked_in{$rev_num[$rev_index]} = "\"" . $' . "\""; 724 print "Checked in: $checked_in{$rev_num[$rev_index]}\n" if ($options{debug}); 725 726 $_ = $vlog_strings[$num+3]; 727 /^\s*Author id:\s*/; 728 my @fields = split; 729 $author{$rev_num[$rev_index]} = "\"" . $fields[2] . "\""; 730 print "Author: $author{$rev_num[$rev_index]}\n" if ($options{debug}); 731 732 my @branches = (); 733 $_ = $vlog_strings[$num+1]; 734 if (/^\s*Branches:\s*/) 735 { 736 $num++; 737 @branches = split /\s+/, $'; 738 } 739 740 $relative_comment_index = 0; 741 @comment_string = (); 742 while (($num + 4 + $relative_comment_index) < @vlog_strings) 743 { 744 last if $vlog_strings[$num+4+$relative_comment_index] 745 =~ /^\s*Rev\s+(\d+\.(\d+\.\d+\.)*\d+)$/ 746 && $vlog_strings[$num+3+$relative_comment_index] 747 =~ /^-{35}$/; 748 749 # We need the \n added for multi-line comments. There is no effect for 750 # single-line comments since RCS inserts the \n if it doesn't exist already 751 # print "Found commment line: $vlog_strings[$num+4+$relative_comment_index]\n" 752 # if ($options{debug}); 753 push @comment_string, $vlog_strings[$num+4+$relative_comment_index], "\n"; 754 $relative_comment_index += 1; 755 } 756 # print "Popped from comment: " . join ("", splice (@comment_string, -2)) 757 # . "\n" 758 # if ($options{debug}); 759 # Pop the "-+" or "=+" line from the comment 760 while ( (pop @comment_string) !~ /^-{35}|={35}$/ ) 761 {} 762 $comment{$rev_num[$rev_index]} = join "", @comment_string; 763 764 $num += ( 4 + $relative_comment_index ); 765 print "Got comment for $rev_num[$rev_index]\n" if ($options{debug}); 766 print "comment string: $comment{$rev_num[$rev_index]}\n" if ($options{debug}); 767 $rev_index += 1; 768 } # while ( $rev_index < $rev_count ) 769 $num -= 1; #although there should be nothing left for this to matter 770 } # Get Rev information 771 } # for ($num = 0; $num < $num_vlog_strings; $num++) 772 # hit_any_key if ($options{debug}); 773 # Create RCS revision numbers corresponding to PVCS version numbers 774 my @rcs_rev_nums; 775 foreach $revision (@rev_num) 776 { 777 $rcs_rev_num{ $revision } = &pvcs_to_rcs_rev_number( $revision ); 778 push @rcs_rev_nums, $rcs_rev_num{$revision}; 779 print"PVCS revision is $revision; RCS revision is $rcs_rev_num{ $revision }\n" 780 if ($options{debug}); 781 } 782 783 # Sort the revision numbers - PVCS and RCS store them in different orders 784 # Clear @_ so we don't pass anything in by accident... 785 @_ = (); 786 @rev_num = sort revisions @rev_num; 787 print "Sorted rev_nums:\n" . join ("\n", @rev_num) . "\n" if ($options{debug}); 788 # hit_any_key; 789 790 # Loop through each version label, checking for need to relabel ' ' with '_'. 791 $num_version_labels = $last_vl - $first_vl + 1; 792 print "Version label count is $num_version_labels\n"; 793 for( $i = $first_vl; $i <= $last_vl; $i += 1 ) 794 { 795 # print("$vlog_strings[$i]\n"); 796 $label_index = $i - $first_vl; 797 $_=$vlog_strings[$i]; 798 print "Starting with string '$_'\n" if ($options{debug}); 799 my @fields = split /\"/; 800 $label = $fields[1]; 801 print "Got label '$label'\n" if ($options{debug}); 802 @fields = split /\s+/, $fields[2]; 803 $label_revision[$label_index] = $fields[2]; 804 print "Original label is $label_revision[$label_index]\n" if ($options{debug}); 805 806 # Create RCS revision numbers corresponding to PVCS version numbers by 807 # adding 1 to the revision number (# after last .) 808 $label_revision[ $label_index ] = pvcs_to_rcs_rev_number( $label_revision [ $label_index ] ); 809 # replace ' ' with '_', if needed 810 $_=$label; 811 $new_label[$label_index] = $label; 812 $new_label[$label_index] =~ s/ /_/g; 813 $new_label[$label_index] =~ s/\./_/g; 814 $new_label[$label_index] = "\"" . $new_label[$label_index] . "\""; 815 print"Label $new_label[$label_index] is for revision $label_revision[$label_index]\n" if ($options{debug}); 816 } 817 818 ########## 819 # 820 # See if the RCS archive is up to date with the PVCS archive 821 # 822 ########## 823 my $cvsarchive; 824 $cvsarchive = "$cvs_dir/$rcsarchive" if $options{'cvs-module-path'}; 825 $cvsarchive .= $rcsarchive; 826 if ($options{verify} =~ /^locks|exists$/ and -f $cvsarchive) 827 { 828 print "Verified existence of " 829 . ($options{'cvs-module-path'} ? $cvsarchive : "$cd/$rcsarchive") 830 . "." 831 . ( ($options{mode} =~ /^convert$/) ? " Skipping." : "" ) 832 . "\n" if ($options{verbose}); 833 next; 834 } 835 836 # Create RCS archive and check in all revisions, then label. 837 my $first_time = 1; 838 foreach $revision (@rev_num) 839 { 840 # print "get -p$revision $pvcsarchive >$workfile\n"; 841 print "get -r$revision $pvcsarchive\n"; 842 # $vcs_output = `vcs -u -r$revision $pvcsarchive`; 843 # $get_output = `get -p$revision $pvcsarchive >$workfile`; 844 # FIXME: Doesn't handle quotes in filenames as FIXME above. 845 $get_output = `get -r$revision \"$pvcsarchive\"`; 846 847 # if this is the first time, delete the rcs archive if it exists 848 # need for $options{verify} == none 849 unlink $rcsarchive if ($first_time and $options{verify} =~ /^none$/ and -f $rcsarchive); 850 851 # Also check here whether this file ought to be "binary" 852 if ( $first_time ) 853 { 854 $rcs_command = "$rcs_base_command -i"; 855 if ( ( @hits = grep { $workfile =~ /$_/ } keys %bin_ext ) || $options{'force-binary'} ) 856 { 857 $rcs_command .= " -kb"; 858 $workfile =~ /$hits[0]/ if (@hits); 859 print "Binary attribute -kb added (" 860 . (@hits ? "file type is '$bin_ext{$hits[0]}' for extension '$&'" : "forced") 861 . ")\n"; 862 } 863 864 # FIXME: Doesn't handle quotes and other special characters in 865 # filenames as two FIXMEs above. 866 $rcs_command .= " \"$workfile\""; 867 868 # print and execute the rcs archive initialization command 869 print "$rcs_command\n"; 870 $wtr = new IO::File "|$rcs_command"; 871 $wtr->print ($description); 872 $wtr->print ("\n") unless ($description =~ /\n$/s); 873 $wtr->print (".\n"); 874 $wtr->close; 875 876 # $rcs_output = `$rcs_base_command -i -kb $workfile`; 877 } 878 879 # if this isn't the first time, we need to lock the rcs branch 880 # 881 # This is a little messy, but it works. Some extra locking is attempted. 882 # (This happens the first time a branch is used, at the least) 883 my $branch = ""; 884 my @branch; 885 @branch = split /\./, $rcs_rev_num{$revision}; 886 pop @branch; 887 $branch = join ".", @branch if @branch != 1; 888 889 # FIXME: Quotes around file names handles spaces but not shell 890 # metacharacters in file names. 891 unless ($first_time) 892 { 893 print "$rcs_base_command -l$branch \"$workfile\"\n" 894 if $options{'debug'}; 895 $rcs_output = `$rcs_base_command -l$branch \"$workfile\"`; 896 } 897 898 # If an empty comment is specified, RCS will not check in the file; 899 # check for this case. (but an empty -t- description is fine - go figure!) 900 # Since RCS will pause and ask for a comment if one is not given, 901 # substitute a dummy comment "no comment". 902 $comment{$revision} =~ /^\s*$/ and $comment{$revision} = "no comment\n"; 903 904 $ci_command = $ci_base_command; 905 $ci_command .= " -f -r$rcs_rev_num{$revision} -d$checked_in{$revision}" 906 . " -w$author{$revision}"; 907 908 $ci_command .= " \"$workfile\""; 909 910 # print and execute the ci command 911 print "$ci_command\n"; 912 $wtr = new IO::File "|$ci_command"; 913 $wtr->print ($comment{$revision}); 914 $wtr->print ("\n") unless ($comment{$revision} =~ /\n$/s); 915 $wtr->print (".\n"); 916 $wtr->close; 917 # $ci_output = `$ci_command`; 918 # $ci_output = `cat $tmpdir/ci.out`; 919 920 $first_time = 0 if ($first_time); 921 } # foreach revision 922 923 # Keep track of 1.*, 2.*, etc. branches as they are created. 924 my %trunk_branches; 925 926 # Attach version labels 927 for( $i = $num_version_labels - 1; $i >= 0; $i -= 1 ) 928 { 929 print "$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"\n" 930 if $options{'debug'}; 931 $rcs_output = `$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"`; 932 print "Version label $new_label[$i] added to revision $label_revision[$i]\n"; 933 934 # If the label revision is attached to a 1.* revision on the trunk 935 # when a 2.* revision exists, then 1.MAX needs to be branched to 936 # allow commits to this label. This applies to 2.* when 3.* 937 # exists, as well. 938 if ($label_revision[$i] !~ /\./) 939 { 940 # This revision is attached to the trunk. 941 # $rcs_rev_nums[0] will always be the max revision. 942 print "Label `$new_label[$i]' moved from $label_revision[$i] to "; 943 if (exists $trunk_branches{$label_revision[$i]}) 944 { 945 $label_revision[$i] = $trunk_branches{$label_revision[$i]}; 946 } 947 else 948 { 949 # Attached to X.* with X < M 950 my @X_revs = grep /^$label_revision[$i]\./, @rcs_rev_nums; 951 # Need a _NEW_ branch from $X_revs[0] to attach 952 # to. CVS could do this easily, but our archive 953 # isn't in a CVS repository yet. 954 my @tmp_lbl = @label_revision; 955 my @branch_nums = grep s/^\Q$X_revs[0]\E\.0\.(\d+)$/$1/, @tmp_lbl; 956 @tmp_lbl = @rcs_rev_nums; 957 push @branch_nums, 958 grep (s/^\Q$X_revs[0]\E\.(\d+)\.\d+$/$1/, @tmp_lbl); 959 my $max = 0; 960 foreach my $num (@branch_nums) 961 { 962 $max = $num if $num > $max; 963 } 964 $max += 2; 965 $trunk_branches{$label_revision[$i]} = "$X_revs[0].0.$max"; 966 $label_revision[$i] = "$X_revs[0].0.$max"; 967 } 968 print "$label_revision[$i].\n"; 969 } 970 971 $rcs_output = `$rcs_base_command -n$new_label[$i]:$label_revision[$i] \"$workfile\"`; 972 print "Version label $new_label[$i] added to revision $label_revision[$i]\n"; 973 974 if ($label_revision[$i] =~ /^(.*)\.0\./) 975 { 976 my $base = $1; 977 my $rootlbl = $new_label[$i]; 978 $rootlbl =~ s/.$/_broot$&/; 979 $rcs_output = `$rcs_base_command -n$rootlbl:$base \"$workfile\"`; 980 print "Version label $rootlbl added to revision $base\n"; 981 } 982 983 } # foreach label 984 985 if ($options{'cvs-module-path'}) 986 { 987 print "Moving $rcsarchive to $cvsarchive\n"; 988 move $rcsarchive, $cvsarchive or warn "Move failed: $!"; 989 } 990 991 # hit_any_key; 992 } # foreach pvcs archive file 993 994 # We processed a vcs directory, so if there were any files, lock it. 995 # We are guaranteed to have made the attempt at 996 # 997 # $skipdirlock gets set if a single file name was passed to this function to enable 998 # a '$0 *' operation... 999 if ( @pvcsarchives && !$skipdirlock) 1000 { 1001 my $fh = new IO::File ">>$donefile_name" or new IO::File ">$donefile_name"; 1002 if ($fh) 1003 { 1004 $fh->close; 1005 } 1006 else 1007 { 1008 error_count 'error', \$errors, "couldn't create lockfile $cd/$donefile_name"; 1009 } 1010 } 1011 1012 $curlevel = $curlevel - 1; 1013 1014 chdir $old_dir 1015 or die "Failed to restore original directory ($old_dir): ", $!, ", stopped"; 1016 1017 # Update the relative directory path. 1018 pop @rel_dirs if -d $dir; 1019 1020 return ($errors, $warnings); 1021 } 1022 1023 1024 1025# 1026# This function effectively does a cmp between two revision numbers 1027# It is intended to be passed into Perl's sort routine. 1028# 1029# the pvcs_out is not implemented well. It should probably be 1030# returnning $b[0] <=> $a[0] rather than $a[0] <=> $b[0] 1031# 1032# The @_ argument implementation was going to be used for revision 1033# comparison as an aid to remove the /^\sRev/ in revision comment 1034# error. The effort was fruitless at the time. 1035sub revisions 1036 { 1037 my @a = split /\./, (defined $a) ? $a : shift; 1038 my @b = split /\./, (defined $b) ? $b : shift; 1039 my $function = @_ ? shift : 'rcs_in'; 1040 my ($i, $ret_val); 1041 1042 die "Not enough arguments to revisions : a = ", join (".", @a), 1043 "; b = ", join (".", @b), ", stopped" 1044 unless (@a and @b); 1045 1046 for ($i = 0; $i < scalar( @a ) && $i < scalar( @b ); $i++) 1047 { 1048 $a[$i] == $b[$i] or return ($a[$i] <=> $b[$i]); 1049 } 1050 1051 return 0 if (scalar (@a) == scalar (@b)); 1052 1053 if ($function eq 'rcs_in') 1054 { 1055 return (($i == @b) || -1); 1056 } 1057 elsif ($function eq 'pvcs_out') 1058 { 1059 return (($i == @a) || -1); 1060 } 1061 else 1062 { 1063 die "error - Invalid function type passed to revisions ($function)", ", stopped"; 1064 } 1065 } 1066 1067 1068 1069sub pvcs_to_rcs_rev_number 1070 { 1071 my($input, $num_fields, @rev_string, $return_rev_num, $i); 1072 1073 $input = $_[0]; 1074 $num_fields = split /\./, $input; 1075 @rev_string = @_; 1076 # @rev_string[$num_fields-1] += 1; 1077 1078 for( $i = 1; $i < $num_fields; $i += 1 ) 1079 { 1080 if ( $i % 2 ) 1081 { 1082 # DRP: 10/1 1083 # RCS does not allow revision zero 1084 $rev_string[ $i ] += 1; 1085 } 1086 elsif ( $i ) 1087 { 1088 # DRP: 10/1 1089 # Branches must have even references for compatibility 1090 # with CVS's magic branch numbers. 1091 # (Indexes 2, 4, 6...) 1092 $rev_string[ $i ] *= 2; 1093 } 1094 } 1095 1096 # If this is a branch revision # (PVCS: a.b.c.*) then we want the CVS 1097 # revision # instead. It's okay to do this conversion here since we 1098 # never commit to branches. We'll only get a PVCS revision # in that 1099 # form when looking through the revision labels. 1100 if ($input =~ /\*$/) 1101 { 1102 pop @rev_string; 1103 # If there is only one entry in @rev_string, this is a 1104 # revision that needs to be attached to the trunk. Let it be 1105 # for now. It might require a new branch, but we can't decide 1106 # which branches are valid to create before we know what 1107 # branches already exist. 1108 push @rev_string, splice (@rev_string, -1, 1, "0") 1109 unless @rev_string == 1; 1110 } 1111 1112 $return_rev_num = join ".", @rev_string; 1113 return $return_rev_num; 1114 } 1115 1116 1117 1118 1119 1120### 1121### 1122### 1123### 1124### 1125### MAIN program: checks to see if there are command line parameters 1126### 1127### 1128### 1129### 1130### 1131 1132 1133 1134 1135 1136# and read the options 1137die $usage 1138 unless GetOptions (\%options, "h|help" => \&exit_help, 1139 "recurse!", "mode|m=s", "errorfiles!", "l", 1140 "rcs-dirs|rcs-directories|r=s", 1141 "pvcs-dirs|pvcs-directories|p=s", "test-binaries|t!", 1142 "rcs-extension=s", "verify|v=s", "vcsid|i=s", "verbose!", 1143 "debug!", "force-binary!", "cvs-branch-labels!", 1144 "warnings|w!", "cvs-module-path|d=s"); 1145 1146 1147 1148# 1149# Special processing for -l !^#%$^@#$%#$ 1150# 1151# At the moment, -l overrides --recurse, regardless of the order the 1152# options were passed in 1153# 1154$options{recurse} = 0 if defined $options{l}; 1155delete $options{l}; 1156 1157 1158 1159# Make sure we got acceptable values for rcs-dirs and pvcs-dirs 1160my @hits = grep /^$options{'rcs-dirs'}/i, ("leaf", "flat"); 1161@hits == 1 or die 1162 "$0: $options{'rcs-dirs'} invalid argument to --rcs-dirs or ambiguous\n" 1163 . " abbreviation.\n" 1164 . " Must be one of: 'leaf' or 'flat'.\n" 1165 . $usage; 1166$options{'rcs-dirs'} = $hits[0]; 1167$options{'rcs-dirs-flat'} = ($options{'rcs-dirs'} =~ /flat/); 1168delete $options{'rcs-dirs'}; 1169 1170@hits = grep /^$options{'pvcs-dirs'}/i, ("leaf", "flat"); 1171@hits == 1 or die 1172 "$0: $options{'pvcs-dirs'} invalid argument to --pvcs-dirs or ambiguous\n" 1173 . " abbreviation.\n" 1174 . " Must be one of: 'leaf' or 'flat'.\n" 1175 . $usage; 1176$options{'pvcs-dirs'} = $hits[0]; 1177$options{'pvcs-dirs-flat'} = ($options{'pvcs-dirs'} =~ /flat/); 1178delete $options{'pvcs-dirs'}; 1179 1180# and for verify 1181@hits = grep /^$options{verify}/i, ("none", "locks", "exists", "lockdates", "revs", "full"); 1182@hits == 1 or die 1183 "$0: $options{verify} invalid argument to --verify or ambiguous\n" 1184 . " abbreviation.\n" 1185 . " Must be one of: 'none', 'locks', 'exists', 'lockdates', 'revs',\n" 1186 . " or 'full'.\n" 1187 . $usage; 1188$options{verify} = $hits[0]; 1189$options{verify} =~ /^none|locks|exists$/ or die 1190 "$0: --verify=$options{verify} unimplemented.\n" 1191 . $usage; 1192 1193# and mode 1194@hits = grep /^$options{mode}/i, ("convert", "verify"); 1195@hits == 1 or die 1196 "$0: $options{mode} invalid argument to --mode or ambiguous abbreviation.\n" 1197 . " Must be 'convert' or 'verify'.\n" 1198 . $usage; 1199$options{mode} = $hits[0]; 1200 1201$options{'cvs-branch-labels'} or die 1202 "$0: RCS Branch Labels unimplemented.\n" 1203 . $usage; 1204 1205# export VCSID into th environment for ourselves and our children 1206$ENV{VCSID} = $options{vcsid}; 1207 1208 1209 1210# 1211# Verify we have all the binary executables we need to run this script 1212# 1213# Allowed this feature to be disabled in case which is missing or we are 1214# running on a system which does not return error codes properly (e.g. WIN95) 1215# 1216# -- i.e. I don't feel like grepping output yet. -- 1217# 1218my @missing_binaries = (); 1219if ($options{'test-binaries'}) 1220 { 1221 foreach (@bin_dependancies) 1222 { 1223 my $output = qx/which $_ 2>&1/; 1224 print $output if $options{verbose} && $output; 1225 if ($? || $output =~ /^no/) 1226 { 1227 push @missing_binaries, $_; 1228 } 1229 } 1230 1231 if (scalar @missing_binaries) 1232 { 1233 print STDERR "The following executables were not found in your PATH: " 1234 . join ( " ", @missing_binaries ) 1235 . "\n" 1236 . "You must correct this before continuing.\n"; 1237 exit 1; 1238 } 1239 } 1240delete $options{'test-binaries'}; 1241 1242 1243 1244# 1245# set up our base archive manipulation commands 1246# 1247 1248# set up our rcs_command mods 1249$rcs_base_command = "rcs"; 1250$rcs_base_command .= " -x$options{'rcs-extension'}" 1251 if $options{'rcs-extension'}; 1252 1253# set up our rcs_command mods 1254$ci_base_command = "ci"; 1255$ci_base_command .= " -x$options{'rcs-extension'}" 1256 if $options{'rcs-extension'}; 1257 1258 1259 1260# 1261# So our logs fill in a manner we can monitor with 'tail -f' fairly easily: 1262# 1263STDERR->autoflush (1); 1264STDOUT->autoflush (1); 1265 1266 1267 1268# Initialize the globals we use to keep track of recursion 1269if ($options{recurse}) 1270 { 1271 $maxlevel = 10000; # Arbitrary recursion limit 1272 } 1273else 1274 { 1275 $maxlevel = 1; 1276 } 1277delete $options{recurse}; 1278 1279# So we can lock the directories behind us 1280$donefile_name = $options{'rcs-dirs-flat'} ? "" : "RCS/"; 1281$errorfile_name = $donefile_name . "#conv.errors"; 1282$donefile_name .= "#conv.done"; 1283 1284 1285 1286# 1287# start the whole thing and drop the return code on exit 1288# 1289push @ARGV, "." unless (@ARGV); 1290while ($_ = shift) 1291 { 1292 # reset the recursion level (corresponds to directory depth) 1293 # level 0 is the first directory we enter... 1294 $curlevel = -1; 1295 my ($e, $w) = execdir($_); 1296 $errors += $e; 1297 $warnings += $w; 1298 } 1299 1300 1301 1302print STDERR "$0: " . ($errors ? "Aborted" : "Done") . ".\n"; 1303print STDERR "$0: "; 1304print STDERR ($errors ? $errors : "No") . " error" . (($errors != 1) ? "s" : ""); 1305print STDERR ", " . ($warnings ? $warnings : "no") . " warning" . (($warnings != 1) ? "s" : "") 1306 if ($options{warnings}); 1307print STDERR ".\n"; 1308 1309 1310 1311# 1312# Woo-hoo! We made it! 1313# 1314exit $errors; 1315