Shipwright::Source - Source


Shipwright documentation Contained in the Shipwright distribution.

Index


Code Index:

NAME

Top

Shipwright::Source - Source

SYNOPSIS

Top

    shipwright import -r ... cpan:XML::LibXML

    use Shipwright::Source;

SUPPORTED SOURCES

Top

Currently, the supported sources are CPAN (Shipwright::SOURCE::CPAN), Compressed (Shipwright::SOURCE::Compressed), Directory (Shipwright::SOURCE::Directory), FTP (Shipwright::SOURCE::FTP), Git (Shipwright::SOURCE::Git), HTTP (Shipwright::SOURCE::HTTP), SVK (Shipwright::SOURCE::SVK), SVN (Shipwright::SOURCE::SVN) and Shipwright (Shipwright::SOURCE::Shipwright).

METHODS

Top

new

type

AUTHORS

Top

sunnavy <sunnavy@bestpractical.com>

LICENCE AND COPYRIGHT

Top


Shipwright documentation Contained in the Shipwright distribution.
package Shipwright::Source;

use warnings;
use strict;
use UNIVERSAL::require;
use File::Temp qw/tempdir/;
use File::Spec::Functions qw/catfile catdir/;
use Shipwright::Util;
use File::Path qw/make_path/;

$ENV{SHIPWRIGHT_SOURCE_ROOT} ||=
  tempdir( 'shipwright_source_XXXXXX', CLEANUP => 1, TMPDIR => 1 );

sub new {
    my $class = shift;
    my %args = (
        follow => 1,
        directory => $ENV{SHIPWRIGHT_SOURCE_ROOT},
        @_,
    );

    $args{download_directory} ||=
      catdir( shipwright_user_root(), 'downloads' );

    $args{scripts_directory} ||= catdir( $args{directory}, '__scripts' );
    $args{map_path}      ||= catfile( $args{directory}, 'map.yml' );
    $args{url_path}      ||= catfile( $args{directory}, 'url.yml' );
    $args{version_path}  ||= catfile( $args{directory}, 'version.yml' );
    $args{branches_path} ||= catfile( $args{directory}, 'branches.yml' );

    for (qw/map_path url_path version_path branches_path/) {
        next if -e $args{$_};
        open my $fh, '>', $args{$_} or confess_or_die "can't write to $args{$_}: $!";
        close $fh;
    }

    confess_or_die "need source arg" unless exists $args{source};

    for my $dir (qw/directory download_directory scripts_directory/) {
        make_path( $args{$dir} ) unless -e $args{$dir};
    }

    my $type = type( \$args{source} );

    confess_or_die "invalid source: $args{source}" unless $type;

    my $module = 'Shipwright::Source::' . $type;
    $module->require;
    return $module->new(%args);
}

sub type {
    my $source = shift;
    return unless $$source;

    _translate_source($source);

    if ( $$source =~ /\.(?:tar\.(?:gz|bz2)|tgz|tbz|zip)$/ ) {
        if ( $$source =~ s/^file://i || -f $$source ) {
            return 'Compressed';
        }
    }

    return 'Directory' if $$source =~ s/^dir(?:ectory)?://i;

    return 'Shipyard' if $$source =~ s/^(?:shipyard|shipwright)://i;

    # prefix that can be omitted
    for my $type (qw/svn http ftp git/) {
        if ( $$source =~ /^$type:/i ) {
            $$source =~ s{^$type:(?!//)}{}i;
            return $type eq 'git' ? 'Git' : uc $type;
        }
    }

    if ( $$source =~ m{^(//|svk:)}i ) {
        $$source =~ s/^svk://i;
        return 'SVK';
    }

    return 'Directory' if -d $$source;

    # default is cpan module or distribution
    $$source =~ s!^cpan:!!i;

    return if $$source =~ /:/ && $$source !~ /::/;


    # if it's not a distribution name like
    # 'S/SU/SUNNAVY/IP-QQWry-v0.0.15.tar.gz', convert '-' to '::'.
    $$source =~ s/-/::/g
      unless $$source =~ /\.(?:tar\.(?:gz|bz2)|tgz|tbz)$/;

    return 'CPAN';

}

sub _translate_source {
    my $source = shift;
    if ( $$source =~ /^(file|dir(ectory)?|shipwright):~/i ) {

        # replace prefix ~ with real home dir
        $$source =~ s/~/user_home/e;
    }
}

1;

__END__