| File: | lib/App/Dest.pm |
| Coverage: | 80.9% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package App::Dest; | ||||||
| 2 | # ABSTRACT: Deployment State Manager | ||||||
| 3 | |||||||
| 4 | 5 5 5 | 3942 23 143 | use strict; | ||||
| 5 | 5 5 5 | 31 16 154 | use warnings; | ||||
| 6 | 5 5 | 703 43 | use 5.016; | ||||
| 7 | |||||||
| 8 | 5 5 5 | 35 17 409 | use File::Basename qw( dirname basename ); | ||||
| 9 | 5 5 5 | 2864 135000 1042 | use File::Copy::Recursive 'dircopy'; | ||||
| 10 | 5 5 5 | 2757 66433 253 | use File::DirCompare (); | ||||
| 11 | 5 5 5 | 76 41 394 | use File::Find 'find'; | ||||
| 12 | 5 5 5 | 92 38 320 | use File::Path qw( mkpath rmtree ); | ||||
| 13 | 5 5 5 | 12869 895574 474 | use IPC::Run 'run'; | ||||
| 14 | 5 5 5 | 8165 27 169 | use Text::Diff (); | ||||
| 15 | 5 5 5 | 2113 40266 79647 | use Try::Tiny qw( try catch ); | ||||
| 16 | |||||||
| 17 | # VERSION | ||||||
| 18 | |||||||
| 19 | my %seen_files; | ||||||
| 20 | |||||||
| 21 | sub init { | ||||||
| 22 | 7 | 1 | 42 | my ($self) = @_; | |||
| 23 | |||||||
| 24 | 7 | 191 | die "Project already initialized\n" if ( -d '.dest' ); | ||||
| 25 | 6 | 499 | mkdir('.dest') or die "Unable to create .dest directory\n"; | ||||
| 26 | 6 | 297 | open( my $watch, '>', '.dest/watch' ) or die "Unable to create .dest/watch file\n"; | ||||
| 27 | |||||||
| 28 | 6 | 70 | if ( -f 'dest.watch' ) { | ||||
| 29 | 1 | 19 | open( my $watches, '<', 'dest.watch' ) or die "Unable to read dest.watch file\n"; | ||||
| 30 | |||||||
| 31 | 1 3 3 | 19 11 18 | my @watches = map { chomp; $_ } <$watches>; | ||||
| 32 | |||||||
| 33 | 1 | 52 | my @errors; | ||||
| 34 | 1 | 7 | for my $watch (@watches) { | ||||
| 35 | try { | ||||||
| 36 | 3 | 253 | $self->add($watch); | ||||
| 37 | } | ||||||
| 38 | catch { | ||||||
| 39 | 0 | 0 | push( @errors, $watch . ': ' . $_ ); | ||||
| 40 | 3 | 65 | }; | ||||
| 41 | } | ||||||
| 42 | |||||||
| 43 | warn | ||||||
| 44 | "Created new watch list based on dest.watch file:\n" . | ||||||
| 45 | 3 | 29 | join( "\n", map { ' ' . $_ } @watches ) . "\n" . | ||||
| 46 | ( | ||||||
| 47 | (@errors) | ||||||
| 48 | 1 0 | 15 0 | ? "With the following errors:\n" . join( "\n", map { ' ' . $_ } @errors ) | ||||
| 49 | : '' | ||||||
| 50 | ); | ||||||
| 51 | } | ||||||
| 52 | 6 | 83 | return 0; | ||||
| 53 | } | ||||||
| 54 | |||||||
| 55 | sub add { | ||||||
| 56 | 14 | 1 | 69 | my ( $self, $dir ) = @_; | |||
| 57 | 14 | 75 | $dir //= ''; | ||||
| 58 | 14 | 78 | $dir =~ s|/$||; | ||||
| 59 | |||||||
| 60 | 14 | 104 | die "Not in project root directory or project not initialized\n" unless ( -d '.dest' ); | ||||
| 61 | 14 | 66 | die "No directory specified; usage: dest add [directory]\n" unless ($dir); | ||||
| 62 | 13 | 190 | die "Directory specified does not exist\n" unless ( -d $dir ); | ||||
| 63 | 12 9 | 95 77 | die "Directory $dir already added\n" if ( grep { $dir eq $_ } $self->_watches ); | ||||
| 64 | |||||||
| 65 | 11 | 187 | open( my $watch, '>>', '.dest/watch' ) or die "Unable to write .dest/watch file\n"; | ||||
| 66 | 11 | 67 | print $watch $dir, "\n"; | ||||
| 67 | |||||||
| 68 | 11 | 1417 | mkpath(".dest/$dir"); | ||||
| 69 | 11 | 250 | return 0; | ||||
| 70 | } | ||||||
| 71 | |||||||
| 72 | sub rm { | ||||||
| 73 | 4 | 1 | 16 | my ( $self, $dir ) = @_; | |||
| 74 | 4 | 179 | $dir //= ''; | ||||
| 75 | 4 | 18 | $dir =~ s|/$||; | ||||
| 76 | |||||||
| 77 | 4 | 40 | die "Not in project root directory or project not initialized\n" unless ( -d '.dest' ); | ||||
| 78 | 4 | 25 | die "No directory specified; usage: dest rm [directory]\n" unless ($dir); | ||||
| 79 | 3 5 | 17 38 | die "Directory $dir not currently tracked\n" unless ( grep { $dir eq $_ } $self->_watches ); | ||||
| 80 | |||||||
| 81 | 2 | 13 | my @watches = $self->_watches; | ||||
| 82 | 2 | 130 | open( my $watch, '>', '.dest/watch' ) or die "Unable to write .dest/watch file\n"; | ||||
| 83 | 2 4 | 10 27 | print $watch $_, "\n" for ( grep { $_ ne $dir } @watches ); | ||||
| 84 | |||||||
| 85 | 2 | 794 | rmtree(".dest/$dir"); | ||||
| 86 | 2 | 510 | return 0; | ||||
| 87 | } | ||||||
| 88 | |||||||
| 89 | sub make { | ||||||
| 90 | 3 | 1 | 14 | my ( $self, $path, $ext ) = @_; | |||
| 91 | 3 | 26 | die "No name specified; usage: dest make [path]\n" unless ($path); | ||||
| 92 | |||||||
| 93 | 2 | 12 | $ext = '.' . $ext if ( defined $ext ); | ||||
| 94 | 2 | 22 | $ext //= ''; | ||||
| 95 | |||||||
| 96 | 2 | 8 | eval { | ||||
| 97 | 2 | 464 | mkpath($path); | ||||
| 98 | 2 | 11 | for ( qw( deploy verify revert ) ) { | ||||
| 99 | 6 | 257 | open( my $file, '>', "$path/$_$ext" ) or die; | ||||
| 100 | 6 | 570 | print $file "\n"; | ||||
| 101 | } | ||||||
| 102 | }; | ||||||
| 103 | 2 | 14 | die "Failed to fully make $path; check permissions or existing files\n" if ($@); | ||||
| 104 | |||||||
| 105 | 2 | 19 | $self->list($path); | ||||
| 106 | 2 | 13 | return 0; | ||||
| 107 | } | ||||||
| 108 | |||||||
| 109 | sub list { | ||||||
| 110 | 5 | 1 | 25 | my ( $self, $path ) = @_; | |||
| 111 | |||||||
| 112 | 5 | 28 | if ($path) { | ||||
| 113 | 3 9 | 13 565 | print join( ' ', map { <"$path/$_*"> } qw( deploy verify revert ) ), "\n"; | ||||
| 114 | } | ||||||
| 115 | else { | ||||||
| 116 | 2 | 10 | for my $path ( $self->_watches ) { | ||||
| 117 | 3 | 17 | print $path, "\n"; | ||||
| 118 | |||||||
| 119 | find( { | ||||||
| 120 | follow => 1, | ||||||
| 121 | no_chdir => 1, | ||||||
| 122 | wanted => sub { | ||||||
| 123 | 11 | 706 | return unless ( m|/deploy(?:\.[^\/]+)?| ); | ||||
| 124 | 2 | 15 | ( my $action = $_ ) =~ s|/deploy(?:\.[^\/]+)?||; | ||||
| 125 | 2 | 34 | print ' ', $action, "\n"; | ||||
| 126 | }, | ||||||
| 127 | 3 | 783 | }, $path ); | ||||
| 128 | } | ||||||
| 129 | } | ||||||
| 130 | |||||||
| 131 | 5 | 33 | return 0; | ||||
| 132 | } | ||||||
| 133 | |||||||
| 134 | sub status { | ||||||
| 135 | 13 | 1 | 128 | my ($self) = @_; | |||
| 136 | |||||||
| 137 | 13 | 177 | die "Not in project root directory or project not initialized\n" unless ( -d '.dest' ); | ||||
| 138 | |||||||
| 139 | 13 | 173 | if ( -f 'dest.watch' ) { | ||||
| 140 | 5 | 44 | my $diff = Text::Diff::diff( '.dest/watch', 'dest.watch' ); | ||||
| 141 | 5 | 2016 | warn "Diff between current watch list and dest.watch file:\n" . $diff if ($diff); | ||||
| 142 | } | ||||||
| 143 | |||||||
| 144 | 13 | 52 | my %seen_actions; | ||||
| 145 | 13 | 149 | for ( $self->_watches ) { | ||||
| 146 | 20 | 95 | my ( $this_path, $printed_path ) = ( $_, 0 ); | ||||
| 147 | |||||||
| 148 | 20 | 76 | eval { File::DirCompare->compare( ".dest/$_", $_, sub { | ||||
| 149 | 32 | 52514 | my ( $a, $b ) = @_; | ||||
| 150 | 32 | 1206 | return if ( $a and $a =~ /\/dest.wrap$/ or $b and $b =~ /\/dest.wrap$/ ); | ||||
| 151 | 32 | 203 | print 'diff - ', $this_path, "\n" unless ( $printed_path++ ); | ||||
| 152 | |||||||
| 153 | 32 | 149 | if ( not $b ) { | ||||
| 154 | 0 | 0 | print ' - ', substr( $a, 7 ), "\n"; | ||||
| 155 | } | ||||||
| 156 | elsif ( not $a ) { | ||||||
| 157 | 30 | 151 | print " + $b\n"; | ||||
| 158 | } | ||||||
| 159 | else { | ||||||
| 160 | 2 | 20 | ( my $action = $b ) =~ s,/(?:deploy|verify|revert)$,,; | ||||
| 161 | 2 | 62 | print " $action\n" unless ( $seen_actions{$action}++ ); | ||||
| 162 | 2 | 13 | print " M $b\n"; | ||||
| 163 | } | ||||||
| 164 | |||||||
| 165 | 32 | 165 | return; | ||||
| 166 | 20 | 2189 | } ) }; | ||||
| 167 | |||||||
| 168 | 20 | 7743 | if ( $@ and $@ =~ /Not a directory/ ) { | ||||
| 169 | 0 | 0 | print '? - ', $this_path, "\n"; | ||||
| 170 | } | ||||||
| 171 | else { | ||||||
| 172 | 20 | 162 | print 'ok - ', $this_path, "\n" unless ($printed_path); | ||||
| 173 | } | ||||||
| 174 | } | ||||||
| 175 | |||||||
| 176 | 13 | 97 | return 0; | ||||
| 177 | } | ||||||
| 178 | |||||||
| 179 | sub diff { | ||||||
| 180 | 5 | 1 | 22 | my ( $self, $path ) = @_; | |||
| 181 | |||||||
| 182 | 5 | 26 | if ( not defined $path ) { | ||||
| 183 | 2 | 10 | $self->diff($_) for ( $self->_watches ); | ||||
| 184 | 2 | 13 | return 0; | ||||
| 185 | } | ||||||
| 186 | |||||||
| 187 | 3 | 11 | eval { File::DirCompare->compare( ".dest/$path", $path, sub { | ||||
| 188 | 2 | 1995 | my ( $a, $b ) = @_; | ||||
| 189 | 2 | 12 | $a ||= ''; | ||||
| 190 | 2 | 11 | $b ||= ''; | ||||
| 191 | |||||||
| 192 | 2 | 23 | return if ( $a =~ /\/dest.wrap$/ or $b =~ /\/dest.wrap$/ ); | ||||
| 193 | 2 | 14 | print Text::Diff::diff( $a, $b ); | ||||
| 194 | 2 | 699 | return; | ||||
| 195 | 3 | 47 | } ) }; | ||||
| 196 | |||||||
| 197 | 3 | 1028 | return 0; | ||||
| 198 | } | ||||||
| 199 | |||||||
| 200 | sub update { | ||||||
| 201 | 2 | 1 | 8 | my $self = shift; | |||
| 202 | |||||||
| 203 | 2 | 45 | die "Not in project root directory or project not initialized\n" unless ( -d '.dest' ); | ||||
| 204 | |||||||
| 205 | 2 | 36 | if ( -f 'dest.watch' ) { | ||||
| 206 | 1 | 6 | my @watches = $self->_watches; | ||||
| 207 | 1 | 15 | open( my $watch, '<', 'dest.watch' ) or die "Unable to read dest.watch file\n"; | ||||
| 208 | |||||||
| 209 | 1 3 3 | 31 9 11 | for my $candidate ( map { chomp; $_ } <$watch> ) { | ||||
| 210 | 3 6 | 10 27 | unless ( grep { $_ eq $candidate } @watches ) { | ||||
| 211 | 1 | 43 | $self->add($candidate); | ||||
| 212 | 1 | 13 | warn "Added $candidate to the watch list\n"; | ||||
| 213 | } | ||||||
| 214 | } | ||||||
| 215 | } | ||||||
| 216 | |||||||
| 217 | 2 | 9 | my @paths = @_; | ||||
| 218 | 2 | 18 | my @watches = $self->_watches; | ||||
| 219 | |||||||
| 220 | 2 | 11 | if (@paths) { | ||||
| 221 | @watches = grep { | ||||||
| 222 | 0 0 | 0 0 | my $watch = $_; | ||||
| 223 | 0 0 | 0 0 | grep { $_ eq $watch } @paths; | ||||
| 224 | } @watches; | ||||||
| 225 | } | ||||||
| 226 | |||||||
| 227 | File::DirCompare->compare( ".dest/$_", $_, sub { | ||||||
| 228 | 4 | 4393 | my ( $a, $b ) = @_; | ||||
| 229 | 4 | 337 | return if ( $a and $a =~ /\/dest.wrap$/ or $b and $b =~ /\/dest.wrap$/ ); | ||||
| 230 | |||||||
| 231 | 4 | 24 | if ( not $b ) { | ||||
| 232 | 0 | 0 | $a =~ s|\.dest/||; | ||||
| 233 | 0 | 0 | $self->revert($a); | ||||
| 234 | } | ||||||
| 235 | elsif ( not $a ) { | ||||||
| 236 | 4 | 1016 | $self->deploy($b); | ||||
| 237 | } | ||||||
| 238 | else { | ||||||
| 239 | |||||||
| 240 | 0 | 0 | $a =~ s|\.dest/||; | ||||
| 241 | 0 | 0 | $a =~ s|/(\w+)$||; | ||||
| 242 | 0 | 0 | $b =~ s|/(\w+)$||; | ||||
| 243 | |||||||
| 244 | 0 | 0 | my $type = $1; | ||||
| 245 | |||||||
| 246 | 0 | 0 | if ( $type eq 'deploy' ) { | ||||
| 247 | 0 | 0 | $self->revert($a); | ||||
| 248 | 0 | 0 | $self->deploy($b); | ||||
| 249 | } | ||||||
| 250 | else { | ||||||
| 251 | 0 | 0 | $self->dircopy( $a, ".dest/$a" ); | ||||
| 252 | } | ||||||
| 253 | } | ||||||
| 254 | 2 | 105 | } ) for (@watches); | ||||
| 255 | |||||||
| 256 | 2 | 3392 | return 0; | ||||
| 257 | } | ||||||
| 258 | |||||||
| 259 | sub verify { | ||||||
| 260 | 4 | 1 | 97 | my ( $self, $path ) = @_; | |||
| 261 | 4 | 76 | die "Not in project root directory or project not initialized\n" unless ( -d '.dest' ); | ||||
| 262 | 4 | 146 | return $self->_action( $path, 'verify' ); | ||||
| 263 | } | ||||||
| 264 | |||||||
| 265 | sub deploy { | ||||||
| 266 | 11 | 1 | 129 | my ( $self, $name, $redeploy ) = @_; | |||
| 267 | 11 | 142 | die "File to deploy required; usage: dest deploy file\n" unless ($name); | ||||
| 268 | 10 | 142 | die "Not in project root directory or project not initialized\n" unless ( -d '.dest' ); | ||||
| 269 | 10 | 624 | my $rv = $self->_action( $name, 'deploy', $redeploy ); | ||||
| 270 | 10 36 | 450 3717 | dircopy( $_, ".dest/$_" ) for ( grep { s|/deploy[^/]*$|| } keys %seen_files ); | ||||
| 271 | 10 | 80393 | return $rv; | ||||
| 272 | } | ||||||
| 273 | |||||||
| 274 | sub revert { | ||||||
| 275 | 6 | 1 | 30 | my ( $self, $name ) = @_; | |||
| 276 | 6 | 44 | die "File to revert required; usage: dest revert file\n" unless ($name); | ||||
| 277 | 5 | 122 | die "Not in project root directory or project not initialized\n" unless ( -d '.dest' ); | ||||
| 278 | 5 | 128 | my $rv = $self->_action( ".dest/$name", 'revert' ); | ||||
| 279 | 5 9 9 9 | 350 227 40624 1141 | rmtree(".dest/$_") for ( map { s|^.dest/||; $_ } grep { s|/revert[^/]*$|| } keys %seen_files ); | ||||
| 280 | 5 | 556 | return $rv; | ||||
| 281 | } | ||||||
| 282 | |||||||
| 283 | sub redeploy { | ||||||
| 284 | 1 | 1 | 4 | my ( $self, $name ) = @_; | |||
| 285 | 1 | 6 | return $self->deploy( $name, 'redeploy' ); | ||||
| 286 | } | ||||||
| 287 | |||||||
| 288 | sub revdeploy { | ||||||
| 289 | 1 | 1 | 5 | my ( $self, $name ) = @_; | |||
| 290 | 1 | 6 | $self->revert($name); | ||||
| 291 | 1 | 202 | return $self->deploy($name); | ||||
| 292 | } | ||||||
| 293 | |||||||
| 294 | sub clean { | ||||||
| 295 | 3 | 1 | 21 | my ($self) = @_; | |||
| 296 | 3 | 43 | die "Not in project root directory or project not initialized\n" unless ( -d '.dest' ); | ||||
| 297 | 3 | 22 | for ( $self->_watches ) { | ||||
| 298 | 3 | 695 | rmtree(".dest/$_"); | ||||
| 299 | 3 | 111 | dircopy( $_, ".dest/$_" ); | ||||
| 300 | } | ||||||
| 301 | 3 | 3739 | return 0; | ||||
| 302 | } | ||||||
| 303 | |||||||
| 304 | sub preinstall { | ||||||
| 305 | 1 | 1 | 5 | my ($self) = @_; | |||
| 306 | 1 | 15 | die "Not in project root directory or project not initialized\n" unless ( -d '.dest' ); | ||||
| 307 | 1 | 6 | for ( $self->_watches ) { | ||||
| 308 | 1 | 425 | rmtree(".dest/$_"); | ||||
| 309 | 1 | 136 | mkdir(".dest/$_"); | ||||
| 310 | } | ||||||
| 311 | 1 | 11 | return 0; | ||||
| 312 | } | ||||||
| 313 | |||||||
| 314 | sub watches { | ||||||
| 315 | 1 | 1 | 4 | my ($self) = @_; | |||
| 316 | 1 | 5 | print join( "\n", $self->_watches ), "\n"; | ||||
| 317 | 1 | 6 | return 0; | ||||
| 318 | } | ||||||
| 319 | |||||||
| 320 | sub _watches { | ||||||
| 321 | 46 | 1073 | open( my $watch, '<', '.dest/watch' ) or die "Unable to read .dest/watch file\n"; | ||||
| 322 | 46 19 59 59 | 2238 342 247 2711 | return sort { $a cmp $b } map { chomp; $_ } <$watch>; | ||||
| 323 | } | ||||||
| 324 | |||||||
| 325 | sub _action { | ||||||
| 326 | 19 | 762 | my ( $self, $path, $type, $redeploy ) = @_; | ||||
| 327 | 19 | 591 | %seen_files = (); | ||||
| 328 | |||||||
| 329 | 19 | 173 | if ($path) { | ||||
| 330 | 17 | 4848 | my @files = <"$path/$type*">; | ||||
| 331 | 17 | 102 | my $file = $files[0]; | ||||
| 332 | |||||||
| 333 | 17 | 84 | unless ($file) { | ||||
| 334 | 0 | 0 | my $this_file = ( split( '/', $path ) )[-1]; | ||||
| 335 | 0 | 0 | die "Unable to $type $this_file (perhaps action has already occured)\n"; | ||||
| 336 | } | ||||||
| 337 | 17 | 357 | $self->_execute( $file, $redeploy ) or die "Failed to $type $path\n"; | ||||
| 338 | } | ||||||
| 339 | else { | ||||||
| 340 | find( { | ||||||
| 341 | follow => 1, | ||||||
| 342 | no_chdir => 1, | ||||||
| 343 | wanted => sub { | ||||||
| 344 | 10 | 2379 | return unless ( /\/$type/ ); | ||||
| 345 | 2 | 15 | $self->_execute($_) or die "Failed to $type $_\n"; | ||||
| 346 | }, | ||||||
| 347 | 2 | 137 | }, $self->_watches ); | ||||
| 348 | } | ||||||
| 349 | |||||||
| 350 | 19 | 5444 | return 0; | ||||
| 351 | } | ||||||
| 352 | |||||||
| 353 | sub _execute { | ||||||
| 354 | 49 | 1952 | my ( $self, $file, $run_quiet, $is_dependency ) = @_; | ||||
| 355 | 49 | 1819 | return if ( $seen_files{$file}++ ); | ||||
| 356 | |||||||
| 357 | 49 | 1335 | my @nodes = split( '/', $file ); | ||||
| 358 | 49 | 432 | my $type = pop @nodes; | ||||
| 359 | 49 | 2439 | ( my $action = join( '/', @nodes ) ) =~ s|^\.dest/||; | ||||
| 360 | |||||||
| 361 | 49 | 1280 | $type =~ s/\..*$//; | ||||
| 362 | |||||||
| 363 | 49 | 3874 | if ( | ||||
| 364 | ( $type eq 'deploy' and not $run_quiet and -f '.dest/' . $file ) or | ||||||
| 365 | ( $type eq 'revert' and not -f $file ) | ||||||
| 366 | ) { | ||||||
| 367 | 0 | 0 | if ( $is_dependency ) { | ||||
| 368 | 0 | 0 | return; | ||||
| 369 | } | ||||||
| 370 | else { | ||||||
| 371 | 0 | 0 | die 'Action already '. $type . "ed\n"; | ||||
| 372 | } | ||||||
| 373 | } | ||||||
| 374 | |||||||
| 375 | 49 | 7388 | open( my $content, '<', $file ) or die "Unable to read $file\n"; | ||||
| 376 | |||||||
| 377 | 49 | 6273 | for ( | ||||
| 378 | 17 | 81 | grep { defined } | ||||
| 379 | 17 17 | 443 123 | map { /dest\.prereq\b[\s:=-]+(.+?)\s*$/; $1 || undef } | ||||
| 380 | 264 | 2185 | grep { /dest\.prereq/ } <$content> | ||||
| 381 | ) { | ||||||
| 382 | 17 | 879 | my @files = <"$_/$type*">; | ||||
| 383 | 17 | 95 | die "Unable to find prereq \"$_/$type*\"\n" unless ( $files[0] ); | ||||
| 384 | 17 | 989 | $self->_execute( $files[0], $run_quiet, 'dependency' ) if ( | ||||
| 385 | ( $type eq 'deploy' and not -f '.dest/' . $files[0] ) or | ||||||
| 386 | ( $type eq 'revert' and -f '.dest/' . $files[0] ) | ||||||
| 387 | ); | ||||||
| 388 | } | ||||||
| 389 | |||||||
| 390 | 49 | 1863 | my $wrap; | ||||
| 391 | 49 | 553 | shift @nodes if ( $nodes[0] eq '.dest' ); | ||||
| 392 | 49 | 312 | while (@nodes) { | ||||
| 393 | 98 | 1091 | my $path = join( '/', @nodes ); | ||||
| 394 | 98 | 2367 | if ( -f "$path/dest.wrap" ) { | ||||
| 395 | 0 | 0 | $wrap = "$path/dest.wrap"; | ||||
| 396 | 0 | 0 | last; | ||||
| 397 | } | ||||||
| 398 | 98 | 1389 | pop @nodes; | ||||
| 399 | } | ||||||
| 400 | |||||||
| 401 | 49 | 257 | if ( $type eq 'verify' ) { | ||||
| 402 | 22 | 82 | my ( $out, $err ); | ||||
| 403 | |||||||
| 404 | run( | ||||||
| 405 | 22 44 | 312 605 | [ grep { defined } ( ($wrap) ? $wrap : undef ), $file ], | ||||
| 406 | \undef, \$out, \$err, | ||||||
| 407 | ) or die "Failed to execute $file\n"; | ||||||
| 408 | |||||||
| 409 | 22 | 2720551 | chomp($out); | ||||
| 410 | 22 | 208 | return ($err) ? 0 : $out if ($run_quiet); | ||||
| 411 | |||||||
| 412 | 22 | 216 | die "$err\n" if ($err); | ||||
| 413 | 22 | 3938 | print '', ( ($out) ? 'ok' : 'not ok' ) . " - verify: $action\n"; | ||||
| 414 | } | ||||||
| 415 | else { | ||||||
| 416 | 27 | 9142 | print "begin - $type: $action\n"; | ||||
| 417 | |||||||
| 418 | 27 | 122 | eval { | ||||
| 419 | 27 54 | 159 844 | run( [ grep { defined } ( ($wrap) ? $wrap : undef ), $file ] ); | ||||
| 420 | }; | ||||||
| 421 | 27 | 2310880 | if ($@) { | ||||
| 422 | 0 | 0 | ( my $err = $@ ) =~ s/\s*at\s+.*$//; | ||||
| 423 | 0 | 0 | chomp($err); | ||||
| 424 | 0 | 0 | die "Failed to execute $file: $err\n"; | ||||
| 425 | } | ||||||
| 426 | |||||||
| 427 | 27 | 1575 | $file =~ s|^\.dest/||; | ||||
| 428 | 27 | 2920 | print "ok - $type: $action\n"; | ||||
| 429 | |||||||
| 430 | 27 | 1151 | if ( $type eq 'deploy' ) { | ||||
| 431 | 18 18 | 1938 1413 | ( my $verify_file = $file ) =~ s|([^/]+)$| 'verify' . substr( $1, 6 ) |e; | ||||
| 432 | 18 | 4711 | $self->_execute($verify_file); | ||||
| 433 | } | ||||||
| 434 | } | ||||||
| 435 | |||||||
| 436 | 49 | 26197 | return 1; | ||||
| 437 | } | ||||||
| 438 | |||||||
| 439 | 1; | ||||||