Mercurial > pub > Impl
view Lib/Deployment/Batch.pm @ 104:196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
Minor and major fixes almost for everything.
A 'Source' property of the ValidationErrors generated from a NodeSet or a NodeList is subject to change in the future.
author | wizard |
---|---|
date | Tue, 11 May 2010 02:42:59 +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;