diff options
author | Jos I. Boumans <kane@dwim.org> | 2007-07-02 17:20:37 +0200 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2007-07-02 13:35:06 +0000 |
commit | 28f2d4d1a9ee0dc43de025aac86c30a6932449c8 (patch) | |
tree | b8a8def9b529a31bac4edfb833c2f92290735ac4 /Porting | |
parent | 629cba96727598e4b29186228abaa02879453180 (diff) | |
download | perl-28f2d4d1a9ee0dc43de025aac86c30a6932449c8.tar.gz |
Add add-package.pl to the core (was Re: Why no (XML|DBI|WWW|Template) modules in the core?)
From: "Jos I. Boumans" <kane@dwim.org>
Message-Id: <A819F8C7-19C9-4ECE-8CF5-80FAAF54F890@dwim.org>
p4raw-id: //depot/perl@31518
Diffstat (limited to 'Porting')
-rw-r--r-- | Porting/add-package.pl | 441 |
1 files changed, 441 insertions, 0 deletions
diff --git a/Porting/add-package.pl b/Porting/add-package.pl new file mode 100644 index 0000000000..db4c531671 --- /dev/null +++ b/Porting/add-package.pl @@ -0,0 +1,441 @@ +#!/opt/bin/perl +use strict; +use warnings; + +use Cwd; +use Getopt::Std; +use File::Basename; +use FindBin; + +my $Opts = {}; +getopts( 'r:p:e:vud', $Opts ); + +my $Cwd = cwd(); +my $Verbose = 1; +my $ExcludeRe = $Opts->{e} ? qr/$Opts->{e}/ : undef; +my $Debug = $Opts->{v} || 0; +my $RunDiff = $Opts->{d} || 0; +my $PkgDir = $Opts->{p} || cwd(); +my $MasterRepo = $Opts->{r} or die "Need repository!\n". usage(); + +### strip trailing slashes; +$MasterRepo =~ s|/$||; + +my $CPV = $Debug ? '-v' : ''; +my $TestBin = 'ptardiff'; +my $PkgDirRe = quotemeta( $PkgDir .'/' ); +my $Repo = $MasterRepo . '-' . basename( $PkgDir ) . '.' . $$; + +### chdir there +chdir $PkgDir or die "Could not chdir to $PkgDir: $!"; + +### set up the repo dir from the master repo +{ print "Setting up working repo under '$Repo'..." if $Verbose; + unless( -d $Repo ) { + system( "mkdir -p $Repo" ) + and die "Could not create working repo '$Repo': $?"; + } + + system( "cp -Rf $MasterRepo/* $Repo" ) + and die "Copying master repo to $Repo failed: $?"; + + print "done\n" if $Verbose; +} + +### copy over all files under lib/ +{ print "Copying libdir..." if $Verbose; + die "No lib/ directory found\n" unless -d 'lib'; + system( "cp -fR $CPV lib $Repo" ) and die "Copy of lib/ failed: $?"; + print "done\n" if $Verbose; +} + +### find the directory to put the t/ and bin/ files under +my $RelTopDir; # topdir from the repo root +my $TopDir; # full path to the top dir +my $ModName; # name of the module +my @ModFiles; # the .PMs in this package +{ print "Creating top level dir..." if $Verbose; + + ### make sure we get the shortest file, so we dont accidentally get + ### a subdir + @ModFiles = sort { length($a) <=> length($b) } + map { chomp; $_ } + grep { $ExcludeRe ? $_ !~ $ExcludeRe : 1 } + grep /\.p(?:m|od)$/, + `find $PkgDir/lib -type f` + or die "No TopDir detected\n"; + + $RelTopDir = $ModFiles[0]; + $RelTopDir =~ s/^$PkgDirRe//; + $RelTopDir =~ s/\.p(m|od)$//; + $TopDir = "$Repo/$RelTopDir"; + + ### create the dir if it's not there yet + unless( -d $TopDir ) { + system( "mkdir $TopDir" ) and die "Creating dir $TopDir failed: $?"; + } + + ### the module name, like Foo::Bar + ### slice syntax not elegant, but we need to remove the + ### leading 'lib/' entry + ### stupid temp vars! stupid perl! it doesn't do @{..}[0..-1] :( + { my @list = @{[split '/', $RelTopDir]}; + $ModName = join '::', @list[1 .. $#list]; + } + + ### the .pm files in this package + @ModFiles = map { s|^$PkgDirRe||; $_ } @ModFiles + or die "Could not detect modfiles\n"; + + print "done\n" if $Verbose; +} + +my $TopDirRe = quotemeta( $TopDir . '/' ); + +### copy over t/ and bin/ directories to the $TopDir +my @TestFiles; +{ print "Copying t/* files to $TopDir..." if $Verbose; + + -d 't' + ? system( "cp -fR $CPV t $TopDir" ) && die "Copy of t/ failed: $?" + : warn "No t/ directory found\n"; + + @TestFiles = map { chomp; s|^$TopDirRe||; $_ } + ### should we get rid of this file? + grep { $ExcludeRe && $_ =~ $ExcludeRe + ? do { warn "Removing $_\n"; + system("rm $_") and die "rm '$_' failed: $?"; + undef + } + : 1 + } `find $TopDir/t -type f` + or die "Could not detect testfiles\n"; + + print "done\n" if $Verbose; +} + +my @BinFiles; +BIN: { + unless (-d 'bin') { + print "No bin/ directory found\n" if $Verbose; + last BIN; + } + print "Copying bin/* files to $TopDir..." if $Verbose; + + system("cp -fR $CPV bin/* $TopDir/bin/") && die "Copy of bin/ failed: $?"; + + @BinFiles = map { chomp; s|^$TopDirRe||; $_ } + ### should we get rid of this file? + grep { $ExcludeRe && $_ =~ $ExcludeRe + ? do { warn "Removing $_\n"; + system("rm $_") and die "rm '$_' failed: $?"; + undef + } + : 1 + } `find $TopDir/bin -type f` + or die "Could not detect binfiles\n"; + + print "done\n" if $Verbose; +} + +### add files where they are required +my @NewFiles; +{ for my $bin ( map { basename( $_ ) } @BinFiles ) { + print "Registering $bin with system files...\n"; + + ### fix installperl, so these files get installed by other utils + ### ./installperl: return if $name =~ + ### /^(?:cpan|instmodsh|prove|corelist|ptar|ptardiff|config_data)\z/; + { my $file = 'installperl'; + + ### not there already? + unless( `grep $TestBin $Repo/$file| grep $bin` ) { + print " Adding $bin to $file..." if $Verbose; + + ### double \\| required --> once for in this script, once + ### for the cli + system("$^X -pi -e 's/($TestBin\\|)/$bin|\$1/' $Repo/$file") + and die "Could not add $bin to $file: $?"; + print "done\n" if $Verbose; + } else { + print " $bin already mentioned in $file\n" if $Verbose; + } + } + + ### fix utils.lst, so the new tools are mentioned + { my $file = 'utils.lst'; + + ### not there already? + unless( `grep $bin $Repo/$file` ) { + print " Adding $bin to $file..." if $Verbose; + + ### double \\| required --> once for in this script, once + ### for the cli + system("$^X -pi -e 's!($TestBin)!\$1\nutils/$bin!' $Repo/$file") + and die "Could not add $bin to $file: $?"; + print "done\n" if $Verbose; + } else { + print " $bin already mentioned in $file\n" if $Verbose; + } + } + + ### make a $bin.PL file and fix it up + { my $src = "utils/${TestBin}.PL"; + my $file = "utils/${bin}.PL"; + + ### not there already? + unless( -e "$Repo/$file" ) { + print " Creating $file..." if $Verbose; + + ### important part of the template looks like this + ### (we'll need to change it): + # my $script = File::Spec->catfile( + # File::Spec->catdir( + # File::Spec->updir, qw[lib Archive Tar bin] + # ), "module-load.pl"); + + ### copy another template file + system( "cp -f $Repo/$src $Repo/$file" ) + and die "Could not create $file from $src: $?"; + + ### change the 'updir' path + ### make sure to escape the \[ character classes + my $updir = join ' ', (split('/', $RelTopDir), 'bin'); + system( "$^X -pi -e'". + 's/^(.*?File::Spec->updir, qw\[).+?(\].*)$/'. + "\$1 $updir \$2/' $Repo/$file" + ) and die "Could not fix updir for $bin in $file: $?"; + + + ### change the name of the file from $TestBin to $bin + system( "$^X -pi -e's/$TestBin/$bin/' $Repo/$file" ) + and die "Could not update $file with '$bin' as name: $?"; + + print "done\n" if $Verbose; + + } else { + print " $file already exists\n" if $Verbose; + } + + ### we've may just have created a new file, it will have to + ### go into the manifest + push @NewFiles, $file; + } + + ### add an entry to utils/Makefile for $bin + { my $file = "utils/Makefile"; + + ### not there already? + unless( `grep $bin $Repo/$file` ) { + print " Adding $bin entries to $file..." if $Verbose; + + ### $bin appears on 4 lines in this file, so replace all 4 + ### first, pl = + system( "$^X -pi -e'/^pl\\s+=/ && s/(${TestBin}.PL)/". + "\$1 ${bin}.PL/' $Repo/$file" + ) and die "Could not add $bin to the pl = entry: $?"; + + ### next, plextract = + system( "$^X -pi -e'/^plextract\\s+=/ " . + "&& s/(${TestBin})/\$1 $bin/' $Repo/$file" + ) and die "Could not add $bin to the plextract = entry: $?"; + + ### third, plextractexe = + system( "$^X -pi -e'/^plextractexe\\s+=/ " . + "&& s!(\./${TestBin})!\$1 ./$bin!' $Repo/$file" + ) and die "Could not add $bin to the plextractexe = entry: $?"; + + ### last, the make directive $bin: + system( "$^X -pi -e'/^(${TestBin}:.+)/; \$x=\$1 or next;" . + "\$x =~ s/$TestBin/$bin/g;" . '$_.=$/.$x.$/;' . + "' $Repo/$file" + ) and die "Could not add $bin as a make directive: $?"; + + print "done\n" if $Verbose; + } else { + print " $bin already added to $file\n" if $Verbose; + } + } + + ### add entries to win32/Makefile and win32/makefile.mk + ### they contain the following lines: + # ./win32/makefile.mk: ..\utils\ptardiff \ + # ./win32/makefile.mk: xsubpp instmodsh prove ptar ptardiff + for my $file ( qw[win32/Makefile win32/makefile.mk] ) { + unless ( `grep $bin $Repo/$file` ) { + print " Adding $bin entries to $file..." if $Verbose; + + system( "$^X -pi -e'/^(.+?utils.${TestBin}.+)/;". + '$x=$1 or next;' . + "\$x =~ s/$TestBin/$bin/g;" . '$_.=$x.$/;' . + "' $Repo/$file" + ) and die "Could not add $bin to UTILS section in $file: $?\n"; + + system( "$^X -pi -e's/( $TestBin)/\$1 $bin/' $Repo/$file" ) + and die "Could not add $bin to $file: $?\n"; + + print "done\n" if $Verbose; + } else { + print " $bin already added to $file\n" if $Verbose; + } + } + + ### we need some entries in a vms specific file as well.. + ### except, i dont understand how it works or what it does, and it + ### looks all a bit odd... so lets just print a warning... + ### the entries look something like this: + # ./vms/descrip_mms.template:utils4 = [.utils]enc2xs.com + # [.utils]piconv.com [.utils]cpan.com [.utils]prove.com + # [.utils]ptar.com [.utils]ptardiff.com [.utils]shasum.com + # ./vms/descrip_mms.template:[.utils]ptardiff.com : [.utils]ptardiff.PL + # $(ARCHDIR)Config.pm + { my $file = 'vms/descrip_mms.template'; + + unless( `grep $bin $Repo/$file` ) { + print $/.$/; + print " WARNING! You should add entries like the following\n" + . " to $file (Using $TestBin as an example)\n" + . " Unfortunately I dont understand what these entries\n" + . " do, so I wont change them automatically:\n\n"; + + print `grep -nC1 $TestBin $Repo/$file`; + print $/.$/; + + } else { + print " $bin already added to $file\n" if $Verbose; + } + } + } +} + +### binary files must be encoded! +### XXX use the new 'uupacktool.pl' +{ my $pack = "$Repo/uupacktool.pl"; + + ### pack.pl encodes binary files for us + -e $pack or die "Need $pack to encode binary files!"; + + ### chdir, so uupacktool writes relative files properly + ### into it's header... + my $curdir = cwd(); + chdir($Repo) or die "Could not chdir to '$Repo': $!"; + + for my $aref ( \@ModFiles, \@TestFiles, \@BinFiles ) { + for my $file ( @$aref ) { + my $full = -e $file ? $file : + -e "$RelTopDir/$file" ? "$RelTopDir/$file" : + die "Can not find $file in $Repo or $TopDir\n"; + + if( -f $full && -s _ && -B _ ) { + print "Binary file $file needs encoding\n" if $Verbose; + + my $out = $full . '.packed'; + + ### does the file exist already? + ### and doesn't have +w + if( -e $out && not -w _ ) { + system("chmod +w $out") + and die "Could not set chmod +w to '$out': $!"; + } + + ### -D to remove the original + system("$^X $pack -D -p $full $out") + and die "Could not encode $full to $out"; + + + $file .= '.packed'; + } + } + } + + chdir($curdir) or die "Could not chdir back to '$curdir': $!"; +} + +### update the manifest +{ my $file = $Repo . '/MANIFEST'; + my @manifest; + { open my $fh, "<$file" or die "Could not open $file: $!"; + @manifest = <$fh>; + close $fh; + } + + ### fill it with files from our package + my %pkg_files; + for ( @ModFiles ) { + $pkg_files{$_} = "$_\t$ModName\n"; + } + + for ( @TestFiles ) { + $pkg_files{"$RelTopDir/$_"} = "$RelTopDir/$_\t$ModName tests\n" + } + + for ( @BinFiles ) { + $pkg_files{"$RelTopDir/$_"} = "$RelTopDir/$_\tthe ". + basename($_) ." utility\n"; + } + + for ( @NewFiles ) { + $pkg_files{$_} = "$_\tthe ". + do { m/(.+?)\.PL$/; basename($1) } . + " utility\n" + } + + ### remove all the files that are already in the manifest; + delete $pkg_files{ [split]->[0] } for @manifest; + + print "Adding the following entries to the MANIFEST:\n" if $Verbose; + print "\t$_" for sort values %pkg_files; + print $/.$/; + + push @manifest, values %pkg_files; + + { chmod 0755, $file; + open my $fh, ">$file" or die "Could not open $file for writing: $!"; + #print $fh sort { lc $a cmp lc $b } @manifest; + ### XXX stolen from pod/buildtoc:sub do_manifest + print $fh + map { $_->[0] } + sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] } + map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] } + @manifest; + + close $fh; + } +} + +### would you like us to show you a diff? +if( $RunDiff ) { + my $diff = $Repo; $diff =~ s/$$/patch/; + + print "Generating diff..." if $Verbose; + + ### weird RV ;( + my $master = basename( $MasterRepo ); + my $repo = basename( $Repo ); + my $chdir = dirname( $MasterRepo ); + + system( "cd $chdir; diff -ruN $master $repo > $diff" ); + #and die "Could not write diff to '$diff': $?"; + die "Could not write diff to '$diff'" unless -e $diff && -s _; + + print "done\n" if $Verbose; + print "\nDiff can be applied with patch -p1 in $MasterRepo\n\n"; + print " Diff written to: $diff\n\n" if $Verbose; +} + +sub usage { + my $me = basename($0); + return qq[ + +Usage: $me -r PERL_REPO_DIR [-p PACKAGE_DIR] [-v] [-d] [-e REGEX] + +Options: + -r Path to perl-core repository + -v Run verbosely + -e Perl regex matching files that shouldn't be included + -d Create a diff as patch file + -p Path to the package to add. Defaults to cwd() + + \n]; + +} |