--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/Deployment/Batch.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,129 @@
+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;
\ No newline at end of file