lib/ExtUtils/Installed.pm

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