CPAN-Common-Index

 view release on metacpan or  search on metacpan

lib/CPAN/Common/Index/LocalPackage.pm  view on Meta::CPAN

sub refresh_index {
    my ($self) = @_;
    my $source = $self->source;
    my $basename = File::Basename::basename($source);
    if ( $source =~ /\.gz$/ ) {
        Carp::croak "can't load gz source files without IO::Uncompress::Gunzip\n"
          unless $CPAN::Common::Index::Mirror::HAS_IO_UNCOMPRESS_GUNZIP;
        ( my $uncompressed = $basename ) =~ s/\.gz$//;
        $uncompressed = File::Spec->catfile( $self->cache, $uncompressed );
        if ( !-f $uncompressed
              or File::stat::stat($source)->mtime > File::stat::stat($uncompressed)->mtime ) {
            no warnings 'once';
            IO::Uncompress::Gunzip::gunzip( map { "$_" } $source, $uncompressed )
              or Carp::croak "gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n";
        }
    }
    else {
        my $dest = File::Spec->catfile( $self->cache, $basename );
        File::Copy::copy($source, $dest)
          if !-e $dest || File::stat::stat($source)->mtime > File::stat::stat($dest)->mtime;
    }
    return 1;
}

sub search_authors { return }; # this package handles packages only

1;


# vim: ts=4 sts=4 sw=4 et:

lib/CPAN/Common/Index/Mirror.pm  view on Meta::CPAN

              or Carp::croak "gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n";
        }
    }
    return 1;
}

# epoch secs
sub index_age {
    my ($self) = @_;
    my $package = $self->cached_package;
    return ( -r $package ? ( stat($package) )[9] : 0 ); # mtime if readable
}

sub search_packages {
    my ( $self, $args ) = @_;
    Carp::croak("Argument to search_packages must be hash reference")
      unless ref $args eq 'HASH';

    my $index_path = $self->cached_package;
    die "Can't read $index_path" unless -r $index_path;

t/local_package.t  view on Meta::CPAN

    }
    else {
        $index_generater = \&new_uncompressed_local_index;
        $note            = "without IO::Uncompress::Gunzip";
    }

    subtest "check index age $note" => sub {
        my $index   = $index_generater->();
        my $package = $index->cached_package;
        ok( -f $package, "got the package file" );
        my $expected_age = ( stat($package) )[9];
        is( $index->index_age, $expected_age, "index_age() is correct" );
    };

    subtest "find package $note" => sub {
        my $index = $index_generater->();
        test_find_package($index);
    };

    subtest "search package $note" => sub {
        my $index = $index_generater->();

t/mirror.t  view on Meta::CPAN

sub common_tests {
    my $note =
      ( $CPAN::Common::Index::Mirror::HAS_IO_UNCOMPRESS_GUNZIP ? "with" : "without" )
      . " IO::Uncompress::Gunzip";

    subtest "check index age $note" => sub {
        my $index   = new_mirror_index;
        my $package = $index->cached_package;
        ok( -f $package, "got the package file" );
        my $expected_age = ( stat($package) )[9];
        is( $index->index_age, $expected_age, "index_age() is correct" );
    };

    subtest "find package $note" => sub {
        my $index = new_mirror_index;
        test_find_package($index);
    };

    subtest "search package $note" => sub {
        my $index = new_mirror_index;