[svn:parrot] r38062 - in branches/install_tools: lib/Parrot t/tools/install tools/dev
jkeenan at svn.parrot.org
jkeenan at svn.parrot.org
Sat Apr 11 12:47:20 UTC 2009
Author: jkeenan
Date: Sat Apr 11 12:47:18 2009
New Revision: 38062
URL: https://trac.parrot.org/parrot/changeset/38062
Log:
Applying patch submitted by wayland in
https://trac.parrot.org/parrot/ticket/426.
Modified:
branches/install_tools/lib/Parrot/Install.pm
branches/install_tools/t/tools/install/02-install_files.t
branches/install_tools/t/tools/install/03-lines_to_files.t
branches/install_tools/tools/dev/install_dev_files.pl
branches/install_tools/tools/dev/install_files.pl
Modified: branches/install_tools/lib/Parrot/Install.pm
==============================================================================
--- branches/install_tools/lib/Parrot/Install.pm Sat Apr 11 09:44:38 2009 (r38061)
+++ branches/install_tools/lib/Parrot/Install.pm Sat Apr 11 12:47:18 2009 (r38062)
@@ -4,6 +4,7 @@
use warnings;
use File::Basename qw(dirname);
use File::Copy;
+use File::Path; # mkpath
use File::Spec;
use base qw( Exporter );
our @EXPORT_OK = qw(
@@ -42,10 +43,10 @@
B<Arguments:> List of five scalars.
- ($files, $installable_exe, $directories) =
+ ($files, $directories) =
lines_to_files(
\%metatransforms,
- \%othertransforms,
+ \@transformorder,
\@manifests,
\%options,
$parrotdir,
@@ -58,18 +59,25 @@
=cut
sub lines_to_files {
- my ($metatransforms, $othertransforms, $manifests_ref,
+ my ($metatransforms, $transformorder, $manifests_ref,
$options_ref, $parrotdir) = @_;
my @files;
- my @installable_exe;
my %directories;
+ my($tkey, $thash);
+ my $filehash;
# We'll report multiple occurrences of the same file
my(%seen);
+ # Check $manifests_ref
ref($manifests_ref) eq 'ARRAY'
or die "Manifests must be listed in an array reference: $!";
@{ $manifests_ref } > 0 or die "No manifests specified";
+
+ # Check $transformorder
+ ref($transformorder) eq 'ARRAY'
+ or die "Transform order should be an array of keys\n";
+
@ARGV = @{ $manifests_ref };
LINE: while ( my $entry = <> ) {
chomp $entry;
@@ -100,56 +108,50 @@
@metadata{ split( /,/, $meta ) } = ();
$metadata{$entry} = 1 for ( keys %metadata ); # Laziness
+ $filehash = {
+ Source => $src,
+ Dest => $dest,
+ DestDirs => [],
+ };
+
FIXFILE: {
# Have to catch this case early for some unknown reason
if ( $entry =~ /^runtime/ ) {
- $dest =~ s/^runtime\/parrot\///;
- $dest = File::Spec->catdir(
+ $filehash->{Dest} =~ s/^runtime\/parrot\///;
+ $filehash->{Dest} = File::Spec->catdir(
$options_ref->{libdir}, $parrotdir, $dest
);
last FIXFILE;
}
- foreach my $tkey (keys %$metatransforms) {
- if ( $metadata{$tkey} ) {
- my $copy = $dest; # only needed for installable
- $dest = File::Spec->catdir(
- $options_ref->{$metatransforms->{$tkey}->{optiondir} . 'dir'},
- &{ $metatransforms->{$tkey}->{transform} }($dest)
- );
- if ( $metatransforms->{$tkey}->{isbin}
- and
- $copy =~ /^installable/
- ) {
- push @installable_exe, [ $src, $dest ];
- next LINE;
- }
- last FIXFILE;
- }
- }
-
- foreach my $tkey (keys %$othertransforms) {
- if ( $entry =~ /$tkey/ ) {
- $dest = File::Spec->catdir(
- $options_ref->{$othertransforms->{$tkey}->{optiondir} . 'dir'},
- &{ $othertransforms->{$tkey}->{transform} }($dest)
- );
- last FIXFILE;
- }
+ foreach my $tkey (@$transformorder) {
+ $thash = $metatransforms->{$tkey};
+ unless($thash->{ismeta} ? $metadata{$tkey} : $entry =~ /$tkey/) { next; }
+ $filehash = &{ $thash->{transform} }($filehash);
+ ref($filehash) eq 'HASH' or die "Error: transform didn't return a hash for key '$tkey'\n";
+ $filehash->{Dest} = File::Spec->catdir(
+ $options_ref->{$thash->{optiondir} . 'dir'},
+ @{ $filehash->{DestDirs} },
+ $filehash->{Dest}
+ );
+ last FIXFILE;
}
- die "Unknown install location in MANIFEST for file '$entry': ";
+ die "Unknown install location in MANIFEST for file '$entry'\n";
}
- $dest = File::Spec->catdir( $options_ref->{buildprefix}, $dest )
- if $options_ref->{buildprefix};
+ if(! $filehash->{Installable}) {
+ $filehash->{Dest} = File::Spec->catdir( $options_ref->{buildprefix}, $filehash->{Dest} )
+ if $options_ref->{buildprefix};
+ }
- $directories{ dirname($dest) } = 1;
- push( @files, [ $src => $dest ] );
+ $directories{ dirname($filehash->{Dest}) } = 1;
+ push( @files, $filehash );
}
continue {
close ARGV if eof; # Reset line numbering for each input file
}
- return(\@files, \@installable_exe, \%directories);
+ (grep { ! ref } @files) and die "lines_to_files from Parrot::Install created a bad hash!\n";
+ return(\@files, \%directories);
}
=head2 C<create_directories()>
@@ -172,21 +174,9 @@
sub create_directories {
my($destdir, $directories) = @_;
- for my $dir ( map { $destdir . $_ } keys %$directories ) {
- unless ( -d $dir ) {
- my @dirs_needed;
-
- # Make full path to the directory $dir
- while ( ! -d $dir ) { # Scan up to nearest existing ancestor
- unshift @dirs_needed, $dir;
- $dir = dirname($dir);
- }
- foreach my $d ( @dirs_needed ) {
- mkdir( $d, 0777 ) or die "mkdir $d: $!";
- }
- }
- }
- return 1;
+ mkpath([
+ grep { ! -d } map { $destdir . $_ } keys %$directories
+ ],0,0777);
}
=head2 C<install_files()>
@@ -196,11 +186,11 @@
install_files(
$destination_directory,
$dry_run_option,
- @list_of_files_and_executables,
+ $list_of_files_and_executables,
);
-B<Arguments:> Takes two scalar arguments, followed by a list consisting of
-2-element, C<source => destination> array references.
+B<Arguments:> Takes two scalar arguments, followed by a reference to a
+list consisting of hashes.
B<Return Value:> True value.
@@ -209,14 +199,20 @@
=cut
sub install_files {
- my($destdir, $dryrun, @files) = @_;
+ my($destdir, $dryrun, $files) = @_;
my($src, $dest, $mode);
+ ref($files) eq 'ARRAY' or die "Error: parameter \$files must be an array\n";
print("Installing ...\n");
- foreach my $el ( @files ) {
- next unless ref($el) eq 'ARRAY';
- ( $src, $dest ) = @{ $el };
+ foreach my $el ( @$files ) {
+ unless(ref($el) eq 'HASH') {
+ my($ref) = ref($el);
+ warn "Bad reference passed in \$files (want a HASH, got a '$ref')\n";
+ next;
+ }
+ ( $src, $dest ) = map { $el->{$_} } qw(Source Dest);
$dest = $destdir . $dest;
+ print "Installing $src to $dest\n";
if ( $dryrun ) {
print "$src -> $dest\n";
next;
@@ -224,7 +220,7 @@
else {
next unless -e $src;
next if $^O eq 'cygwin' and -e "$src.exe"; # stat works, copy not
- copy( $src, $dest ) or die "copy $src to $dest: $!";
+ copy( $src, $dest ) or die "Error: couldn't copy $src to $dest: $!\n";
print "$dest\n";
}
$mode = ( stat($src) )[2];
Modified: branches/install_tools/t/tools/install/02-install_files.t
==============================================================================
--- branches/install_tools/t/tools/install/02-install_files.t Sat Apr 11 09:44:38 2009 (r38061)
+++ branches/install_tools/t/tools/install/02-install_files.t Sat Apr 11 12:47:18 2009 (r38062)
@@ -6,7 +6,7 @@
use strict;
use warnings;
-use Test::More tests => 17;
+use Test::More tests => 18;
use Carp;
use Cwd;
use File::Copy;
@@ -29,39 +29,89 @@
my @dirs = qw(foo/bar foo/bar/baz);
create_directories($tdir, { map { $_ => 1 } @dirs });
- my @files = ( [ "$testsourcedir/README", "$dirs[0]/README"] );
+ {
+ my ( $stdout, $stderr, $rv );
+
+ eval {
+ capture(
+ sub { $rv = install_files($tdir, 1); },
+ \$stdout,
+ \$stderr,
+ );
+ };
+ like($@, qr/Error: parameter \$files must be an array/s, "Catches non-ARRAY \$files");
+ }
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+
+ # Case where element in @files is not a hash ref
+ my $files_ref = [ q[] ];
{
my ( $stdout, $stderr, $rv );
capture(
- sub { $rv = install_files($tdir, 1, @files); },
+ sub { $rv = install_files($tdir, 0, $files_ref); },
+ \$stdout,
+ \$stderr,
+ );
+ like($stderr, qr/Bad reference passed in \$files/, "Catches non-HASH files");
+
+ like( $stdout, qr/Installing \.\.\./,
+ 'Got expected installation message' );
+ }
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+
+ my $files_ref = [ {
+ Source => "$testsourcedir/README",
+ Dest => "$dirs[0]/README",
+ } ];
+
+ {
+ my ( $stdout, $stderr, $rv );
+
+ capture(
+ sub { $rv = install_files($tdir, 1, $files_ref); },
\$stdout,
\$stderr,
);
ok( $rv, 'install_files() completed successfully in dry-run case' );
my $files_created = 0;
- foreach my $el (@files) {
- $files_created++ if -f "$tdir$el->[1]";
+ foreach my $el (@$files_ref) {
+ $files_created++ if -f $tdir . $el->{Dest};
}
is( $files_created, 0, 'Dry run, so no files created' );
like( $stdout, qr/Installing.*README.*README/s,
'Got expected installation message' );
+ $stdout =~ qr/Installing.*README.*README/s or print "Warning was: $stderr";
}
{
my ( $stdout, $stderr, $rv );
capture(
- sub { $rv = install_files($tdir, 0, @files); },
+ sub { $rv = install_files($tdir, 0, $files_ref); },
\$stdout,
\$stderr,
);
ok( $rv, 'install_files() completed successfully in production case' );
my $files_created = 0;
- foreach my $el (@files) {
- $files_created++ if -f "$tdir$el->[1]";
+ foreach my $el (@$files_ref) {
+ $files_created++ if -f "$tdir$el->{Dest}";
}
is( $files_created, 1, 'Production, so 1 file created' );
@@ -84,23 +134,29 @@
copy "$testsourcedir/$f", "$tdir/$f"
or die "Unable to copy $f prior to testing: $!";
}
- my @files = (
- [ "$tdir/README", "$dirs[0]/README" ],
- [ "$tdir/phony", "$dirs[0]/phony" ],
- );
+ my $files_ref = [
+ {
+ Source => "$tdir/README",
+ Dest => "$dirs[0]/README",
+ },
+ {
+ Source => "$tdir/phony",
+ Dest => "$dirs[0]/phony",
+ },
+ ];
{
my ( $stdout, $stderr, $rv );
capture(
- sub { $rv = install_files($tdir, 0, @files); },
+ sub { $rv = install_files($tdir, 0, $files_ref); },
\$stdout,
\$stderr,
);
ok( $rv, 'install_files() completed successfully in mock-Cygwin case' );
my $files_created = 0;
- foreach my $el (@files) {
- $files_created++ if -f "$tdir$el->[1]";
+ foreach my $el (@$files_ref) {
+ $files_created++ if -f "$tdir$el->{Dest}";
}
is( $files_created, 2, 'Production, so 2 files created' );
@@ -124,24 +180,33 @@
copy "$testsourcedir/$f", "$tdir/$f"
or die "Unable to copy $f prior to testing: $!";
}
- my @files = (
- [ "$tdir/README", "$dirs[0]/README" ],
- [ "$tdir/phony", "$dirs[0]/phony" ],
- [ "$tdir/phony.exe", "$dirs[0]/phony.exe" ],
- );
+ my $files_ref = [
+ {
+ Source => "$tdir/README",
+ Dest => "$dirs[0]/README"
+ },
+ {
+ Source => "$tdir/phony",
+ Dest => "$dirs[0]/phony"
+ },
+ {
+ Source => "$tdir/phony.exe",
+ Dest => "$dirs[0]/phony.exe"
+ },
+ ];
{
my ( $stdout, $stderr, $rv );
capture(
- sub { $rv = install_files($tdir, 0, @files); },
+ sub { $rv = install_files($tdir, 0, $files_ref); },
\$stdout,
\$stderr,
);
ok( $rv, 'install_files() completed successfully in mock-Cygwin case' );
my $files_created = 0;
- foreach my $el (@files) {
- $files_created++ if -f "$tdir$el->[1]";
+ foreach my $el (@$files_ref) {
+ $files_created++ if -f "$tdir$el->{Dest}";
}
is( $files_created, 2,
'Production, so 2 files created; 1 file passed over' );
@@ -159,38 +224,19 @@
my @dirs = qw(foo/bar foo/bar/baz);
create_directories($tdir, { map { $_ => 1 } @dirs });
- # Case where element in @files is not an array ref
- my @files = ( q{} );
-
- {
- my ( $stdout, $stderr, $rv );
- capture(
- sub { $rv = install_files($tdir, 0, @files); },
- \$stdout,
- \$stderr,
- );
- ok( $rv, 'install_files() handled invalid argument as expected' );
-
- like( $stdout, qr/Installing \.\.\./,
- 'Got expected installation message' );
- }
-}
-
-{
- my $tdir = tempdir( CLEANUP => 1 );
- $tdir .= '/';
-
- my @dirs = qw(foo/bar foo/bar/baz);
- create_directories($tdir, { map { $_ => 1 } @dirs });
-
# Case where element in @files does not hold existent file
my $nonexistent = q{ajdpfadksjfjvjkvds} . $$;
- my @files = ( [ $nonexistent, "$dirs[0]/$nonexistent"] );
+ my $files_ref = [
+ {
+ Source => $nonexistent,
+ Dest => "$dirs[0]/$nonexistent",
+ }
+ ];
{
my ( $stdout, $stderr, $rv );
capture(
- sub { $rv = install_files($tdir, 0, @files); },
+ sub { $rv = install_files($tdir, 0, $files_ref); },
\$stdout,
\$stderr,
);
Modified: branches/install_tools/t/tools/install/03-lines_to_files.t
==============================================================================
--- branches/install_tools/t/tools/install/03-lines_to_files.t Sat Apr 11 09:44:38 2009 (r38061)
+++ branches/install_tools/t/tools/install/03-lines_to_files.t Sat Apr 11 12:47:18 2009 (r38062)
@@ -6,7 +6,7 @@
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 8;
use Carp;
use Cwd;
use File::Copy;
@@ -24,19 +24,39 @@
my $testsourcedir = qq{$cwd/t/tools/install/testlib};
my $parrotdir = q{};;
+
+# Double-check these to see if they make sense now
my %metatransforms = (
doc => {
optiondir => 'doc',
transform => sub {
my($dest) = @_;
- $dest =~ s/^docs\/resources/resources/; # resources go in the top level of docs
- $dest =~ s/^docs/pod/; # other docs are actually raw Pod
+ # resources go in the top level of docs
+ $dest =~ s/^docs\/resources/resources/;
+ # other docs are actually raw Pod
+ $dest =~ s/^docs/pod/;
$parrotdir, $dest;
},
},
+ '.*' => {
+ optiondir => 'foo',
+ transform => sub {
+ return($_[0]);
+ }
+ }
);
+my(@transformorder) = ('doc', '.*');
-my %othertransforms = (
+my %badmetatransforms = (
+ doc => {
+ optiondir => 'doc',
+ transform => sub {
+ my($dest) = @_;
+ $dest =~ s/^docs\/resources/resources/; # resources go in the top level of docs
+ $dest =~ s/^docs/pod/; # other docs are actually raw Pod
+ $parrotdir, $dest;
+ },
+ },
'.*' => {
optiondir => 'foo',
transform => sub {
@@ -50,13 +70,13 @@
packages => 'main',
);
-my ($files_ref, $installable_exe_ref, $directories_ref);
+my ($files_ref, $directories_ref, %badtransformorder);
eval {
- ($files_ref, $installable_exe_ref, $directories_ref) =
+ ($files_ref, $directories_ref) =
lines_to_files(
\%metatransforms,
- \%othertransforms,
+ \@transformorder,
{},
\%options,
$parrotdir,
@@ -67,10 +87,10 @@
);
eval {
- ($files_ref, $installable_exe_ref, $directories_ref) =
+ ($files_ref, $directories_ref) =
lines_to_files(
\%metatransforms,
- \%othertransforms,
+ \@transformorder,
[],
\%options,
$parrotdir,
@@ -80,6 +100,20 @@
"Correctly detected lack of manifest files"
);
+eval {
+ ($files_ref, $directories_ref) =
+ lines_to_files(
+ \%metatransforms,
+ \%badtransformorder,
+ [ qw( MANIFEST MANIFEST.generated ) ],
+ \%options,
+ $parrotdir,
+ );
+};
+like($@, qr/Transform order should be an array of keys/,
+ "Correctly detected incorrect type for transform order"
+);
+
{
my $tdir = tempdir( CLEANUP => 1 );
chdir $tdir or die "Unable to change to testing directory: $!";
@@ -89,23 +123,40 @@
or die "Unable to copy file to tempdir for testing: $!";
my ($stdout, $stderr);
- capture(
- sub {
- ($files_ref, $installable_exe_ref, $directories_ref) =
- lines_to_files(
- \%metatransforms,
- \%othertransforms,
- [ qw( MANIFEST MANIFEST.generated ) ],
- \%options,
- $parrotdir,
- );
- },
- \$stdout,
- \$stderr,
+ eval {
+ ($files_ref, $directories_ref) =
+ lines_to_files(
+ \%badmetatransforms,
+ \@transformorder,
+ [ qw( MANIFEST MANIFEST.generated ) ],
+ \%options,
+ $parrotdir,
+ );
+ };
+ like($@, qr/transform didn't return a hash for key/,
+ "Correctly detected transform with a bad return value"
);
+ eval {
+ capture(
+ sub {
+ ($files_ref, $directories_ref) =
+ lines_to_files(
+ \%metatransforms,
+ \@transformorder,
+ [ qw( MANIFEST MANIFEST.generated ) ],
+ \%options,
+ $parrotdir,
+ );
+ },
+ \$stdout,
+ \$stderr,
+ );
+ };
+# Is there a way we can skip these two tests as failed and continue?
+ $@ and die "Error encountered while testing for duplicates: $@ ##";
like($stderr, qr/MANIFEST\.generated:\d+:\s+Duplicate entry/,
"Detected duplicate entries in one or more manifest files" );
- is( scalar @{ $installable_exe_ref }, 0,
+ is( scalar(grep { $_->{Installable} } @$files_ref), 0,
"No installable executables in this test" );
chdir $cwd or die "Unable to return to starting directory: $!";
@@ -119,10 +170,10 @@
or die "Unable to copy file to tempdir for testing: $!";
eval {
- ($files_ref, $installable_exe_ref, $directories_ref) =
+ ($files_ref, $directories_ref) =
lines_to_files(
\%metatransforms,
- \%othertransforms,
+ \@transformorder,
[ $defective_man ],
\%options,
$parrotdir,
@@ -178,9 +229,13 @@
+## In the code below:
+## - othertransforms needs to be merged into metatransforms
+## - transformorder needs to be added
+## - $installable_exe needs to be removed
#{
-# my($metatransforms, $othertransforms, $manifests, $options, $parrotdir,
+# my($metatransforms, $transformorder, $manifests, $options, $parrotdir,
# $files, $installable_exe, $directories);
#
# # First lines_to_files test
@@ -190,7 +245,7 @@
#
# # Second lines_to_files test
## eval { lines_to_files(
-## $metatransforms, $othertransforms,
+## $metatransforms, $transformorder,
## [qw(MANIFEST MANIFEST.generated)],
## $options, $parrotdir
## ); };
Modified: branches/install_tools/tools/dev/install_dev_files.pl
==============================================================================
--- branches/install_tools/tools/dev/install_dev_files.pl Sat Apr 11 09:44:38 2009 (r38061)
+++ branches/install_tools/tools/dev/install_dev_files.pl Sat Apr 11 12:47:18 2009 (r38062)
@@ -1,4 +1,4 @@
-#! perl -Ilib
+#! perl
################################################################################
# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
@@ -96,74 +96,87 @@
my $parrotdir = $options{versiondir};
# Set up transforms on filenames
+my(@transformorder) = (qw(lib share include src doc), '^(tools|VERSION)', '^compilers');
my(%metatransforms) = (
lib => {
+ ismeta => 1,
optiondir => 'lib',
transform => sub {
- my($dest) = @_;
- $parrotdir, "tools", $dest;
+ my($filehash) = @_;
+ $filehash->{DestDirs} = [$parrotdir, "tools"];
+ return($filehash);
},
},
share => {
+ ismeta => 1,
optiondir => 'data',
transform => sub {
- my($dest) = @_;
- $parrotdir, basename($dest);
+ my($filehash) = @_;
+ $filehash->{Dest} = basename($filehash->{Dest});
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
},
},
include => {
+ ismeta => 1,
optiondir => 'include',
transform => sub {
- my($dest) = @_;
- $dest =~ s/^src//; # strip off leading src/ dir
- $dest =~ s/^include//;
- $parrotdir, $dest;
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^src//; # strip off leading src/ dir
+ $filehash->{Dest} =~ s/^include//;
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
},
},
src => {
+ ismeta => 1,
optiondir => 'src',
transform => sub {
- my($dest) = @_;
- $dest =~ s/^src//; # strip off leading src/ dir
- $parrotdir, $dest;
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^src//; # strip off leading src/ dir
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
},
},
doc => {
+ ismeta => 1,
optiondir => 'doc',
transform => sub {
- my($dest) = @_;
- $dest =~ s/^docs/pod/; # other docs are actually raw Pod
- $parrotdir, $dest;
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^docs/pod/; # other docs are actually raw Pod
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
},
},
-);
-
-my(%othertransforms) = (
'^(tools|VERSION)' => {
optiondir => 'lib',
transform => sub {
- my($dest) = @_;
- $parrotdir, $dest;
+ my($filehash) = @_;
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
},
},
'^compilers' => {
optiondir => 'lib',
transform => sub {
- my($dest) = @_;
- $dest =~ s/^compilers/languages/;
- $parrotdir, $dest;
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^compilers/languages/;
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
},
},
);
-my($files, $installable_exe, $directories) = Parrot::Install::lines_to_files(
- \%metatransforms, \%othertransforms, \@manifests, \%options, $parrotdir
+my($filehashes, $directories) = lines_to_files(
+ \%metatransforms, \@transformorder, \@manifests, \%options, $parrotdir
);
unless ( $options{'dry-run'} ) {
- Parrot::Install::create_directories($options{destdir}, $directories);
+ create_directories($options{destdir}, $directories);
}
-Parrot::Install::install_files($options{destdir}, $options{'dry-run'}, @$files, @$installable_exe);
+install_files($options{destdir}, $options{'dry-run'}, $filehashes);
+
+print "Finished install_dev_files.pl\n";
# Local Variables:
# mode: cperl
Modified: branches/install_tools/tools/dev/install_files.pl
==============================================================================
--- branches/install_tools/tools/dev/install_files.pl Sat Apr 11 09:44:38 2009 (r38061)
+++ branches/install_tools/tools/dev/install_files.pl Sat Apr 11 12:47:18 2009 (r38062)
@@ -1,6 +1,6 @@
-# perl
+#! perl
################################################################################
-# Copyright (C) 2001-2008, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
################################################################################
@@ -148,73 +148,85 @@
my $parrotdir = $options{versiondir};
-my %metatransforms = (
+# Set up transforms on filenames
+my(@transformorder) = qw(lib bin include doc pkgconfig ^compilers);
+my(%metatransforms) = (
lib => {
+ ismeta => 1,
optiondir => 'lib',
transform => sub {
- my($dest) = @_;
- if ( $dest =~ /^install_/ ) {
- $dest =~ s/^install_//; # parrot with different config
- $parrotdir, 'include', $dest;
+ my($filehash) = @_;
+ local($_) = $filehash->{Dest};
+ if ( /^install_/ ) {
+ s/^install_//; # parrot with different config
+ $filehash->{DestDirs} = [$parrotdir, 'include'];
+ $filehash->{Dest} = $_;
}
else {
# don't allow libraries to be installed into subdirs of libdir
- basename($dest);
+ $filehash->{Dest} = basename($_);
}
+ return($filehash);
},
},
bin => {
+ ismeta => 1,
optiondir => 'bin',
transform => sub {
- my($dest) = @_;
- $dest =~ s/^installable_//; # parrot with different config
- $dest;
+ my($filehash) = @_;
+ # parrot with different config
+ $filehash->{Installable} = $filehash->{Dest} =~ s/^installable_//;
+ return($filehash);
},
isbin => 1,
},
include => {
+ ismeta => 1,
optiondir => 'include',
transform => sub {
- my($dest) = @_;
- $dest =~ s/^include//;
- $parrotdir, $dest;
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^include//;
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
},
},
doc => {
+ ismeta => 1,
optiondir => 'doc',
transform => sub {
- my($dest) = @_;
- $dest =~ s/^docs\/resources/resources/; # resources go in the top level of docs
- $dest =~ s/^docs/pod/; # other docs are actually raw Pod
- $parrotdir, $dest;
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s#^docs/resources#resources#; # resources go in the top level of docs
+ $filehash->{Dest} =~ s/^docs/pod/; # other docs are actually raw Pod
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
},
},
pkgconfig => {
+ ismeta => 1,
optiondir => 'lib',
transform => sub {
- my($dest) = @_;
+ my($filehash) = @_;
# For the time being this is hardcoded as being installed under
# libdir as it is typically done with automake installed packages.
# If there is a use case to make this configurable we'll add a
# seperate --pkgconfigdir option.
- 'pkgconfig', $parrotdir, $dest;
+ $filehash->{DestDirs} = ['pkgconfig', $parrotdir];
+ return($filehash);
},
},
-);
-
-my %othertransforms = (
'^compilers' => {
optiondir => 'lib',
transform => sub {
- my($dest) = @_;
- $dest =~ s/^compilers/languages/;
- $parrotdir, $dest;
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^compilers/languages/;
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
},
},
);
-my($files, $installable_exe, $directories) = lines_to_files(
- \%metatransforms, \%othertransforms, \@manifests, \%options, $parrotdir
+my($filehashes, $directories) = lines_to_files(
+ \%metatransforms, \@transformorder, \@manifests, \%options, $parrotdir
);
unless ( $options{'dry-run'} ) {
@@ -222,36 +234,34 @@
}
# TT #347
-# 1. skip build_dir-only binaries for @installable_exe
-for (@$installable_exe) {
- my ( $i, $dest ) = @$_;
- my ($file) = $i =~ /installable_(.+)$/;
+# 1. skip build_dir-only binaries for files marked Installable
+my($filehash, @removes, $removes);
+foreach $filehash (grep { $_->{Installable} } @$filehashes) {
+ my( $src, $dest ) = map { $filehash->{$_} } qw(Source Dest);
+ my ($file) = $src =~ /installable_(.+)$/;
next unless $file;
- my @f = map { $_ ? $_->[0] : '' } @$files;
- if (grep(/^$file$/, @f)) {
- if (-e $file) {
- print "skipping $file, using installable_$file instead\n";
- @$files = map {$_ and $_->[0] !~ /^$file$/ ? $_ : undef} @$files;
- }
+ if((grep { $_->{Source} =~ /^$file$/ } @$filehashes) and -e $file) {
+ print "skipping $file, using installable_$file instead\n";
+ push @removes, $file;
}
}
+$removes = join '|', @removes;
+@$filehashes = grep { $_->{Source} !~ /^($removes)$/ } @$filehashes;
+
# 2. for every .exe check if there's an installable. Fail if not
-foreach my $f (@$files ) {
- next unless $_;
- my ( $f, $dest ) = @$_;
- my $i;
+my $i;
+foreach $filehash (grep { ! $_->{Installable} } @$filehashes ) {
+ my( $src, $dest ) = map { $filehash->{$_} } qw(Source Dest);
+ next unless $src =~ /\.exe$/;
# This logic will fail on non-win32 if the generated files are really
# generated as with rt #40817. We don't have [main]bin here.
- $i = "installable_$f" if $f =~ /\.exe$/;
- next unless $i;
- unless (map {$_->[0] =~ /^$i$/} @$installable_exe) {
+ $i = "installable_$src";
+ unless (map {$_->{Source} =~ /^$i$/} grep { $_->{Installable} } @$filehashes) {
die "$i is missing in MANIFEST or MANIFEST.generated\n";
}
}
-install_files(
- $options{destdir}, $options{'dry-run'}, @$files, @$installable_exe
-);
+install_files($options{destdir}, $options{'dry-run'}, $filehashes);
print "Finished install_files.pl\n";
More information about the parrot-commits
mailing list