view Lib/Deployment/Batch.pm @ 134:44977efed303

Significant performance optimizations Fixed recursion problems due converting objects to JSON Added cache support for the templates Added discovery feature for the web methods
author wizard
date Mon, 21 Jun 2010 02:39:53 +0400
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;