view Lib/Deployment/Batch.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 16ada169ca75
children
line wrap: on
line source

use strict;

package Deployment::Batch;

require URI::file;

my %Provider;
our $AUTOLOAD;

our %Dirs;
our %Context;

$Context{DieOnError} = 1; # dies by default if the action fails to run

our @history;

# make all inc absolute;
@INC = map { URI::file->new_abs($_)->dir } @INC;

sub AUTOLOAD {
    my $method = $AUTOLOAD;

    shift if $_[0] eq __PACKAGE__;

    my $class = "$method";
    
    if (not $Provider{$method}) {
        (my $file = "$class.pm") =~ s/::/\//g;
        require $file;
        $Provider{$method} = 1;
    }

    my $action = $class->new(@_);
    
    push @history,$action;
    if ($Context{Immediate}) {
        $action->_Run or ($Context{DieOnError} ? die $_->LastError : return 0);
    }

    return 1;
}

sub SetDir {
    shift if $_[0] eq __PACKAGE__;
    my ($name,$dir) = @_;

    $Dirs{$name} = URI::file->new_abs($dir);
}

sub Rollback {
    return 1 if not @history;

    $_->_Rollback or $_->Log('Rollback: ',$_->LastError) foreach reverse grep { $_->isProcessed } @history;
    undef @history;
    return 1;
}

sub Commit {
    return 1 if not @history;

    # during commit we are in the immediate mode
    local $Context{Immediate} = 1;

    $_->_Run or $_->Log('Run: ',$_->LastError) and Rollback() and last foreach grep { not $_->isProcessed } @history;
    return 0 if not @history;
    undef @history;
    return 1;
}

sub DoPackage {
    shift if $_[0] eq __PACKAGE__;
    my ($package,$inline) = @_;

    Log( "The package is required" ) and return 0 if not $package;
    Log( "Processing $package" );
    my $t0 = [Time::HiRes::gettimeofday()];

    if ($inline and $inline eq 'inline') {
        $inline = 1;
    } else {
        $inline = 0;
    }
    
    if (not $inline) {
        my %copy = %Context;
        local %Context = %copy;
        local @history = ();
        $Context{Package} = $Context{PackageDir} ? URI::file->new($package)->abs($Context{PackageDir}) : URI::file->new_abs($package);
        $Context{PackageDir} = URI::file->new('./')->abs($Context{Package});

        undef $@;
        do $package or Log("$package: ". ($@ || $!)) and Rollback() and Log("Rollback completed in ",Time::HiRes::tv_interval($t0)," s") and return 0;

        Log("Commiting");
        Commit or Log("Commit failed in ",Time::HiRes::tv_interval($t0)) and return 0;
        Log("Commit successful in ",Time::HiRes::tv_interval($t0),' s');
        return 1;
    } else {
        local $Context{Package} = $Context{PackageDir} ? URI::file->new($package)->abs($Context{PackageDir}) : URI::file->new_abs($package);
        local $Context{PackageDir} = URI::file->new('./')->abs($Context{Package});

        do $package or Log("$package: ". ($@ || $!)) and Rollback() and Log("Rollback completed in ",Time::HiRes::tv_interval($t0),' s') and return 0;

        return 1;
    }
}

sub Dir {
    shift if $_[0] eq __PACKAGE__;
    my $uriDir = $Dirs{$_[0]} or die "No such directory entry $_[0]";
    shift;
    return $uriDir->dir.join('/',@_);
}

sub PackageDir {
    shift if $_[0] eq __PACKAGE__;
    return $Context{PackageDir}->dir.join('/',@_);
}

sub Log {
    shift if $_[0] eq __PACKAGE__;

    if (my $hout = $Context{LogOutput}) {
        print $hout 'DoPackage: ',@_,"\n";
    }
    1;
}

1;