lib/ExtUtils/Installed.pm

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