File Coverage

blib/lib/Alien/CodePress.pm

Criterion	Covered	Total	%
statement	90	97	92.7
branch	3	6	50.0
condition	1	3	33.3
subroutine	23	23	100.0
pod	8	8	100.0
total	125	137	91.2

# $Id$
# $Source$
# $Author$
# $HeadURL$
# $Revision$
# $Date$
package Alien::CodePress;

use strict;
use warnings;
use 5.00600;

use Carp;
use File::Spec;
use File::Copy      qw(copy);
use File::Path      qw(mkpath);
use File::Basename  qw(dirname);
use Archive::Extract;
use vars qw($VERSION);

use Alien::CodePress::Archive;

$VERSION = 1.03;

my @PROPERTIES = qw(
    path
);


__PACKAGE__->make_accessors(@PROPERTIES);


sub new {
    my ($class, $options_ref) = @_;
    my $self = { };

    bless $self, $class;

    $self->init_properties();
    $self->set_properties($options_ref);

    return $self;
}

sub version {
    return Alien::CodePress::Archive->version;
}

sub files {
    my ($self) = @_;
    my $path   = $self->get_path;
    my $source = File::Spec->catfile(
        $path,
        Alien::CodePress::Archive->filename()
    );

    my $ae = Archive::Extract->new( archive => $source );
    my @file_list = $ae->files;

    return @file_list;
}

sub install {
    my ($self, $destdir) = @_;
    my $path             = $self->get_path;
    $destdir           ||= File::Spec->curdir();

    my $source = File::Spec->catfile(
        $path,
        Alien::CodePress::Archive->filename()
    );

    my $ae = Archive::Extract->new( archive => $source );
    $ae->extract( to => $destdir );

    return;
}

sub init_path {
    my $module_filename =  __PACKAGE__ . q{.pm};
       $module_filename =~ s{::}{/}xmsg;
    my $base =  $INC{$module_filename};
       $base =~ s{\.pm\z}{}xms;

    return $base;
}



my %properties;
sub make_accessors {
    my ($class, @properties) = @_;

    for my $property (@properties) {
        no strict 'refs'; ## no critic
        my $get_fqdn   = join q{::}, $class, "get_$property";
        my $set_fqdn   = join q{::}, $class, "set_$property";
        *{ $get_fqdn } = sub {
            my ($self) = @_;
            return $self->{$property};
        };
        *{ $set_fqdn } = sub {
            my ($self, $value) = @_;
            $self->{$property} = $value;
            return;
        };
        $properties{$class}{$property} = 1;
    }

    return;
}

sub init_properties {
    my ($self) = @_;

    for my $property (keys %{ $properties{ ref $self } }) {
        my $init_property = "init_$property";
        my $set_property  = "set_$property";
        if ($self->can($init_property)) {
            $self->$set_property( $self->$init_property );
        }
    }

    return;
}

sub set_properties {
    my ($self, $properties_ref) = @_;
    return if not ref $properties_ref eq 'HASH';

    while (my ($property, $value) = each %{ $properties_ref }) {
        my $set_value = "set_$property";
        $self->$set_value($value);
    }

    return;
}


BEGIN {
    my $this_module =  __PACKAGE__;
       $this_module =~ s{::}{/}xmsg;
       $this_module = quotemeta $this_module;
    if ( __FILE__ !~ m{$this_module\.pm \z}xms ) {
        require Carp;
        Carp::croak(sprintf
            'Wrong case in name for module %s. ' .
            'Sure you did not mean `use %s` instead?',
            __PACKAGE__, __PACKAGE__
        );
    }
}

1;

__END__