Pinto

 view release on metacpan or  search on metacpan

lib/Pinto/Config.pm  view on Meta::CPAN

#------------------------------------------------------------------------------

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

    # Some folks tend to put quotes around multi-value configuration
    # parameters, even though they shouldn't.  Be kind and remove them.
    my $sources = $self->sources;
    $sources =~ s/ ['"] //gx;

    return map { URI->new($_) } split m{ \s+ }mx, $sources;
}

#------------------------------------------------------------------------------

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

    return ( $self->root_dir, $self->config_dir, $self->cache_dir, $self->authors_dir, $self->log_dir, $self->db_dir );
}

lib/Pinto/DistributionSpec.pm  view on Meta::CPAN

);

#------------------------------------------------------------------------------

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;

    my @args = @_;
    if ( @args == 1 and not ref $args[0] ) {
        my @path_parts = split m{/+}x, $args[0];

        my $author  = shift @path_parts;    # First element
        my $archive = pop @path_parts;      # Last element
        my $subdirs = [@path_parts];        # Everything else

        throw "Invalid distribution spec: $args[0]"
            if not( $author and $archive );

        @args = ( author => $author, subdirs => $subdirs, archive => $archive );
    }

lib/Pinto/PackageSpec.pm  view on Meta::CPAN

);

#------------------------------------------------------------------------------

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;

    my @args = @_;
    if ( @args == 1 and not ref $args[0] ) {
        my ( $name, $version ) = split m{~}x, $_[0], 2;
        @args = ( name => $name, version => $version || 0 );
    }

    return $class->$orig(@args);
};

#------------------------------------------------------------------------------


sub is_core {

lib/Pinto/Remote/Action.pm  view on Meta::CPAN

    chomp $data;
    if ( not $data ) {

        # HACK: So that blank lines come out right
        # Need to find a better way to do this!!
        $self->chrome->show('');
        return 1;
    }

    for my $line ( split m/\n/, $data, -1 ) {

        if ( $line eq $PINTO_SERVER_STATUS_OK ) {
            ${$status} = 1;
        }
        elsif ( $line eq $PINTO_SERVER_PROGRESS_MESSAGE ) {
            $self->chrome->show_progress;
        }
        elsif ( $line eq $PINTO_SERVER_NULL_MESSAGE ) {

            # Do nothing, discard message

lib/Pinto/Util.pm  view on Meta::CPAN

sub parse_dist_path {
    my ($path) = @_;

    # eg: /yadda/authors/id/A/AU/AUTHOR/subdir1/subdir2/Foo-1.0.tar.gz
    # or: A/AU/AUTHOR/subdir/Foo-1.0.tar.gz

    if ( $path =~ s{^ (?:.*/authors/id/)? (.*) $}{$1}mx ) {

        # $path = 'A/AU/AUTHOR/subdir/Foo-1.0.tar.gz'
        my @path_parts = split m{ / }mx, $path;
        my $author     = $path_parts[2];          # AUTHOR
        my $archive    = $path_parts[-1];         # Foo-1.0.tar.gz
        return ( $author, $archive );
    }

    throw "Unable to parse path: $path";
}

#-------------------------------------------------------------------------------

lib/Pinto/Util.pm  view on Meta::CPAN

}

#-------------------------------------------------------------------------------


sub user_colors {
    my $colors = $ENV{PINTO_COLORS} || $ENV{PINTO_COLOURS};

    return $PINTO_DEFAULT_COLORS if not $colors;

    return [ split m/\s* , \s*/x, $colors ];
}

#-------------------------------------------------------------------------------


sub is_blank {
    my ($string) = @_;

    return 1 if not $string;
    return 0 if $string =~ m/ \S /x;

t/lib/Pinto/Tester/Util.pm  view on Meta::CPAN

#------------------------------------------------------------------------------

sub parse_reg_spec {
    my ($spec) = @_;

    # Remove all whitespace from spec
    $spec =~ s{\s+}{}g;

    # Spec looks like "AUTHOR/Foo-Bar-1.2/Foo::Bar-1.2/stack/+"
    my ( $author, $dist_archive, $pkg, $stack_name, $is_pinned ) = split m{/}x, $spec;

    # Spec must at least have these
    throw "Could not parse pkg spec: $spec"
        if not( $author and $dist_archive and $pkg );

    # Append the usual suffix to the archive
    $dist_archive .= '.tar.gz' unless $dist_archive =~ m{\.tar\.gz$}x;

    # Normalize the is_pinned flag
    $is_pinned = ( $is_pinned eq '*' ? 1 : 0 ) if defined $is_pinned;

    # Parse package name/version
    my ( $pkg_name, $pkg_version ) = split m{~}x, $pkg;

    # Set defaults
    $stack_name  ||= 'master';
    $pkg_version ||= 0;

    return ( $author, $dist_archive, $pkg_name, $pkg_version, $stack_name, $is_pinned );
}

#------------------------------------------------------------------------------