[41] | 1 | package LATMOS::Accounts::Synchro; |
---|
| 2 | |
---|
| 3 | use 5.010000; |
---|
| 4 | use strict; |
---|
| 5 | use warnings; |
---|
| 6 | use base qw(Config::IniFiles); |
---|
| 7 | use LATMOS::Accounts::Bases; |
---|
[249] | 8 | use LATMOS::Accounts::Log; |
---|
[261] | 9 | use LATMOS::Accounts::Utils qw(exec_command); |
---|
[815] | 10 | use Fcntl qw(:flock); |
---|
[41] | 11 | |
---|
| 12 | =head1 NAME |
---|
| 13 | |
---|
| 14 | LATMOS::Accounts::Synchro - Perl extension for blah blah blah |
---|
| 15 | |
---|
| 16 | =head1 SYNOPSIS |
---|
| 17 | |
---|
| 18 | use LATMOS::Accounts; |
---|
| 19 | blah blah blah |
---|
| 20 | |
---|
| 21 | =head1 DESCRIPTION |
---|
| 22 | |
---|
| 23 | Stub documentation for LATMOS::Accounts, created by h2xs. It looks like the |
---|
| 24 | author of the extension was negligent enough to leave the stub |
---|
| 25 | unedited. |
---|
| 26 | |
---|
| 27 | Blah blah blah. |
---|
| 28 | |
---|
| 29 | =head1 FUNCTIONS |
---|
| 30 | |
---|
| 31 | =cut |
---|
| 32 | |
---|
[1952] | 33 | our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0]; |
---|
[41] | 34 | |
---|
[49] | 35 | =head2 new($from, $to, %options) |
---|
[41] | 36 | |
---|
| 37 | Create a new synchronisation where $from and $to are LATMOS::Accounts::Base |
---|
| 38 | based objects. $to can be an array ref of objects. |
---|
| 39 | |
---|
| 40 | =cut |
---|
| 41 | |
---|
| 42 | sub new { |
---|
[49] | 43 | my ($class, $from, $to, %options) = @_; |
---|
[41] | 44 | |
---|
[563] | 45 | my $state_file = $options{state_dir} |
---|
| 46 | ? $options{state_dir} . '/synchronisation.ini' |
---|
| 47 | : undef; |
---|
| 48 | if ($state_file && ! -w $state_file) { |
---|
[49] | 49 | # don't exists, we have to create it |
---|
[563] | 50 | open(my $handle, '>', $state_file) or do { |
---|
| 51 | la_log(LA_ERR, "Cannot open status file %s", $state_file); |
---|
[317] | 52 | return; |
---|
| 53 | }; |
---|
[51] | 54 | print $handle "[_default_]\n"; |
---|
[49] | 55 | close($handle); |
---|
| 56 | } |
---|
[41] | 57 | |
---|
[49] | 58 | my $self = Config::IniFiles->new( |
---|
[566] | 59 | $state_file |
---|
[563] | 60 | ? (-file => $state_file) |
---|
[49] | 61 | : (), |
---|
| 62 | ); |
---|
| 63 | |
---|
[563] | 64 | if ($state_file && !$self->GetFileName) { |
---|
| 65 | $self->SetFileName($state_file); |
---|
[51] | 66 | } |
---|
[49] | 67 | |
---|
[296] | 68 | $self->{from} = $from or do { |
---|
| 69 | la_log(LA_ERR, "No database source"); |
---|
| 70 | return; |
---|
| 71 | }; |
---|
[73] | 72 | $self->{options} = { %options }; |
---|
[41] | 73 | |
---|
| 74 | # allow ref and array ref of, eg |
---|
| 75 | # to = $foo and $to = [ $foo, $bar ] |
---|
[45] | 76 | foreach (ref($to) eq 'ARRAY' ? @{ $to || []} : ($to)) { |
---|
[41] | 77 | push(@{$self->{to}}, $_); |
---|
| 78 | } |
---|
| 79 | bless($self, $class) |
---|
| 80 | } |
---|
| 81 | |
---|
[1023] | 82 | =head2 name |
---|
| 83 | |
---|
| 84 | Return the name of this synchronisation |
---|
| 85 | |
---|
| 86 | =cut |
---|
| 87 | |
---|
[77] | 88 | sub name { |
---|
| 89 | $_[0]->{options}{name} |
---|
| 90 | } |
---|
| 91 | |
---|
[1023] | 92 | =head2 from |
---|
| 93 | |
---|
| 94 | Return the base object source for this synchronisation |
---|
| 95 | |
---|
| 96 | =cut |
---|
| 97 | |
---|
[41] | 98 | sub from { |
---|
| 99 | my ($self) = @_; |
---|
| 100 | return $self->{from} |
---|
| 101 | } |
---|
| 102 | |
---|
[1023] | 103 | =head2 to |
---|
| 104 | |
---|
| 105 | Return the list of base destination for this synchronisation |
---|
| 106 | |
---|
| 107 | =cut |
---|
| 108 | |
---|
[41] | 109 | sub to { |
---|
| 110 | my ($self) = @_; |
---|
| 111 | return @{$self->{to} || []}; |
---|
| 112 | } |
---|
| 113 | |
---|
| 114 | =head2 load_dest |
---|
| 115 | |
---|
| 116 | Try to loaded all base, return the count of filtrered base which cannot |
---|
| 117 | be loaded |
---|
| 118 | |
---|
| 119 | =cut |
---|
| 120 | |
---|
| 121 | sub load_dest { |
---|
| 122 | my ($self) = @_; |
---|
| 123 | my @loaded; |
---|
| 124 | my $unloaded = 0; |
---|
| 125 | foreach ($self->to) { |
---|
| 126 | if($_->load) { |
---|
| 127 | push(@loaded, $_); |
---|
| 128 | } else { |
---|
| 129 | $unloaded++; |
---|
[578] | 130 | warn "Cannot load $_"; |
---|
[41] | 131 | } |
---|
| 132 | } |
---|
| 133 | $self->{to} = \@loaded; |
---|
| 134 | return $unloaded; |
---|
| 135 | } |
---|
| 136 | |
---|
[1023] | 137 | =head2 enter_synch_mode |
---|
| 138 | |
---|
| 139 | Configure base for synchronisation |
---|
| 140 | |
---|
| 141 | =cut |
---|
| 142 | |
---|
[282] | 143 | sub enter_synch_mode { |
---|
| 144 | my ($self) = @_; |
---|
[532] | 145 | $self->from->load or return; |
---|
| 146 | # if any cannot be loaded, return, |
---|
| 147 | # TODO we need a way to force if some still can be sync |
---|
| 148 | $self->load_dest and return; |
---|
[282] | 149 | my %state = (); |
---|
[861] | 150 | $state{$self->from->label} = $self->from->wexported( |
---|
| 151 | $self->{options}{unexported} ? 1 : 0 |
---|
| 152 | ); |
---|
[282] | 153 | foreach ($self->to) { |
---|
| 154 | $state{$_->label} = $_->wexported(1); |
---|
| 155 | } |
---|
| 156 | la_log(LA_DEBUG, "Entering synch mode, old state: %s", join(', ', map { |
---|
| 157 | "$_ => $state{$_}" } sort keys %state)); |
---|
| 158 | %state |
---|
| 159 | } |
---|
| 160 | |
---|
[1023] | 161 | =head2 leave_synch_mode (%state) |
---|
| 162 | |
---|
| 163 | Retore base to previous state |
---|
| 164 | |
---|
| 165 | =cut |
---|
| 166 | |
---|
[282] | 167 | sub leave_synch_mode { |
---|
| 168 | my ($self, %state) = @_; |
---|
| 169 | la_log(LA_DEBUG, "Leaving synch mode"); |
---|
| 170 | $self->from->wexported($state{$self->from->label}); |
---|
[861] | 171 | foreach my $base (grep { $_ } $self->to) { |
---|
| 172 | $base->wexported($state{$base->label}); |
---|
[282] | 173 | } |
---|
| 174 | } |
---|
| 175 | |
---|
[1023] | 176 | =head2 lock |
---|
| 177 | |
---|
| 178 | Create a lock to denied another synchronisation to run |
---|
| 179 | |
---|
| 180 | =cut |
---|
| 181 | |
---|
[564] | 182 | sub lock { |
---|
| 183 | my ($self) = @_; |
---|
| 184 | |
---|
| 185 | $self->{lock}{handle} and return 1; |
---|
[815] | 186 | la_log(LA_DEBUG, "Trying to lock (pid $$)"); |
---|
[564] | 187 | if ($self->{options}{state_dir}) { |
---|
| 188 | my $lockfile = $self->{options}{state_dir} . '/synclock'; |
---|
| 189 | open(my $handle, '>>', $lockfile) or return; |
---|
| 190 | flock($handle, LOCK_EX); |
---|
| 191 | $self->{lock}{handle} = $handle; |
---|
| 192 | $self->{lock}{filename} = $lockfile; |
---|
[815] | 193 | la_log(LA_DEBUG, "lock done (pid $$)"); |
---|
[564] | 194 | return 1; |
---|
| 195 | } else { return 1 } |
---|
| 196 | } |
---|
| 197 | |
---|
[1023] | 198 | =head2 unlock |
---|
| 199 | |
---|
| 200 | Remove lock |
---|
| 201 | |
---|
| 202 | =cut |
---|
| 203 | |
---|
[564] | 204 | sub unlock { |
---|
| 205 | my ($self) = @_; |
---|
| 206 | if (my $handle = $self->{lock}{handle}) { |
---|
| 207 | close($handle); |
---|
| 208 | delete($self->{lock}{handle}); |
---|
| 209 | unlink($self->{lock}{filename}); |
---|
| 210 | delete($self->{lock}{filename}); |
---|
| 211 | return 1; |
---|
| 212 | } |
---|
| 213 | return; |
---|
| 214 | } |
---|
| 215 | |
---|
[1023] | 216 | =head2 sync_object ($otype, $uid, %options) |
---|
| 217 | |
---|
| 218 | Synchronise object type C<$otype> named C<$uid> |
---|
| 219 | |
---|
| 220 | =cut |
---|
| 221 | |
---|
[83] | 222 | sub sync_object { |
---|
[532] | 223 | my ($self, $otype, $uid, %options) = @_; |
---|
[564] | 224 | |
---|
| 225 | $self->lock or return; |
---|
| 226 | |
---|
[282] | 227 | my %state = $self->enter_synch_mode; |
---|
[532] | 228 | |
---|
| 229 | my $res = $self->_sync_object($otype, $uid, %options); |
---|
[259] | 230 | |
---|
[282] | 231 | $self->leave_synch_mode(%state); |
---|
| 232 | |
---|
[564] | 233 | $self->unlock; |
---|
| 234 | |
---|
[532] | 235 | $res; |
---|
[83] | 236 | } |
---|
| 237 | |
---|
[532] | 238 | sub _sync_object { |
---|
| 239 | my ($self, $otype, $uid, %options) = @_; |
---|
| 240 | foreach ($self->to) { |
---|
| 241 | my $res = $_->sync_object_from($self->from, $otype, $uid, %options); |
---|
| 242 | if (defined $res) { |
---|
| 243 | la_log(LA_NOTICE, $_->label . " $uid ($otype) $res") if ($res); |
---|
| 244 | return 1; |
---|
| 245 | } else { |
---|
| 246 | la_log(LA_ERR, "error synching $uid ($otype) to " . $_->label); |
---|
| 247 | return; |
---|
| 248 | } |
---|
| 249 | } |
---|
| 250 | } |
---|
| 251 | |
---|
[1023] | 252 | =head2 process |
---|
| 253 | |
---|
| 254 | Run the syncronisation |
---|
| 255 | |
---|
| 256 | =cut |
---|
| 257 | |
---|
[60] | 258 | sub process { |
---|
[532] | 259 | my ($self, %options) = @_; |
---|
[60] | 260 | |
---|
[564] | 261 | $self->lock or return; |
---|
[861] | 262 | |
---|
| 263 | if (!(my $res = $self->run_pre_synchro({}))) { |
---|
| 264 | la_log(LA_ERR, "Pre synchro script failed, aborting"); |
---|
| 265 | $self->unlock; |
---|
| 266 | return; |
---|
| 267 | } |
---|
[564] | 268 | |
---|
[282] | 269 | my %state = $self->enter_synch_mode; |
---|
| 270 | |
---|
[60] | 271 | # tracking current base revision: |
---|
| 272 | $self->{current_rev} = $self->from->current_rev; |
---|
| 273 | |
---|
[668] | 274 | my %desterror; |
---|
[819] | 275 | my $updated = 0; |
---|
[1377] | 276 | |
---|
| 277 | # We do base one by one |
---|
| 278 | |
---|
[668] | 279 | foreach my $destbase ($self->to) { |
---|
| 280 | my %objlist; |
---|
| 281 | foreach my $otype ($self->from->list_supported_objects) { |
---|
| 282 | $destbase->is_supported_object($otype) or next; |
---|
| 283 | |
---|
[1354] | 284 | my %existings; |
---|
| 285 | my %filtering; |
---|
| 286 | |
---|
| 287 | $existings{$otype} = { map { $_ => 1 } |
---|
[1865] | 288 | $self->from->listRealObjects($otype) }; |
---|
[668] | 289 | |
---|
[1354] | 290 | # Is there a filter to apply: |
---|
| 291 | my $filtername = 'filter.' . $destbase->label . '.' . $otype; |
---|
| 292 | if (my $filter = $self->{options}->{$filtername}) { |
---|
| 293 | la_log(LA_DEBUG, "Found %s param, using it: %s", $filtername, $filter); |
---|
| 294 | $filtering{$otype} = { map { $_ => 1 } |
---|
[1865] | 295 | $self->from->search_objects($otype, $filter, 'oalias=NULL') }; |
---|
[1354] | 296 | } else { |
---|
| 297 | $filtering{$otype} = $existings{$otype}; |
---|
| 298 | } |
---|
| 299 | |
---|
| 300 | |
---|
[668] | 301 | # deleting non existing object in dest: |
---|
[1377] | 302 | |
---|
| 303 | # Sync: noDelete.Base = yes mean no delete |
---|
| 304 | # noDelete.Base.Otype = yes mean no delete for this object |
---|
| 305 | if ($self->{options}->{'noDelete'} || |
---|
| 306 | $self->{options}->{'noDelete.' . $destbase->label} || |
---|
| 307 | $self->{options}->{'noDelete.' . $destbase->label . '.' . $otype}) { |
---|
[1384] | 308 | la_log(LA_INFO, 'Not deleting object type \'%s` from base \'%s` because %s is set', |
---|
[1377] | 309 | $otype, |
---|
| 310 | $destbase->label, |
---|
| 311 | $self->{options}->{'noDelete.' . $destbase->label . '.' . $otype} |
---|
| 312 | ? 'noDelete.' . $destbase->label . '.' . $otype |
---|
| 313 | : $self->{options}->{'noDelete.' . $destbase->label} |
---|
| 314 | ? 'noDelete.' . $destbase->label |
---|
| 315 | : 'noDelete' |
---|
| 316 | ); |
---|
| 317 | } else { |
---|
| 318 | |
---|
[1354] | 319 | my $deletefiltered = 'deletefiltered.' . $destbase->label . '.' . $otype; |
---|
[1377] | 320 | |
---|
[1865] | 321 | foreach ($destbase->listRealObjects($otype)) { |
---|
[1354] | 322 | |
---|
| 323 | if ($filtering{$otype}{$_}) { |
---|
| 324 | # the object must exists |
---|
| 325 | next; |
---|
| 326 | } elsif ($existings{$otype}{$_}) { |
---|
| 327 | # object exists but is filtered |
---|
| 328 | if (!$self->{options}->{$deletefiltered}) { |
---|
| 329 | next; |
---|
[819] | 330 | } |
---|
[565] | 331 | } |
---|
[1354] | 332 | |
---|
| 333 | if (my $res = $destbase->sync_object_from($self->from, |
---|
| 334 | $otype, $_, %options)) { |
---|
| 335 | la_log(LA_NOTICE, "%s::%s::%s => %s %s", |
---|
| 336 | $self->from->label, $otype, $_, $destbase->label, $res, |
---|
| 337 | ); |
---|
| 338 | if ($destbase->is_transactionnal) { |
---|
| 339 | $destbase->commit; |
---|
| 340 | } |
---|
| 341 | $updated = 1; |
---|
| 342 | } else { |
---|
| 343 | if ($destbase->is_transactionnal) { |
---|
| 344 | $destbase->rollback; |
---|
| 345 | } |
---|
| 346 | } |
---|
[60] | 347 | } |
---|
[1377] | 348 | } # noDelete.Base |
---|
[668] | 349 | |
---|
[1377] | 350 | |
---|
[1354] | 351 | # Finding object to synchronize: |
---|
| 352 | @{$objlist{$otype}} = grep { $filtering{$otype}{$_} } $self->from->list_objects_from_rev( |
---|
[668] | 353 | $otype, |
---|
| 354 | $self->val($self->from->label, $destbase->label, 0), |
---|
| 355 | ); |
---|
[532] | 356 | } |
---|
[1354] | 357 | |
---|
| 358 | my %objectok; |
---|
[668] | 359 | foreach my $pass (1, 0) { |
---|
[861] | 360 | foreach my $otype ($destbase->ordered_objects) { |
---|
| 361 | exists($objlist{$otype}) or next; |
---|
[668] | 362 | foreach (@{$objlist{$otype} || []}) { |
---|
[1354] | 363 | |
---|
| 364 | # If first synchro is not ok, don't retry to sync the object |
---|
| 365 | if ((!$pass) && (!$objectok{$otype}{$_})) { |
---|
| 366 | next; |
---|
| 367 | } |
---|
| 368 | |
---|
[532] | 369 | my $res = $destbase->sync_object_from($self->from, $otype, $_, |
---|
| 370 | %options, firstpass => $pass); |
---|
| 371 | if (defined $res) { |
---|
[819] | 372 | if ($res) { |
---|
| 373 | la_log(LA_NOTICE, "%s::%s::%s => %s %s", |
---|
| 374 | $self->from->label, $otype, $_, |
---|
| 375 | $destbase->label, $res, |
---|
| 376 | ); |
---|
[861] | 377 | if ($destbase->is_transactionnal) { |
---|
| 378 | $destbase->commit; |
---|
| 379 | } |
---|
[819] | 380 | $updated = 1; |
---|
[1354] | 381 | $objectok{$otype}{$_} = 1; |
---|
[819] | 382 | } |
---|
[532] | 383 | } else { |
---|
| 384 | la_log(LA_ERR, "Cannot synch %s::%s::%s => %s", |
---|
| 385 | $self->from->label, $otype, $_, |
---|
| 386 | $destbase->label, |
---|
| 387 | ); |
---|
[541] | 388 | $desterror{$destbase->label} = 1; |
---|
[861] | 389 | if ($destbase->is_transactionnal) { |
---|
| 390 | $destbase->rollback; |
---|
| 391 | } |
---|
[532] | 392 | } |
---|
| 393 | } |
---|
[66] | 394 | } |
---|
[532] | 395 | } |
---|
[1805] | 396 | if (!$desterror{$destbase->label}) { |
---|
| 397 | $destbase->commit if(!$destbase->is_transactionnal); |
---|
| 398 | $self->newval($self->from->label, $destbase->label, $self->{current_rev}); |
---|
| 399 | if(!($self->{options}{nocreate} || $self->{options}{test})) { |
---|
| 400 | $self->write_status; |
---|
| 401 | la_log(LA_NOTICE, |
---|
[1915] | 402 | "Update synch. status to %s for base %s to %s", |
---|
| 403 | $self->{current_rev} || '(none)', $self->from->label, $destbase->label |
---|
[1805] | 404 | ); |
---|
| 405 | } |
---|
| 406 | } |
---|
[45] | 407 | } |
---|
| 408 | |
---|
[532] | 409 | $self->leave_synch_mode(%state); |
---|
[819] | 410 | my $res = $self->run_post_synchro( |
---|
| 411 | { |
---|
[861] | 412 | UPDATED => $updated || undef, |
---|
[819] | 413 | } |
---|
| 414 | ); |
---|
[1805] | 415 | if ($res) { |
---|
[819] | 416 | } else { |
---|
[1805] | 417 | la_log(LA_ERROR, "Post synchronization script failed: %s", $res); |
---|
[525] | 418 | } |
---|
[282] | 419 | |
---|
[564] | 420 | $self->unlock; |
---|
| 421 | |
---|
[1204] | 422 | if (!$res) { # postscript failure |
---|
| 423 | return; |
---|
| 424 | } elsif (grep { $desterror{$_} } keys %desterror) { |
---|
| 425 | # There were errors :\ |
---|
| 426 | return; |
---|
| 427 | } else { |
---|
| 428 | return 1; |
---|
| 429 | } |
---|
[41] | 430 | } |
---|
| 431 | |
---|
[1023] | 432 | =head2 write_status |
---|
| 433 | |
---|
| 434 | Write savepoint file |
---|
| 435 | |
---|
| 436 | =cut |
---|
| 437 | |
---|
[525] | 438 | sub write_status { |
---|
| 439 | my ($self) = @_; |
---|
| 440 | if (my $file = $self->GetFileName) { |
---|
[537] | 441 | open(my $handle, '>', $file) or do { |
---|
| 442 | la_log(LA_ERR, "Cannot open status file %s for writing: %s", |
---|
| 443 | $file, $!); |
---|
| 444 | return; |
---|
| 445 | }; |
---|
[525] | 446 | my $oldfh = select($handle); |
---|
| 447 | $self->OutputConfig(); |
---|
| 448 | select($oldfh); |
---|
| 449 | close($handle); |
---|
| 450 | return 1; |
---|
[538] | 451 | } |
---|
[537] | 452 | |
---|
[525] | 453 | return 0; |
---|
| 454 | } |
---|
| 455 | |
---|
[1206] | 456 | =head2 reset_savepoint |
---|
[1205] | 457 | |
---|
[1206] | 458 | Reset savepoint in status file to force full synchronisation |
---|
[1205] | 459 | |
---|
| 460 | =cut |
---|
| 461 | |
---|
[1206] | 462 | sub reset_savepoint { |
---|
[1205] | 463 | my ($self) = @_; |
---|
| 464 | foreach my $destbase ($self->to) { |
---|
[1206] | 465 | # don't register savepoint on error |
---|
[1205] | 466 | $self->newval($self->from->label, $destbase->label, 0); |
---|
| 467 | } |
---|
| 468 | $self->write_status; |
---|
| 469 | } |
---|
| 470 | |
---|
[1023] | 471 | =head2 run_pre_synchro |
---|
| 472 | |
---|
| 473 | Run task done before synchronisation |
---|
| 474 | |
---|
| 475 | =cut |
---|
| 476 | |
---|
[861] | 477 | sub run_pre_synchro { |
---|
| 478 | my ($self, $env) = @_; |
---|
| 479 | |
---|
| 480 | $env ||= {}; |
---|
| 481 | $env->{HOOK_TYPE} = 'PRE'; |
---|
| 482 | |
---|
| 483 | foreach my $base ($self->to) { |
---|
[1071] | 484 | if ($base->config('presynchro')) { |
---|
[861] | 485 | la_log LA_DEBUG, "Executing base pre synchro `%s' for %s", |
---|
[1071] | 486 | $base->config('presynchro'), $base->label; |
---|
[861] | 487 | exec_command( |
---|
[1071] | 488 | $base->config('presynchro'), |
---|
[861] | 489 | { |
---|
| 490 | BASE => $base->label, |
---|
| 491 | BASETYPE => $base->type, |
---|
| 492 | %{ $env }, |
---|
| 493 | } |
---|
| 494 | ); |
---|
| 495 | } |
---|
| 496 | } |
---|
| 497 | |
---|
| 498 | $self->{options}{pre} or return 1; |
---|
| 499 | |
---|
| 500 | la_log(LA_DEBUG, "Running post synchro `%s'", $self->{options}{pre}); |
---|
| 501 | |
---|
| 502 | exec_command($self->{options}{post}, $env); |
---|
| 503 | } |
---|
| 504 | |
---|
[1023] | 505 | =head2 run_post_synchro |
---|
| 506 | |
---|
| 507 | Run task done after synchronisation |
---|
| 508 | |
---|
| 509 | =cut |
---|
| 510 | |
---|
[259] | 511 | sub run_post_synchro { |
---|
[819] | 512 | my ($self, $env) = @_; |
---|
[861] | 513 | |
---|
| 514 | $env ||= {}; |
---|
| 515 | $env->{HOOK_TYPE} = 'PRE'; |
---|
[259] | 516 | |
---|
[861] | 517 | foreach my $base ($self->to) { |
---|
[1071] | 518 | if ($base->config('postsynchro')) { |
---|
[861] | 519 | la_log LA_DEBUG, "Executing base post synchro `%s' for %s", |
---|
[1071] | 520 | $base->config('postsynchro'), $base->label; |
---|
[861] | 521 | exec_command( |
---|
[1071] | 522 | $base->config('postsynchro'), |
---|
[861] | 523 | { |
---|
| 524 | BASE => $base->label, |
---|
| 525 | BASETYPE => $base->type, |
---|
| 526 | %{ $env }, |
---|
| 527 | } |
---|
| 528 | ); |
---|
| 529 | } |
---|
| 530 | } |
---|
| 531 | |
---|
[259] | 532 | $self->{options}{post} or return 1; |
---|
| 533 | |
---|
[861] | 534 | la_log(LA_DEBUG, "Running post synchro `%s'", $self->{options}{post}); |
---|
| 535 | |
---|
[819] | 536 | exec_command($self->{options}{post}, $env); |
---|
[259] | 537 | } |
---|
| 538 | |
---|
| 539 | |
---|
[41] | 540 | 1; |
---|
| 541 | |
---|
| 542 | __END__ |
---|
| 543 | # Below is stub documentation for your module. You'd better edit it! |
---|
| 544 | |
---|
| 545 | =head1 SEE ALSO |
---|
| 546 | |
---|
| 547 | Mention other useful documentation such as the documentation of |
---|
| 548 | related modules or operating system documentation (such as man pages |
---|
| 549 | in UNIX), or any relevant external documentation such as RFCs or |
---|
| 550 | standards. |
---|
| 551 | |
---|
| 552 | If you have a mailing list set up for your module, mention it here. |
---|
| 553 | |
---|
| 554 | If you have a web site set up for your module, mention it here. |
---|
| 555 | |
---|
| 556 | =head1 AUTHOR |
---|
| 557 | |
---|
| 558 | Thauvin Olivier, E<lt>olivier.thauvin@latmosipsl.frE<gt> |
---|
| 559 | |
---|
| 560 | =head1 COPYRIGHT AND LICENSE |
---|
| 561 | |
---|
| 562 | Copyright (C) 2009 by Thauvin Olivier |
---|
| 563 | |
---|
| 564 | This library is free software; you can redistribute it and/or modify |
---|
| 565 | it under the same terms as Perl itself, either Perl version 5.10.0 or, |
---|
| 566 | at your option, any later version of Perl 5 you may have available. |
---|
| 567 | |
---|
| 568 | |
---|
| 569 | =cut |
---|