File Coverage

blib/lib/CPAN/Common/Index/LocalPackage.pm

Criterion	Covered	Total	%
statement	55	56	98.2
branch	11	14	78.5
condition	2	6	33.3
subroutine	14	15	93.3
pod	2	4	50.0
total	84	95	88.4

use 5.008001;
use strict;
use warnings;

package CPAN::Common::Index::LocalPackage;
# ABSTRACT: Search index via custom local CPAN package flatfile

our $VERSION = '0.007';

use parent 'CPAN::Common::Index::Mirror';

use Class::Tiny qw/source/;

use Carp;
use IO::Uncompress::Gunzip ();
use File::Basename ();
use File::Copy ();
use File::Spec;
use File::stat ();

#pod =attr source (REQUIRED)
#pod
#pod Path to a local file in the form of 02packages.details.txt.  It may
#pod be compressed with a ".gz" suffix or it may be uncompressed.
#pod
#pod =attr cache
#pod
#pod Path to a local directory to store a (possibly uncompressed) copy
#pod of the source index.  Defaults to a temporary directory if not
#pod specified.
#pod
#pod =cut

sub BUILD {
    my $self = shift;

    my $file = $self->source;
    if ( !defined $file ) {
        Carp::croak("'source' parameter must be provided");
    }
    elsif ( !-f $file ) {
        Carp::croak("index file '$file' does not exist");
    }

    return;
}

sub cached_package {
    my ($self) = @_;
    my $package = File::Spec->catfile(
        $self->cache, File::Basename::basename($self->source)
    );
    $package =~ s/\.gz$//;
    $self->refresh_index unless -r $package;
    return $package;
}

sub refresh_index {
    my ($self) = @_;
    my $source = $self->source;
    my $basename = File::Basename::basename($source);
    if ( $source =~ /\.gz$/ ) {
        ( 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 ) {
            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:

__END__