view release on metacpan or  search on metacpan

lib/MYDan/Util/Deploy.pm  view on Meta::CPAN

package MYDan::Util::Deploy;
use strict;
use warnings;
use Cwd;
use Digest::MD5;
use File::Basename;

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

    map{ die "$_ undef" unless $self{$_} }qw( link path repo version keep );

    map{ 
        die "$_ format error" unless $self{$_} =~ /[a-zA-Z0-9]/ && $self{$_} !~ /'/;
    }qw( link path repo version );

    die "keep format error" unless $self{keep} =~ /^\d+$/;

    die "$self{repo}: No such directory.\n" if $self{repo} !~ /@/ && ! -d $self{repo};

    unless( -d $self{path} )
    {
        die "mkdir path $self{path} fail: $!" if system "mkdir -p '$self{path}'";
    }

    my $linkdir = dirname $self{link};
    unless( -d $linkdir )
    {
        die "mkdir path $linkdir fail: $!" if system "mkdir -p '$linkdir'";
    }

    $self{cache} = (getpwnam((getpwuid $<)[0]))[7] . "/.mydan/deploy";

    $self{path} = Cwd::abs_path( $self{path} ) unless $self{path} =~ /^\//;
    $self{repo} = Cwd::abs_path( $self{repo} ) if $self{repo} !~ /@/ && $self{repo} !~ /^\//;

    bless \%self, ref $class || $class;
}

sub deploy
{
    my $this = shift;

    my ( $path, $link, $version ) = @$this{qw( path link version )};

	return $this->_recoverlink() if $this->{comeback};

    my $temp = "$link.backup";

    if( $version =~ /^backup\d*$/ )
    {
        $temp = "$link.$version";
        die "$temp: No such directory.\n" unless -d $temp;
        die "link $link fail.\n" if syscmd( "ln -fsn '$temp' '$link'" );
        return $this;
    }

    $this->_explain();

    if( -d $link && ! -e $temp )
    {
        die "backup old link fail.\n" if syscmd( "mv '$link' '$temp'" );
    }

    die "link $link may be a directory.\n" if -d $link && ! -l $link;

	$this->_savelink();

	return $this if $this->{stage};

    die "link $link fail.\n" if syscmd( "ln -fsn '$path/$version' '$link'" );

    $this->_clean();
    return $this;
}

sub _recoverlink
{
    my $this = shift;

    my ( $link, $version, $cache ) = @$this{qw( link version cache )};

    my $md5 = Digest::MD5->new->add( "$link:$version" )->hexdigest;

    die "recover link fail: No such link.\n" unless -l "$cache/$md5";
    my $newlink = readlink "$cache/$md5";
    die "recover link fail: No link to a directory.\n" unless -d $newlink;

    die "recover link fail: ln -fsn.\n" if syscmd("ln -fsn $newlink '$link'");

    return $this;
}