1 package CPANPLUS::Module;
9 use CPANPLUS::Module::Signature;
10 use CPANPLUS::Module::Checksums;
11 use CPANPLUS::Internals::Constants;
15 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
16 use IPC::Cmd qw[can_run run];
17 use File::Find qw[find];
18 use Params::Check qw[check];
19 use Module::Load::Conditional qw[can_load check_install];
21 $Params::Check::VERBOSE = 1;
23 @ISA = qw[ CPANPLUS::Module::Signature CPANPLUS::Module::Checksums];
33 ### get a module object from the CPANPLUS::Backend object
34 my $mod = $cb->module_tree('Some::Module');
48 C<CPANPLUS::Module> creates objects from the information in the
49 source files. These can then be used to query and perform actions
50 on, like fetching or installing.
52 These objects should only be created internally. For C<fake> objects,
53 there's the C<CPANPLUS::Module::Fake> class. To obtain a module object
54 consult the C<CPANPLUS::Backend> documentation.
59 module => { default => '', required => 1 }, # full module name
60 version => { default => '0.0' }, # version number
61 path => { default => '', required => 1 }, # extended path on the
63 # /author/id/K/KA/KANE
64 comment => { default => ''}, # comment on module
65 package => { default => '', required => 1 }, # package name, like
67 description => { default => '' }, # description of the
69 dslip => { default => ' ' }, # dslip information
70 _id => { required => 1 }, # id of the Internals
72 _status => { no_override => 1 }, # stores status object
73 author => { default => '', required => 1,
74 allow => IS_AUTHOBJ }, # module author
75 mtime => { default => '' },
78 ### autogenerate accessors ###
79 for my $key ( keys %$tmpl ) {
81 *{__PACKAGE__."::$key"} = sub {
82 $_[0]->{$key} = $_[1] if @_ > 1;
93 Returns a list of all accessor methods to the object
97 ### *name is an alias, include it explicitly
98 sub accessors { return ('name', keys %$tmpl) };
102 An objects of this class has the following accessors:
116 Version of the module. Defaults to '0.0' if none was provided.
120 Extended path on the mirror.
124 Any comment about the module -- largely unused.
128 The name of the package.
132 Description of the module -- only registered modules have this.
136 The five character dslip string, that represents meta-data of the
137 module -- again, only registered modules have this.
141 The C<CPANPLUS::Module::Status> object associated with this object.
146 The C<CPANPLUS::Module::Author> object associated with this object.
150 The C<CPANPLUS::Internals> object that spawned this module object.
156 ### Alias ->name to ->module, for human beings.
161 my $obj = CPANPLUS::Internals->_retrieve_id( $self->_id );
166 =head1 STATUS ACCESSORS
168 C<CPANPLUS> caches a lot of results from method calls and saves data
169 it collected along the road for later reuse.
171 C<CPANPLUS> uses this internally, but it is also available for the end
172 user. You can get a status object by calling:
176 You can then query the object as follows:
182 The installer type used for this distribution. Will be one of
183 'makemaker' or 'build'. This determines whether C<CPANPLUS::Dist::MM>
184 or C<CPANPLUS::Dist::Build> will be used to build this distribution.
188 The dist object used to do the CPAN-side of the installation. Either
189 a C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build> object.
193 The custom dist object used to do the operating specific side of the
194 installation, if you've chosen to use this. For example, if you've
195 chosen to install using the C<ports> format, this may be a
196 C<CPANPLUS::Dist::Ports> object.
198 Undefined if you didn't specify a separate format to install through.
202 A hashref of prereqs this distribution was found to have. Will look
205 { Carp => 0.01, strict => 0 }
207 Might be undefined if the distribution didn't have any prerequisites.
211 Flag indicating, if a signature check was done, whether it was OK or
216 The directory this distribution was extracted to.
220 The location this distribution was fetched to.
224 The text of this distributions README file.
228 Flag indicating if an uninstall call was done successfully.
232 Flag indicating if the C<create> call to your dist object was done
237 Flag indicating if the C<install> call to your dist object was done
242 The location of this distributions CHECKSUMS file.
246 Flag indicating if the checksums check was done successfully.
250 The checksum value this distribution is expected to have
256 =head2 $self = CPANPLUS::Module::new( OPTIONS )
258 This method returns a C<CPANPLUS::Module> object. Normal users
259 should never call this method directly, but instead use the
260 C<CPANPLUS::Backend> to obtain module objects.
262 This example illustrates a C<new()> call with all required arguments:
264 CPANPLUS::Module->new(
266 path => 'authors/id/A/AA/AAA',
267 package => 'Foo-1.0.tgz',
268 author => $author_object,
269 _id => INTERNALS_OBJECT_ID,
272 Every accessor is also a valid option to pass to C<new>.
274 Returns a module object on success and false on failure.
280 my($class, %hash) = @_;
282 ### don't check the template for sanity
283 ### -- we know it's good and saves a lot of performance
284 local $Params::Check::SANITY_CHECK_TEMPLATE = 0;
286 my $object = check( $tmpl, \%hash ) or return;
288 bless $object, $class;
293 ### only create status objects when they're actually asked for
296 return $self->_status if $self->_status;
298 my $acc = Object::Accessor->new;
299 $acc->mk_accessors( qw[ installer_type dist_cpan dist prereqs
300 signature extract fetch readme uninstall
301 created installed prepared checksums files
302 checksum_ok checksum_value _fetch_from] );
304 $self->_status( $acc );
306 return $self->_status;
310 ### flush the cache of this object ###
313 $self->status->mk_flush;
317 =head2 $mod->package_name
319 Returns the name of the package a module is in. For C<Acme::Bleach>
320 that might be C<Acme-Bleach>.
322 =head2 $mod->package_version
324 Returns the version of the package a module is in. For a module
325 in the package C<Acme-Bleach-1.1.tar.gz> this would be C<1.1>.
327 =head2 $mod->package_extension
329 Returns the suffix added by the compression method of a package a
330 certain module is in. For a module in C<Acme-Bleach-1.1.tar.gz>, this
333 =head2 $mod->package_is_perl_core
335 Returns a boolean indicating of the package a particular module is in,
336 is actually a core perl distribution.
338 =head2 $mod->module_is_supplied_with_perl_core( [version => $]] )
340 Returns a boolean indicating whether C<ANY VERSION> of this module
341 was supplied with the current running perl's core package.
343 =head2 $mod->is_bundle
345 Returns a boolean indicating if the module you are looking at, is
346 actually a bundle. Bundles are identified as modules whose name starts
349 =head2 $mod->is_third_party
351 Returns a boolean indicating whether the package is a known third-party
352 module (i.e. it's not provided by the standard Perl distribution and
353 is not available on the CPAN, but on a third party software provider).
354 See L<Module::ThirdParty> for more details.
356 =head2 $mod->third_party_information
358 Returns a reference to a hash with more information about a third-party
359 module. See the documentation about C<module_information()> in
360 L<Module::ThirdParty> for more details.
364 { ### fetches the test reports for a certain module ###
371 while ( my($type, $index) = each %map ) {
372 my $name = 'package_' . $type;
377 my @res = $self->parent->_split_package_string(
378 package => $self->package
381 ### return the corresponding index from the result
382 return $res[$index] if @res;
387 sub package_is_perl_core {
390 ### check if the package looks like a perl core package
391 return 1 if $self->package_name eq PERL_CORE;
393 my $core = $self->module_is_supplied_with_perl_core;
394 ### ok, so it's found in the core, BUT it could be dual-lifed
396 ### if the package is newer than installed, then it's dual-lifed
397 return if $self->version > $self->installed_version;
399 ### if the package is newer or equal to the corelist,
400 ### then it's dual-lifed
401 return if $self->version >= $core;
403 ### otherwise, it's older than corelist, thus unsuitable.
407 ### not in corelist, not a perl core package.
411 sub module_is_supplied_with_perl_core {
413 my $ver = shift || $];
415 ### check Module::CoreList to see if it's a core package
416 require Module::CoreList;
417 my $core = $Module::CoreList::version{ $ver }->{ $self->module };
422 ### make sure Bundle-Foo also gets flagged as bundle
424 return shift->module =~ /^bundle(?:-|::)/i ? 1 : 0;
430 return unless can_load( modules => { 'Module::ThirdParty' => 0 } );
432 return Module::ThirdParty::is_3rd_party( $self->name );
435 sub third_party_information {
438 return unless $self->is_third_party;
440 return Module::ThirdParty::module_information( $self->name );
446 =head2 $clone = $self->clone
448 Clones the current module object for tinkering with.
449 It will have a clean C<CPANPLUS::Module::Status> object, as well as
450 a fake C<CPANPLUS::Module::Author> object.
457 ### clone the object ###
459 for my $acc ( grep !/status/, __PACKAGE__->accessors() ) {
460 $data{$acc} = $self->$acc();
463 my $obj = CPANPLUS::Module::Fake->new( %data );
470 =head2 $where = $self->fetch
472 Fetches the module from a CPAN mirror.
473 Look at L<CPANPLUS::Internals::Fetch::_fetch()> for details on the
474 options you can pass.
480 my $cb = $self->parent;
483 my %args = ( module => $self );
485 ### if a custom fetch location got specified before, add that here
486 $args{fetch_from} = $self->status->_fetch_from
487 if $self->status->_fetch_from;
489 my $where = $cb->_fetch( @_, %args ) or return;
491 ### do an md5 check ###
492 if( !$self->status->_fetch_from and
493 $cb->configure_object->get_conf('md5') and
494 $self->package ne CHECKSUMS
496 unless( $self->_validate_checksum ) {
497 error( loc( "Checksum error for '%1' -- will not trust package",
508 =head2 $path = $self->extract
510 Extracts the fetched module.
511 Look at L<CPANPLUS::Internals::Extract::_extract()> for details on
512 the options you can pass.
518 my $cb = $self->parent;
520 unless( $self->status->fetch ) {
521 error( loc( "You have not fetched '%1' yet -- cannot extract",
526 return $cb->_extract( @_, module => $self );
529 =head2 $type = $self->get_installer_type([prefer_makefile => BOOL])
531 Gets the installer type for this module. This may either be C<build> or
532 C<makemaker>. If C<Module::Build> is unavailable or no installer type
533 is available, it will fall back to C<makemaker>. If both are available,
534 it will pick the one indicated by your config, or by the
535 C<prefer_makefile> option you can pass to this function.
537 Returns the installer type on success, and false on error.
541 sub get_installer_type {
543 my $cb = $self->parent;
544 my $conf = $cb->configure_object;
549 prefer_makefile => { default => $conf->get_conf('prefer_makefile'),
550 store => \$prefer_makefile, allow => BOOLEANS },
553 check( $tmpl, \%hash ) or return;
555 my $extract = $self->status->extract();
557 error(loc("Cannot determine installer type of unextracted module '%1'",
563 ### check if it's a makemaker or a module::build type dist ###
564 my $found_build = -e BUILD_PL->( $extract );
565 my $found_makefile = -e MAKEFILE_PL->( $extract );
568 $type = INSTALLER_BUILD if !$prefer_makefile && $found_build;
569 $type = INSTALLER_BUILD if $found_build && !$found_makefile;
570 $type = INSTALLER_MM if $prefer_makefile && $found_makefile;
571 $type = INSTALLER_MM if $found_makefile && !$found_build;
573 ### ok, so it's a 'build' installer, but you don't /have/ module build
574 if( $type eq INSTALLER_BUILD and (
575 not grep { $_ eq INSTALLER_BUILD } CPANPLUS::Dist->dist_types )
577 error( loc( "This module requires '%1' and '%2' to be installed, ".
578 "but you don't have it! Will fall back to ".
579 "'%3', but might not be able to install!",
580 'Module::Build', INSTALLER_BUILD, INSTALLER_MM ) );
581 $type = INSTALLER_MM;
583 ### ok, actually we found neither ###
585 error( loc( "Unable to find '%1' or '%2' for '%3'; ".
586 "Will default to '%4' but might be unable ".
587 "to install!", BUILD_PL->(), MAKEFILE_PL->(),
588 $self->module, INSTALLER_MM ) );
589 $type = INSTALLER_MM;
592 return $self->status->installer_type( $type ) if $type;
598 =head2 $dist = $self->dist([target => 'prepare|create', format => DISTRIBUTION_TYPE, args => {key => val}]);
600 Create a distribution object, ready to be installed.
601 Distribution type defaults to your config settings
603 The optional C<args> hashref is passed on to the specific distribution
604 types' C<create> method after being dereferenced.
606 Returns a distribution object on success, false on failure.
608 See C<CPANPLUS::Dist> for details.
614 my $cb = $self->parent;
615 my $conf = $cb->configure_object;
618 ### have you determined your installer type yet? if not, do it here,
620 $self->get_installer_type unless $self->status->installer_type;
623 my($type,$args,$target);
625 format => { default => $conf->get_conf('dist_type') ||
626 $self->status->installer_type,
628 target => { default => TARGET_CREATE, store => \$target },
629 args => { default => {}, store => \$args },
632 check( $tmpl, \%hash ) or return;
634 my $dist = CPANPLUS::Dist->new(
639 my $dist_cpan = $type eq $self->status->installer_type
641 : CPANPLUS::Dist->new(
642 format => $self->status->installer_type,
647 $self->status->dist_cpan( $dist_cpan );
648 $self->status->dist( $dist );
651 ### first prepare the dist
652 $dist->prepare( %$args ) or return;
653 $self->status->prepared(1);
655 ### you just wanted us to prepare?
656 last DIST if $target eq TARGET_PREPARE;
658 $dist->create( %$args ) or return;
659 $self->status->created(1);
667 =head2 $bool = $mod->prepare( )
669 Convenience method around C<install()> that prepares a module
670 without actually building it. This is equivalent to invoking C<install>
671 with C<target> set to C<prepare>
673 Returns true on success, false on failure.
679 return $self->install( @_, target => TARGET_PREPARE );
682 =head2 $bool = $mod->create( )
684 Convenience method around C<install()> that creates a module.
685 This is equivalent to invoking C<install> with C<target> set to
688 Returns true on success, false on failure.
694 return $self->install( @_, target => TARGET_CREATE );
697 =head2 $bool = $mod->test( )
699 Convenience wrapper around C<install()> that tests a module, without
701 It's the equivalent to invoking C<install()> with C<target> set to
702 C<create> and C<skiptest> set to C<0>.
704 Returns true on success, false on failure.
710 return $self->install( @_, target => TARGET_CREATE, skiptest => 0 );
715 =head2 $bool = $self->install([ target => 'prepare|create|install', format => FORMAT_TYPE, extractdir => DIRECTORY, fetchdir => DIRECTORY, prefer_bin => BOOL, force => BOOL, verbose => BOOL, ..... ]);
717 Installs the current module. This includes fetching it and extracting
718 it, if this hasn't been done yet, as well as creating a distribution
721 This means you can pass it more arguments than described above, which
722 will be passed on to the relevant methods as they are called.
724 See C<CPANPLUS::Internals::Fetch>, C<CPANPLUS::Internals::Extract> and
725 C<CPANPLUS::Dist> for details.
727 Returns true on success, false on failure.
733 my $cb = $self->parent;
734 my $conf = $cb->configure_object;
737 my $args; my $target; my $format;
738 { ### so we can use the rest of the args to the create calls etc ###
739 local $Params::Check::NO_DUPLICATES = 1;
740 local $Params::Check::ALLOW_UNKNOWN = 1;
742 ### targets 'dist' and 'test' are now completely ignored ###
744 ### match this allow list with Dist->_resolve_prereqs
745 target => { default => TARGET_INSTALL, store => \$target,
746 allow => [TARGET_PREPARE, TARGET_CREATE,
748 force => { default => $conf->get_conf('force'), },
749 verbose => { default => $conf->get_conf('verbose'), },
750 format => { default => $conf->get_conf('dist_type'),
754 $args = check( $tmpl, \%hash ) or return;
758 ### if this target isn't 'install', we will need to at least 'create'
759 ### every prereq, so it can build
760 ### XXX prereq_target of 'prepare' will do weird things here, and is
762 $args->{'prereq_target'} ||= TARGET_CREATE if $target ne TARGET_INSTALL;
764 ### check if it's already upto date ###
765 if( $target eq TARGET_INSTALL and !$args->{'force'} and
766 !$self->package_is_perl_core() and # separate rules apply
767 ( $self->status->installed() or $self->is_uptodate ) and
768 !INSTALL_VIA_PACKAGE_MANAGER->($format)
770 msg(loc("Module '%1' already up to date, won't install without force",
771 $self->module), $args->{'verbose'} );
772 return $self->status->installed(1);
775 # if it's a non-installable core package, abort the install.
776 if( $self->package_is_perl_core() ) {
777 # if the installed is newer, say so.
778 if( $self->installed_version > $self->version ) {
779 error(loc("The core Perl %1 module '%2' (%3) is more ".
780 "recent than the latest release on CPAN (%4). ".
782 $], $self->module, $self->installed_version,
784 # if the installed matches, say so.
785 } elsif( $self->installed_version == $self->version ) {
786 error(loc("The core Perl %1 module '%2' (%3) can only ".
787 "be installed by Perl itself. ".
789 $], $self->module, $self->installed_version ) );
790 # otherwise, the installed is older; say so.
792 error(loc("The core Perl %1 module '%2' can only be ".
793 "upgraded from %3 to %4 by Perl itself (%5). ".
795 $], $self->module, $self->installed_version,
796 $self->version, $self->package ) );
800 ### it might be a known 3rd party module
801 } elsif ( $self->is_third_party ) {
802 my $info = $self->third_party_information;
804 "%1 is a known third-party module.\n\n".
805 "As it isn't available on the CPAN, CPANPLUS can't install " .
806 "it automatically. Therefore you need to install it manually " .
807 "before proceeding.\n\n".
808 "%2 is part of %3, published by %4, and should be available ".
809 "for download at the following address:\n\t%5",
810 $self->name, $self->name, $info->{name}, $info->{author},
817 ### fetch it if need be ###
818 unless( $self->status->fetch ) {
820 for (qw[prefer_bin fetchdir]) {
821 $params->{$_} = $args->{$_} if exists $args->{$_};
823 for (qw[force verbose]) {
824 $params->{$_} = $args->{$_} if defined $args->{$_};
826 $self->fetch( %$params ) or return;
829 ### extract it if need be ###
830 unless( $self->status->extract ) {
832 for (qw[prefer_bin extractdir]) {
833 $params->{$_} = $args->{$_} if exists $args->{$_};
835 for (qw[force verbose]) {
836 $params->{$_} = $args->{$_} if defined $args->{$_};
838 $self->extract( %$params ) or return;
841 $format ||= $self->status->installer_type;
844 error( loc( "Don't know what installer to use; " .
845 "Couldn't find either '%1' or '%2' in the extraction " .
846 "directory '%3' -- will be unable to install",
847 BUILD_PL->(), MAKEFILE_PL->(), $self->status->extract ) );
849 $self->status->installed(0);
854 ### do SIGNATURE checks? ###
855 if( $conf->get_conf('signature') ) {
856 unless( $self->check_signature( verbose => $args->{verbose} ) ) {
857 error( loc( "Signature check failed for module '%1' ".
858 "-- Not trusting this module, aborting install",
860 $self->status->signature(0);
862 ### send out test report on broken sig
863 if( $conf->get_conf('cpantest') ) {
867 buffer => CPANPLUS::Error->stack_as_string,
868 verbose => $args->{verbose},
869 force => $args->{force},
870 ) or error(loc("Failed to send test report for '%1'",
878 $self->status->signature(1);
882 ### a target of 'create' basically means not to run make test ###
883 ### eh, no it /doesn't/.. skiptest => 1 means skiptest => 1.
884 #$args->{'skiptest'} = 1 if $target eq 'create';
886 ### bundle rules apply ###
887 if( $self->is_bundle ) {
888 ### check what we need to install ###
889 my @prereqs = $self->bundle_modules();
891 error( loc( "Bundle '%1' does not specify any modules to install",
894 ### XXX mark an error here? ###
898 my $dist = $self->dist( format => $format,
902 error( loc( "Unable to create a new distribution object for '%1' " .
903 "-- cannot continue", $self->module ) );
907 return 1 if $target ne TARGET_INSTALL;
909 my $ok = $dist->install( %$args ) ? 1 : 0;
911 $self->status->installed($ok);
917 =pod @list = $self->bundle_modules()
919 Returns a list of module objects the Bundle specifies.
921 This requires you to have extracted the bundle already, using the
924 Returns false on error.
930 my $cb = $self->parent;
932 unless( $self->is_bundle ) {
933 error( loc("'%1' is not a bundle", $self->module ) );
938 unless( $dir = $self->status->extract ) {
939 error( loc("Don't know where '%1' was extracted to", $self->module ) );
945 wanted => sub { push @files, File::Spec->rel2abs($_) if /\.pm/i; },
949 my $prereqs = {}; my @list; my $seen = {};
950 for my $file ( @files ) {
951 my $fh = FileHandle->new($file)
952 or( error(loc("Could not open '%1' for reading: %2",
957 ### quick hack to read past the header of the file ###
958 last if $flag && m|^=head|i;
960 ### from perldoc cpan:
962 ### In this pod section each line obeys the format
963 ### Module_Name [Version_String] [- optional text]
964 $flag = 1 if m|^=head1 CONTENTS|i;
966 if ($flag && /^(?!=)(\S+)\s*(\S+)?/) {
968 my $version = $2 || '0';
970 my $obj = $cb->module_tree($module);
973 error(loc("Cannot find bundled module '%1'", $module),
974 loc("-- it does not seem to exist") );
978 ### make sure we list no duplicates ###
979 unless( $seen->{ $obj->module }++ ) {
981 $prereqs->{ $module } =
982 $cb->_version_to_number( version => $version );
988 ### store the prereqs we just found ###
989 $self->status->prereqs( $prereqs );
996 =head2 $text = $self->readme
998 Fetches the readme belonging to this module and stores it under
999 C<< $obj->status->readme >>. Returns the readme as a string on
1000 success and returns false on failure.
1006 my $conf = $self->parent->configure_object;
1008 ### did we already dl the readme once? ###
1009 return $self->status->readme() if $self->status->readme();
1011 ### this should be core ###
1012 return unless can_load( modules => { FileHandle => '0.0' },
1016 ### get a clone of the current object, with a fresh status ###
1017 my $obj = $self->clone or return;
1019 ### munge the package name
1020 my $pkg = README->( $obj );
1021 $obj->package($pkg);
1024 { ### disable checksum fetches on readme downloads
1026 my $tmp = $conf->get_conf( 'md5' );
1027 $conf->set_conf( md5 => 0 );
1029 $file = $obj->fetch;
1031 $conf->set_conf( md5 => $tmp );
1033 return unless $file;
1036 ### read the file into a scalar, to store in the original object ###
1037 my $fh = new FileHandle;
1038 unless( $fh->open($file) ) {
1039 error( loc( "Could not open file '%1': %2", $file, $! ) );
1044 { local $/; $in = <$fh> };
1047 return $self->status->readme( $in );
1052 =head2 $version = $self->installed_version()
1054 Returns the currently installed version of this module, if any.
1056 =head2 $where = $self->installed_file()
1058 Returns the location of the currently installed file of this module,
1061 =head2 $bool = $self->is_uptodate([version => VERSION_NUMBER])
1063 Returns a boolean indicating if this module is uptodate or not.
1067 ### uptodate/installed functions
1068 { my $map = { # hashkey, alternate rv
1069 installed_version => ['version', 0 ],
1070 installed_file => ['file', ''],
1071 is_uptodate => ['uptodate', 0 ],
1074 while( my($method, $aref) = each %$map ) {
1075 my($key,$alt_rv) = @$aref;
1079 ### never use the @INC hooks to find installed versions of
1080 ### modules -- they're just there in case they're not on the
1081 ### perl install, but the user shouldn't trust them for *other*
1083 ### XXX CPANPLUS::inc is now obsolete, so this should not
1084 ### be needed anymore
1085 #local @INC = CPANPLUS::inc->original_inc;
1089 ### make sure check_install is not looking in %INC, as
1090 ### that may contain some of our sneakily loaded modules
1091 ### that aren't installed as such. -- kane
1092 local $Module::Load::Conditional::CHECK_INC_HASH = 0;
1093 my $href = check_install(
1094 module => $self->module,
1095 version => $self->version,
1099 return $href->{$key} || $alt_rv;
1108 =head2 $href = $self->details()
1110 Returns a hashref with key/value pairs offering more information about
1111 a particular module. For example, for C<Time::HiRes> it might look like
1114 Author Jarkko Hietaniemi (jhi@iki.fi)
1115 Description High resolution time, sleep, and alarm
1116 Development Stage Released
1117 Installed File /usr/local/perl/lib/Time/Hires.pm
1118 Interface Style plain Functions, no references used
1119 Language Used C and perl, a C compiler will be needed
1120 Package Time-HiRes-1.65.tar.gz
1121 Public License Unknown
1122 Support Level Developer
1123 Version Installed 1.52
1124 Version on CPAN 1.65
1130 my $conf = $self->parent->configure_object();
1131 my $cb = $self->parent;
1135 Author => loc("%1 (%2)", $self->author->author(),
1136 $self->author->email() ),
1137 Package => $self->package,
1138 Description => $self->description || loc('None given'),
1139 'Version on CPAN' => $self->version,
1142 ### check if we have the module installed
1143 ### if so, add version have and version on cpan
1144 $res->{'Version Installed'} = $self->installed_version
1145 if $self->installed_version;
1146 $res->{'Installed File'} = $self->installed_file if $self->installed_file;
1149 for my $item( split '', $self->dslip ) {
1150 $res->{ $cb->_dslip_defs->[$i]->[0] } =
1151 $cb->_dslip_defs->[$i]->[1]->{$item} || loc('Unknown');
1158 =head2 @list = $self->contains()
1160 Returns a list of module objects that represent the modules also
1161 present in the package of this module.
1163 For example, for C<Archive::Tar> this might return:
1166 Archive::Tar::Constant
1173 my $cb = $self->parent;
1174 my $pkg = $self->package;
1176 my @mods = $cb->search( type => 'package', allow => [qr/^$pkg$/] );
1183 =head2 @list_of_hrefs = $self->fetch_report()
1185 This function queries the CPAN testers database at
1186 I<http://testers.cpan.org/> for test results of specified module
1187 objects, module names or distributions.
1189 Look at L<CPANPLUS::Internals::Report::_query_report()> for details on
1190 the options you can pass and the return value to expect.
1196 my $cb = $self->parent;
1198 return $cb->_query_report( @_, module => $self );
1203 =head2 $bool = $self->uninstall([type => [all|man|prog])
1205 This function uninstalls the specified module object.
1207 You can install 2 types of files, either C<man> pages or C<prog>ram
1208 files. Alternately you can specify C<all> to uninstall both (which
1211 Returns true on success and false on failure.
1213 Do note that this does an uninstall via the so-called C<.packlist>,
1214 so if you used a module installer like say, C<ports> or C<apt>, you
1215 should not use this, but use your package manager instead.
1221 my $conf = $self->parent->configure_object();
1224 my ($type,$verbose);
1226 type => { default => 'all', allow => [qw|man prog all|],
1228 verbose => { default => $conf->get_conf('verbose'),
1229 store => \$verbose },
1230 force => { default => $conf->get_conf('force') },
1233 ### XXX add a warning here if your default install dist isn't
1234 ### makefile or build -- that means you are using a package manager
1235 ### and this will not do what you think!
1237 my $args = check( $tmpl, \%hash ) or return;
1239 if( $conf->get_conf('dist_type') and (
1240 ($conf->get_conf('dist_type') ne INSTALLER_BUILD) or
1241 ($conf->get_conf('dist_type') ne INSTALLER_MM))
1243 msg(loc("You have a default installer type set (%1) ".
1244 "-- you should probably use that package manager to " .
1245 "uninstall modules", $conf->get_conf('dist_type')), $verbose);
1248 ### check if we even have the module installed -- no point in continuing
1250 unless( $self->installed_version ) {
1251 error( loc( "Module '%1' is not installed, so cannot uninstall",
1256 ### nothing to uninstall ###
1257 my $files = $self->files( type => $type ) or return;
1258 my $dirs = $self->directory_tree( type => $type ) or return;
1259 my $sudo = $conf->get_program('sudo');
1261 ### just in case there's no file; M::B doensn't provide .packlists yet ###
1262 my $pack = $self->packlist;
1263 $pack = $pack->[0]->packlist_file() if $pack;
1265 ### first remove the files, then the dirs if they are empty ###
1267 for my $file( @$files, $pack ) {
1268 next unless defined $file && -f $file;
1270 msg(loc("Unlinking '%1'", $file), $verbose);
1272 my @cmd = ($^X, "-eunlink+q[$file]");
1273 unshift @cmd, $sudo if $sudo;
1276 unless ( run( command => \@cmd,
1277 verbose => $verbose,
1278 buffer => \$buffer )
1280 error(loc("Failed to unlink '%1': '%2'",$file, $buffer));
1285 for my $dir ( sort @$dirs ) {
1287 open DIR, $dir or next;
1288 my @count = readdir(DIR);
1291 next unless @count == 2; # . and ..
1293 msg(loc("Removing '%1'", $dir), $verbose);
1295 ### this fails on my win2k machines.. it indeed leaves the
1296 ### dir, but it's not a critical error, since the files have
1297 ### been removed. --kane
1298 #unless( rmdir $dir ) {
1299 # error( loc( "Could not remove '%1': %2", $dir, $! ) )
1300 # unless $^O eq 'MSWin32';
1303 my @cmd = ($^X, "-ermdir+q[$dir]");
1304 unshift @cmd, $sudo if $sudo;
1307 unless ( run( command => \@cmd,
1308 verbose => $verbose,
1309 buffer => \$buffer )
1311 error(loc("Failed to rmdir '%1': %2",$dir,$buffer));
1316 $self->status->uninstall(!$flag);
1317 $self->status->installed( $flag ? 1 : undef);
1324 =head2 @modobj = $self->distributions()
1326 Returns a list of module objects representing all releases for this
1327 module on success, false on failure.
1335 my @list = $self->author->distributions( %hash, module => $self ) or return;
1337 ### it's another release then by the same author ###
1338 return grep { $_->package_name eq $self->package_name } @list;
1343 =head2 @list = $self->files ()
1345 Returns a list of files used by this module, if it is installed.
1350 return shift->_extutils_installed( @_, method => 'files' );
1355 =head2 @list = $self->directory_tree ()
1357 Returns a list of directories used by this module.
1361 sub directory_tree {
1362 return shift->_extutils_installed( @_, method => 'directory_tree' );
1367 =head2 @list = $self->packlist ()
1369 Returns the C<ExtUtils::Packlist> object for this module.
1374 return shift->_extutils_installed( @_, method => 'packlist' );
1379 =head2 @list = $self->validate ()
1381 Returns a list of files that are missing for this modules, but
1382 are present in the .packlist file.
1387 return shift->_extutils_installed( method => 'validate' );
1390 ### generic method to call an ExtUtils::Installed method ###
1391 sub _extutils_installed {
1393 my $conf = $self->parent->configure_object();
1396 my ($verbose,$type,$method);
1398 verbose => { default => $conf->get_conf('verbose'),
1399 store => \$verbose, },
1400 type => { default => 'all',
1401 allow => [qw|prog man all|],
1403 method => { required => 1,
1405 allow => [qw|files directory_tree packlist
1410 my $args = check( $tmpl, \%hash ) or return;
1412 ### old versions of cygwin + perl < 5.8 are buggy here. bail out if we
1413 ### find we're being used by them
1414 { my $err = ON_OLD_CYGWIN;
1415 if($err) { error($err); return };
1418 return unless can_load(
1419 modules => { 'ExtUtils::Installed' => '0.0' },
1420 verbose => $verbose,
1424 unless( $inst = ExtUtils::Installed->new() ) {
1425 error( loc("Could not create an '%1' object", 'ExtUtils::Installed' ) );
1427 ### in case it's being used directly... ###
1432 { ### EU::Installed can die =/
1434 eval { @files = $inst->$method( $self->module, $type ) };
1438 error( loc("Could not get '%1' for '%2': %3",
1439 $method, $self->module, $@ ) );
1443 return wantarray ? @files : \@files;
1447 =head2 $bool = $self->add_to_includepath;
1449 Adds the current modules path to C<@INC> and C<$PERL5LIB>. This allows
1450 you to add the module from it's build dir to your path.
1452 You can reset C<@INC> and C<$PERL5LIB> to it's original state when you
1453 started the program, by calling:
1455 $self->parent->flush('lib');
1459 sub add_to_includepath {
1461 my $cb = $self->parent;
1463 if( my $dir = $self->status->extract ) {
1465 $cb->_add_to_includepath(
1467 File::Spec->catdir(BLIB->($dir), LIB),
1468 File::Spec->catdir(BLIB->($dir), ARCH),
1474 error(loc( "No extract dir registered for '%1' -- can not add ".
1475 "add builddir to search path!", $self->module ));
1485 =head2 $path = $self->best_path_to_module_build();
1489 If a newer version of Module::Build is found in your path, it will
1490 return this C<special> path. If the newest version of C<Module::Build>
1491 is found in your regular C<@INC>, the method will return false. This
1492 indicates you do not need to add a special directory to your C<@INC>.
1494 Note that this is only relevant if you're building your own
1495 C<CPANPLUS::Dist::*> plugin -- the built-in dist types already have
1500 ### make sure we're always running 'perl Build.PL' and friends
1501 ### against the highest version of module::build available
1502 sub best_path_to_module_build {
1505 ### Since M::B will actually shell out and run the Build.PL, we must
1506 ### make sure it refinds the proper version of M::B in the path.
1507 ### that may be either in our cp::inc or in site_perl, or even a
1508 ### new M::B being installed.
1509 ### don't add anything else here, as that might screw up prereq checks
1511 ### XXX this might be needed for Dist::MM too, if a makefile.pl is
1512 ### masquerading as a Build.PL
1514 ### did we find the most recent module::build in our installer path?
1516 ### XXX can't do changes to @INC, they're being ignored by
1517 ### new_from_context when writing a Build script. see ticket:
1518 ### #8826 Module::Build ignores changes to @INC when writing Build
1519 ### from new_from_context
1520 ### XXX applied schwern's patches (as seen on CPANPLUS::Devel 10/12/04)
1521 ### and upped the version to 0.26061 of the bundled version, and things
1524 ### this functionality is now obsolete -- prereqs should be installed
1525 ### and we no longer use the CPANPLUS::inc magic.. so comment this out.
1526 # require Module::Build;
1527 # if( CPANPLUS::inc->path_to('Module::Build') and (
1528 # CPANPLUS::inc->path_to('Module::Build') eq
1529 # CPANPLUS::inc->installer_path )
1532 # ### if the module being installed is *not* Module::Build
1533 # ### itself -- as that would undoubtedly be newer -- add
1534 # ### the path to the installers to @INC
1535 # ### if it IS module::build itself, add 'lib' to its path,
1536 # ### as the Build.PL would do as well, but the API doesn't.
1537 # ### this makes self updates possible
1538 # return $self->module eq 'Module::Build'
1540 # : CPANPLUS::inc->installer_path;
1543 ### otherwise, the path was found through a 'normal' way of
1552 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
1556 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
1560 The CPAN++ interface (of which this module is a part of) is copyright (c)
1561 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
1563 This library is free software; you may redistribute and/or modify it
1564 under the same terms as Perl itself.
1569 # c-indentation-style: bsd
1571 # indent-tabs-mode: nil
1573 # vim: expandtab shiftwidth=4: