lib/ExtUtils/Installed.pm

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