lib/CPANPLUS/Module.pm

   1 package CPANPLUS::Module;
   2
   3 use strict;
   4 use vars qw[@ISA];
   5
   6
   7 use CPANPLUS::Dist;
   8 use CPANPLUS::Error;
   9 use CPANPLUS::Module::Signature;
  10 use CPANPLUS::Module::Checksums;
  11 use CPANPLUS::Internals::Constants;
  12
  13 use FileHandle;
  14
  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];
  20
  21 $Params::Check::VERBOSE = 1;
  22
  23 @ISA = qw[ CPANPLUS::Module::Signature CPANPLUS::Module::Checksums];
  24
  25 =pod
  26
  27 =head1 NAME
  28
  29 CPANPLUS::Module
  30
  31 =head1 SYNOPSIS
  32
  33     ### get a module object from the CPANPLUS::Backend object
  34     my $mod = $cb->module_tree('Some::Module');
  35
  36     ### accessors
  37     $mod->version;
  38     $mod->package;
  39
  40     ### methods
  41     $mod->fetch;
  42     $mod->extract;
  43     $mod->install;
  44
  45
  46 =head1 DESCRIPTION
  47
  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.
  51
  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.
  55
  56 =cut
  57
  58 my $tmpl = {
  59     module      => { default => '', required => 1 },    # full module name
  60     version     => { default => '0.0' },                # version number
  61     path        => { default => '', required => 1 },    # extended path on the
  62                                                         # cpan mirror, like
  63                                                         # /author/id/K/KA/KANE
  64     comment     => { default => ''},                    # comment on module
  65     package     => { default => '', required => 1 },    # package name, like
  66                                                         # 'bar-baz-1.03.tgz'
  67     description => { default => '' },                   # description of the
  68                                                         # module
  69     dslip       => { default => '    ' },               # dslip information
  70     _id         => { required => 1 },                   # id of the Internals
  71                                                         # parent object
  72     _status     => { no_override => 1 },                # stores status object
  73     author      => { default => '', required => 1,
  74                      allow => IS_AUTHOBJ },             # module author
  75     mtime       => { default => '' },
  76 };
  77
  78 ### autogenerate accessors ###
  79 for my $key ( keys %$tmpl ) {
  80     no strict 'refs';
  81     *{__PACKAGE__."::$key"} = sub {
  82         $_[0]->{$key} = $_[1] if @_ > 1;
  83         return $_[0]->{$key};
  84     }
  85 }
  86
  87 =pod
  88
  89 =head1 CLASS METHODS
  90
  91 =head2 accessors ()
  92
  93 Returns a list of all accessor methods to the object
  94
  95 =cut
  96
  97 ### *name is an alias, include it explicitly
  98 sub accessors { return ('name', keys %$tmpl) };
  99
 100 =head1 ACCESSORS
 101
 102 An objects of this class has the following accessors:
 103
 104 =over 4
 105
 106 =item name
 107
 108 Name of the module.
 109
 110 =item module
 111
 112 Name of the module.
 113
 114 =item version
 115
 116 Version of the module. Defaults to '0.0' if none was provided.
 117
 118 =item path
 119
 120 Extended path on the mirror.
 121
 122 =item comment
 123
 124 Any comment about the module -- largely unused.
 125
 126 =item package
 127
 128 The name of the package.
 129
 130 =item description
 131
 132 Description of the module -- only registered modules have this.
 133
 134 =item dslip
 135
 136 The five character dslip string, that represents meta-data of the
 137 module -- again, only registered modules have this.
 138
 139 =item status
 140
 141 The C<CPANPLUS::Module::Status> object associated with this object.
 142 (see below).
 143
 144 =item author
 145
 146 The C<CPANPLUS::Module::Author> object associated with this object.
 147
 148 =item parent
 149
 150 The C<CPANPLUS::Internals> object that spawned this module object.
 151
 152 =back
 153
 154 =cut
 155
 156 ### Alias ->name to ->module, for human beings.
 157 *name = *module;
 158
 159 sub parent {
 160     my $self = shift;
 161     my $obj  = CPANPLUS::Internals->_retrieve_id( $self->_id );
 162
 163     return $obj;
 164 }
 165
 166 =head1 STATUS ACCESSORS
 167
 168 C<CPANPLUS> caches a lot of results from method calls and saves data
 169 it collected along the road for later reuse.
 170
 171 C<CPANPLUS> uses this internally, but it is also available for the end
 172 user. You can get a status object by calling:
 173
 174     $modobj->status
 175
 176 You can then query the object as follows:
 177
 178 =over 4
 179
 180 =item installer_type
 181
 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.
 185
 186 =item dist_cpan
 187
 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.
 190
 191 =item dist
 192
 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.
 197
 198 Undefined if you didn't specify a separate format to install through.
 199
 200 =item prereqs
 201
 202 A hashref of prereqs this distribution was found to have. Will look
 203 something like this:
 204
 205     { Carp  => 0.01, strict => 0 }
 206
 207 Might be undefined if the distribution didn't have any prerequisites.
 208
 209 =item signature
 210
 211 Flag indicating, if a signature check was done, whether it was OK or
 212 not.
 213
 214 =item extract
 215
 216 The directory this distribution was extracted to.
 217
 218 =item fetch
 219
 220 The location this distribution was fetched to.
 221
 222 =item readme
 223
 224 The text of this distributions README file.
 225
 226 =item uninstall
 227
 228 Flag indicating if an uninstall call was done successfully.
 229
 230 =item created
 231
 232 Flag indicating if the C<create> call to your dist object was done
 233 successfully.
 234
 235 =item installed
 236
 237 Flag indicating if the C<install> call to your dist object was done
 238 successfully.
 239
 240 =item checksums
 241
 242 The location of this distributions CHECKSUMS file.
 243
 244 =item checksum_ok
 245
 246 Flag indicating if the checksums check was done successfully.
 247
 248 =item checksum_value
 249
 250 The checksum value this distribution is expected to have
 251
 252 =back
 253
 254 =head1 METHODS
 255
 256 =head2 $self = CPANPLUS::Module::new( OPTIONS )
 257
 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.
 261
 262 This example illustrates a C<new()> call with all required arguments:
 263
 264         CPANPLUS::Module->new(
 265             module  => 'Foo',
 266             path    => 'authors/id/A/AA/AAA',
 267             package => 'Foo-1.0.tgz',
 268             author  => $author_object,
 269             _id     => INTERNALS_OBJECT_ID,
 270         );
 271
 272 Every accessor is also a valid option to pass to C<new>.
 273
 274 Returns a module object on success and false on failure.
 275
 276 =cut
 277
 278
 279 sub new {
 280     my($class, %hash) = @_;
 281
 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;
 285
 286     my $object  = check( $tmpl, \%hash ) or return;
 287
 288     bless $object, $class;
 289
 290     return $object;
 291 }
 292
 293 ### only create status objects when they're actually asked for
 294 sub status {
 295     my $self = shift;
 296     return $self->_status if $self->_status;
 297
 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] );
 303
 304     $self->_status( $acc );
 305
 306     return $self->_status;
 307 }
 308
 309
 310 ### flush the cache of this object ###
 311 sub _flush {
 312     my $self = shift;
 313     $self->status->mk_flush;
 314     return 1;
 315 }
 316
 317 =head2 $mod->package_name
 318
 319 Returns the name of the package a module is in. For C<Acme::Bleach>
 320 that might be C<Acme-Bleach>.
 321
 322 =head2 $mod->package_version
 323
 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>.
 326
 327 =head2 $mod->package_extension
 328
 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
 331 would be C<tar.gz>.
 332
 333 =head2 $mod->package_is_perl_core
 334
 335 Returns a boolean indicating of the package a particular module is in,
 336 is actually a core perl distribution.
 337
 338 =head2 $mod->module_is_supplied_with_perl_core( [version => $]] )
 339
 340 Returns a boolean indicating whether C<ANY VERSION> of this module
 341 was supplied with the current running perl's core package.
 342
 343 =head2 $mod->is_bundle
 344
 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
 347 with C<Bundle::>.
 348
 349 =head2 $mod->is_third_party
 350
 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.
 355
 356 =head2 $mod->third_party_information
 357
 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.
 361
 362 =cut
 363
 364 {   ### fetches the test reports for a certain module ###
 365     my %map = (
 366         name        => 0,
 367         version     => 1,
 368         extension   => 2,
 369     );
 370
 371     while ( my($type, $index) = each %map ) {
 372         my $name    = 'package_' . $type;
 373
 374         no strict 'refs';
 375         *$name = sub {
 376             my $self = shift;
 377             my @res  = $self->parent->_split_package_string(
 378                             package => $self->package
 379                        );
 380
 381             ### return the corresponding index from the result
 382             return $res[$index] if @res;
 383             return;
 384         };
 385     }
 386
 387     sub package_is_perl_core {
 388         my $self = shift;
 389
 390         ### check if the package looks like a perl core package
 391         return 1 if $self->package_name eq PERL_CORE;
 392
 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
 395         if ($core) {
 396             ### if the package is newer than installed, then it's dual-lifed
 397             return if $self->version > $self->installed_version;
 398
 399             ### if the package is newer or equal to the corelist,
 400             ### then it's dual-lifed
 401             return if $self->version >= $core;
 402
 403             ### otherwise, it's older than corelist, thus unsuitable.
 404             return 1;
 405         }
 406
 407         ### not in corelist, not a perl core package.
 408         return;
 409     }
 410
 411     sub module_is_supplied_with_perl_core {
 412         my $self = shift;
 413         my $ver  = shift || $];
 414
 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 };
 418
 419         return $core;
 420     }
 421
 422     ### make sure Bundle-Foo also gets flagged as bundle
 423     sub is_bundle {
 424         return shift->module =~ /^bundle(?:-|::)/i ? 1 : 0;
 425     }
 426
 427     sub is_third_party {
 428         my $self = shift;
 429
 430         return unless can_load( modules => { 'Module::ThirdParty' => 0 } );
 431
 432         return Module::ThirdParty::is_3rd_party( $self->name );
 433     }
 434
 435     sub third_party_information {
 436         my $self = shift;
 437
 438         return unless $self->is_third_party;
 439
 440         return Module::ThirdParty::module_information( $self->name );
 441     }
 442 }
 443
 444 =pod
 445
 446 =head2 $clone = $self->clone
 447
 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.
 451
 452 =cut
 453
 454 sub clone {
 455     my $self = shift;
 456
 457     ### clone the object ###
 458     my %data;
 459     for my $acc ( grep !/status/, __PACKAGE__->accessors() ) {
 460         $data{$acc} = $self->$acc();
 461     }
 462
 463     my $obj = CPANPLUS::Module::Fake->new( %data );
 464
 465     return $obj;
 466 }
 467
 468 =pod
 469
 470 =head2 $where = $self->fetch
 471
 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.
 475
 476 =cut
 477
 478 sub fetch {
 479     my $self = shift;
 480     my $cb   = $self->parent;
 481
 482     ### custom args
 483     my %args            = ( module => $self );
 484
 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;
 488
 489     my $where = $cb->_fetch( @_, %args ) or return;
 490
 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
 495     ) {
 496         unless( $self->_validate_checksum ) {
 497             error( loc( "Checksum error for '%1' -- will not trust package",
 498                         $self->package) );
 499             return;
 500         }
 501     }
 502
 503     return $where;
 504 }
 505
 506 =pod
 507
 508 =head2 $path = $self->extract
 509
 510 Extracts the fetched module.
 511 Look at L<CPANPLUS::Internals::Extract::_extract()> for details on
 512 the options you can pass.
 513
 514 =cut
 515
 516 sub extract {
 517     my $self = shift;
 518     my $cb   = $self->parent;
 519
 520     unless( $self->status->fetch ) {
 521         error( loc( "You have not fetched '%1' yet -- cannot extract",
 522                     $self->module) );
 523         return;
 524     }
 525
 526     return $cb->_extract( @_, module => $self );
 527 }
 528
 529 =head2 $type = $self->get_installer_type([prefer_makefile => BOOL])
 530
 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.
 536
 537 Returns the installer type on success, and false on error.
 538
 539 =cut
 540
 541 sub get_installer_type {
 542     my $self = shift;
 543     my $cb   = $self->parent;
 544     my $conf = $cb->configure_object;
 545     my %hash = @_;
 546
 547     my $prefer_makefile;
 548     my $tmpl = {
 549         prefer_makefile => { default => $conf->get_conf('prefer_makefile'),
 550                              store => \$prefer_makefile, allow => BOOLEANS },
 551     };
 552
 553     check( $tmpl, \%hash ) or return;
 554
 555     my $extract = $self->status->extract();
 556     unless( $extract ) {
 557         error(loc("Cannot determine installer type of unextracted module '%1'",
 558                   $self->module));
 559         return;
 560     }
 561
 562
 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 );
 566
 567     my $type;
 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;
 572
 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 )
 576     ) {
 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;
 582
 583     ### ok, actually we found neither ###
 584     } elsif ( !$type ) {
 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;
 590     }
 591
 592     return $self->status->installer_type( $type ) if $type;
 593     return;
 594 }
 595
 596 =pod
 597
 598 =head2 $dist = $self->dist([target => 'prepare|create', format => DISTRIBUTION_TYPE, args => {key => val}]);
 599
 600 Create a distribution object, ready to be installed.
 601 Distribution type defaults to your config settings
 602
 603 The optional C<args> hashref is passed on to the specific distribution
 604 types' C<create> method after being dereferenced.
 605
 606 Returns a distribution object on success, false on failure.
 607
 608 See C<CPANPLUS::Dist> for details.
 609
 610 =cut
 611
 612 sub dist {
 613     my $self = shift;
 614     my $cb   = $self->parent;
 615     my $conf = $cb->configure_object;
 616     my %hash = @_;
 617
 618     ### have you determined your installer type yet? if not, do it here,
 619     ### we need the info
 620     $self->get_installer_type unless $self->status->installer_type;
 621
 622
 623     my($type,$args,$target);
 624     my $tmpl = {
 625         format  => { default => $conf->get_conf('dist_type') ||
 626                                 $self->status->installer_type,
 627                      store   => \$type },
 628         target  => { default => TARGET_CREATE, store => \$target },
 629         args    => { default => {}, store => \$args },
 630     };
 631
 632     check( $tmpl, \%hash ) or return;
 633
 634     my $dist = CPANPLUS::Dist->new(
 635                                 format => $type,
 636                                 module => $self
 637                             ) or return;
 638
 639     my $dist_cpan = $type eq $self->status->installer_type
 640                         ? $dist
 641                         : CPANPLUS::Dist->new(
 642                                 format  => $self->status->installer_type,
 643                                 module  => $self,
 644                             );
 645
 646     ### store the dists
 647     $self->status->dist_cpan(   $dist_cpan );
 648     $self->status->dist(        $dist );
 649
 650     DIST: {
 651         ### first prepare the dist
 652         $dist->prepare( %$args ) or return;
 653         $self->status->prepared(1);
 654
 655         ### you just wanted us to prepare?
 656         last DIST if $target eq TARGET_PREPARE;
 657
 658         $dist->create( %$args ) or return;
 659         $self->status->created(1);
 660     }
 661
 662     return $dist;
 663 }
 664
 665 =pod
 666
 667 =head2 $bool = $mod->prepare( )
 668
 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>
 672
 673 Returns true on success, false on failure.
 674
 675 =cut
 676
 677 sub prepare {
 678     my $self = shift;
 679     return $self->install( @_, target => TARGET_PREPARE );
 680 }
 681
 682 =head2 $bool = $mod->create( )
 683
 684 Convenience method around C<install()> that creates a module.
 685 This is equivalent to invoking C<install> with C<target> set to
 686 C<create>
 687
 688 Returns true on success, false on failure.
 689
 690 =cut
 691
 692 sub create {
 693     my $self = shift;
 694     return $self->install( @_, target => TARGET_CREATE );
 695 }
 696
 697 =head2 $bool = $mod->test( )
 698
 699 Convenience wrapper around C<install()> that tests a module, without
 700 installing it.
 701 It's the equivalent to invoking C<install()> with C<target> set to
 702 C<create> and C<skiptest> set to C<0>.
 703
 704 Returns true on success, false on failure.
 705
 706 =cut
 707
 708 sub test {
 709     my $self = shift;
 710     return $self->install( @_, target => TARGET_CREATE, skiptest => 0 );
 711 }
 712
 713 =pod
 714
 715 =head2 $bool = $self->install([ target => 'prepare|create|install', format => FORMAT_TYPE, extractdir => DIRECTORY, fetchdir => DIRECTORY, prefer_bin => BOOL, force => BOOL, verbose => BOOL, ..... ]);
 716
 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
 719 object for it.
 720
 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.
 723
 724 See C<CPANPLUS::Internals::Fetch>, C<CPANPLUS::Internals::Extract> and
 725 C<CPANPLUS::Dist> for details.
 726
 727 Returns true on success, false on failure.
 728
 729 =cut
 730
 731 sub install {
 732     my $self = shift;
 733     my $cb   = $self->parent;
 734     my $conf = $cb->configure_object;
 735     my %hash = @_;
 736
 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;
 741
 742         ### targets 'dist' and 'test' are now completely ignored ###
 743         my $tmpl = {
 744                         ### match this allow list with Dist->_resolve_prereqs
 745             target     => { default => TARGET_INSTALL, store => \$target,
 746                             allow   => [TARGET_PREPARE, TARGET_CREATE,
 747                                         TARGET_INSTALL] },
 748             force      => { default => $conf->get_conf('force'), },
 749             verbose    => { default => $conf->get_conf('verbose'), },
 750             format     => { default => $conf->get_conf('dist_type'),
 751                                 store => \$format },
 752         };
 753
 754         $args = check( $tmpl, \%hash ) or return;
 755     }
 756
 757
 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
 761     ### not supported.
 762     $args->{'prereq_target'} ||= TARGET_CREATE if $target ne TARGET_INSTALL;
 763
 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)
 769     ) {
 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);
 773     }
 774
 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). ".
 781                       "Aborting install.",
 782                       $], $self->module, $self->installed_version,
 783                       $self->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. ".
 788                       "Aborting install.",
 789                       $], $self->module, $self->installed_version ) );
 790         # otherwise, the installed is older; say so.
 791         } else {
 792             error(loc("The core Perl %1 module '%2' can only be ".
 793                       "upgraded from %3 to %4 by Perl itself (%5). ".
 794                       "Aborting install.",
 795                       $], $self->module, $self->installed_version,
 796                       $self->version, $self->package ) );
 797         }
 798         return;
 799
 800     ### it might be a known 3rd party module
 801     } elsif ( $self->is_third_party ) {
 802         my $info = $self->third_party_information;
 803         error(loc(
 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},
 811             $info->{url}
 812         ));
 813
 814         return;
 815     }
 816
 817     ### fetch it if need be ###
 818     unless( $self->status->fetch ) {
 819         my $params;
 820         for (qw[prefer_bin fetchdir]) {
 821             $params->{$_} = $args->{$_} if exists $args->{$_};
 822         }
 823         for (qw[force verbose]) {
 824             $params->{$_} = $args->{$_} if defined $args->{$_};
 825         }
 826         $self->fetch( %$params ) or return;
 827     }
 828
 829     ### extract it if need be ###
 830     unless( $self->status->extract ) {
 831         my $params;
 832         for (qw[prefer_bin extractdir]) {
 833             $params->{$_} = $args->{$_} if exists $args->{$_};
 834         }
 835         for (qw[force verbose]) {
 836             $params->{$_} = $args->{$_} if defined $args->{$_};
 837         }
 838         $self->extract( %$params ) or return;
 839     }
 840
 841     $format ||= $self->status->installer_type;
 842
 843     unless( $format ) {
 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 ) );
 848
 849         $self->status->installed(0);
 850         return;
 851     }
 852
 853
 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",
 859                         $self->module ) );
 860             $self->status->signature(0);
 861
 862             ### send out test report on broken sig
 863             if( $conf->get_conf('cpantest') ) {
 864                 $cb->_send_report(
 865                     module  => $self,
 866                     failed  => 1,
 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'",
 871                      $self->module ) );
 872             }
 873
 874             return;
 875
 876         } else {
 877             ### signature OK ###
 878             $self->status->signature(1);
 879         }
 880     }
 881
 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';
 885
 886     ### bundle rules apply ###
 887     if( $self->is_bundle ) {
 888         ### check what we need to install ###
 889         my @prereqs = $self->bundle_modules();
 890         unless( @prereqs ) {
 891             error( loc( "Bundle '%1' does not specify any modules to install",
 892                         $self->module ) );
 893
 894             ### XXX mark an error here? ###
 895         }
 896     }
 897
 898     my $dist = $self->dist( format  => $format,
 899                             target  => $target,
 900                             args    => $args );
 901     unless( $dist ) {
 902         error( loc( "Unable to create a new distribution object for '%1' " .
 903                     "-- cannot continue", $self->module ) );
 904         return;
 905     }
 906
 907     return 1 if $target ne TARGET_INSTALL;
 908
 909     my $ok = $dist->install( %$args ) ? 1 : 0;
 910
 911     $self->status->installed($ok);
 912
 913     return 1 if $ok;
 914     return;
 915 }
 916
 917 =pod @list = $self->bundle_modules()
 918
 919 Returns a list of module objects the Bundle specifies.
 920
 921 This requires you to have extracted the bundle already, using the
 922 C<extract()> method.
 923
 924 Returns false on error.
 925
 926 =cut
 927
 928 sub bundle_modules {
 929     my $self = shift;
 930     my $cb   = $self->parent;
 931
 932     unless( $self->is_bundle ) {
 933         error( loc("'%1' is not a bundle", $self->module ) );
 934         return;
 935     }
 936
 937     my $dir;
 938     unless( $dir = $self->status->extract ) {
 939         error( loc("Don't know where '%1' was extracted to", $self->module ) );
 940         return;
 941     }
 942
 943     my @files;
 944     find( {
 945         wanted      => sub { push @files, File::Spec->rel2abs($_) if /\.pm/i; },
 946         no_chdir    => 1,
 947     }, $dir );
 948
 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",
 953                         $file,$!)), next );
 954
 955         my $flag;
 956         while(<$fh>) {
 957             ### quick hack to read past the header of the file ###
 958             last if $flag && m|^=head|i;
 959
 960             ### from perldoc cpan:
 961             ### =head1 CONTENTS
 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;
 965
 966             if ($flag && /^(?!=)(\S+)\s*(\S+)?/) {
 967                 my $module  = $1;
 968                 my $version = $2 || '0';
 969
 970                 my $obj = $cb->module_tree($module);
 971
 972                 unless( $obj ) {
 973                     error(loc("Cannot find bundled module '%1'", $module),
 974                           loc("-- it does not seem to exist") );
 975                     next;
 976                 }
 977
 978                 ### make sure we list no duplicates ###
 979                 unless( $seen->{ $obj->module }++ ) {
 980                     push @list, $obj;
 981                     $prereqs->{ $module } =
 982                         $cb->_version_to_number( version => $version );
 983                 }
 984             }
 985         }
 986     }
 987
 988     ### store the prereqs we just found ###
 989     $self->status->prereqs( $prereqs );
 990
 991     return @list;
 992 }
 993
 994 =pod
 995
 996 =head2 $text = $self->readme
 997
 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.
