Mercurial > pub > Impl

comparison Lib/Deployment/Batch.pm @ 0:03e58a454b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
comparison
equal deleted inserted replaced
-1:000000000000 0:03e58a454b20
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;