Mercurial > pub > Impl
diff Lib/Deployment/Batch.pm @ 49:16ada169ca75
migrating to the Eclipse IDE
author | wizard@linux-odin.local |
---|---|
date | Fri, 26 Feb 2010 10:49:21 +0300 |
parents | 03e58a454b20 |
children |
line wrap: on
line diff
--- a/Lib/Deployment/Batch.pm Fri Feb 26 01:43:42 2010 +0300 +++ b/Lib/Deployment/Batch.pm Fri Feb 26 10:49:21 2010 +0300 @@ -1,129 +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 +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;