|
49
|
1 use strict;
|
|
|
2
|
|
|
3 package Deployment::Batch;
|
|
|
4
|
|
|
5 require URI::file;
|
|
|
6
|
|
|
7 my %Provider;
|
|
|
8 our $AUTOLOAD;
|
|
|
9
|
|
|
10 our %Dirs;
|
|
|
11 our %Context;
|
|
|
12
|
|
|
13 $Context{DieOnError} = 1; # dies by default if the action fails to run
|
|
|
14
|
|
|
15 our @history;
|
|
|
16
|
|
|
17 # make all inc absolute;
|
|
|
18 @INC = map { URI::file->new_abs($_)->dir } @INC;
|
|
|
19
|
|
|
20 sub AUTOLOAD {
|
|
|
21 my $method = $AUTOLOAD;
|
|
|
22
|
|
|
23 shift if $_[0] eq __PACKAGE__;
|
|
|
24
|
|
|
25 my $class = "$method";
|
|
|
26
|
|
|
27 if (not $Provider{$method}) {
|
|
|
28 (my $file = "$class.pm") =~ s/::/\//g;
|
|
|
29 require $file;
|
|
|
30 $Provider{$method} = 1;
|
|
|
31 }
|
|
|
32
|
|
|
33 my $action = $class->new(@_);
|
|
|
34
|
|
|
35 push @history,$action;
|
|
|
36 if ($Context{Immediate}) {
|
|
|
37 $action->_Run or ($Context{DieOnError} ? die $_->LastError : return 0);
|
|
|
38 }
|
|
|
39
|
|
|
40 return 1;
|
|
|
41 }
|
|
|
42
|
|
|
43 sub SetDir {
|
|
|
44 shift if $_[0] eq __PACKAGE__;
|
|
|
45 my ($name,$dir) = @_;
|
|
|
46
|
|
|
47 $Dirs{$name} = URI::file->new_abs($dir);
|
|
|
48 }
|
|
|
49
|
|
|
50 sub Rollback {
|
|
|
51 return 1 if not @history;
|
|
|
52
|
|
|
53 $_->_Rollback or $_->Log('Rollback: ',$_->LastError) foreach reverse grep { $_->isProcessed } @history;
|
|
|
54 undef @history;
|
|
|
55 return 1;
|
|
|
56 }
|
|
|
57
|
|
|
58 sub Commit {
|
|
|
59 return 1 if not @history;
|
|
|
60
|
|
|
61 # during commit we are in the immediate mode
|
|
|
62 local $Context{Immediate} = 1;
|
|
|
63
|
|
|
64 $_->_Run or $_->Log('Run: ',$_->LastError) and Rollback() and last foreach grep { not $_->isProcessed } @history;
|
|
|
65 return 0 if not @history;
|
|
|
66 undef @history;
|
|
|
67 return 1;
|
|
|
68 }
|
|
|
69
|
|
|
70 sub DoPackage {
|
|
|
71 shift if $_[0] eq __PACKAGE__;
|
|
|
72 my ($package,$inline) = @_;
|
|
|
73
|
|
|
74 Log( "The package is required" ) and return 0 if not $package;
|
|
|
75 Log( "Processing $package" );
|
|
|
76 my $t0 = [Time::HiRes::gettimeofday()];
|
|
|
77
|
|
|
78 if ($inline and $inline eq 'inline') {
|
|
|
79 $inline = 1;
|
|
|
80 } else {
|
|
|
81 $inline = 0;
|
|
|
82 }
|
|
|
83
|
|
|
84 if (not $inline) {
|
|
|
85 my %copy = %Context;
|
|
|
86 local %Context = %copy;
|
|
|
87 local @history = ();
|
|
|
88 $Context{Package} = $Context{PackageDir} ? URI::file->new($package)->abs($Context{PackageDir}) : URI::file->new_abs($package);
|
|
|
89 $Context{PackageDir} = URI::file->new('./')->abs($Context{Package});
|
|
|
90
|
|
|
91 undef $@;
|
|
|
92 do $package or Log("$package: ". ($@ || $!)) and Rollback() and Log("Rollback completed in ",Time::HiRes::tv_interval($t0)," s") and return 0;
|
|
|
93
|
|
|
94 Log("Commiting");
|
|
|
95 Commit or Log("Commit failed in ",Time::HiRes::tv_interval($t0)) and return 0;
|
|
|
96 Log("Commit successful in ",Time::HiRes::tv_interval($t0),' s');
|
|
|
97 return 1;
|
|
|
98 } else {
|
|
|
99 local $Context{Package} = $Context{PackageDir} ? URI::file->new($package)->abs($Context{PackageDir}) : URI::file->new_abs($package);
|
|
|
100 local $Context{PackageDir} = URI::file->new('./')->abs($Context{Package});
|
|
|
101
|
|
|
102 do $package or Log("$package: ". ($@ || $!)) and Rollback() and Log("Rollback completed in ",Time::HiRes::tv_interval($t0),' s') and return 0;
|
|
|
103
|
|
|
104 return 1;
|
|
|
105 }
|
|
|
106 }
|
|
|
107
|
|
|
108 sub Dir {
|
|
|
109 shift if $_[0] eq __PACKAGE__;
|
|
|
110 my $uriDir = $Dirs{$_[0]} or die "No such directory entry $_[0]";
|
|
|
111 shift;
|
|
|
112 return $uriDir->dir.join('/',@_);
|
|
|
113 }
|
|
|
114
|
|
|
115 sub PackageDir {
|
|
|
116 shift if $_[0] eq __PACKAGE__;
|
|
|
117 return $Context{PackageDir}->dir.join('/',@_);
|
|
|
118 }
|
|
|
119
|
|
|
120 sub Log {
|
|
|
121 shift if $_[0] eq __PACKAGE__;
|
|
|
122
|
|
|
123 if (my $hout = $Context{LogOutput}) {
|
|
|
124 print $hout 'DoPackage: ',@_,"\n";
|
|
|
125 }
|
|
|
126 1;
|
|
|
127 }
|
|
|
128
|
|
|
129 1;
|
