lib/ExtUtils/Installed.pm

   1 package ExtUtils::Installed;
   2
   3 use 5.006;
   4 use strict;
   5 use Carp qw();
   6 use ExtUtils::Packlist;
   7 use ExtUtils::MakeMaker;
   8 use Config;
   9 use File::Find;
  10 use File::Basename;
  11 use File::Spec;
  12 require VMS::Filespec if $^O eq 'VMS';
  13
  14 our $VERSION = '0.05';
  15
  16 my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/);
  17
  18 sub _is_prefix {
  19     my ($self, $path, $prefix) = @_;
  20     return unless defined $prefix && defined $path;
  21
  22     if( $^O eq 'VMS' ) {
  23         $prefix = VMS::Filespec::unixify($prefix);
  24         $path   = VMS::Filespec::unixify($path);
  25     }
  26     return 1 if substr($path, 0, length($prefix)) eq $prefix;
  27
  28     if ($DOSISH) {
  29         $path =~ s|\\|/|g;
  30         $prefix =~ s|\\|/|g;
  31         return 1 if $path =~ m{^\Q$prefix\E}i;
  32     }
  33     return(0);
  34 }
  35
  36 sub _is_doc {
  37     my ($self, $path) = @_;
  38     my $man1dir = $Config{man1direxp};
  39     my $man3dir = $Config{man3direxp};
  40     return(($man1dir && $self->_is_prefix($path, $man1dir))
  41            ||
  42            ($man3dir && $self->_is_prefix($path, $man3dir))
  43            ? 1 : 0)
  44 }
  45
  46 sub _is_type {
  47     my ($self, $path, $type) = @_;
  48     return 1 if $type eq "all";
  49
  50     return($self->_is_doc($path)) if $type eq "doc";
  51
  52     if ($type eq "prog") {
  53         return($self->_is_prefix($path, $Config{prefix} || $Config{prefixexp})
  54                &&
  55                !($self->_is_doc($path))
  56                ? 1 : 0);
  57     }
  58     return(0);
  59 }
  60
  61 sub _is_under {
  62     my ($self, $path, @under) = @_;
  63     $under[0] = "" if (! @under);
  64     foreach my $dir (@under) {
  65         return(1) if ($self->_is_prefix($path, $dir));
  66     }
  67
  68     return(0);
  69 }
  70
  71 sub new {
  72     my ($class) = @_;
  73     $class = ref($class) || $class;
  74     my $self = {};
  75
  76     my $archlib = $Config{archlibexp};
  77     my $sitearch = $Config{sitearchexp};
  78
  79     # File::Find does not know how to deal with VMS filepaths.
  80     if( $^O eq 'VMS' ) {
  81         $archlib  = VMS::Filespec::unixify($archlib);
  82         $sitearch = VMS::Filespec::unixify($sitearch);
  83     }
  84
  85     if ($DOSISH) {
  86         $archlib =~ s|\\|/|g;
  87         $sitearch =~ s|\\|/|g;
  88     }
  89
  90     # Read the core packlist
  91     $self->{Perl}{packlist} =
  92       ExtUtils::Packlist->new( File::Spec->catfile($archlib, '.packlist') );
  93     $self->{Perl}{version} = $Config{version};
  94
  95     # Read the module packlists
  96     my $sub = sub {
  97         # Only process module .packlists
  98         return if ($_) ne ".packlist" || $File::Find::dir eq $archlib;
  99
 100         # Hack of the leading bits of the paths & convert to a module name
 101         my $module = $File::Find::name;
 102
 103         $module =~ s!\Q$archlib\E/?auto/(.*)/.packlist!$1!s  or
 104         $module =~ s!\Q$sitearch\E/?auto/(.*)/.packlist!$1!s;
 105         my $modfile = "$module.pm";
 106         $module =~ s!/!::!g;
 107
 108         # Find the top-level module file in @INC
 109         $self->{$module}{version} = '';
 110         foreach my $dir (@INC) {
 111             my $p = File::Spec->catfile($dir, $modfile);
 112             if (-f $p) {
 113                 require ExtUtils::MM;
 114                 $self->{$module}{version} = MM->parse_version($p);
 115                 last;
 116             }
 117         }
 118
 119         # Read the .packlist
 120         $self->{$module}{packlist} =
 121           ExtUtils::Packlist->new($File::Find::name);
 122     };
 123
 124     my(@dirs) = grep { -e } ($archlib, $sitearch);
 125     find($sub, @dirs) if @dirs;
 126
 127     return(bless($self, $class));
 128 }
 129
 130 sub modules {
 131     my ($self) = @_;
 132     return sort keys %$self;
 133 }
 134
 135 sub files {
 136     my ($self, $module, $type, @under) = @_;
 137
 138     # Validate arguments
 139     Carp::croak("$module is not installed") if (! exists($self->{$module}));
 140     $type = "all" if (! defined($type));
 141     Carp::croak('type must be "all", "prog" or "doc"')
 142         if ($type ne "all" && $type ne "prog" && $type ne "doc");
 143
 144     my (@files);
 145     foreach my $file (keys(%{$self->{$module}{packlist}})) {
 146         push(@files, $file)
 147           if ($self->_is_type($file, $type) &&
 148               $self->_is_under($file, @under));
 149     }
 150     return(@files);
 151 }
 152
 153 sub directories {
 154     my ($self, $module, $type, @under) = @_;
 155     my (%dirs);
 156     foreach my $file ($self->files($module, $type, @under)) {
 157         $dirs{dirname($file)}++;
 158     }
 159     return sort keys %dirs;
 160 }
 161
 162 sub directory_tree {
 163     my ($self, $module, $type, @under) = @_;
 164     my (%dirs);
 165     foreach my $dir ($self->directories($module, $type, @under)) {
 166         $dirs{$dir}++;
 167         my ($last) = ("");
 168         while ($last ne $dir) {
 169             $last = $dir;
 170             $dir = dirname($dir);
 171             last if !$self->_is_under($dir, @under);
 172             $dirs{$dir}++;
 173         }
 174     }
 175     return(sort(keys(%dirs)));
 176 }
 177
 178 sub validate {
 179     my ($self, $module, $remove) = @_;
 180     Carp::croak("$module is not installed") if (! exists($self->{$module}));
 181     return($self->{$module}{packlist}->validate($remove));
 182 }
 183
 184 sub packlist {
 185     my ($self, $module) = @_;
 186     Carp::croak("$module is not installed") if (! exists($self->{$module}));
 187     return($self->{$module}{packlist});
 188 }
 189
 190 sub version {
 191     my ($self, $module) = @_;
 192     Carp::croak("$module is not installed") if (! exists($self->{$module}));
 193     return($self->{$module}{version});
 194 }
 195
 196
 197 1;
 198
 199 __END__
 200
 201 =head1 NAME
 202
 203 ExtUtils::Installed - Inventory management of installed modules
 204
 205 =head1 SYNOPSIS
 206
 207    use ExtUtils::Installed;
 208    my ($inst) = ExtUtils::Installed->new();
 209    my (@modules) = $inst->modules();
 210    my (@missing) = $inst->validate("DBI");
 211    my $all_files = $inst->files("DBI");
 212    my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local");
 213    my $all_dirs = $inst->directories("DBI");
 214    my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog");
 215    my $packlist = $inst->packlist("DBI");
 216
 217 =head1 DESCRIPTION
 218
 219 ExtUtils::Installed  provides a standard way to find out what core and module
 220 files have been installed.  It uses the information stored in .packlist files
 221 created during installation to provide this information.  In addition it
 222 provides facilities to classify the installed files and to extract directory
 223 information from the .packlist files.
 224
 225 =head1 USAGE
 226
 227 The new() function searches for all the installed .packlists on the system, and
 228 stores their contents. The .packlists can be queried with the functions
 229 described below.
 230
 231 =head1 FUNCTIONS
 232
 233 =over 4
 234
 235 =item new()
 236
 237 This takes no parameters, and searches for all the installed .packlists on the
 238 system.  The packlists are read using the ExtUtils::packlist module.
 239
 240 =item modules()
 241
 242 This returns a list of the names of all the installed modules.  The perl 'core'
 243 is given the special name 'Perl'.
 244
 245 =item files()
 246
 247 This takes one mandatory parameter, the name of a module.  It returns a list of
 248 all the filenames from the package.  To obtain a list of core perl files, use
 249 the module name 'Perl'.  Additional parameters are allowed.  The first is one
 250 of the strings "prog", "doc" or "all", to select either just program files,
 251 just manual files or all files.  The remaining parameters are a list of
 252 directories. The filenames returned will be restricted to those under the
 253 specified directories.
 254
 255 =item directories()
 256
 257 This takes one mandatory parameter, the name of a module.  It returns a list of
 258 all the directories from the package.  Additional parameters are allowed.  The
 259 first is one of the strings "prog", "doc" or "all", to select either just
 260 program directories, just manual directories or all directories.  The remaining
 261 parameters are a list of directories. The directories returned will be
 262 restricted to those under the specified directories.  This method returns only
 263 the leaf directories that contain files from the specified module.
 264
 265 =item directory_tree()
 266
 267 This is identical in operation to directories(), except that it includes all the
 268 intermediate directories back up to the specified directories.
 269
 270 =item validate()
 271
 272 This takes one mandatory parameter, the name of a module.  It checks that all
 273 the files listed in the modules .packlist actually exist, and returns a list of
 274 any missing files.  If an optional second argument which evaluates to true is
 275 given any missing files will be removed from the .packlist
 276
 277 =item packlist()
 278
 279 This returns the ExtUtils::Packlist object for the specified module.
 280
 281 =item version()
 282
 283 This returns the version number for the specified module.
 284
 285 =back
 286
 287 =head1 EXAMPLE
 288
 289 See the example in L<ExtUtils::Packlist>.
 290
 291 =head1 AUTHOR
 292
 293 Alan Burlison <Alan.Burlison@uk.sun.com>
 294
 295 =cut