1001
1002 =cut
1003
1004 sub readme {
1005     my $self = shift;
1006     my $conf = $self->parent->configure_object;
1007
1008     ### did we already dl the readme once? ###
1009     return $self->status->readme() if $self->status->readme();
1010
1011     ### this should be core ###
1012     return unless can_load( modules     => { FileHandle => '0.0' },
1013                             verbose     => 1,
1014                         );
1015
1016     ### get a clone of the current object, with a fresh status ###
1017     my $obj  = $self->clone or return;
1018
1019     ### munge the package name
1020     my $pkg = README->( $obj );
1021     $obj->package($pkg);
1022
1023     my $file;
1024     {   ### disable checksum fetches on readme downloads
1025
1026         my $tmp = $conf->get_conf( 'md5' );
1027         $conf->set_conf( md5 => 0 );
1028
1029         $file = $obj->fetch;
1030
1031         $conf->set_conf( md5 => $tmp );
1032
1033         return unless $file;
1034     }
1035
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, $! ) );
1040         return;
1041     }
1042
1043     my $in;
1044     { local $/; $in = <$fh> };
1045     $fh->close;
1046
1047     return $self->status->readme( $in );
1048 }
1049
1050 =pod
1051
1052 =head2 $version = $self->installed_version()
1053
1054 Returns the currently installed version of this module, if any.
1055
1056 =head2 $where = $self->installed_file()
1057
1058 Returns the location of the currently installed file of this module,
1059 if any.
1060
1061 =head2 $bool = $self->is_uptodate([version => VERSION_NUMBER])
1062
1063 Returns a boolean indicating if this module is uptodate or not.
1064
1065 =cut
1066
1067 ### uptodate/installed functions
1068 {   my $map = {             # hashkey,      alternate rv
1069         installed_version   => ['version',  0 ],
1070         installed_file      => ['file',     ''],
1071         is_uptodate         => ['uptodate', 0 ],
1072     };
1073
1074     while( my($method, $aref) = each %$map ) {
1075         my($key,$alt_rv) = @$aref;
1076
1077         no strict 'refs';
1078         *$method = sub {
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*
1082             ### modules!
1083             ### XXX CPANPLUS::inc is now obsolete, so this should not
1084             ### be needed anymore
1085             #local @INC = CPANPLUS::inc->original_inc;
1086
1087             my $self = shift;
1088
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,
1096                             @_,
1097                         );
1098
1099             return $href->{$key} || $alt_rv;
1100         }
1101     }
1102 }
1103
1104
1105
1106 =pod
1107
1108 =head2 $href = $self->details()
1109
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
1112 this:
1113
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
1125
1126 =cut
1127
1128 sub details {
1129     my $self = shift;
1130     my $conf = $self->parent->configure_object();
1131     my $cb   = $self->parent;
1132     my %hash = @_;
1133
1134     my $res = {
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,
1140     };
1141
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;
1147
1148     my $i = 0;
1149     for my $item( split '', $self->dslip ) {
1150         $res->{ $cb->_dslip_defs->[$i]->[0] } =
1151                 $cb->_dslip_defs->[$i]->[1]->{$item} || loc('Unknown');
1152         $i++;
1153     }
1154
1155     return $res;
1156 }
1157
1158 =head2 @list = $self->contains()
1159
1160 Returns a list of module objects that represent the modules also
1161 present in the package of this module.
1162
1163 For example, for C<Archive::Tar> this might return:
1164
1165     Archive::Tar
1166     Archive::Tar::Constant
1167     Archive::Tar::File
1168
1169 =cut
1170
1171 sub contains {
1172     my $self = shift;
1173     my $cb   = $self->parent;
1174     my $pkg  = $self->package;
1175
1176     my @mods = $cb->search( type => 'package', allow => [qr/^$pkg$/] );
1177
1178     return @mods;
1179 }
1180
1181 =pod
1182
1183 =head2 @list_of_hrefs = $self->fetch_report()
1184
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.
1188
1189 Look at L<CPANPLUS::Internals::Report::_query_report()> for details on
1190 the options you can pass and the return value to expect.
1191
1192 =cut
1193
1194 sub fetch_report {
1195     my $self    = shift;
1196     my $cb      = $self->parent;
1197
1198     return $cb->_query_report( @_, module => $self );
1199 }
1200
1201 =pod
1202
1203 =head2 $bool = $self->uninstall([type => [all|man|prog])
1204
1205 This function uninstalls the specified module object.
1206
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
1209 is the default).
1210
1211 Returns true on success and false on failure.
1212
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.
1216
1217 =cut
1218
1219 sub uninstall {
1220     my $self = shift;
1221     my $conf = $self->parent->configure_object();
1222     my %hash = @_;
1223
1224     my ($type,$verbose);
1225     my $tmpl = {
1226         type    => { default => 'all', allow => [qw|man prog all|],
1227                         store => \$type },
1228         verbose => { default => $conf->get_conf('verbose'),
1229                         store => \$verbose },
1230         force   => { default => $conf->get_conf('force') },
1231     };
1232
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!
1236
1237     my $args = check( $tmpl, \%hash ) or return;
1238
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))
1242     ) {
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);
1246     }
1247
1248     ### check if we even have the module installed -- no point in continuing
1249     ### otherwise
1250     unless( $self->installed_version ) {
1251         error( loc( "Module '%1' is not installed, so cannot uninstall",
1252                     $self->module ) );
1253         return;
1254     }
1255
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');
1260
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;
1264
1265     ### first remove the files, then the dirs if they are empty ###
1266     my $flag = 0;
1267     for my $file( @$files, $pack ) {
1268         next unless defined $file && -f $file;
1269
1270         msg(loc("Unlinking '%1'", $file), $verbose);
1271
1272         my @cmd = ($^X, "-eunlink+q[$file]");
1273         unshift @cmd, $sudo if $sudo;
1274
1275         my $buffer;
1276         unless ( run(   command => \@cmd,
1277                         verbose => $verbose,
1278                         buffer  => \$buffer )
1279         ) {
1280             error(loc("Failed to unlink '%1': '%2'",$file, $buffer));
1281             $flag++;
1282         }
1283     }
1284
1285     for my $dir ( sort @$dirs ) {
1286         local *DIR;
1287         open DIR, $dir or next;
1288         my @count = readdir(DIR);
1289         close DIR;
1290
1291         next unless @count == 2;    # . and ..
1292
1293         msg(loc("Removing '%1'", $dir), $verbose);
1294
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';
1301         #}
1302
1303         my @cmd = ($^X, "-ermdir+q[$dir]");
1304         unshift @cmd, $sudo if $sudo;
1305
1306         my $buffer;
1307         unless ( run(   command => \@cmd,
1308                         verbose => $verbose,
1309                         buffer  => \$buffer )
1310         ) {
1311             error(loc("Failed to rmdir '%1': %2",$dir,$buffer));
1312             $flag++;
1313         }
1314     }
1315
1316     $self->status->uninstall(!$flag);
1317     $self->status->installed( $flag ? 1 : undef);
1318
1319     return !$flag;
1320 }
1321
1322 =pod
1323
1324 =head2 @modobj = $self->distributions()
1325
1326 Returns a list of module objects representing all releases for this
1327 module on success, false on failure.
1328
1329 =cut
1330
1331 sub distributions {
1332     my $self = shift;
1333     my %hash = @_;
1334
1335     my @list = $self->author->distributions( %hash, module => $self ) or return;
1336
1337     ### it's another release then by the same author ###
1338     return grep { $_->package_name eq $self->package_name } @list;
1339 }
1340
1341 =pod
1342
1343 =head2 @list = $self->files ()
1344
1345 Returns a list of files used by this module, if it is installed.
1346
1347 =cut
1348
1349 sub files {
1350     return shift->_extutils_installed( @_, method => 'files' );
1351 }
1352
1353 =pod
1354
1355 =head2 @list = $self->directory_tree ()
1356
1357 Returns a list of directories used by this module.
1358
1359 =cut
1360
1361 sub directory_tree {
1362     return shift->_extutils_installed( @_, method => 'directory_tree' );
1363 }
1364
1365 =pod
1366
1367 =head2 @list = $self->packlist ()
1368
1369 Returns the C<ExtUtils::Packlist> object for this module.
1370
1371 =cut
1372
1373 sub packlist {
1374     return shift->_extutils_installed( @_, method => 'packlist' );
1375 }
1376
1377 =pod
1378
1379 =head2 @list = $self->validate ()
1380
1381 Returns a list of files that are missing for this modules, but
1382 are present in the .packlist file.
1383
1384 =cut
1385
1386 sub validate {
1387     return shift->_extutils_installed( method => 'validate' );
1388 }
1389
1390 ### generic method to call an ExtUtils::Installed method ###
1391 sub _extutils_installed {
1392     my $self = shift;
1393     my $conf = $self->parent->configure_object();
1394     my %hash = @_;
1395
1396     my ($verbose,$type,$method);
1397     my $tmpl = {
1398         verbose => {    default     => $conf->get_conf('verbose'),
1399                         store       => \$verbose, },
1400         type    => {    default     => 'all',
1401                         allow       => [qw|prog man all|],
1402                         store       => \$type, },
1403         method  => {    required    => 1,
1404                         store       => \$method,
1405                         allow       => [qw|files directory_tree packlist
1406                                         validate|],
1407                     },
1408     };
1409
1410     my $args = check( $tmpl, \%hash ) or return;
1411
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 };
1416     }
1417
1418     return unless can_load(
1419                         modules     => { 'ExtUtils::Installed' => '0.0' },
1420                         verbose     => $verbose,
1421                     );
1422
1423     my $inst;
1424     unless( $inst = ExtUtils::Installed->new() ) {
1425         error( loc("Could not create an '%1' object", 'ExtUtils::Installed' ) );
1426
1427         ### in case it's being used directly... ###
1428         return;
1429     }
1430
1431
1432     {   ### EU::Installed can die =/
1433         my @files;
1434         eval { @files = $inst->$method( $self->module, $type ) };
1435
1436         if( $@ ) {
1437             chomp $@;
1438             error( loc("Could not get '%1' for '%2': %3",
1439                         $method, $self->module, $@ ) );
1440             return;
1441         }
1442
1443         return wantarray ? @files : \@files;
1444     }
1445 }
1446
1447 =head2 $bool = $self->add_to_includepath;
1448
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.
1451
1452 You can reset C<@INC> and C<$PERL5LIB> to it's original state when you
1453 started the program, by calling:
1454
1455     $self->parent->flush('lib');
1456
1457 =cut
1458
1459 sub add_to_includepath {
1460     my $self = shift;
1461     my $cb   = $self->parent;
1462
1463     if( my $dir = $self->status->extract ) {
1464
1465             $cb->_add_to_includepath(
1466                     directories => [
1467                         File::Spec->catdir(BLIB->($dir), LIB),
1468                         File::Spec->catdir(BLIB->($dir), ARCH),
1469                         BLIB->($dir),
1470                     ]
1471             ) or return;
1472
1473     } else {
1474         error(loc(  "No extract dir registered for '%1' -- can not add ".
1475                     "add builddir to search path!", $self->module ));
1476         return;
1477     }
1478
1479     return 1;
1480
1481 }
1482
1483 =pod
1484
1485 =head2 $path = $self->best_path_to_module_build();
1486
1487 B<OBSOLETE>
1488
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>.
1493
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
1496 this taken care of.
1497
1498 =cut
1499
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 {
1503     my $self = shift;
1504
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
1510
1511     ### XXX this might be needed for Dist::MM too, if a makefile.pl is
1512     ### masquerading as a Build.PL
1513
1514     ### did we find the most recent module::build in our installer path?
1515
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
1522     ### work again
1523
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 )
1530 #     ) {
1531 #
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'
1539 #                         ? 'lib'
1540 #                         : CPANPLUS::inc->installer_path;
1541 #     }
1542
1543     ### otherwise, the path was found through a 'normal' way of
1544     ### scanning @INC.
1545     return;
1546 }
1547
1548 =pod
1549
1550 =head1 BUG REPORTS
1551
1552 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
1553
1554 =head1 AUTHOR
1555
1556 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
1557
1558 =head1 COPYRIGHT
1559
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.
1562
1563 This library is free software; you may redistribute and/or modify it
1564 under the same terms as Perl itself.
1565
1566 =cut
1567
1568 # Local variables:
1569 # c-indentation-style: bsd
1570 # c-basic-offset: 4
1571 # indent-tabs-mode: nil
1572 # End:
1573 # vim: expandtab shiftwidth=4:
1574
1575 1;
1576
1577 __END__
1578
1579 todo:
1580 reports();