view release on metacpan or  search on metacpan

lib/Lab/Moose/DataFolder.pm  view on Meta::CPAN

    my $basename = basename($folder);

    if ( $self->time_prefix ) {
        $basename = strftime( '%H-%M-%S', localtime() ) . "_$basename";
        $folder = our_catfile( $dirname, $basename );
    }

    if ( $self->date_prefix ) {
        $basename = strftime( '%Y-%m-%d', localtime() ) . "_$basename";
        $folder = our_catfile( $dirname, $basename );
    }

    my $folder_number = _get_folder_number(
        basename => $basename,
        dirname  => $dirname
    );

    $folder .= sprintf( '_%03d', $folder_number );

    mkdir $folder
        or croak "cannot make directory '$folder': $!";

    $self->_path($folder);

    $self->_create_meta_file();

    if ( $self->copy_script ) {
        $self->_copy_user_script();
    }

}

sub _copy_user_script {
    my $self   = shift;
    my $script = $0;

    my $basename;
    my $script_name = $self->script_name();

    if ($script_name) {
        $basename = $script_name;
    }
    else {
        $basename = basename($script);
    }

    my $copy = our_catfile( $self->path, $basename );

    copy( $script, $copy )
        or croak "copy of $script to $copy failed: $!";
}

sub _create_meta_file {
    my $self = shift;
    my $time = [ gettimeofday() ];

    my %meta_data = (
        argv => [@ARGV_COPY],

        # See http://stackoverflow.com/questions/3526420/how-do-i-get-the-current-user-in-perl-in-a-portable-way
        user => getlogin() || getpwuid($<),
        host => hostname(),
        date      => strftime( "%c", localtime() ),
        timestamp => join( '.',      @{$time} ),
        version   => _get_version(),
    );

    my $meta_file = Lab::Moose::DataFile::Meta->new(
        folder   => $self,
        filename => 'META.yml',
    );

    $self->_meta_file($meta_file);

    $meta_file->log( meta => \%meta_data );
}

sub _get_version {
    no strict 'vars';    ## no critic
    if ( defined $VERSION ) {
        return $VERSION;
    }
    else {
        return 'git';
    }
}

sub _get_folder_number {
    my ( $basename, $dirname ) = validated_list(
        \@_,
        basename => { isa => 'Str' },
        dirname  => { isa => 'Str' },
    );

    opendir my $dh, $dirname
        or croak "cannot open directory '$dirname'";

    my @entries = readdir $dh;

    @entries = map { decode( 'UTF-8', $_ ) } @entries;

    my $max = max map {
        my $entry = $_;
        if ( $entry =~ /^\Q${basename}\E_([0-9]+)$/ ) {
            my $num = $1;
        }
        else {
            my $num = 0;
        }
    } @entries;

    return $max + 1;
}

__PACKAGE__->meta->make_immutable();
1;

__END__

=pod