Event-ExecFlow-0.64/0000755000175000017500000000000011313136551013251 5ustar joernjoernEvent-ExecFlow-0.64/t/0000755000175000017500000000000011313136550013513 5ustar joernjoernEvent-ExecFlow-0.64/t/02.parallel.t0000755000175000017500000000377411177275151015743 0ustar joernjoernuse strict; use Test::More; $ENV{PATH} = "./bin:../bin:$ENV{PATH}"; plan tests => 14; use_ok('Event::ExecFlow'); use_ok('Event::ExecFlow::Frontend::Term'); use_ok('Event::ExecFlow::Scheduler::SimpleMax;'); run_test(); exit; sub run_test { my $scheduler = Event::ExecFlow::Scheduler::SimpleMax->new( max => 5 ); my $sleeps1 = build_sleeps($scheduler, 1); my $sleeps2 = build_sleeps($scheduler, 2); my $code_was_executed; my $code = Event::ExecFlow::Job::Code->new ( name => "code", title => "Some code", code => sub { $code_was_executed = 1; print "CODE WAS EXECUTED\n"; }, depends_on => [ "sleeps_1" ], ); my $job = Event::ExecFlow::Job::Group->new ( name => "all", title => "All jobs under the hood", jobs => [ $sleeps1, $code, $sleeps2 ], parallel => 1, scheduler => $scheduler, ); my $frontend = Event::ExecFlow::Frontend::Term->new; $frontend->set_quiet(1); $frontend->start_job($job); ok($code_was_executed, "Job succesfully finished"); } sub build_sleeps { my ($scheduler, $nr) = @_; my @jobs; my $max = 5; my $dur = 2; for my $i ( 1..$max ) { push @jobs, Event::ExecFlow::Job::Command->new ( name => "sleep_${nr}_$i", title => "Take a sleep ($i/$max)", command => "perl -e'\$|=1;for(1..$dur){print qq(\$_\\n);sleep 1}'", progress_max => $dur, progress_parser => qr/(\d+)/, post_callbacks => sub { my ($job) = @_; ok($job->get_state eq 'finished',"Job $i executed Ok"); }, ); } return Event::ExecFlow::Job::Group->new ( name => "sleeps_$nr", title => "A bunch of sleeps", jobs => \@jobs, parallel => 1, scheduler => $scheduler, ); } Event-ExecFlow-0.64/t/01.use.t0000644000175000017500000000010410400600447014703 0ustar joernjoernuse strict; use Test::More tests => 1; use_ok('Event::ExecFlow'); Event-ExecFlow-0.64/lib/0000755000175000017500000000000011313136550014016 5ustar joernjoernEvent-ExecFlow-0.64/lib/Event/0000755000175000017500000000000011313136550015077 5ustar joernjoernEvent-ExecFlow-0.64/lib/Event/ExecFlow/0000755000175000017500000000000011313136550016613 5ustar joernjoernEvent-ExecFlow-0.64/lib/Event/ExecFlow/Job/0000755000175000017500000000000011313136550017325 5ustar joernjoernEvent-ExecFlow-0.64/lib/Event/ExecFlow/Job/Code.pm0000644000175000017500000000473510412036160020541 0ustar joernjoernpackage Event::ExecFlow::Job::Code; use base qw( Event::ExecFlow::Job ); use strict; sub get_exec_type { "sync" } sub get_type { "code" } sub get_code { shift->{code} } sub set_code { shift->{code} = $_[1] } sub new { my $class = shift; my %par = @_; my ($code) = $par{'code'}; my $self = $class->SUPER::new(@_); $self->set_code($code); return $self; } sub execute { my $self = shift; my $code = $self->get_code; eval { $code->($self) }; $self->set_error_message($@) if $@; $self->execution_finished; 1; } sub cancel { my $self = shift; $self->set_cancelled(1); 1; } sub pause_job { my $self = shift; 1; } sub backup_state { my $self = shift; my $data_href = $self->SUPER::backup_state(); delete $data_href->{code}; return $data_href; } 1; __END__ =head1 NAME Event::ExecFlow::Job::Code - Execute a closure =head1 SYNOPSIS Event::ExecFlow::Job::Code->new ( code => Closure to execute, ... Event::ExecFlow::Job attributes ); =head1 DESCRIPTION Use this module for execution of arbitrary Perl code (passed as a closure) inside an Event::ExecFlow. =head1 OBJECT HIERARCHY Event::ExecFlow Event::ExecFlow::Job +--- Event::ExecFlow::Job::Code Event::ExecFlow::Frontend Event::ExecFlow::Callbacks =head1 ATTRIBUTES Attributes can by accessed at runtime using the common get_ATTR(), set_ATTR() style accessors. [ FIXME: describe all attributes in detail ] =head1 METHODS [ FIXME: describe all methods in detail ] =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright 2005-2006 by Jörn Reder. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA. =cut Event-ExecFlow-0.64/lib/Event/ExecFlow/Job/Group.pm0000644000175000017500000004071511313134021020755 0ustar joernjoernpackage Event::ExecFlow::Job::Group; use base qw( Event::ExecFlow::Job ); use strict; use Scalar::Util qw(weaken); sub get_type { "group" } sub get_jobs { shift->{jobs} } sub get_fail_with_members { shift->{fail_with_members} } sub get_stop_on_failure { shift->{stop_on_failure} } sub get_parallel { shift->{parallel} } sub get_scheduler { shift->{scheduler} } sub get_member_finished_callbacks { shift->{member_finished_callbacks} } sub set_jobs { shift->{jobs} = $_[1] } sub set_fail_with_members { shift->{fail_with_members} = $_[1] } sub set_stop_on_failure { shift->{stop_on_failure} = $_[1] } sub set_parallel { shift->{parallel} = $_[1] } sub set_member_finished_callbacks { shift->{member_finished_callbacks} = $_[1] } sub new { my $class = shift; my %par = @_; my ($jobs, $fail_with_members, $stop_on_failure) = @par{'jobs','fail_with_members','stop_on_failure'}; my ($parallel, $scheduler, $member_finished_callbacks) = @par{'parallel','scheduler','member_finished_callbacks'}; $jobs = [] unless defined $jobs; $fail_with_members = 1 unless defined $fail_with_members; $stop_on_failure = 1 unless defined $stop_on_failure; my $self = $class->SUPER::new(@_); for my $cb ( $member_finished_callbacks ) { $cb ||= Event::ExecFlow::Callbacks->new; $cb = Event::ExecFlow::Callbacks->new($cb) if ref $cb eq 'CODE'; } $self->set_jobs($jobs); $self->set_fail_with_members($fail_with_members); $self->set_stop_on_failure($stop_on_failure); $self->set_parallel($parallel); $self->set_scheduler($scheduler); $self->set_member_finished_callbacks($member_finished_callbacks); return $self; } sub set_frontend { my $self = shift; my ($frontend) = @_; $self->SUPER::set_frontend($frontend); $_->set_frontend($frontend) for @{$self->get_jobs}; return $frontend; } sub set_scheduler { my $self = shift; my ($scheduler) = @_; $self->{scheduler} = $scheduler; foreach my $job ( @{$self->get_jobs} ) { $job->set_scheduler($scheduler) if $job->get_type eq 'group'; } return $scheduler; } sub get_exec_type { my $self = shift; my $job = $self->get_next_job; return "sync" if not $job; return $job->get_exec_type; } sub get_diskspace_consumed { my $self = shift; my $sum = $self->SUPER::get_diskspace_consumed; $sum += $_->get_diskspace_consumed for @{$self->get_jobs}; return $sum; } sub get_diskspace_freed { my $self = shift; my $sum = $self->SUPER::get_diskspace_freed; $sum += $_->get_diskspace_freed for @{$self->get_jobs}; return $sum; } sub init { my $self = shift; $self->SUPER::init(); foreach my $job ( @{$self->get_jobs} ) { $job->set_group($self); weaken($job->{group}); $self->add_child_post_callback($job); } $self->set_progress_max($self->get_job_cnt); 1; } sub reset_non_finished_jobs { my $self = shift; if ( $self->get_state ne 'finished' ) { $self->set_state("waiting"); $self->set_cancelled(0); $self->set_error_message(); $self->get_frontend->report_job_progress($self); } foreach my $job ( @{$self->get_jobs} ) { if ( $job->get_state ne 'finished' ) { $job->set_state("waiting"); $job->set_cancelled(0); $job->set_error_message(); $self->get_frontend->report_job_progress($job); } $job->reset_non_finished_jobs if $job->get_type eq 'group'; } 1; } sub get_job_cnt { my $self = shift; my $cnt = 0; foreach my $job ( @{$self->get_jobs} ) { $cnt += $job->get_job_cnt; } return $cnt; } sub init_progress_state { my $self = shift; my $progress_cnt = 0; foreach my $job ( @{$self->get_jobs} ) { if ( $job->get_type eq 'group' ) { $job->init_progress_state; $progress_cnt += $job->get_progress_cnt; } else { ++$progress_cnt if $job->get_state eq 'finished' || $job->get_state eq 'error'; } } $self->set_progress_cnt($progress_cnt); $self->set_progress_max($self->get_job_cnt); $self->set_state("finished") if $self->get_progress_cnt == $self->get_progress_max; 1; } sub set_group_in_all_childs { my $self = shift; foreach my $job ( @{$self->get_jobs} ) { if ( $job->get_type eq 'group' ) { $job->set_group($self); weaken($job->{group}); $job->set_group_in_all_childs; } else { $job->set_group($self); weaken($job->{group}); } } 1; } sub increase_progress_max { my $self = shift; my ($add) = @_; my $job = $self; while ( $job ) { $job->set_progress_max($job->get_progress_max + $add); $job = $job->get_group; } 1; } sub decrease_progress_max { my $self = shift; my ($del) = @_; my $job = $self; while ( $job ) { $job->set_progress_max($job->get_progress_max - $del); $job = $job->get_group; } 1; } sub increase_progress_cnt { my $self = shift; my ($add) = @_; my $job = $self; while ( $job ) { $job->set_progress_cnt($job->get_progress_cnt + $add); $job = $job->get_group; } 1; } sub decrease_progress_cnt { my $self = shift; my ($del) = @_; my $job = $self; while ( $job ) { $job->set_progress_cnt($job->get_progress_cnt - $del); $job = $job->get_group; } 1; } sub add_job { my $self = shift; my ($job) = @_; push @{$self->get_jobs}, $job; $job->set_frontend($self->get_frontend); $job->set_group($self); weaken($job->{group}); my $job_cnt = $job->get_job_cnt; $self->increase_progress_max($job_cnt) if $job_cnt != 0; if ( $self->get_state eq 'finished' || $self->get_state eq 'error' ) { $self->set_state("waiting"); } $self->add_child_post_callback($job); $self->get_frontend->report_job_added($job); 1; } sub remove_job { my $self = shift; my ($job) = @_; my $jobs = $self->get_jobs; my $i; for ( $i=0; $i < @{$jobs}; ++$i ) { last if $jobs->[$i] eq $job; } die "Job with ID ".$job->get_id." no member of this group" if $i == @{$jobs}; splice @{$jobs}, $i, 1; my $job_cnt = $job->get_job_cnt; $self->decrease_progress_max($job_cnt) if $job_cnt != 0; $self->get_frontend->report_job_removed($job); 1; } sub get_job_by_name { my $self = shift; my ($job_name) = @_; foreach my $job ( @{$self->get_jobs} ) { return $job if $job->get_name eq $job_name; } die "Job '$job_name' not member of group '".$self->get_name."'"; } sub execute { my $self = shift; my %par = @_; my ($skip) = $par{'skip'}; $skip = "" if ! defined $skip; my $blocked_job; while ( 1 ) { if ( $self->get_cancelled || $self->all_jobs_finished || ( $self->get_error_message && $self->get_stop_on_failure ) ) { $self->execution_finished; if ( $self->get_scheduler && $self->get_scheduler->is_exclusive ) { $self->get_scheduler->run; } return; } return if $self->get_scheduler && $self->get_scheduler->is_exclusive; my $job = $self->get_next_job(blocked=>$blocked_job); next if defined $job && "$job" eq "$skip"; if ( !$job ) { $self->try_reschedule_jobs(skip => $skip); last; } if ( $self->get_scheduler ) { my $state = $self->get_scheduler->schedule_job($job); return if $state eq 'sched-blocked'; if ( $state eq 'job-blocked' ) { $blocked_job = $job; next; } die "Illegal scheduler state '$state'" unless $state eq 'ok'; } $self->start_child_job($job); last if !$self->get_parallel; } 1; } sub try_reschedule_jobs { my $self = shift; my %par = @_; my ($skip) = $par{'skip'}; my $executed = 0; foreach my $job ( @{$self->get_jobs} ) { next if "$job" eq "$skip"; # Parallel execution groups which are running now # probably can execute more job, so give it a try. if ( $job->get_type eq 'group' && $job->get_state eq 'running' && $job->get_parallel ) { $job->execute; $executed = 1; } } if ( !$executed && $self->get_group ) { $self->get_group->execute(skip => $self); } 1; } sub cancel { my $self = shift; $self->set_cancelled(1); $_->get_state eq 'running' && $_->cancel for @{$self->get_jobs}; 1; } sub pause_job { my $self = shift; $_->get_state eq 'running' && $_->pause for @{$self->get_jobs}; 1; } sub reset { my $self = shift; foreach my $job ( @{$self->get_jobs} ) { if ( $job->reset ) { $self->decrease_progress_cnt($job->get_job_cnt); } } $self->get_frontend->report_job_progress($self); return $self->SUPER::reset() if $self->get_progress_cnt == 0; 0; } sub add_child_post_callback { my $self = shift; my ($job) = @_; if ( $job->{_post_callbacks_added} ) { return; require Carp; Carp::confess($job->get_info.": callbacks added twice!"); } $job->{_post_callbacks_added} = 1; $job->get_post_callbacks->add( sub { my ($job) = @_; $self->child_job_finished($job); 1; }); 1; } sub start_child_job { my $self = shift; my ($job) = @_; $Event::ExecFlow::DEBUG && print "Group->start_child_job(".$job->get_info.")\n"; $self->set_progress_cnt(0) unless defined $self->get_progress_cnt; $self->get_frontend->report_job_progress($self); $job->start; 1; } sub child_job_finished { my $self = shift; my ($job) = @_; $Event::ExecFlow::DEBUG && print "Group->child_job_finished(".$job->get_info.")\n"; $self->get_member_finished_callbacks->execute() if $self->get_member_finished_callbacks; if ( $job->get_error_message && !$job->get_cancelled ) { if ( $self->get_fail_with_members ) { $self->set_state("error"); $self->add_job_error_message($job); $self->get_frontend->report_job_error($self); } } if ( $self->get_scheduler ) { $self->get_scheduler->job_finished($job); } $self->execute; 1; } sub add_job_error_message { my $self = shift; my ($job) = @_; my $error_message = $self->get_error_message || ""; $error_message .= "Job '".$job->get_info."' ". "failed with error message:\n". $job->get_error_message."\n". ("-"x80)."\n"; $self->set_error_message($error_message); 1; } sub get_first_job { my $self = shift; return $self->get_jobs->[0]; } sub get_next_job { my $self = shift; my %par = @_; my ($blocked) = $par{'blocked'}; $blocked = "" if ! defined $blocked; my $next_job; foreach my $job ( @{$self->get_jobs} ) { next if defined $job && "$job" eq "$blocked"; $Event::ExecFlow::DEBUG && print "Group(".$self->get_info.")->get_next_job: check ".$job->get_info."=>".$job->get_state."\n"; if ( $job->get_state eq 'waiting' && $self->dependencies_ok($job) ) { $next_job = $job; last; } } $Event::ExecFlow::DEBUG && print "Group(".$self->get_info.")->get_next_job=". ($next_job ? $next_job->get_info : "NOJOB")."\n"; return $next_job; } sub dependencies_ok { my $self = shift; my ($job) = @_; foreach my $dep_job_name ( @{$job->get_depends_on} ) { my $dep_job = $self->get_job_by_name($dep_job_name); $Event::ExecFlow::DEBUG && print "Job(".$job->get_info.")->dependencies_ok: check ".$dep_job->get_info." =>".$dep_job->get_state."\n"; return if $dep_job->get_state ne 'finished'; } return 1; } sub all_jobs_finished { my $self = shift; foreach my $job ( @{$self->get_jobs} ) { return 0 if $job->get_state eq 'waiting' || $job->get_state eq 'error' || $job->get_state eq 'running'; } return 1; } sub get_max_diskspace_consumed { my $self = shift; my ($currently_consumed, $max_consumed) = @_; foreach my $job ( @{$self->get_jobs} ) { ($currently_consumed, $max_consumed) = $job->get_max_diskspace_consumed ($currently_consumed, $max_consumed); } return ($currently_consumed, $max_consumed); } sub backup_state { my $self = shift; my $data_href = $self->SUPER::backup_state(); delete $data_href->{jobs}; delete $data_href->{scheduler}; delete $data_href->{member_finished_callbacks}; my $jobs = $self->get_jobs; foreach my $job ( @{$jobs} ) { push @{$data_href->{jobs}}, $job->backup_state; } return $data_href; } sub restore_state { my $self = shift; my ($data_href) = @_; my $jobs = $self->get_jobs; $self->SUPER::restore_state($data_href); my $job_states = delete $self->{jobs}; my $i = 0; foreach my $job ( @{$jobs} ) { $job->restore_state($job_states->[$i]); ++$i; } $self->set_jobs($jobs); 1; } sub add_stash_to_all_jobs { my $self = shift; my ($add_stash) = @_; $self->add_stash($add_stash); foreach my $job ( @{$self->get_jobs} ) { if ( $job->get_type eq 'group' ) { $job->add_stash_to_all_jobs($add_stash); } else { $job->add_stash($add_stash); } } } sub traverse_all_jobs { my $self = shift; my ($code) = @_; foreach my $job ( @{$self->get_jobs} ) { $code->($job); if ( $job->get_type eq 'group' ) { $job->traverse_all_jobs($code); } } 1; } sub get_job_with_id { my $self = shift; my ($job_id) = @_; my $job; $self->traverse_all_jobs(sub{ $job = $_[0] if $_[0]->get_id eq $job_id; }); return $job; } 1; __END__ =head1 NAME Event::ExecFlow::Job::Group - Build a group of jobs =head1 SYNOPSIS Event::ExecFlow::Job::Group->new ( jobs => List of job group members, fail_with_members => Boolean whether group should fail with its members, stop_on_failure => Boolean whether execuction should stop on failure, parallel => Boolean whether members may be executed in parallel, scheduler => Scheduler object for add. control of par. execution, ... Event::ExecFlow::Job attributes ); =head1 DESCRIPTION Use this module to group together jobs of any type, including groups, which results in arbitrary complex nested job plans. =head1 OBJECT HIERARCHY Event::ExecFlow Event::ExecFlow::Job +--- Event::ExecFlow::Job::Group Event::ExecFlow::Frontend Event::ExecFlow::Callbacks =head1 ATTRIBUTES Attributes can by accessed at runtime using the common get_ATTR(), set_ATTR() style accessors. [ FIXME: describe all attributes in detail ] =head1 METHODS [ FIXME: describe all methods in detail ] =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright 2005-2006 by Jörn Reder. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA. =cut Event-ExecFlow-0.64/lib/Event/ExecFlow/Job/Command.pm0000644000175000017500000002060011313135455021242 0ustar joernjoernpackage Event::ExecFlow::Job::Command; use base qw( Event::ExecFlow::Job ); use Locale::TextDomain $Event::ExecFlow::locale_textdomain; use strict; use AnyEvent; # prevent warnings from AnyEvent { package AnyEvent::Impl::Event::CondVar; package AnyEvent::Impl::Event::Glib; } sub get_type { "command" } sub get_exec_type { "async" } #------------------------------------------------------------------------ sub get_command { shift->{command} } sub get_fetch_output { shift->{fetch_output} } sub get_node { shift->{node} } sub get_output { shift->{output} } sub get_progress_parser { shift->{progress_parser} } sub get_got_exec_ok { shift->{got_exec_ok} } sub get_configure_callback { shift->{configure_callback} } sub set_command { shift->{command} = $_[1] } sub set_fetch_output { shift->{fetch_output} = $_[1] } sub set_node { shift->{node} = $_[1] } sub set_output { shift->{output} = $_[1] } sub set_progress_parser { shift->{progress_parser} = $_[1] } sub set_got_exec_ok { shift->{got_exec_ok} = $_[1] } sub set_configure_callback { shift->{configure_callback} = $_[1] } #------------------------------------------------------------------------ sub get_pids { shift->{pids} } sub get_fh { shift->{fh} } sub get_watcher { shift->{watcher} } sub get_executed_command { shift->{executed_command} } sub set_pids { shift->{pids} = $_[1] } sub set_fh { shift->{fh} = $_[1] } sub set_watcher { shift->{watcher} = $_[1] } sub set_executed_command { shift->{executed_command} = $_[1] } #------------------------------------------------------------------------ sub new { my $class = shift; my %par = @_; my ($command, $fetch_output, $node, $progress_parser) = @par{'command','fetch_output','node','progress_parser'}; my ($configure_callback) = $par{'configure_callback'}; my $self = $class->SUPER::new(@_); $self->set_command($command); $self->set_fetch_output($fetch_output); $self->set_node($node); $self->set_progress_parser($progress_parser); $self->set_configure_callback($configure_callback); return $self; } sub init { my $self = shift; $self->SUPER::init(); $self->set_pids([]); $self->set_fh(); $self->set_watcher(); $self->set_output(""); 1; } sub execute { my $self = shift; $self->open_pipe; 1; } sub open_pipe { my $self = shift; my $command = $self->get_command; if ( ref $command eq 'CODE' ) { $Event::ExecFlow::JOB = $self; $command = $command->($self); $Event::ExecFlow::JOB = undef; } if ( $self->get_configure_callback ) { my $cb = $self->get_configure_callback; $command = &$cb($command); } if ( $self->get_node ) { $command = $self->get_node->prepare_command($command, $self); } $command =~ s/\s+$//; my $execflow = $command =~ /execflow/ ? "" : "execflow "; $command = $execflow.$command; $command .= " && echo EXECFLOW_OK" if $command !~ /EXECFLOW_OK/; $self->log (__x("Executing command: {command}", command => $command)); $Event::ExecFlow::DEBUG && print "Command(".$self->get_info."): command=$command\n"; $self->set_executed_command($command); local $ENV{LC_ALL} = "C"; local $ENV{LANG} = "C"; my $pid = open (my $fh, "( $command ) 2>&1 |") or die "can't fork '$command'"; my $watcher = AnyEvent->io ( fh => $fh, poll => 'r', cb => sub { $self->command_progress; }); push @{$self->get_pids}, $pid; $self->set_fh($fh); $self->set_watcher($watcher); return $fh; } sub close_pipe { my $self = shift; $self->set_watcher(undef); close($self->get_fh); $self->set_fh(undef); $self->set_pids([]); if ( !$self->get_error_message && !$self->get_got_exec_ok ) { $self->set_error_message( "Command exits with failure code:\n". "Command: ".$self->get_executed_command."\n\n". "Output: ".$self->get_output ); } 1; } sub command_progress { my $self = shift; my $fh = $self->get_fh; #-- read and check for eof my $buffer; if ( !sysread($fh, $buffer, 4096) ) { $self->close_pipe; $self->execution_finished; return; } #-- get job's PID my ($pid) = ( $buffer =~ /EXEC_FLOW_JOB_PID=(\d+)/ ); if ( defined $pid ) { push @{$self->get_pids}, $pid; $buffer =~ s/EXEC_FLOW_JOB_PID=(\d+)\n//; } #-- succesfully executed? if ( $buffer =~ s/EXECFLOW_OK\n// ) { $self->set_got_exec_ok(1); } #-- store output if ( $self->get_fetch_output ) { $self->{output} .= $buffer; } else { $self->{output} = substr($self->{output}.$buffer,-16384); } #-- parse output & report progress my $progress_parser = $self->get_progress_parser; if ( ref $progress_parser eq 'CODE' ) { $progress_parser->($self, $buffer); } elsif ( ref $progress_parser eq 'Regexp' ) { if ( $buffer =~ $progress_parser ) { $self->set_progress_cnt($1); } } $self->get_frontend->report_job_progress($self) if $self->progress_has_changed; 1; } sub cancel { my $self = shift; $self->set_cancelled(1); my $pids = $self->get_pids; return unless @{$pids}; kill 9, @{$pids}; $self->log(__x("Sending signal 9 to PID(s)")." ".join(", ", @{$pids})); 1; } sub pause_job { my $self = shift; my $signal; if ( $self->get_paused ) { $signal = "STOP"; } else { $signal = "CONT"; } my $pids = $self->get_pids; kill $signal, @{$pids} if @{$pids}; 1; } sub backup_state { my $self = shift; my $data_href = $self->SUPER::backup_state(); delete $data_href->{configure_callback}; delete $data_href->{progress_parser}; delete $data_href->{node}; delete $data_href->{watcher}; delete $data_href->{fh}; delete $data_href->{command} if ref $data_href->{command} eq 'CODE'; return $data_href; } 1; __END__ =head1 NAME Event::ExecFlow::Job::Command - External command for async execution =head1 SYNOPSIS Event::ExecFlow::Job::Command->new ( command => Shell command to be executed, fetch_output => Boolean if output should be fetched, progress_parser => A closure or regex for progress parsing, configure_callback => A closure to configure the command before execution, ... Event::ExecFlow::Job attributes ); =head1 DESCRIPTION Use this module for asynchronous execution of an external command with Event::ExecFlow. =head1 OBJECT HIERARCHY Event::ExecFlow Event::ExecFlow::Job +--- Event::ExecFlow::Job::Command Event::ExecFlow::Frontend Event::ExecFlow::Callbacks =head1 ATTRIBUTES Attributes can by accessed at runtime using the common get_ATTR(), set_ATTR() style accessors. [ FIXME: describe all attributes in detail ] =head1 METHODS [ FIXME: describe all methods in detail ] =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright 2005-2006 by Jörn Reder. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA. =cut Event-ExecFlow-0.64/lib/Event/ExecFlow/Scheduler.pm0000644000175000017500000000440010413740455021072 0ustar joernjoernpackage Event::ExecFlow::Scheduler; use strict; sub is_exclusive { 0 } sub schedule_job { die ref(shift)." missing schedule_job() implementation" } sub job_finished { die ref(shift)." missing job_finished() implementation" } 1; __END__ =head1 NAME Event::ExecFlow::Scheduler - Abstract class for parallel scheduling =head1 SYNOPSIS #-- Create a new Scheduler object my $scheduler = Event::ExecFlow::Scheduler::XYZ->new ( ... ); #-- Attach scheduler to a group job with parallel execution $group_job->set_parallel(1); $group_job->set_scheduler($scheduler); #-- The following methods gets called by Event::ExecFlow #-- at runtime $scheduler->schedule_job($job); $scheduler->job_finished($job); =head1 DESCRIPTION This abstract base class represents just an interface which needs to be implemented by custom schedulers for controlling the execution of jobs in a Event::ExecFlow::Group which has the parallel option set. Event::ExecFlow ships a very simple example for a scheduler which just limits the maximum number of parallel executed jobs: Event::ExecFlow::Scheduler::SimpleMax. =head1 OBJECT HIERARCHY Event::ExecFlow Event::ExecFlow::Job +--- Event::ExecFlow::Job::Group +--- Event::ExecFlow::Job::Command +--- Event::ExecFlow::Job::Code Event::ExecFlow::Frontend Event::ExecFlow::Callbacks Event::ExecFlow::Scheduler +--- Event::ExecFlow::Scheduler::SimpleMax =head1 METHODS [ FIXME: describe all methods in detail ] =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright 2005-2006 by Jörn Reder. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA. =cut Event-ExecFlow-0.64/lib/Event/ExecFlow/Job.pm0000644000175000017500000004354411313135327017676 0ustar joernjoernpackage Event::ExecFlow::Job; use strict; use Carp; use Locale::TextDomain $Event::ExecFlow::locale_textdomain; sub get_id { shift->{id} } sub get_title { shift->{title} } sub get_name { shift->{name} } sub get_depends_on { shift->{depends_on} } sub get_state { shift->{state} } sub get_cancelled { shift->{cancelled} } sub get_error_message { shift->{error_message} } sub get_warning_message { shift->{warning_message} } sub get_progress_max { shift->{progress_max} } sub get_progress_cnt { shift->{progress_cnt} } sub get_progress_start_time { shift->{progress_start_time} } sub get_progress_end_time { shift->{progress_end_time} } sub get_progress_ips { shift->{progress_ips} } sub get_no_progress { shift->{no_progress} } sub get_last_progress { shift->{last_progress} } sub get_last_percent_logged { shift->{last_percent_logged} } sub get_pre_callbacks { shift->{pre_callbacks} } sub get_post_callbacks { shift->{post_callbacks} } sub get_error_callbacks { shift->{error_callbacks} } sub get_warning_callbacks { shift->{warning_callbacks} } sub get_frontend { shift->{frontend} } sub get_group { shift->{group} } sub get_diskspace_consumed { shift->{diskspace_consumed} } sub get_diskspace_freed { shift->{diskspace_freed} } sub get_stash { shift->{stash} } sub get_paused { shift->{paused} } sub get_paused_seconds { shift->{paused_seconds} } sub get_paused_start_time { shift->{paused_start_time} } sub get_skipped { shift->{skipped} } sub set_title { shift->{title} = $_[1] } sub set_name { shift->{name} = $_[1] } sub set_state { shift->{state} = $_[1] } sub set_error_message { shift->{error_message} = $_[1] } sub set_warning_message { shift->{warning_message} = $_[1] } sub set_progress_max { shift->{progress_max} = $_[1] } sub set_progress_cnt { shift->{progress_cnt} = $_[1] } sub set_progress_start_time { shift->{progress_start_time} = $_[1] } sub set_progress_end_time { shift->{progress_end_time} = $_[1] } sub set_progress_ips { shift->{progress_ips} = $_[1] } sub set_no_progress { shift->{no_progress} = $_[1] } sub set_last_progress { shift->{last_progress} = $_[1] } sub set_last_percent_logged { shift->{last_percent_logged} = $_[1] } sub set_pre_callbacks { shift->{pre_callbacks} = $_[1] } sub set_post_callbacks { shift->{post_callbacks} = $_[1] } sub set_error_callbacks { shift->{error_callbacks} = $_[1] } sub set_warning_callbacks { shift->{warning_callbacks} = $_[1] } sub set_frontend { shift->{frontend} = $_[1] } sub set_group { shift->{group} = $_[1] } sub set_diskspace_consumed { shift->{diskspace_consumed} = $_[1] } sub set_diskspace_freed { shift->{diskspace_freed} = $_[1] } sub set_stash { shift->{stash} = $_[1] } sub set_paused { shift->{paused} = $_[1] } sub set_paused_seconds { shift->{paused_seconds} = $_[1] } sub set_paused_start_time { shift->{paused_start_time} = $_[1] } sub set_skipped { shift->{skipped} = $_[1] } sub set_depends_on { my $self = shift; my ($jobs_lref) = @_; my @job_names = map { ref $_ ? $_->get_name : $_ } @{$jobs_lref}; $self->{depends_on} = \@job_names; return \@job_names; } sub set_cancelled { my $self = shift; my ($cancelled) = @_; $self->{cancelled} = $cancelled; $self->set_state($cancelled ? "cancelled":"waiting"); return $cancelled; } sub finished_ok { my $self = shift; return !$self->get_cancelled && !$self->get_error_message; } my $JOB_ID = (time - 1140691085) * 1_000_000; sub new { my $class = shift; my %par = @_; my ($title, $name, $depends_on, $pre_callbacks) = @par{'title','name','depends_on','pre_callbacks'}; my ($post_callbacks, $error_callbacks, $warning_callbacks) = @par{'post_callbacks','error_callbacks','warning_callbacks'}; my ($progress_cnt, $progress_max, $progress_ips, $no_progress) = @par{'progress_cnt','progress_max','progress_ips','no_progress'}; my ($diskspace_consumed, $diskspace_freed, $stash, $frontend) = @par{'diskspace_consumed','diskspace_freed','stash','frontend'}; my $id = ++$JOB_ID; $depends_on ||= []; $stash ||= {}; $name ||= '~'.$id; croak "Job '$name' depends on itself" if grep { $_ eq $name } @{$depends_on}; for my $cb ( $pre_callbacks, $post_callbacks, $error_callbacks, $warning_callbacks ) { $cb ||= Event::ExecFlow::Callbacks->new; $cb = Event::ExecFlow::Callbacks->new($cb) if ref $cb eq 'CODE'; } my $self = bless { id => $id, title => $title, name => $name, depends_on => $depends_on, state => 'waiting', diskspace_consumed => $diskspace_consumed, diskspace_freed => $diskspace_freed, progress_cnt => $progress_cnt, progress_max => $progress_max, progress_ips => $progress_ips, no_progress => $no_progress, pre_callbacks => $pre_callbacks, post_callbacks => $post_callbacks, error_callbacks => $error_callbacks, warning_callbacks => $warning_callbacks, stash => $stash, frontend => $frontend, paused_seconds => 0, last_percent_logged => 0, group => undef, }, $class; $self->set_depends_on($depends_on); return $self; } sub init { my $self = shift; return if $self->get_state ne 'waiting' && $self->get_state ne 'running'; $self->set_state("waiting"); $self->set_progress_start_time(time); $self->set_progress_end_time(); $self->set_cancelled(); $self->set_error_message(); $self->set_last_percent_logged(0); $self->set_last_progress(); $self->set_progress_cnt(0); 1; } sub start { my $self = shift; $Event::ExecFlow::DEBUG && print "Job->start(".$self->get_info.")\n"; if ( !$self->get_frontend ) { require Event::ExecFlow::Frontend; $self->set_frontend(Event::ExecFlow::Frontend->new); } $self->init; $self->set_state("running"); $self->get_frontend->report_job_start($self); $self->get_pre_callbacks->execute($self); if ( $self->get_error_message ) { $self->execution_finished; return 0; } if ( $self->get_warning_message ) { $self->get_warning_callbacks->execute($self); $self->get_frontend->report_job_warning($self); } if ( $self->get_skipped ) { # may be set by pre_callbacks $self->execution_finished; return 0; } $self->execute; 1; } sub reset { my $self = shift; return if $self->get_state eq 'running' or $self->get_state eq 'waiting'; $self->set_state("waiting"); $self->set_progress_start_time(); $self->set_progress_end_time(); $self->set_cancelled(); $self->set_error_message(); $self->set_last_percent_logged(0); $self->set_last_progress(); $self->set_progress_cnt(0); $self->get_frontend->report_job_progress($self); 1; } sub cancel { die "Missing implementation for method cancel() of object ".shift; } sub execute { die "Missing implementation for method execute() of object ".shift; } sub pause { my $self = shift; $self->set_paused(!$self->get_paused); $self->pause_job; if ( $self->get_paused ) { $self->set_paused_start_time(time); } else { my $start_time = $self->get_paused_start_time; my $duration = time - $start_time; $self->set_paused_seconds($duration + $self->get_paused_seconds); $self->set_paused_start_time(); } 1; } sub execution_finished { my $self = shift; $Event::ExecFlow::DEBUG && print "Job->execution_finished(".$self->get_info.")\n"; $self->set_progress_end_time(time); $self->get_frontend->report_job_progress($self); if ( !$self->get_cancelled ) { if ( $self->get_error_message ) { $self->set_state("error"); } else { $self->set_state("finished"); } } $self->get_post_callbacks->execute($self); $self->set_state("error") if $self->get_error_message; $self->get_frontend->report_job_finished($self); if ( !$self->get_cancelled ) { if ( $self->get_error_message ) { $self->get_error_callbacks->execute($self); $self->get_frontend->report_job_error($self); } if ( $self->get_warning_message ) { $self->get_warning_callbacks->execute($self); $self->get_frontend->report_job_warning($self); } } if ( $self->get_type ne 'group' and $self->get_state eq 'finished' ) { my $parent = $self; while ( $parent = $parent->get_group ) { $parent->set_progress_cnt($parent->get_progress_cnt+1); $self->get_frontend->report_job_progress($parent); } } 1; } sub emit_warning_message { my $self = shift; my ($warning) = @_; $self->get_frontend->report_job_warning($self, $warning); 1; } sub get_job_cnt { 1 } sub get_info { my $self = shift; return $self->get_title || $self->get_name || "Unnamed"; } sub get_progress_fraction { my $self = shift; my $max = $self->get_progress_max || 0; my $cnt = $self->get_progress_cnt || 0; return $max == 0 ? 0 : $cnt / $max; } sub get_progress_percent { my $self = shift; return sprintf("%.2f", 100 * $self->get_progress_fraction); } sub get_progress_text { my $self = shift; return $self->get_info.": ".$self->get_progress_stats; } sub get_progress_stats { my $self = shift; my $cancelled = $self->get_cancelled ? "[".__("Cancelled")."]" : ""; $cancelled ||= $self->get_error_message ? "[".__("Error")."]" : ""; $cancelled ||= $self->get_skipped ? "[".__("Skipped")."]" : ""; return __("Waiting")." ".$cancelled if $self->get_state eq 'waiting'; my $cnt = $self->get_progress_cnt; my $max = $self->get_progress_max || 1; my $time = ( time - $self->get_progress_start_time - $self->get_paused_seconds ); my $ips_label = $self->get_progress_ips; my $ips = ""; if ( $self->get_progress_end_time ) { $time = $self->get_progress_end_time - $self->get_progress_start_time - $self->get_paused_seconds; my $text = __x( "Duration: {time}", time => $self->format_time($time) ); if ( $ips_label ) { $time ||= 1; $text .= ", $ips_label: ".sprintf( "%2.1f", $cnt / $time ); } return $text." ".$cancelled; } return $cancelled if $self->get_no_progress; return __("Initializing")." ".$cancelled if ! defined $cnt; $ips = sprintf( ", %2.1f $ips_label", $cnt / $time ) if $ips_label && $time; my $elapsed = ""; $elapsed = ", " . __x( "elapsed {time}", time => $self->format_time($time) ) if $self->get_type ne 'group'; my $percent = $self->get_progress_percent.'%'; $percent .= __" finished" if $self->get_type eq 'group'; my $eta = ""; $eta = ", ETA: " . $self->format_time( int( $time * $max / $cnt ) - $time + 1 ) if $time > 5 && $cnt != 0 && $self->get_type ne 'group'; my $int_percent = int( $cnt / $max * 100 ); if ( $int_percent > $self->get_last_percent_logged + 10 ) { $int_percent = int( $int_percent / 10 ) * 10; $self->set_last_percent_logged($int_percent); my $line = $self->get_info . ": " . __x( "{percent}PERCENT done.", percent => $int_percent ); $line =~ s/PERCENT/%/; $self->log($line); } $cancelled = " ".$cancelled if $cancelled; return "$percent$ips$elapsed$eta$cancelled"; } sub format_time { my $self = shift; my ($time) = @_; my ($h, $m, $s); $h = int($time/3600); $m = int(($time-$h*3600)/60); $s = $time % 60; return sprintf ("%02d:%02d", $m, $s) if $h == 0; return sprintf ("%02d:%02d:%02d", $h, $m, $s); } sub log { my $self = shift; $self->get_frontend->log(@_); 1; } sub progress_has_changed { my $self = shift; my $last_progress = $self->get_last_progress||""; my $curr_progress = $self->get_progress_cnt."/".$self->get_progress_max; if ( $last_progress ne $curr_progress ) { $self->set_last_progress($curr_progress); return 1; } else { return 0; } } sub frontend_signal { my $self = shift; my ($signal, @args) = @_; my $method = "signal_$signal"; $self->get_frontend->$method(@args); 1; } sub get_max_diskspace_consumed { my $self = shift; my ($currently_consumed, $max_consumed) = @_; $currently_consumed += $self->get_diskspace_consumed; if ( $currently_consumed > $max_consumed ) { $max_consumed = $currently_consumed; } $currently_consumed -= $self->get_diskspace_freed; return ($currently_consumed, $max_consumed); } sub backup_state { my $self = shift; my %data = %{$self}; delete @data{ qw( pre_callbacks post_callbacks error_callbacks warning_callbacks frontend group _post_callbacks_added ) }; $data{type} = $self->get_type; return \%data; } sub restore_state { my $self = shift; my ($data_href) = @_; if ( $data_href->{type} ne $self->get_type ) { die "Can't restore job state due to data type mismatch: ". "Job type=".$self->get_type.", ". "Data type=".$data_href->{type}; } foreach my $key ( keys %{$data_href} ) { $self->{$key} = $data_href->{$key}; } delete $self->{type}; $self->set_state("waiting") if $self->get_state eq 'running'; 1; } sub add_stash { my $self = shift; my ($add_stash) = @_; my $stash = $self->get_stash; while ( my ($k, $v) = each %{$add_stash} ) { $stash->{$k} = $v; } 1; } sub get_job_with_id { my $self = shift; my ($job_id) = @_; return $self if $job_id eq $self->get_id; return; } 1; __END__ =head1 NAME Event::ExecFlow::Job - Abstract base class for all job classes =head1 SYNOPSIS Event::ExecFlow::Job->new ( title => Descriptive title, name => Internal short name, depends_on => Names of jobs, this job depends on, progress_max => Maximum expected progress value, progress_ips => String to show as "items per second", no_progress => Job has no progress state at all, pre_callbacks => Callbacks executed before job starts, post_callbacks => Callbacks executed after job finished, error_callbacks => Callbacks executed if job had errors, warning_callbacks => Callbacks executed if job had warnings, stash => A custom data hash stored with the job, ); =head1 DESCRIPTION This is an abstract base class and usually not used directly from the application. For daily programming the attributes defined in this class are most important, since they are common to all Jobs of the Event::ExecFlow framework. =head1 OBJECT HIERARCHY Event::ExecFlow Event::ExecFlow::Job +--- Event::ExecFlow::Job::Group +--- Event::ExecFlow::Job::Command +--- Event::ExecFlow::Job::Code Event::ExecFlow::Frontend Event::ExecFlow::Callbacks Event::ExecFlow::Scheduler +--- Event::ExecFlow::Scheduler::SimpleMax =head1 ATTRIBUTES Attributes may be set with the new() constructor passed as a hash and accessed at runtime using the common get_ATTR(), set_ATTR() style accessors. [ FIXME: describe all attributes in detail ] =head1 METHODS [ FIXME: describe all methods in detail ] =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright 2005-2006 by Jörn Reder. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA. =cut Event-ExecFlow-0.64/lib/Event/ExecFlow/Frontend.pm0000644000175000017500000000604110400606534020731 0ustar joernjoernpackage Event::ExecFlow::Frontend; use strict; use Carp; sub new { my $class = shift; my $self = bless {}, $class; return $self; } sub start_job { my $self = shift; my ($job) = @_; $job->set_frontend($self); $job->start; 1; } #--------------------------------------------------------------------- # Dummy implementation, needs to by overridden by application class #--------------------------------------------------------------------- sub report_job_added { my $self = shift; my ($job) = @_; 1; } sub report_job_start { my $self = shift; my ($job) = @_; 1; } sub report_job_progress { my $self = shift; my ($job) = @_; 1; } sub report_job_error { my $self = shift; my ($job) = @_; 1; } sub report_job_warning { my $self = shift; my ($job, $message) = @_; $message ||= $job->get_warning_message; 1; } sub report_job_finished { my $self = shift; my ($job) = @_; 1; } sub log { my $self = shift; my ($msg) = @_; } 1; __END__ =head1 NAME Event::ExecFlow::Frontend - Abstract base class for custom frontends =head1 SYNOPSIS #-- Derived from Event::ExecFlow::Frontend my $frontend = MyApp::GUI::Frontent->new(); my $job = Event::ExecFlow::Job::Command->new ( ... ); $frontend->start_job($job); #-- Later the following methods are called and need to #-- by implemented by you $frontend->report_job_start($job); $frontend->report_job_progress($job); $frontend->report_job_error($job); $frontend->report_job_warning($job); $frontend->report_job_finished($job); $frontend->log($message); =head1 DESCRIPTION This is an abstract base class and usually not used directly from the application. For daily programming the attributes defined in this class are most important, since they are common to all Jobs of the Event::ExecFlow framework. =head1 OBJECT HIERARCHY Event::ExecFlow Event::ExecFlow::Job +--- Event::ExecFlow::Job::Group +--- Event::ExecFlow::Job::Command +--- Event::ExecFlow::Job::Code Event::ExecFlow::Frontend Event::ExecFlow::Callbacks Event::ExecFlow::Scheduler +--- Event::ExecFlow::Scheduler::SimpleMax =head1 METHODS [ FIXME: describe all methods in detail ] =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright 2005-2006 by Jörn Reder. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA. =cut Event-ExecFlow-0.64/lib/Event/ExecFlow/Scheduler/0000755000175000017500000000000011313136550020531 5ustar joernjoernEvent-ExecFlow-0.64/lib/Event/ExecFlow/Scheduler/SimpleMax.pm0000644000175000017500000000533310400606534022772 0ustar joernjoernpackage Event::ExecFlow::Scheduler::SimpleMax; use strict; use base qw ( Event::ExecFlow::Scheduler ); sub get_max { shift->{max} } sub get_cnt { shift->{cnt} } sub set_max { shift->{max} = $_[1] } sub set_cnt { shift->{cnt} = $_[1] } sub new { my $class = shift; my %par = @_; my ($max) = $par{'max'}; return bless { max => $max, cnt => 0, }, $class; } sub schedule_job { my $self = shift; my ($job) = @_; my $state; if ( $self->get_cnt >= $self->get_max ) { $state = 'sched-blocked'; } elsif ( $job->get_type ne 'group' ) { ++$self->{cnt}; $state = 'ok'; } else { $state = 'ok'; } return $state; } sub job_finished { my $self = shift; my ($job) = @_; --$self->{cnt} if $job->get_type ne 'group'; 1; } 1; __END__ =head1 NAME Event::ExecFlow::Scheduler::SimpleMax - Limit number of parallel executed jobs =head1 SYNOPSIS #-- Create a new Scheduler object my $scheduler = Event::ExecFlow::Scheduler::SimpleMax->new( max => 5 ); #-- Attach scheduler to a group job $group_job->set_parallel(1); $group_job->set_scheduler($scheduler); =head1 DESCRIPTION This is a simple scheduler which just limits the maximum number of parallel executed jobs. It's mainly an example implementation of the Event::ExecFlow::Scheduler interface, not really of big practical use ;) =head1 OBJECT HIERARCHY Event::ExecFlow Event::ExecFlow::Job +--- Event::ExecFlow::Job::Group +--- Event::ExecFlow::Job::Command +--- Event::ExecFlow::Job::Code Event::ExecFlow::Frontend Event::ExecFlow::Callbacks Event::ExecFlow::Scheduler +--- Event::ExecFlow::Scheduler::SimpleMax =head1 METHODS [ FIXME: describe all methods in detail ] =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright 2005-2006 by Jörn Reder. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA. =cut Event-ExecFlow-0.64/lib/Event/ExecFlow/Callbacks.pm0000644000175000017500000000565110411454747021050 0ustar joernjoernpackage Event::ExecFlow::Callbacks; use strict; sub get_cb_list { shift->{cb_list} } sub set_cb_list { shift->{cb_list} = $_[1] } sub new { my $class = shift; my @cb_list = @_; my $self = bless { cb_list => \@cb_list, }, $class; return $self; } sub prepend { my $self = shift; my (@cb) = @_; unshift @{$self->get_cb_list}, @cb; return $self; } sub add { my $self = shift; my (@cb) = @_; push @{$self->get_cb_list}, @cb; return $self; } sub execute { my $self = shift; my ($job) = @_; foreach my $cb ( @{$self->get_cb_list} ) { eval { $cb->(@_) }; print "Catched Callbacks Exception: $@" if $@; if ( $@ ) { $job->set_error_message($@); return 0; } } 1; } 1; __END__ =head1 NAME Event::ExecFlow::Callbacks - Callbacks attached to jobs =head1 SYNOPSIS #-- Create a new Callbacks object my $callbacks = Event::ExecFlow::Callbacks->new ( sub { print "sub called\n" }, sub { print "another sub of this called\n" }, ); #-- Attach callbacks to a job $job->set_pre_callbacks($callbacks); #-- Add more subs $callbacks->add(sub { print "a sub added later\n" }); $callbacks->prepend(sub { print "a sub prepended to the list of subs } ); #-- the execute() methods is executed later by Event::ExecFlow $callbacks->execute($job); =head1 DESCRIPTION This class represents one or more closures which can be attached as callbacks to an Event::ExecFlow::Job. =head1 OBJECT HIERARCHY Event::ExecFlow Event::ExecFlow::Job +--- Event::ExecFlow::Job::Group +--- Event::ExecFlow::Job::Command +--- Event::ExecFlow::Job::Code Event::ExecFlow::Frontend Event::ExecFlow::Callbacks Event::ExecFlow::Scheduler +--- Event::ExecFlow::Scheduler::SimpleMax =head1 ATTRIBUTES Attributes can by accessed at runtime using the common get_ATTR(), set_ATTR() style accessors. [ FIXME: describe all attributes in detail ] =head1 METHODS [ FIXME: describe all methods in detail ] =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright 2005-2006 by Jörn Reder. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA. =cut Event-ExecFlow-0.64/lib/Event/ExecFlow/Frontend/0000755000175000017500000000000011313136550020372 5ustar joernjoernEvent-ExecFlow-0.64/lib/Event/ExecFlow/Frontend/Term.pm0000644000175000017500000000411410607755560021654 0ustar joernjoernpackage Event::ExecFlow::Frontend::Term; use base qw( Event::ExecFlow::Frontend ); use AnyEvent; use strict; sub get_quiet { shift->{quiet} } sub get_nl_needed { shift->{nl_needed} } sub set_quiet { shift->{quiet} = $_[1] } sub set_nl_needed { shift->{nl_needed} = $_[1] } sub start_job { my $self = shift; my ($job) = @_; my $w = AnyEvent->condvar; $job->get_post_callbacks->add(sub { $w->broadcast }); $self->SUPER::start_job($job); $w->wait; 1; } sub report_job_start { my $self = shift; my ($job) = @_; return if $self->get_quiet; $self->new_line; print "START [".$job->get_name."]: ". $job->get_progress_text."\n"; 1; } sub report_job_progress { my $self = shift; my ($job) = @_; return if $self->get_quiet; print "PROGRESS [".$job->get_name."]: ". $job->get_progress_text." \r"; $self->set_nl_needed(1); 1; } sub report_job_error { my $self = shift; my ($job) = @_; return if $self->get_quiet; $self->new_line; print "ERROR [".$job->get_name."]:\n". $job->get_error_message."\n"; 1; } sub report_job_warning { my $self = shift; my ($job, $message) = @_; $message ||= $job->get_warning_message; $self->new_line; print "WARNING [".$job->get_name."]: $message\n"; 1; } sub report_job_finished { my $self = shift; my ($job) = @_; return if $self->get_quiet and $job->get_state eq 'finished'; $self->new_line; print "\nFINISHED [".$job->get_name."]: "; print $job->get_cancelled ? "CANCELLED\n" : $job->get_error_message ? "ERROR\n" : "OK\n"; 1; } sub new_line { my $self = shift; if ( $self->get_nl_needed ) { print "\n"; $self->set_nl_needed(0); } 1; } sub log { my $self = shift; my ($msg) = @_; return; print "LOG $msg\n"; 1; } 1; Event-ExecFlow-0.64/lib/Event/ExecFlow.pm0000644000175000017500000000732611313136436017164 0ustar joernjoernpackage Event::ExecFlow; $VERSION = "0.64"; sub import { my $class = shift; my ($domain) = @_; $domain ||= "event.execflow"; $Event::ExecFlow::locale_textdomain = $domain; require Event::ExecFlow::Frontend; require Event::ExecFlow::Callbacks; require Event::ExecFlow::Job::Command; require Event::ExecFlow::Job::Group; require Event::ExecFlow::Job::Code; 1; } $Event::ExecFlow::DEBUG = 0; 1; __END__ =head1 NAME Event::ExecFlow - High level API for event-based execution flow control =head1 NOTE This is release has nearly no documentation yet. If you're interested in the details please contact the author. =head1 ABSTRACT Event::ExecFlow provides a ligh level API for defining complex flow controls with asynchronous execution of external programs. =head1 SYNOPSIS use Event::ExecFlow; my $job = Event::ExecFlow::Job::Group->new ( jobs => [ Event::ExecFlow::Job::Command->new ( name => "transcode", title => "Transcoding DVD title to OGG", command => "transcode -i /dev/dvd ...", fetch_output => 1, progress_max => 4711, # number of frames progress_parser => sub { my ($job, $buffer) = @_; $job->set_progress_cnt($1) if $buffer =~ /\[\d+-(\d+)\]/; #-- or simply write this: #-- progress_parser => qr/\[\d+-(\d+)\]/, }, ), Event::ExecFlow::Job::Code->new ( name => "checks", title => "Do some checks", depends_on => [ "transcode" ], code => sub { my ($job) = @_; my $transcode = $job->get_group->get_job_by_name("transcode"); if ( $transcode->get_output !~ /.../ ) { $job->set_error_message("XY check failed"); } #-- this could be done easier as a post_callback added to #-- the "transcode" job above, but it's nevertheless a good #-- example for the 'Code' job type and shows how jobs can #-- interfere with each other. }, ), Event::ExecFlow::Job::Command->new ( title => "Muxing OGG file", depends_on => [ "checks" ], command => "ogmmerge ...", no_progress => 1, ), ], ); #-- this inherits from Event::ExecFlow::Frontend my $frontend = Video::DVDRip::GUI::ExecFlow->new(...); $frontend->start_job($job); =head1 DESCRIPTION Event::ExecFlow offers a high level API to declare jobs, which mainly execute external commands, parse their output to get progress or other status information, triggers actions when the command has been finished etc. Such jobs can be chained together in a recursive fashion to fulfill rather complex tasks which consist of many jobs. Additionally it defines an extensible API for communication with the frontend application, which may be a written using Gtk2, Tk or Qt or is a simple text console program. In case of Gtk2 a custom widget for displaying an Event::ExecFlow job plan, including progress updates, is shipped with the Gtk2::Ex::FormFactory package. =head1 REQUIREMENTS Event::ExecFlow requires the follwing Perl modules: AnyEvent >= 0.04 Locale::TextDomain Test::More =head1 INSTALLATION You get the latest installation tarballs and online documentation at this location: http://www.exit1.org/Event-ExecFlow/ If your system meets the requirements mentioned above, installation is just: perl Makefile.PL make test make install =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright 2005-2006 by Jörn Reder. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-ExecFlow-0.64/Changes0000644000175000017500000000305111313136532014542 0ustar joernjoern$Id: Changes,v 1.7 2009-12-19 11:47:38 joern Exp $ Revision history and release notes for Event::ExecFlow: 0.64 Sat Dec 19, 2009, joern Bugfixes: - Accumulated group member errors were not reported to the frontend. - Use Perl's builtin command execution with a subshell instead of forking. 0.63 Fri Apr 13, 2007, joern Features: - Improved output layout of Event::ExecFlow::Term. - Event::ExecFlow::Frontend::Term->set_quiet(1) will print just warning and error messages. - Added method Event::ExecFlow::Job->reset() Bugfixes: - Increase group progress on child finish only when it was successful. - Group considered itself finished even when a child job didn't finish successfully (cancelled or error). 0.62 Sat Jun 17, 2006, joern Features: - Executed programs are now set into C locale, so parsing output is independent from the locale settings. Bugfix: - set job into error state if post callbacks return with error. 0.61 Sun Apr 2, 2006, joern Notes: - added some helper methods to the Group class - scheduler stuff is still work in progress and needs some cleanup - shell commands maybe closures returning the shell code at runtime - fixed a bug with depends_on argument to constructor not processed correctly 0.60 Mon Mar 27, 2006, joern Notes: - First public CPAN release - API may change but should by fairly stable - Documentation is mainly missing yet, only PODs with SYNPOSIS and stub chapters. Event-ExecFlow-0.64/MANIFEST0000644000175000017500000000062310400603262014375 0ustar joernjoernChanges Makefile.PL README MANIFEST META.yml bin/execflow lib/Event/ExecFlow/Callbacks.pm lib/Event/ExecFlow/Frontend.pm lib/Event/ExecFlow/Frontend/Term.pm lib/Event/ExecFlow/Job/Code.pm lib/Event/ExecFlow/Job/Command.pm lib/Event/ExecFlow/Job/Group.pm lib/Event/ExecFlow/Job.pm lib/Event/ExecFlow.pm lib/Event/ExecFlow/Scheduler.pm lib/Event/ExecFlow/Scheduler/SimpleMax.pm t/02.parallel.t t/01.use.t Event-ExecFlow-0.64/META.yml0000644000175000017500000000105211313136551014520 0ustar joernjoern--- #YAML:1.0 name: Event-ExecFlow version: 0.64 abstract: ~ author: [] license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: AnyEvent: 0.4 Locale::TextDomain: 0 Test::More: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Event-ExecFlow-0.64/bin/0000755000175000017500000000000011313136550014020 5ustar joernjoernEvent-ExecFlow-0.64/bin/execflow0000755000175000017500000000070610400600113015550 0ustar joernjoern#!/usr/bin/perl # $Id: execflow,v 1.1 2006/02/27 13:36:11 joern Exp $ use strict; use Getopt::Std; my $USAGE = <<__EOU; Usage: execflow [-n nice] command options ... __EOU main: { my %opt; my $opt_ok = getopts ('n:', \%opt); usage() if not $opt_ok or !@ARGV; my $nice = $opt{n}; print STDERR "EXEC_FLOW_JOB_PID=$$\n"; exec "nice", "-n", $nice, @ARGV if $nice; exec @ARGV; } sub usage { print $USAGE; exit 1; } Event-ExecFlow-0.64/README0000644000175000017500000000676011313136551014142 0ustar joernjoernNAME Event::ExecFlow - High level API for event-based execution flow control NOTE This is release has nearly no documentation yet. If you're interested in the details please contact the author. ABSTRACT Event::ExecFlow provides a ligh level API for defining complex flow controls with asynchronous execution of external programs. SYNOPSIS use Event::ExecFlow; my $job = Event::ExecFlow::Job::Group->new ( jobs => [ Event::ExecFlow::Job::Command->new ( name => "transcode", title => "Transcoding DVD title to OGG", command => "transcode -i /dev/dvd ...", fetch_output => 1, progress_max => 4711, # number of frames progress_parser => sub { my ($job, $buffer) = @_; $job->set_progress_cnt($1) if $buffer =~ /\[\d+-(\d+)\]/; #-- or simply write this: #-- progress_parser => qr/\[\d+-(\d+)\]/, }, ), Event::ExecFlow::Job::Code->new ( name => "checks", title => "Do some checks", depends_on => [ "transcode" ], code => sub { my ($job) = @_; my $transcode = $job->get_group->get_job_by_name("transcode"); if ( $transcode->get_output !~ /.../ ) { $job->set_error_message("XY check failed"); } #-- this could be done easier as a post_callback added to #-- the "transcode" job above, but it's nevertheless a good #-- example for the 'Code' job type and shows how jobs can #-- interfere with each other. }, ), Event::ExecFlow::Job::Command->new ( title => "Muxing OGG file", depends_on => [ "checks" ], command => "ogmmerge ...", no_progress => 1, ), ], ); #-- this inherits from Event::ExecFlow::Frontend my $frontend = Video::DVDRip::GUI::ExecFlow->new(...); $frontend->start_job($job); DESCRIPTION Event::ExecFlow offers a high level API to declare jobs, which mainly execute external commands, parse their output to get progress or other status information, triggers actions when the command has been finished etc. Such jobs can be chained together in a recursive fashion to fulfill rather complex tasks which consist of many jobs. Additionally it defines an extensible API for communication with the frontend application, which may be a written using Gtk2, Tk or Qt or is a simple text console program. In case of Gtk2 a custom widget for displaying an Event::ExecFlow job plan, including progress updates, is shipped with the Gtk2::Ex::FormFactory package. REQUIREMENTS Event::ExecFlow requires the follwing Perl modules: AnyEvent >= 0.04 Locale::TextDomain Test::More INSTALLATION You get the latest installation tarballs and online documentation at this location: http://www.exit1.org/Event-ExecFlow/ If your system meets the requirements mentioned above, installation is just: perl Makefile.PL make test make install AUTHORS Jörn Reder COPYRIGHT AND LICENSE Copyright 2005-2006 by Jörn Reder. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Event-ExecFlow-0.64/Makefile.PL0000644000175000017500000000107510400577745015240 0ustar joernjoern# $Id: Makefile.PL,v 1.2 2006/02/27 13:34:29 joern Exp $ use strict; use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Event::ExecFlow', 'VERSION_FROM' => 'lib/Event/ExecFlow.pm', 'EXE_FILES' => [ 'bin/execflow' ], 'PREREQ_PM' => { 'Test::More' => 0, 'AnyEvent' => 0.4, 'Locale::TextDomain' => 0, }, 'dist' => { COMPRESS => "gzip", SUFFIX => "gz", PREOP => q[pod2text lib/Event/ExecFlow.pm > README], POSTOP => q[mkdir -p dist && mv Event-ExecFlow-*tar.gz dist/], }, );