Beam-Make

 view release on metacpan or  search on metacpan

lib/Beam/Make.pm  view on Meta::CPAN

use Scalar::Util qw( blessed );
use List::Util qw( max );
use Beam::Make::Cache;
use File::stat;
with 'Beam::Runnable';

has conf => ( is => 'ro', default => sub { YAML::LoadFile( 'Beamfile' ) } );
# Beam::Wire container objects
has _wire => ( is => 'ro', default => sub { {} } );

sub run( $self, @argv ) {
    my ( @targets, %vars );

    for my $arg ( @argv ) {
        if ( $arg =~ /^([^=]+)=([^=]+)$/ ) {
            $vars{ $1 } = $2;
        }
        else {
            push @targets, $arg;
        }
    }

lib/Beam/Make.pm  view on Meta::CPAN

            # We were directly asked to build this, so let the user
            # know about it
            say $result;
        }
        return $recipe->last_modified;
    };
    $build->( $_ ) for @targets;
}

# Resolve any references via Beam::Wire container lookups
sub _resolve_ref( $self, $conf ) {
    return $conf if !ref $conf || blessed $conf;
    if ( ref $conf eq 'HASH' ) {
        if ( grep { $_ !~ /^\$/ } keys %$conf ) {
            my %resolved;
            for my $key ( keys %$conf ) {
                $resolved{ $key } = $self->_resolve_ref( $conf->{ $key } );
            }
            return \%resolved;
        }
        else {

lib/Beam/Make/Cache.pm  view on Meta::CPAN

#pod     # Update modified time to now
#pod     $cache->set( $name, $hash );
#pod
#pod Set an entry in the cache. C<$name> is the recipe name. C<$hash> is an identifier
#pod for the content (usually a base64 SHA-1 hash from L<Digest::SHA>). C<$time> is a
#pod L<Time::Piece> object to save as the last modified time. If C<$time> is not provided,
#pod defaults to now.
#pod
#pod =cut

sub set( $self, $name, $hash, $time=Time::Piece->new ) {
    my $cache = $self->_fetch_cache;
    $cache->{ $name } = {
        hash => $hash,
        time => blessed $time eq 'Time::Piece' ? $time->epoch : $time,
    };
    $self->_write_cache( $cache );
}

#pod =method last_modified
#pod
#pod     my $time = $cache->last_modified( $name, $hash );
#pod
#pod Get the last modified timestamp (as a L<Time::Piece> object) for the
#pod given recipe C<$name>. If the C<$hash> does not match what was given to
#pod L</set>, or if the recipe has never been made, returns C<0>.
#pod
#pod =cut

sub last_modified( $self, $name, $hash ) {
    my $cache = $self->_fetch_cache;
    return Time::Piece->new( $cache->{ $name }{ time } )
        if $cache->{ $name }
        && $cache->{ $name }{ hash } eq $hash
        ;
    return 0;
}

sub _fetch_cache( $self ) {
    my $last_read = $self->_last_read;
    if ( -e $self->file && ( !$last_read || stat( $self->file )->mtime > $last_read ) ) {
        $self->_last_read( stat( $self->file )->mtime );
        $self->_cache( YAML::LoadFile( $self->file ) );
    }
    return $self->_cache;
}

sub _write_cache( $self, $cache ) {
    my $old_cache = $self->_fetch_cache;
    $cache = { %$old_cache, %$cache };
    YAML::DumpFile( $self->file, $cache );
    $self->_cache( $cache );
    $self->_last_read( stat( $self->file )->mtime );
    return;
}

1;

lib/Beam/Make/DBI.pm  view on Meta::CPAN

has dbh => ( is => 'ro', required => 1 );

#pod =attr query
#pod
#pod An array of SQL queries to execute.
#pod
#pod =cut

has query => ( is => 'ro', required => 1 );

sub make( $self, %vars ) {
    my $dbh = $self->dbh;
    for my $sql ( $self->query->@* ) {
        $dbh->do( $sql );
    }
    $self->cache->set( $self->name, $self->_cache_hash );
    return 0;
}

sub _cache_hash( $self ) {
    # If our write query changed, we should update
    my $content = sha1_base64( join "\0", $self->query->@* );
    return $content;
}

sub last_modified( $self ) {
    my $last_modified = $self->cache->last_modified( $self->name, $self->_cache_hash );
    return $last_modified;
}

1;

__END__

=pod

lib/Beam/Make/DBI/CSV.pm  view on Meta::CPAN

#pod         $class: Beam::Make::DBI::CSV
#pod         dbh: { $ref: 'container.yml:sqlite' }
#pod         csv: { $ref: 'container.yml:psv' }
#pod         file: accounts.psv
#pod         table: accounts
#pod
#pod =cut

has csv => ( is => 'ro', default => sub { Text::CSV->new } );

sub make( $self, %vars ) {
    my $dbh = $self->dbh;
    open my $fh, '<', $self->file;
    my $csv = $self->csv;
    my @fields = $csv->getline( $fh )->@*;
    my $sth = $dbh->prepare(
        sprintf 'INSERT INTO %s ( %s ) VALUES ( %s )',
        $dbh->quote_identifier( $self->table ),
        join( ', ', map { $dbh->quote_identifier( $_ ) } @fields ),
        join( ', ', ('?')x@fields ),
    );
    while ( my $row = $csv->getline( $fh ) ) {
        $sth->execute( @$row );
    }
    $self->cache->set( $self->name, $self->_cache_hash );
    return 0;
}

sub _cache_hash( $self ) {
    my $content = join ';',
        map { join ',', @$_ }
        $self->dbh->selectall_arrayref( 'SELECT * FROM ' . $self->table )->@*;
    return sha1_base64( $content );
}

sub last_modified( $self ) {
    return $self->cache->last_modified( $self->name, $self->_cache_hash );
}

1;

__END__

=pod

=head1 NAME

lib/Beam/Make/DBI/Schema.pm  view on Meta::CPAN

#pod
#pod A list of key/value pairs of columns. The key is the column name, the value
#pod is the SQL to use for the column definition.
#pod
#pod =back
#pod
#pod =cut

has schema => ( is => 'ro', required => 1 );

sub make( $self, %vars ) {
    my $dbh = $self->dbh;

    # Now, prepare the changes to be made
    my @changes;
    for my $table_schema ( $self->schema->@* ) {
        my $table = $table_schema->{table};
        my @columns = $table_schema->{columns}->@*;
        my $table_info = $dbh->table_info( '', '%', qq{$table} )->fetchrow_arrayref;
        if ( !$table_info ) {
            push @changes, sprintf 'CREATE TABLE %s ( %s )', $dbh->quote_identifier( $table ),

lib/Beam/Make/DBI/Schema.pm  view on Meta::CPAN


    # Now execute the changes
    for my $change ( @changes ) {
        $dbh->do( $change );
    }

    $self->cache->set( $self->name, $self->_cache_hash );
    return 0;
}

sub _cache_hash( $self ) {
    my $dbh = $self->dbh;
    my %tables;
    for my $table_info ( $dbh->table_info( '', '%', '%' )->fetchall_arrayref( {} )->@* ) {
        my $table_name = $table_info->{TABLE_NAME};
        for my $column_info ( $dbh->column_info( '', '%', $table_name, '%' )->fetchall_arrayref( {} )->@* ) {
            my $column_name = $column_info->{COLUMN_NAME};
            push $tables{ $table_name }->@*, $column_name;
        }
    }
    my $content = join ';',
        map { sprintf '%s=%s', $_, join ',', sort $tables{ $_ }->@* } sort keys %tables;
    return sha1_base64( $content );
}

sub last_modified( $self ) {
    return $self->cache->last_modified( $self->name, $self->_cache_hash );
}

1;

__END__

=pod

=head1 NAME

lib/Beam/Make/Docker/Container.pm  view on Meta::CPAN

#pod The path to the Docker executable to use. Defaults to looking up
#pod C<docker> in C<PATH>.
#pod
#pod =cut

has docker => (
    is => 'ro',
    default => sub { which 'docker' },
);

sub make( $self, %vars ) {
    # Always clean if we're making: Docker can only have one container
    # with a given name.
    $self->clean;

    my @cmd = (
        $self->docker, qw( container create ),
        '--name' => $self->name,
        ( $self->restart ? ( '--restart' => $self->restart ) : () ),
        ( $self->environment ? map {; "-e", $_ } $self->environment->@* : () ),
        ( $self->ports ? map {; "-p", $_ } $self->ports->@* : () ),

lib/Beam/Make/Docker/Container.pm  view on Meta::CPAN

    # Update the cache
    my $info = $self->_container_info;
    my $created = $info->{Created} =~ s/^(\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}).*$/$1/r;
    my $iso8601 = '%Y-%m-%dT%H:%M:%S';
    $self->cache->set( $self->name, $self->_cache_hash, Time::Piece->strptime( $created, $iso8601 ) );

    $self->start;
    return 0;
}

sub clean( $self ) {
    my $info = $self->_container_info;
    if ( keys %$info ) {
        if ( $info->{State}{Running} ) {
            system qw( docker stop ), $self->name;
        }
        system qw( docker rm ), $self->name;
    }
}

sub start( $self ) {
    system qw( docker start ), $self->name;
}

sub _container_info( $self ) {
    state $json = JSON::PP->new->canonical->utf8;
    my $output = $self->{_inspect_output};
    if ( !$output ) {
        my $cmd = join ' ', $self->docker, qw( container inspect ), $self->name;
        $LOG->debug( 'Running docker command:', $cmd );
        $output = `$cmd`;
        $self->{_inspect_output} = $output;
    }
    my ( $container ) = $json->decode( $output )->@*;
    return $container || {};
}

sub _config_hash( $self ) {
    my @keys = grep !/^_|^name$|^cache$/, keys %$self;
    my $json = JSON::PP->new->canonical->utf8;
    my $hash = sha1_base64( $json->encode( { $self->%{ @keys } } ) );
    return $hash;
}

sub _cache_hash( $self ) {
    my $container = $self->_container_info;
    return '' unless keys %$container;
    return sha1_base64( $container->{Id} . $self->_config_hash );
}

sub last_modified( $self ) {
    return $self->cache->last_modified( $self->name, $self->_cache_hash );
}

1;

__END__

=pod

=head1 NAME

lib/Beam/Make/Docker/Image.pm  view on Meta::CPAN

#pod The path to the Docker executable to use. Defaults to looking up
#pod C<docker> in C<PATH>.
#pod
#pod =cut

has docker => (
    is => 'ro',
    default => sub { which 'docker' },
);

sub make( $self, %vars ) {
    my @cmd = ( $self->docker );
    if ( my $context = $self->build ) {
        push @cmd, 'build', '-t', $self->image;
        if ( my @tags = $self->tags->@* ) {
            push @cmd, map {; '-t', $_ } @tags;
        }
        if ( my %args = $self->args->%* ) {
            push @cmd, map {; '--build-arg', join '=', $_, $args{$_} } keys %args;
        }
        if ( my $file = $self->dockerfile ) {

lib/Beam/Make/Docker/Image.pm  view on Meta::CPAN


    # Update the cache
    my $info = $self->_image_info;
    my $created = $info->{Created} =~ s/^(\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}).*$/$1/r;
    my $iso8601 = '%Y-%m-%dT%H:%M:%S';
    $self->cache->set( $self->name, $self->_cache_hash, Time::Piece->strptime( $created, $iso8601 ) );

    return 0;
}

sub _image_info( $self ) {
    state $json = JSON::PP->new->canonical->utf8;
    my $output = $self->{_inspect_output};
    if ( !$output ) {
        my $cmd = join ' ', $self->docker, qw( image inspect ), $self->image;
        $LOG->debug( 'Running docker command:', $cmd );
        $output = `$cmd`;
        $self->{_inspect_output} = $output;
    }
    my ( $image ) = $json->decode( $output )->@*;
    return $image || {};
}

sub _config_hash( $self ) {
    my @keys = grep !/^_|^name$|^cache$/, keys %$self;
    my $json = JSON::PP->new->canonical->utf8;
    my $hash = sha1_base64( $json->encode( { $self->%{ @keys } } ) );
    return $hash;
}

sub _cache_hash( $self ) {
    my $image = $self->_image_info;
    return '' unless keys %$image;
    return sha1_base64( $image->{Id} . $self->_config_hash );
}

sub last_modified( $self ) {
    return $self->cache->last_modified( $self->name, $self->_cache_hash );
}

1;

__END__

=pod

=head1 NAME

lib/Beam/Make/Docker/Image/Hub.pm  view on Meta::CPAN

use autodie qw( :all );
use Moo;
use Log::Any qw( $LOG );
use JSON::PP qw( decode_json );
use HTTP::Tiny;
use Digest::SHA qw( sha1_base64 );
use experimental qw( signatures postderef );

extends 'Beam::Make::Docker::Image';

sub _cache_hash( $self ) {
    # Check the Docker Hub API to get the image's ID
    my ( $repo, $tag ) = split /:/, $self->image;
    $tag //= 'latest';
    my $token_uri = "https://auth.docker.io/token";
    my $token_data = {
        service => 'registry.docker.io',
        scope => sprintf( 'repository:%s:pull', $repo ),
    };
    my $http = HTTP::Tiny->new;
    $token_uri .= '?' . $http->www_form_urlencode( $token_data );

lib/Beam/Make/File.pm  view on Meta::CPAN

#pod     # A single, multi-line shell script
#pod     - |
#pod         if [ $( date ) -gt $DATE ]; then
#pod             echo Another day $( date ) >> /var/log/calendar.log
#pod         fi
#pod
#pod =cut

has commands => ( is => 'ro', required => 1 );

sub make( $self, %vars ) {
    for my $cmd ( $self->commands->@* ) {
        my @cmd = ref $cmd eq 'ARRAY' ? @$cmd : ( $cmd );
        system @cmd;
        if ( $? != 0 ) {
            die sprintf 'Error running external command "%s": %s', "@cmd", $?;
        }
    }
    # XXX: If the recipe does not create the file, throw an error
    $self->cache->set( $self->name, $self->_cache_hash );
    return 0;
}

sub _cache_hash( $self ) {
    return -e $self->name ? Digest::SHA->new( 1 )->addfile( $self->name )->b64digest : '';
}

sub last_modified( $self ) {
    return -e $self->name ? $self->cache->last_modified( $self->name, $self->_cache_hash ) : 0;
}

1;

__END__

=pod

=head1 NAME

lib/Beam/Make/Recipe.pm  view on Meta::CPAN


has cache => ( is => 'ro', required => 1 );

#pod =method fill_env
#pod
#pod Fill in any environment variables in the given array of strings. Environment variables
#pod are interpreted as a POSIX shell: C<< $name >> or C<< ${name} >>.
#pod
#pod =cut

sub fill_env( $self, @ary ) {
    return map {
        defined $_ ?
            s{\$\{([^\}]+\})}{ $ENV{ $1 } // ( "\$$1" ) }egr
            =~ s{\$([a-zA-Z_][a-zA-Z0-9_]+)}{ $ENV{ $1 } // ( "\$$1" ) }egr
        : $_
     } @ary;
}

1;



( run in 0.975 second using v1.01-cache-2.11-cpan-65fba6d93b7 )