Porting/add-package.pl

   1 #!/opt/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use Cwd;
   6 use Getopt::Std;
   7 use File::Basename;
   8 use FindBin;
   9
  10 my $Opts = {};
  11 getopts( 'r:p:e:vudn', $Opts );
  12
  13 my $Cwd         = cwd();
  14 my $Verbose     = 1;
  15 my $ExcludeRe   = $Opts->{e} ? qr/$Opts->{e}/ : undef;
  16 my $Debug       = $Opts->{v} || 0;
  17 my $RunDiff     = $Opts->{d} || 0;
  18 my $PkgDir      = $Opts->{p} || cwd();
  19 my $Repo        = $Opts->{r} or die "Need repository!\n". usage();
  20 my $NoBranch    = $Opts->{n} || 0;
  21
  22 ### strip trailing slashes;
  23 $Repo =~ s|/$||;
  24
  25 my $CPV         = $Debug ? '-v' : '';
  26 my $TestBin     = 'ptardiff';
  27 my $PkgDirRe    = quotemeta( $PkgDir .'/' );
  28 my $BranchName  = basename( $PkgDir ) . '.' . $$;
  29 my $OrigRepo    = $Repo;
  30
  31 ### establish working directory, either branch or full copy
  32 if ( $NoBranch ) {
  33     ### create a copy of the repo directory
  34     my $RepoCopy = "$Repo-$BranchName";
  35     print "Copying repository to $RepoCopy ..." if $Verbose;
  36
  37     system( "cp --archive -f $Repo $RepoCopy" )
  38         and die "Copying master repo to $RepoCopy failed: $?";
  39
  40     ### Going forward, use the copy in place of the original repo
  41     $Repo = $RepoCopy;
  42
  43     print "done\n" if $Verbose;
  44 }
  45 else {
  46     ### create a git branch for the new package
  47     print "Setting up a branch from blead called '$BranchName'..." if $Verbose;
  48     chdir $Repo or die "Could not chdir to $Repo: $!";
  49     unless ( -d '.git' ) {
  50         die "\n$Repo is not a git repository\n";
  51     }
  52     my $status = `git status`;
  53     unless ( $status =~ /nothing to commit/ims ) {
  54       die "\nWorking directory not clean. Stopping.\n";
  55     }
  56     system( "git co -b $BranchName blead" )
  57             and die "Could not create branch '$BranchName': $?";
  58
  59     print "done\n" if $Verbose;
  60 }
  61
  62 ### chdir there
  63 chdir $PkgDir or die "Could not chdir to $PkgDir: $!";
  64
  65 ### copy over all files under lib/
  66 my @LibFiles;
  67 {   print "Copying libdir..." if $Verbose;
  68     die "Can't (yet) copy from a repository (found .git or .svn)"
  69         if -d '.git' || -d '.svn';
  70     die "No lib/ directory found\n" unless -d 'lib';
  71     system( "cp -fR $CPV lib $Repo" ) and die "Copy of lib/ failed: $?";
  72
  73     @LibFiles =    map { chomp; $_ }
  74                     ### should we get rid of this file?
  75                     grep { $ExcludeRe && $_ =~ $ExcludeRe
  76                         ? do {  warn "Removing $_\n";
  77                                 system("rm $_") and die "rm '$_' failed: $?";
  78                                 undef
  79                             }
  80                         : 1
  81                      } `find lib -type f`
  82         or die "Could not detect library files\n";
  83
  84     print "done\n" if $Verbose;
  85 }
  86
  87 ### find the directory to put the t/ and bin/ files under
  88 my $RelTopDir;      # topdir from the repo root
  89 my $TopDir;         # full path to the top dir
  90 my $ModName;        # name of the module
  91 my @ModFiles;       # the .PMs in this package
  92 {   print "Creating top level dir..." if $Verbose;
  93
  94     ### make sure we get the shortest file, so we dont accidentally get
  95     ### a subdir
  96     @ModFiles   =  sort { length($a) <=> length($b) }
  97                    map  { chomp; $_ }
  98                    grep { $ExcludeRe ? $_ !~ $ExcludeRe : 1 }
  99                    grep /\.p(?:m|od)$/,
 100                     `find $PkgDir/lib -type f`
 101                         or die "No TopDir detected\n";
 102
 103     $RelTopDir  = $ModFiles[0];
 104     $RelTopDir  =~ s/^$PkgDirRe//;
 105     $RelTopDir  =~ s/\.p(m|od)$//;
 106     $TopDir     = "$Repo/$RelTopDir";
 107
 108     ### create the dir if it's not there yet
 109     unless( -d $TopDir ) {
 110         system( "mkdir $TopDir" ) and die "Creating dir $TopDir failed: $?";
 111     }
 112
 113     ### the module name, like Foo::Bar
 114     ### slice syntax not elegant, but we need to remove the
 115     ### leading 'lib/' entry
 116     ### stupid temp vars! stupid perl! it doesn't do @{..}[0..-1] :(
 117     {   my @list = @{[split '/', $RelTopDir]};
 118         $ModName = join '::', @list[1 .. $#list];
 119     }
 120
 121     ### the .pm files in this package
 122     @ModFiles = map { s|^$PkgDirRe||; $_ } @ModFiles
 123         or die "Could not detect modfiles\n";
 124
 125     print "done\n" if $Verbose;
 126 }
 127
 128 my $TopDirRe = quotemeta( $TopDir . '/' );
 129
 130 ### copy over t/ and bin/ directories to the $TopDir
 131 my @TestFiles;
 132 {   print "Copying t/* files to $TopDir..." if $Verbose;
 133
 134    -d 't'
 135        ? system( "cp -fR $CPV t $TopDir" ) && die "Copy of t/ failed: $?"
 136        : warn "No t/ directory found\n";
 137
 138     @TestFiles =    map { chomp; s|^$TopDirRe||; $_ }
 139                     ### should we get rid of this file?
 140                     grep { $ExcludeRe && $_ =~ $ExcludeRe
 141                         ? do {  warn "Removing $_\n";
 142                                 system("rm $_") and die "rm '$_' failed: $?";
 143                                 undef
 144                             }
 145                         : 1
 146                      } `find $TopDir/t -type f`
 147         or die "Could not detect testfiles\n";
 148
 149     print "done\n" if $Verbose;
 150 }
 151
 152 my $BinDir;
 153 my @BinFiles;
 154 my $TopBinDir;
 155 BIN: {
 156     $BinDir = -d 'bin'      ? 'bin' :
 157               -d 'scripts'  ? 'scripts' : undef ;
 158     unless ($BinDir) {
 159         print "No bin/ or scripts/ directory found\n" if $Verbose;
 160         last BIN;
 161     }
 162     my $TopBinDir = "$TopDir/$BinDir/";
 163     print "Copying $BinDir/* files to $TopBinDir..." if $Verbose;
 164
 165     my $CopyCmd = "cp -fR $CPV $BinDir $TopDir";
 166     print "Running '$CopyCmd'..." if $Verbose;
 167
 168     system($CopyCmd) && die "Copy of $BinDir failed: $?";
 169
 170     @BinFiles = map { chomp; s|^$TopDirRe||; $_ }
 171                 ### should we get rid of this file?
 172                 grep { $ExcludeRe && $_ =~ $ExcludeRe
 173                     ? do {  warn "Removing $_\n";
 174                             system("rm $_") and die "rm '$_' failed: $?";
 175                             undef
 176                         }
 177                     : 1
 178                  } `find $TopBinDir -type f`
 179         or die "Could not detect binfiles\n";
 180
 181     print "done\n" if $Verbose;
 182 }
 183
 184 ### add files where they are required
 185 my @NewFiles;
 186 my @ChangedFiles;
 187 {   for my $bin ( map { basename( $_ ) } @BinFiles ) {
 188         print "Registering $bin with system files...\n";
 189
 190         ### fix installperl, so these files get installed by other utils
 191         ### ./installperl:    return if $name =~
 192         ### /^(?:cpan|instmodsh|prove|corelist|ptar|ptardiff|config_data)\z/;
 193         {   my $file = 'installperl';
 194
 195             ### not there already?
 196             unless( `grep $TestBin $Repo/$file| grep $bin` ) {
 197                 print "   Adding $bin to $file..." if $Verbose;
 198
 199                 ### double \\| required --> once for in this script, once
 200                 ### for the cli
 201                 system("$^X -pi -e 's/($TestBin\\|)/$bin|\$1/' $Repo/$file")
 202                     and die "Could not add $bin to $file: $?";
 203                 print "done\n" if $Verbose;
 204                 push @ChangedFiles, $file;
 205             } else {
 206                 print "    $bin already mentioned in $file\n" if $Verbose;
 207             }
 208         }
 209
 210         ### fix utils.lst, so the new tools are mentioned
 211         {   my $file = 'utils.lst';
 212
 213             ### not there already?
 214             unless( `grep $bin $Repo/$file` ) {
 215                 print "    Adding $bin to $file..." if $Verbose;
 216
 217                 ### double \\| required --> once for in this script, once
 218                 ### for the cli
 219                 system("$^X -pi -e 's!($TestBin)!\$1\nutils/$bin!' $Repo/$file")
 220                     and die "Could not add $bin to $file: $?";
 221                 print "done\n" if $Verbose;
 222                 push @ChangedFiles, $file;
 223             } else {
 224                 print "    $bin already mentioned in $file\n" if $Verbose;
 225             }
 226         }
 227
 228         ### make a $bin.PL file and fix it up
 229         {   my $src  = "utils/${TestBin}.PL";
 230             my $file = "utils/${bin}.PL";
 231
 232             ### not there already?
 233             unless( -e "$Repo/$file" ) {
 234                 print "    Creating $file..." if $Verbose;
 235
 236                 ### important part of the template looks like this
 237                 ### (we'll need to change it):
 238                 # my $script = File::Spec->catfile(
 239                 #    File::Spec->catdir(
 240                 #        File::Spec->updir, qw[lib Archive Tar bin]
 241                 #    ), "module-load.pl");
 242
 243                 ### copy another template file
 244                 system( "cp -f $Repo/$src $Repo/$file" )
 245                     and die "Could not create $file from $src: $?";
 246
 247                 ### change the 'updir' path
 248                 ### make sure to escape the \[ character classes
 249                 my $updir = join ' ', (split('/', $RelTopDir), $BinDir);
 250                 system( "$^X -pi -e'".
 251                         's/^(.*?File::Spec->updir, qw\[).+?(\].*)$/'.
 252                         "\$1 $updir \$2/' $Repo/$file"
 253                 ) and die "Could not fix updir for $bin in $file: $?";
 254
 255
 256                 ### change the name of the file from $TestBin to $bin
 257                 system( "$^X -pi -e's/$TestBin/$bin/' $Repo/$file" )
 258                     and die "Could not update $file with '$bin' as name: $?";
 259
 260                 print "done\n" if $Verbose;
 261
 262             } else {
 263                 print "    $file already exists\n" if $Verbose;
 264             }
 265
 266             ### we've may just have created a new file, it will have to
 267             ### go into the manifest
 268             push @NewFiles, $file;
 269         }
 270
 271         ### add an entry to utils/Makefile.SH for $bin
 272         {   my $file = "utils/Makefile.SH";
 273
 274             ### not there already?
 275             unless( `grep $bin $Repo/$file` ) {
 276                 print "    Adding $bin entries to $file..." if $Verbose;
 277
 278                 ### $bin appears on 4 lines in this file, so replace all 4
 279                 ### first, pl =
 280                 system( "$^X -pi -e'/^pl\\s+=/ && s/(${TestBin}.PL)/".
 281                         "\$1 ${bin}.PL/' $Repo/$file"
 282                 ) and die "Could not add $bin to the pl = entry: $?";
 283
 284                 ### next, plextract =
 285                 system( "$^X -pi -e'/^plextract\\s+=/ " .
 286                         "&& s/(${TestBin})/\$1 $bin/' $Repo/$file"
 287                 ) and die "Could not add $bin to the plextract = entry: $?";
 288
 289                 ### third, plextractexe =
 290                 system( "$^X -pi -e'/^plextractexe\\s+=/ " .
 291                         "&& s!(\./${TestBin})!\$1 ./$bin!' $Repo/$file"
 292                 ) and die "Could not add $bin to the plextractexe = entry: $?";
 293
 294                 ### last, the make directive $bin:
 295                 system( "$^X -pi -e'/^(${TestBin}:.+)/; \$x=\$1 or next;" .
 296                         "\$x =~ s/$TestBin/$bin/g;" . '$_.=$/.$x.$/;' .
 297                         "' $Repo/$file"
 298                 ) and die "Could not add $bin as a make directive: $?";
 299
 300                 push @ChangedFiles, $file;
 301                 print "done\n" if $Verbose;
 302             } else {
 303                 print "    $bin already added to $file\n" if $Verbose;
 304             }
 305         }
 306
 307         ### add entries to win32/Makefile and win32/makefile.mk
 308         ### they contain the following lines:
 309         # ./win32/makefile.mk:            ..\utils\ptardiff       \
 310         # ./win32/makefile.mk:        xsubpp instmodsh prove ptar ptardiff
 311         for my $file ( qw[win32/Makefile win32/makefile.mk] ) {
 312             unless ( `grep $bin $Repo/$file` ) {
 313                 print "    Adding $bin entries to $file..." if $Verbose;
 314
 315                system( "$^X -pi -e'/^(.+?utils.${TestBin}.+)/;".
 316                         '$x=$1 or next;' .
 317                         "\$x =~ s/$TestBin/$bin/g;" . '$_.=$x.$/;' .
 318                         "' $Repo/$file"
 319                 ) and die "Could not add $bin to UTILS section in $file: $?\n";
 320
 321                 system( "$^X -pi -e's/( $TestBin)/\$1 $bin/' $Repo/$file" )
 322                     and die "Could not add $bin to $file: $?\n";
 323
 324                 push @ChangedFiles, $file;
 325                 print "done\n" if $Verbose;
 326             } else {
 327                 print "    $bin already added to $file\n" if $Verbose;
 328             }
 329         }
 330
 331         ### we need some entries in a vms specific file as well..
 332         ### except, i dont understand how it works or what it does, and it
 333         ### looks all a bit odd... so lets just print a warning...
 334         ### the entries look something like this:
 335         # ./vms/descrip_mms.template:utils4 = [.utils]enc2xs.com
 336         #   [.utils]piconv.com [.utils]cpan.com [.utils]prove.com
 337         #   [.utils]ptar.com [.utils]ptardiff.com [.utils]shasum.com
 338         # ./vms/descrip_mms.template:[.utils]ptardiff.com : [.utils]ptardiff.PL
 339         #   $(ARCHDIR)Config.pm
 340         {   my $file = 'vms/descrip_mms.template';
 341
 342             unless( `grep $bin $Repo/$file` ) {
 343                 print $/.$/;
 344                 print "    WARNING! You should add entries like the following\n"
 345                     . "    to $file (Using $TestBin as an example)\n"
 346                     . "    Unfortunately I dont understand what these entries\n"
 347                     . "    do, so I wont change them automatically:\n\n";
 348
 349                 print `grep -nC1 $TestBin $Repo/$file`;
 350                 print $/.$/;
 351
 352             } else {
 353                 print "    $bin already added to $file\n" if $Verbose;
 354             }
 355         }
 356     }
 357 }
 358
 359 ### binary files must be encoded!
 360 ### XXX use the new 'uupacktool.pl'
 361 {   my $pack = "$Repo/uupacktool.pl";
 362
 363     ### pack.pl encodes binary files for us
 364     -e $pack or die "Need $pack to encode binary files!";
 365
 366     ### chdir, so uupacktool writes relative files properly
 367     ### into it's header...
 368     my $curdir = cwd();
 369     chdir($Repo) or die "Could not chdir to '$Repo': $!";
 370
 371     for my $aref ( \@ModFiles, \@TestFiles, \@BinFiles ) {
 372         for my $file ( @$aref ) {
 373             my $full = -e $file                 ? $file              :
 374                        -e "$RelTopDir/$file"    ? "$RelTopDir/$file" :
 375                        die "Can not find $file in $Repo or $TopDir\n";
 376
 377             if( -f $full && -s _ && -B _ ) {
 378                 print "Binary file $file needs encoding\n" if $Verbose;
 379
 380                 my $out = $full . '.packed';
 381
 382                 ### does the file exist already?
 383                 ### and doesn't have +w
 384                 if( -e $out && not -w _ ) {
 385                     system("chmod +w $out")
 386                         and die "Could not set chmod +w to '$out': $!";
 387                 }
 388
 389                 ### -D to remove the original
 390                 system("$^X $pack -D -p $full $out")
 391                     and die "Could not encode $full to $out";
 392
 393
 394                 $file .= '.packed';
 395             }
 396         }
 397     }
 398
 399     chdir($curdir) or die "Could not chdir back to '$curdir': $!";
 400 }
 401
 402 ### update the manifest
 403 {   my $file        = $Repo . '/MANIFEST';
 404     my @manifest;
 405     {   open my $fh, "<$file" or die "Could not open $file: $!";
 406         @manifest    = <$fh>;
 407         close $fh;
 408     }
 409
 410     ### fill it with files from our package
 411     my %pkg_files;
 412     for ( @ModFiles ) {
 413         $pkg_files{$_}              = "$_\t$ModName\n";
 414     }
 415
 416     for ( @TestFiles ) {
 417         $pkg_files{"$RelTopDir/$_"} = "$RelTopDir/$_\t$ModName tests\n"
 418     }
 419
 420     for ( @BinFiles ) {
 421         $pkg_files{"$RelTopDir/$_"} = "$RelTopDir/$_\tthe ".
 422                                             basename($_) ." utility\n";
 423     }
 424
 425     for ( @NewFiles ) {
 426         $pkg_files{$_}              = "$_\tthe ".
 427                                         do { m/(.+?)\.PL$/; basename($1) } .
 428                                         " utility\n"
 429     }
 430
 431     ### remove all the files that are already in the manifest;
 432     delete $pkg_files{ [split]->[0] } for @manifest;
 433
 434     print "Adding the following entries to the MANIFEST:\n" if $Verbose;
 435     print "\t$_" for sort values %pkg_files;
 436     print $/.$/;
 437
 438     push @manifest, values %pkg_files;
 439
 440     {   chmod 0755, $file;
 441         open my $fh, ">$file" or die "Could not open $file for writing: $!";
 442         #print $fh sort { lc $a cmp lc $b } @manifest;
 443         ### XXX stolen from pod/buildtoc:sub do_manifest
 444         print $fh
 445             map  { $_->[0] }
 446             sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
 447             map  { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
 448             @manifest;
 449
 450         close $fh;
 451     }
 452     push @ChangedFiles, 'MANIFEST';
 453 }
 454
 455
 456 ### would you like us to show you a diff?
 457 if( $RunDiff ) {
 458     if ( $NoBranch ) {
 459
 460         my $diff = $Repo; $diff =~ s/$$/patch/;
 461
 462         ### weird RV ;(
 463         my $master = basename( $OrigRepo );
 464         my $repo   = basename( $Repo );
 465         my $chdir  = dirname( $OrigRepo );
 466
 467         ### the .patch file is added by an rsync from the APC
 468         ### but isn't actually in the p4 repo, so exclude it
 469         my $cmd = "cd $chdir; diff -ruN --exclude=.patch $master $repo > $diff";
 470
 471         print "Running: '$cmd'\n";
 472
 473         print "Generating diff..." if $Verbose;
 474
 475         system( $cmd );
 476             #and die "Could not write diff to '$diff': $?";
 477         die "Could not write diff to '$diff'" unless -e $diff && -s _;
 478
 479         print "done\n" if $Verbose;
 480         print "\nDiff can be applied with patch -p1 in $OrigRepo\n\n";
 481         print "  Diff written to: $diff\n\n" if $Verbose;
 482     }
 483     else {
 484         my $diff = "$Repo/$BranchName"; $diff =~ s/$$/patch/;
 485         my $cmd = "cd $Repo; git diff > $diff";
 486
 487         print "Running: '$cmd'\n";
 488
 489         print "Generating diff..." if $Verbose;
 490
 491         system( $cmd );
 492             #and die "Could not write diff to '$diff': $?";
 493         die "Could not write diff to '$diff'" unless -e $diff && -s _;
 494
 495         print "done\n" if $Verbose;
 496         print "  Diff written to: $diff\n\n" if $Verbose;
 497     }
 498 }
 499
 500
 501 # add files to git index
 502 unless ( $NoBranch ) {
 503     chdir $Repo;
 504     system( "git add $CPV $_" )
 505         for ( @LibFiles, @NewFiles, @ChangedFiles,
 506               map { "$RelTopDir/$_" } @TestFiles, @BinFiles );
 507 }
 508
 509 # return to original directory
 510 chdir $Cwd;
 511
 512 sub usage {
 513     my $me = basename($0);
 514     return qq[
 515
 516 Usage: $me -r PERL_REPO_DIR [-p PACKAGE_DIR] [-v] [-d] [-e REGEX]
 517
 518 Options:
 519   -r    Path to perl-core git repository
 520   -v    Run verbosely
 521   -e    Perl regex matching files that shouldn't be included
 522   -d    Create a diff as patch file
 523   -p    Path to the package to add. Defaults to cwd()
 524   -n    No branching; repository is not a git repo
 525
 526     \n];
 527
 528 }