view Lib/Deployment/Batch/Generic.pm @ 134:44977efed303

Significant performance optimizations Fixed recursion problems due converting objects to JSON Added cache support for the templates Added discovery feature for the web methods
author wizard
date Mon, 21 Jun 2010 02:39:53 +0400
parents 16ada169ca75
children
line wrap: on
line source

use strict;
package Deployment::Batch;
our @history;

package Deployment::Batch::Generic;
use Common;
use Time::HiRes;
our @ISA = qw(Object);

BEGIN {
    DeclareProperty isProcessed => ACCESS_READ;
    DeclareProperty LastError => ACCESS_READ;
    DeclareProperty LocalHistory => ACCESS_NONE;
}

sub _Run {
    my ($this) = @_;

    undef $@;
    local @history = ();
    my $t0 = [Time::HiRes::gettimeofday];
    eval {
        $this->Run;
    };
    $this->Log("completed in ",Time::HiRes::tv_interval($t0)," s");

    if ($@) {
        $this->{$LastError} = $@;
        Deployment::Batch::Rollback(); # rallback nested actions
        return 0;
    }

    $this->{$LocalHistory} = \@history;
    $this->{$isProcessed} = 1;

    return 1;
}

sub Name {
    my $this = shift;
    (my $mod = ref $this) =~ s/^(?:\w+\:\:)*(\w+)$/$1/;
    return $mod;
}

sub _Rollback {
    my ($this) = @_;

    undef $@;
    eval {
        $this->Rollback;
    };

    if ($@) {
        $this->{$LastError} = $@;
    }

    $this->{$isProcessed} = 0;

    if ($this->{$LocalHistory}) {
        local @history = @{$this->{$LocalHistory}};
        Deployment::Batch::Rollback();
    }

    return 1;
}

sub Context {
    my $this = shift;

    return \%Deployment::Batch::Context;
}

sub Log {
    my $this = shift @_;
    if ($this->Context->{LogOutput}) {
        my $out = $this->Context->{LogOutput};
        print $out $this->Name,": ",@_,"\n";
    }
}

sub Run {
}

sub Rollback {
}

1;