diff options
Diffstat (limited to 'lib/ExtUtils')
| -rw-r--r-- | lib/ExtUtils/Install.pm | 31 | ||||
| -rw-r--r-- | lib/ExtUtils/Installed.pm | 268 | ||||
| -rw-r--r-- | lib/ExtUtils/Liblist.pm | 45 | ||||
| -rw-r--r-- | lib/ExtUtils/MM_Unix.pm | 12 | ||||
| -rw-r--r-- | lib/ExtUtils/MM_VMS.pm | 155 | ||||
| -rw-r--r-- | lib/ExtUtils/Mksymlists.pm | 7 | ||||
| -rw-r--r-- | lib/ExtUtils/Packlist.pm | 231 | ||||
| -rwxr-xr-x | lib/ExtUtils/inst | 139 |
8 files changed, 782 insertions, 106 deletions
diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index a3d2481224..992d178659 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -30,6 +30,7 @@ sub install { use Cwd qw(cwd); use ExtUtils::MakeMaker; # to implement a MY class + use ExtUtils::Packlist; use File::Basename qw(dirname); use File::Copy qw(copy); use File::Find qw(find); @@ -37,10 +38,11 @@ sub install { use File::Compare qw(compare); my(%hash) = %$hash; - my(%pack, %write, $dir, $warn_permissions); + my(%pack, $dir, $warn_permissions); + my($packlist) = ExtUtils::Packlist->new(); # -w doesn't work reliably on FAT dirs $warn_permissions++ if $^O eq 'MSWin32'; - local(*DIR, *P); + local(*DIR); for (qw/read write/) { $pack{$_}=$hash{$_}; delete $hash{$_}; @@ -63,15 +65,7 @@ sub install { } closedir DIR; } - if (-f $pack{"read"}) { - open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}"); - # Remember what you found - while (<P>) { - chomp; - $write{$_}++; - } - close P; - } + $packlist->read($pack{"read"}) if (-f $pack{"read"}); my $cwd = cwd(); my $umask = umask 0 unless $Is_VMS; @@ -134,7 +128,7 @@ sub install { } else { inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0 } - $write{$targetfile}++; + $packlist->{$targetfile}++; }, "."); chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!"); @@ -144,11 +138,7 @@ sub install { $dir = dirname($pack{'write'}); mkpath($dir,0,0755); print "Writing $pack{'write'}\n"; - open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!"); - for (sort keys %write) { - print P "$_\n"; - } - close P; + $packlist->write($pack{'write'}); } } @@ -190,14 +180,13 @@ sub install_default { } sub uninstall { + use ExtUtils::Packlist; my($fil,$verbose,$nonono) = @_; die "no packlist file found: $fil" unless -f $fil; # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al)); # require $my_req; # Hairy, but for the first - local *P; - open P, $fil or Carp::croak("uninstall: Could not read packlist " . - "file $fil: $!"); - while (<P>) { + my ($packlist) = ExtUtils::Packlist->new($fil); + foreach (sort(keys(%$packlist))) { chomp; print "unlink $_\n" if $verbose; forceunlink($_) unless $nonono; diff --git a/lib/ExtUtils/Installed.pm b/lib/ExtUtils/Installed.pm new file mode 100644 index 0000000000..c6dde68b90 --- /dev/null +++ b/lib/ExtUtils/Installed.pm @@ -0,0 +1,268 @@ +package ExtUtils::Installed; +use strict; +use Carp qw(); +use ExtUtils::Packlist; +use ExtUtils::MakeMaker; +use Config; +use File::Find; +use File::Basename; +use vars qw($VERSION); +$VERSION = '0.01'; + +sub _is_type($$$) +{ +my ($self, $path, $type) = @_; +return(1) if ($type eq "all"); +if ($type eq "doc") + { + return(substr($path, 0, length($Config{installman1dir})) + eq $Config{installman1dir} + || + substr($path, 0, length($Config{installman3dir})) + eq $Config{installman3dir} + ? 1 : 0) + } +if ($type eq "prog") + { + return(substr($path, 0, length($Config{prefix})) eq $Config{prefix} + && + substr($path, 0, length($Config{installman1dir})) + ne $Config{installman1dir} + && + substr($path, 0, length($Config{installman3dir})) + ne $Config{installman3dir} + ? 1 : 0); + } +return(0); +} + +sub _is_under($$;) +{ +my ($self, $path, @under) = @_; +$under[0] = "" if (! @under); +foreach my $dir (@under) + { + return(1) if (substr($path, 0, length($dir)) eq $dir); + } +return(0); +} + +sub new($) +{ +my ($class) = @_; +$class = ref($class) || $class; +my $self = {}; + +# Read the core packlist +$self->{Perl}{packlist} = + ExtUtils::Packlist->new("$Config{installarchlib}/.packlist"); +$self->{Perl}{version} = $]; + +# Read the module packlists +my $sub = sub + { + # Only process module .packlists + return if ($_) ne ".packlist" || $File::Find::dir eq $Config{installarchlib}; + + # Hack of the leading bits of the paths & convert to a module name + my $module = $File::Find::name; + $module =~ s!$Config{archlib}/auto/(.*)/.packlist!$1!; + $module =~ s!$Config{sitearch}/auto/(.*)/.packlist!$1!; + my $modfile = "$module.pm"; + $module =~ s!/!::!g; + + # Find the top-level module file in @INC + $self->{$module}{version} = ''; + foreach my $dir (@INC) + { + my $p = MM->catfile($dir, $modfile); + if (-f $p) + { + $self->{$module}{version} = MM->parse_version($p); + last; + } + } + + # Read the .packlist + $self->{$module}{packlist} = ExtUtils::Packlist->new($File::Find::name); + }; +find($sub, $Config{archlib}, $Config{sitearch}); + +return(bless($self, $class)); +} + +sub modules($) +{ +my ($self) = @_; +return(sort(keys(%$self))); +} + +sub files($$;$) +{ +my ($self, $module, $type, @under) = @_; + +# Validate arguments +Carp::croak("$module is not installed") if (! exists($self->{$module})); +$type = "all" if (! defined($type)); +Carp::croak('type must be "all", "prog" or "doc"') + if ($type ne "all" && $type ne "prog" && $type ne "doc"); + +my (@files); +foreach my $file (keys(%{$self->{$module}{packlist}})) + { + push(@files, $file) + if ($self->_is_type($file, $type) && $self->_is_under($file, @under)); + } +return(@files); +} + +sub directories($$;$) +{ +my ($self, $module, $type, @under) = @_; +my (%dirs); +foreach my $file ($self->files($module, $type, @under)) + { + $dirs{dirname($file)}++; + } +return(sort(keys(%dirs))); +} + +sub directory_tree($$;$) +{ +my ($self, $module, $type, @under) = @_; +my (%dirs); +foreach my $dir ($self->directories($module, $type, @under)) + { + $dirs{$dir}++; + my ($last); + while ($last ne $dir) + { + $last = $dir; + $dir = dirname($dir); + last if (! $self->_is_under($dir, @under)); + $dirs{$dir}++; + } + } +return(sort(keys(%dirs))); +} + +sub validate($;$) +{ +my ($self, $module, $remove) = @_; +Carp::croak("$module is not installed") if (! exists($self->{$module})); +return($self->{$module}{packlist}->validate($remove)); +} + +sub packlist($$) +{ +my ($self, $module) = @_; +Carp::croak("$module is not installed") if (! exists($self->{$module})); +return($self->{$module}{packlist}); +} + +sub version($$) +{ +my ($self, $module) = @_; +Carp::croak("$module is not installed") if (! exists($self->{$module})); +return($self->{$module}{version}); +} + +sub DESTROY +{ +} + +1; + +__END__ + +=head1 NAME + +ExtUtils::Installed - Inventory management of installed modules + +=head1 SYNOPSIS + + use ExtUtils::Installed; + my ($inst) = ExtUtils::Installed->new(); + my (@modules) = $inst->modules(); + my (@missing) = $inst->validate("DBI"); + my $all_files = $inst->files("DBI"); + my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local"); + my $all_dirs = $inst->directories("DBI"); + my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog"); + my $packlist = $inst->packlist("DBI"); + +=head1 DESCRIPTION + +ExtUtils::Installed provides a standard way to find out what core and module +files have been installed. It uses the information stored in .packlist files +created during installation to provide this information. In addition it +provides facilities to classify the installed files and to extract directory +information from the .packlist files. + +=head1 USAGE + +The new() function searches for all the installed .packlists on the system, and +stores their contents. The .packlists can be queried with the functions +described below. + +=head1 FUNCTIONS + +=over + +=item new() + +This takes no parameters, and searches for all the installed .packlists on the +system. The packlists are read using the ExtUtils::packlist module. + +=item modules() + +This returns a list of the names of all the installed modules. The perl 'core' +is given the special name 'Perl'. + +=item files() + +This takes one mandatory parameter, the name of a module. It returns a list of +all the filenames from the package. To obtain a list of core perl files, use +the module name 'Perl'. Additional parameters are allowed. The first is one +of the strings "prog", "man" or "all", to select either just program files, +just manual files or all files. The remaining parameters are a list of +directories. The filenames returned will be restricted to those under the +specified directories. + +=item directories() + +This takes one mandatory parameter, the name of a module. It returns a list of +all the directories from the package. Additional parameters are allowed. The +first is one of the strings "prog", "man" or "all", to select either just +program directories, just manual directories or all directories. The remaining +parameters are a list of directories. The directories returned will be +restricted to those under the specified directories. This method returns only +the leaf directories that contain files from the specified module. + +=item directory_tree() + +This is identical in operation to directory(), except that it includes all the +intermediate directories back up to the specified directories. + +=item validate() + +This takes one mandatory parameter, the name of a module. It checks that all +the files listed in the modules .packlist actually exist, and returns a list of +any missing files. If an optional second argument which evaluates to true is +given any missing files will be removed from the .packlist + +=item packlist() + +This returns the ExtUtils::Packlist object for the specified module. + +=item version() + +This returns the version number for the specified module. + +=back + +=head1 AUTHOR + +Alan Burlison <Alan.Burlison@uk.sun.com> + +=cut diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm index aebb057d58..5c35dc7307 100644 --- a/lib/ExtUtils/Liblist.pm +++ b/lib/ExtUtils/Liblist.pm @@ -261,9 +261,38 @@ sub _win32_ext { sub _vms_ext { my($self, $potential_libs,$verbose) = @_; - return ('', '', '', '') unless $potential_libs; + my(@crtls,$crtlstr); + my($dbgqual) = $self->{OPTIMIZE} || $Config{'optimize'} || + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and + # a library spec could be resolved via a logical name, we go to some trouble + # to insure that the copy in the local tree is used, rather than one to + # which a system-wide logical may point. + if ($self->{PERL_SRC}) { + my($lib,$locspec,$type); + foreach $lib (@crtls) { + if (($locspec,$type) = $lib =~ m-^([\w$\-]+)(/\w+)?- and $locspec =~ /perl/i) { + if (lc $type eq '/share') { $locspec .= $Config{'exe_ext'}; } + elsif (lc $type eq '/library') { $locspec .= $Config{'lib_ext'}; } + else { $locspec .= $Config{'obj_ext'}; } + $locspec = $self->catfile($self->{PERL_SRC},$locspec); + $lib = "$locspec$type" if -e $locspec; + } + } + } + $crtlstr = @crtls ? join(' ',@crtls) : ''; - my(@dirs,@libs,$dir,$lib,%sh,%olb,%obj); + unless ($potential_libs) { + warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose; + return ('', '', $crtlstr, ''); + } + + my(@dirs,@libs,$dir,$lib,%sh,%olb,%obj,$ldlib); my $cwd = cwd(); my($so,$lib_ext,$obj_ext) = @Config{'so','lib_ext','obj_ext'}; # List of common Unix library names and there VMS equivalents @@ -388,8 +417,10 @@ sub _vms_ext { push(@libs, map { "$_/Library" } sort keys %olb); push(@libs, map { "$_/Share" } sort keys %sh); $lib = join(' ',@libs); - warn "Result: $lib\n" if $verbose; - wantarray ? ($lib, '', $lib, '') : $lib; + + $ldlib = $crtlstr ? "$lib $crtlstr" : $lib; + warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose; + wantarray ? ($lib, '', $ldlib, '') : $lib; } 1; @@ -499,8 +530,10 @@ these directives, rather than elements used on the linker command line. =item * -LDLOADLIBS and EXTRALIBS are always identical under VMS, and BSLOADLIBS -and LD_RIN_PATH are always empty. +LDLOADLIBS contains both the libraries found based on C<$potential_libs> and +the CRTLs, if any, specified in Config.pm. EXTRALIBS contains just those +libraries found based on C<$potential_libs>. BSLOADLIBS and LD_RUN_PATH +are always empty. =back diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 5faa435e3a..92a46426da 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -98,17 +98,13 @@ trailing slash :-) # '; sub catdir { - shift; + my $self = shift @_; my @args = @_; for (@args) { # append a slash to each argument unless it has one there $_ .= "/" if $_ eq '' or substr($_,-1) ne "/"; } - my $result = join('', @args); - # remove a trailing slash unless we are root - substr($result,-1) = "" - if length($result) > 1 && substr($result,-1) eq "/"; - $result; + $self->canonpath(join('', @args)); } =item catfile @@ -121,12 +117,12 @@ complete path ending with a filename sub catfile { my $self = shift @_; my $file = pop @_; - return $file unless @_; + return $self->canonpath($file) unless @_; my $dir = $self->catdir(@_); for ($dir) { $_ .= "/" unless substr($_,length($_)-1,1) eq "/"; } - return $dir.$file; + return $self->canonpath($dir.$file); } =item curdir diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 954f6123d5..29bfaf2e55 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -61,15 +61,22 @@ sub eliminate_macros { if ($self->{$2}) { ($head,$macro,$tail) = ($1,$2,$3); if (ref $self->{$macro}) { - carp "Can't expand macro containing " . ref $self->{$macro}; - $npath = "$head\cB$macro\cB$tail"; - $complex = 1; + if (ref $self->{$macro} eq 'ARRAY') { + print "Note: expanded array macro \$($macro) in $path\n" if $Verbose; + $macro = join ' ', @{$self->{$macro}}; + } + else { + print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}), + "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n"; + $macro = "\cB$macro\cB"; + $complex = 1; + } } else { ($macro = unixify($self->{$macro})) =~ s#/$##; } $npath = "$head$macro$tail"; } } - if ($complex) { $npath =~ s#\cB(.*?)\cB#\$($1)#g; } + if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#g; } print "eliminate_macros($path) = |$npath|\n" if $Verbose >= 3; $npath; } @@ -193,7 +200,7 @@ sub wraplist { # traversing array (scalar(@array) doesn't show them, but # foreach(@array) does) (5.00307) next unless $word =~ /\w/; - $line .= ', ' if length($line); + $line .= ' ' if length($line); if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; } $line .= $word; $hlen += length($word) + 2; @@ -632,9 +639,9 @@ sub constants { if ($self->{OBJECT} =~ /\s/) { $self->{OBJECT} =~ s/(\\)?\n+\s+/ /g; - $self->{OBJECT} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT}))); + $self->{OBJECT} = $self->wraplist(map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT}))); } - $self->{LDFROM} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM}))); + $self->{LDFROM} = $self->wraplist(map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM}))); # Fix up directory specs @@ -726,12 +733,12 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision push @m,' # Handy lists of source code files: -XS_FILES = ',$self->wraplist(', ', sort keys %{$self->{XS}}),' -C_FILES = ',$self->wraplist(', ', @{$self->{C}}),' -O_FILES = ',$self->wraplist(', ', @{$self->{O_FILES}} ),' -H_FILES = ',$self->wraplist(', ', @{$self->{H}}),' -MAN1PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN1PODS}}),' -MAN3PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN3PODS}}),' +XS_FILES = ',$self->wraplist(sort keys %{$self->{XS}}),' +C_FILES = ',$self->wraplist(@{$self->{C}}),' +O_FILES = ',$self->wraplist(@{$self->{O_FILES}} ),' +H_FILES = ',$self->wraplist(@{$self->{H}}),' +MAN1PODS = ',$self->wraplist(sort keys %{$self->{MAN1PODS}}),' +MAN3PODS = ',$self->wraplist(sort keys %{$self->{MAN3PODS}}),' '; @@ -764,21 +771,22 @@ INST_DYNAMIC = $(INST_ARCHAUTODIR)$(BASEEXT).$(DLEXT) INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs '; } else { + my $shr = $Config{'dbgprefix'} . 'PERLSHR'; push @m,' INST_STATIC = INST_DYNAMIC = INST_BOOT = EXPORT_LIST = $(BASEEXT).opt -PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : "Sys\$Share:PerlShr.$Config{'dlext'}"),' +PERL_ARCHIVE = ',($ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}"),' '; } $self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ]; $self->{PM_TO_BLIB} = [ %{$self->{PM}} ]; push @m,' -TO_INST_PM = ',$self->wraplist(', ',@{$self->{TO_INST_PM}}),' +TO_INST_PM = ',$self->wraplist(@{$self->{TO_INST_PM}}),' -PM_TO_BLIB = ',$self->wraplist(', ',@{$self->{PM_TO_BLIB}}),' +PM_TO_BLIB = ',$self->wraplist(@{$self->{PM_TO_BLIB}}),' '; join('',@m); @@ -795,18 +803,41 @@ instance of this qualifier on the command line. sub cflags { my($self,$libperl) = @_; - my($quals) = $Config{'ccflags'}; + my($quals) = $self->{CCFLAGS} || $Config{'ccflags'}; + my($definestr,$undefstr,$flagoptstr) = ('','',''); + my($incstr) = '/Include=($(PERL_INC)'; my($name,$sys,@m); - my($optimize) = '/Optimize'; ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ; print STDOUT "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}. " required to modify CC command for $self->{'BASEEXT'}\n" if ($Config{$name}); + if ($quals =~ / -[DIUOg]/) { + while ($quals =~ / -([Og])(\d*)\b/) { + my($type,$lvl) = ($1,$2); + $quals =~ s/ -$type$lvl\b\s*//; + if ($type eq 'g') { $flagoptstr = '/NoOptimize'; } + else { $flagoptstr = '/Optimize' . (defined($lvl) ? "=$lvl" : ''); } + } + while ($quals =~ / -([DIU])(\S+)/) { + my($type,$def) = ($1,$2); + $quals =~ s/ -$type$def\s*//; + $def =~ s/"/""/g; + if ($type eq 'D') { $definestr .= qq["$def",]; } + elsif ($type eq 'I') { $flagincstr .= ',' . $self->fixpath($def,1); } + else { $undefstr .= qq["$def",]; } + } + } + if (length $quals and $quals !~ m!/!) { + warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n"; + $quals = ''; + } + if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; } + if (length $undefstr) { chop($undefstr); $quals .= "/Undef=($undefstr)"; } # Deal with $self->{DEFINE} here since some C compilers pay attention # to only one /Define clause on command line, so we have to - # conflate the ones from $Config{'cc'} and $self->{DEFINE} + # conflate the ones from $Config{'ccflags'} and $self->{DEFINE} if ($quals =~ m:(.*)/define=\(?([^\(\/\)\s]+)\)?(.*)?:i) { $quals = "$1/Define=($2," . ($self->{DEFINE} ? "$self->{DEFINE}," : '') . "\$(DEFINE_VERSION),\$(XS_DEFINE_VERSION))$3"; @@ -817,16 +848,18 @@ sub cflags { } $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb"; + if ($libperl =~ s/^$Config{'dbgprefix'}//) { $libperl =~ s/perl([^Dd]*)\./perld$1./; } if ($libperl =~ /libperl(\w+)\./i) { - my($type) = uc $1; - my(%map) = ( 'D' => 'DEBUGGING', 'E' => 'EMBED', 'M' => 'MULTIPLICITY', - 'DE' => 'DEBUGGING,EMBED', 'DM' => 'DEBUGGING,MULTIPLICITY', - 'EM' => 'EMBED,MULTIPLICITY', 'DEM' => 'DEBUGGING,EMBED,MULTIPLICITY' ); - $quals =~ s:/define=\(([^\)]+)\):/Define=($1,$map{$type}):i + my($type) = uc $1; + my(%map) = ( 'D' => 'DEBUGGING', 'E' => 'EMBED', 'M' => 'MULTIPLICITY', + 'DE' => 'DEBUGGING,EMBED', 'DM' => 'DEBUGGING,MULTIPLICITY', + 'EM' => 'EMBED,MULTIPLICITY', 'DEM' => 'DEBUGGING,EMBED,MULTIPLICITY' ); + my($add) = join(',', grep { $quals !~ /\b$_\b/ } split(/,/,$map{$type})); + $quals =~ s:/define=\(([^\)]+)\):/Define=($1,$add):i if $add; + $self->{PERLTYPE} ||= $type; } # Likewise with $self->{INC} and /Include - my($incstr) = '/Include=($(PERL_INC)'; if ($self->{'INC'}) { my(@includes) = split(/\s+/,$self->{INC}); foreach (@includes) { @@ -835,14 +868,24 @@ sub cflags { } } $quals .= "$incstr)"; + $self->{CCFLAGS} = $quals; - $optimize = '/Debug/NoOptimize' - if ($self->{OPTIMIZE} =~ /-g/ or $self->{OPTIMIZE} =~ m!/Debug!i); + $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'}; + if ($self->{OPTIMIZE} !~ m!/!) { + if ($self->{OPTIMIZE} =~ m!\b-g\b!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' } + elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) { + $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : ''); + } + else { + warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE}; + $self->{OPTIMIZE} = '/Optimize'; + } + } return $self->{CFLAGS} = qq{ -CCFLAGS = $quals -OPTIMIZE = $optimize -PERLTYPE = +CCFLAGS = $self->{CCFLAGS} +OPTIMIZE = $self->{OPTIMIZE} +PERLTYPE = $self->{PERLTYPE} SPLIT = LARGE = }; @@ -1274,30 +1317,13 @@ sub dlsyms { my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; - my($srcdir)= $attribs{PERL_SRC} || $self->{PERL_SRC} || ''; my(@m); unless ($self->{SKIPHASH}{'dynamic'}) { push(@m,' -dynamic :: rtls.opt $(INST_ARCHAUTODIR)$(BASEEXT).opt +dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt $(NOECHO) $(NOOP) '); - if ($srcdir) { - my($popt) = $self->catfile($srcdir,'perlshr.opt'); - my($lopt) = $self->catfile($srcdir,'crtl.opt'); - push(@m,"# Depend on \$(BASEEXT).opt to insure we copy here *after* autogenerating (wrong) rtls.opt in Mksymlists -rtls.opt : $popt $lopt \$(BASEEXT).opt - Copy/Log $popt Sys\$Disk:[]rtls.opt - Append/Log $lopt Sys\$Disk:[]rtls.opt -"); - } - else { - push(@m,' -# rtls.opt is built in the same step as $(BASEEXT).opt -rtls.opt : $(BASEEXT).opt - $(TOUCH) $(MMS$TARGET) -'); - } } push(@m,' @@ -1347,6 +1373,7 @@ sub dynamic_lib { my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; + my $shr = $Config{'dbgprefix'} . 'PerlShr'; my(@m); push @m," @@ -1355,10 +1382,10 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep "; push @m, ' -$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) +$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) - $(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config{'dlext'},' - Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option + $(NOECHO) If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",' + Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option '; push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); @@ -1418,27 +1445,20 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) '; # If this extension has it's own library (eg SDBM_File) # then copy that to $(INST_STATIC) and add $(OBJECT) into it. - push(@m, ' $(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB}; + push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB}; + + push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n"); - push(@m,' - If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET) -'); # if there was a library to copy, then we can't use MMS$SOURCE_LIST, # 'cause it's a library and you can't stick them in other libraries. # In that case, we use $OBJECT instead and hope for the best if ($self->{MYEXTLIB}) { - push(@m,' - Library/Object/Replace $(MMS$TARGET) $(OBJECT) -'); + push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n"); } else { - push(@m,' - Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST) -'); + push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n"); } - push(@m, ' - $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;" -'); + push(@m,"\t",'$(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"',"\n"); push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); join('',@m); } @@ -1661,6 +1681,9 @@ clean :: push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all')); my($file,$line); $line = ''; #avoid unitialized var warning + # Occasionally files are repeated several times from different sources + { my(%of) = map { ($_,1) } @otherfiles; @otherfiles = keys %of; } + foreach $file (@otherfiles) { $file = $self->fixpath($file); if (length($line) + length($file) > 80) { @@ -1705,6 +1728,8 @@ realclean :: clean } push(@files, values %{$self->{PM}}); $line = ''; #avoid unitialized var warning + # Occasionally files are repeated several times from different sources + { my(%f) = map { ($_,1) } @files; @files = keys %f; } foreach $file (@files) { $file = $self->fixpath($file); if (length($line) + length($file) > 80 || ++$fcnt >= 2) { @@ -1726,6 +1751,8 @@ realclean :: clean else { push(@allfiles, $attribs{FILES}); } } $line = ''; + # Occasionally files are repeated several times from different sources + { my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; } foreach $file (@allfiles) { $file = $self->fixpath($file); if (length($line) + length($file) > 80) { diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm index 2f2366a1c8..4ac175af5e 100644 --- a/lib/ExtUtils/Mksymlists.pm +++ b/lib/ExtUtils/Mksymlists.pm @@ -178,13 +178,6 @@ sub _write_vms { } close OPT; - # Options file specifying RTLs to which this extension must be linked. - # Eventually, the list of libraries will be supplied by a working - # extliblist routine. - open OPT,'>rtls.opt'; - print OPT "PerlShr/Share\n"; - foreach $rtl (split(/\s+/,$Config::Config{'libs'})) { print OPT "$rtl\n"; } - close OPT; } 1; diff --git a/lib/ExtUtils/Packlist.pm b/lib/ExtUtils/Packlist.pm new file mode 100644 index 0000000000..a0128492b2 --- /dev/null +++ b/lib/ExtUtils/Packlist.pm @@ -0,0 +1,231 @@ +package ExtUtils::Packlist; +use strict; +use Carp qw(); +use vars qw($VERSION); +$VERSION = '0.02'; + +# Used for generating filehandle globs. IO::File might not be available! +my $fhname = "FH1"; + +sub mkfh() +{ +no strict; +my $fh = \*{$fhname++}; +use strict; +return($fh); +} + +sub new($$) +{ +my ($class, $packfile) = @_; +$class = ref($class) || $class; +my %self; +tie(%self, $class, $packfile); +return(bless(\%self, $class)); +} + +sub TIEHASH +{ +my ($class, $packfile) = @_; +my $self = { packfile => $packfile }; +bless($self, $class); +$self->read($packfile) if (defined($packfile) && -f $packfile); +return($self); +} + +sub STORE +{ +$_[0]->{data}->{$_[1]} = $_[2]; +} + +sub FETCH +{ +return($_[0]->{data}->{$_[1]}); +} + +sub FIRSTKEY +{ +my $reset = scalar(keys(%{$_[0]->{data}})); +return(each(%{$_[0]->{data}})); +} + +sub NEXTKEY +{ +return(each(%{$_[0]->{data}})); +} + +sub EXISTS +{ +return(exists($_[0]->{data}->{$_[1]})); +} + +sub DELETE +{ +return(delete($_[0]->{data}->{$_[1]})); +} + +sub CLEAR +{ +%{$_[0]->{data}} = (); +} + +sub DESTROY +{ +} + +sub read($;$) +{ +my ($self, $packfile) = @_; +$self = tied(%$self) || $self; + +if (defined($packfile)) { $self->{packfile} = $packfile; } +else { $packfile = $self->{packfile}; } +Carp::croak("No packlist filename specified") if (! defined($packfile)); +my $fh = mkfh(); +open($fh, "<$packfile") || Carp::croak("Can't open file $packfile: $!"); +$self->{data} = {}; +my ($line); +while (defined($line = <$fh>)) + { + chomp $line; + my ($key, @kvs) = split(' ', $line); + $key =~ s!/./!/!g; # Some .packlists have spurious '/./' bits in the paths + if (! @kvs) + { + $self->{data}->{$key} = undef; + } + else + { + my ($data) = {}; + foreach my $kv (@kvs) + { + my ($k, $v) = split('=', $kv); + $data->{$k} = $v; + } + $self->{data}->{$key} = $data; + } + } +close($fh); +} + +sub write($;$) +{ +my ($self, $packfile) = @_; +$self = tied(%$self) || $self; +if (defined($packfile)) { $self->{packfile} = $packfile; } +else { $packfile = $self->{packfile}; } +Carp::croak("No packlist filename specified") if (! defined($packfile)); +my $fh = mkfh(); +open($fh, ">$packfile") || Carp::croak("Can't open file $packfile: $!"); +foreach my $key (sort(keys(%{$self->{data}}))) + { + print $fh ("$key"); + if (ref($self->{data}->{$key})) + { + my $data = $self->{data}->{$key}; + foreach my $k (sort(keys(%$data))) + { + print $fh (" $k=$data->{$k}"); + } + } + print $fh ("\n"); + } +close($fh); +} + +sub validate($;$) +{ +my ($self, $remove) = @_; +$self = tied(%$self) || $self; +my @missing; +foreach my $key (sort(keys(%{$self->{data}}))) + { + if (! -e $key) + { + push(@missing, $key); + delete($self->{data}{$key}) if ($remove); + } + } +return(@missing); +} + +1; + +__END__ + +=head1 NAME + +ExtUtils::Packlist - manage .packlist files + +=head1 SYNOPSIS + + use ExtUtils::Packlist; + my ($pl) = ExtUtils::Packlist->new('.packlist'); + $pl->read('/an/old/.packlist'); + my @missing_files = $pl->validate(); + $pl->write('/a/new/.packlist'); + + $pl->{'/some/file/name'}++; + or + $pl->{'/some/other/file/name'} = { type => 'file', + from => '/some/file' }; + +=head1 DESCRIPTION + +ExtUtils::Packlist provides a standard way to manage .packlist files. +Functions are provided to read and write .packlist files. The original +.packlist format is a simple list of absolute pathnames, one per line. In +addition, this package supports an extended format, where as well as a filename +each line may contain a list of attributes in the form of a space separated +list of key=value pairs. This is used by the installperl script to +differentiate between files and links, for example. + +=head1 USAGE + +The hash reference returned by the new() function can be used to examine and +modify the contents of the .packlist. Items may be added/deleted from the +.packlist by modifying the hash. If the value associated with a hash key is a +scalar, the entry written to the .packlist by any subsequent write() will be a +simple filename. If the value is a hash, the entry written will be the +filename followed by the key=value pairs from the hash. Reading back the +.packlist will recreate the original entries. + +=head1 FUNCTIONS + +=over + +=item new() + +This takes an optional parameter, the name of a .packlist. If the file exists, +it will be opened and the contents of the file will be read. The new() method +returns a reference to a hash. This hash holds an entry for each line in the +.packlist. In the case of old-style .packlists, the value associated with each +key is undef. In the case of new-style .packlists, the value associated with +each key is a hash containing the key=value pairs following the filename in the +.packlist. + +=item read() + +This takes an optional parameter, the name of the .packlist to be read. If +no file is specified, the .packlist specified to new() will be read. If the +.packlist does not exist, Carp::croak will be called. + +=item write() + +This takes an optional parameter, the name of the .packlist to be written. If +no file is specified, the .packlist specified to new() will be overwritten. + +=item validate() + +This checks that every file listed in the .packlist actually exists. If an +argument which evaluates to true is given, any missing files will be removed +from the internal hash. The return value is a list of the missing files, which +will be empty if they all exist. + +=back + +=head1 AUTHOR + +Alan Burlison <Alan.Burlison@uk.sun.com> + +=cut diff --git a/lib/ExtUtils/inst b/lib/ExtUtils/inst new file mode 100755 index 0000000000..cbf2d01194 --- /dev/null +++ b/lib/ExtUtils/inst @@ -0,0 +1,139 @@ +#!/usr/local/bin/perl -w + +use strict; +use IO::File; +use ExtUtils::Packlist; +use ExtUtils::Installed; + +use vars qw($Inst @Modules); + +################################################################################ + +sub do_module($) +{ +my ($module) = @_; +my $help = <<EOF; +Available commands are: + f [all|prog|doc] - List installed files of a given type + d [all|prog|doc] - List the directories used by a module + v - Validate the .packlist - check for missing files + t <tarfile> - Create a tar archive of the module + q - Quit the module +EOF +print($help); +while (1) + { + print("$module cmd? "); + my $reply = <STDIN>; chomp($reply); + CASE: + { + $reply =~ /^f\s*/ and do + { + my $class = (split(' ', $reply))[1]; + $class = 'all' if (! $class); + my @files; + if (eval { @files = $Inst->files($module, $class); }) + { + print("$class files in $module are:\n ", + join("\n ", @files), "\n"); + last CASE; + } + else + { print($@); } + }; + $reply =~ /^d\s*/ and do + { + my $class = (split(' ', $reply))[1]; + $class = 'all' if (! $class); + my @dirs; + if (eval { @dirs = $Inst->directories($module, $class); }) + { + print("$class directories in $module are:\n ", + join("\n ", @dirs), "\n"); + last CASE; + } + else + { print($@); } + }; + $reply =~ /^t\s*/ and do + { + my $file = (split(' ', $reply))[1]; + my $tmp = "/tmp/inst.$$"; + if (my $fh = IO::File->new($tmp, "w")) + { + $fh->print(join("\n", $Inst->files($module))); + $fh->close(); + system("tar cvf $file -I $tmp"); + unlink($tmp); + last CASE; + } + else { print("Can't open $file: $!\n"); } + last CASE; + }; + $reply eq 'v' and do + { + if (my @missing = $Inst->validate($module)) + { + print("Files missing from $module are:\n ", + join("\n ", @missing), "\n"); + } + else + { + print("$module has no missing files\n"); + } + last CASE; + }; + $reply eq 'q' and do + { + return; + }; + # Default + print($help); + } + } +} + +################################################################################ + +sub toplevel() +{ +my $help = <<EOF; +Available commands are: + l - List all installed modules + m <module> - Select a module + q - Quit the program +EOF +print($help); +while (1) + { + print("cmd? "); + my $reply = <STDIN>; chomp($reply); + CASE: + { + $reply eq 'l' and do + { + print("Installed modules are:\n ", join("\n ", @Modules), "\n"); + last CASE; + }; + $reply =~ /^m\s+/ and do + { + do_module((split(' ', $reply))[1]); + last CASE; + }; + $reply eq 'q' and do + { + exit(0); + }; + # Default + print($help); + } + } +} + +################################################################################ + +$Inst = ExtUtils::Installed->new(); +@Modules = $Inst->modules(); +toplevel(); + +################################################################################ |