annotate Lib/Deployment/Batch.pm @ 47:a9b70d836b28

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