Schedule-At-1.15/0000755000227400117050000000000011745442661012216 5ustar josearlcSchedule-At-1.15/At.pm0000755000227400117050000003160411745442310013116 0ustar josearlcpackage Schedule::At; require 5.004; # Copyright (c) 1997-2012 Jose A. Rodriguez. All rights reserved. # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. use vars qw($VERSION @ISA $TIME_FORMAT $SHELL); $VERSION = '1.15'; $SHELL = ''; ############################################################################### # Load configuration for this OS ############################################################################### use Config; my @configs = split (/\./, "$Config{'osname'}"); while (@configs) { my $subName = 'AtCfg_' . join('_', @configs); $subName =~ s/[^\w\d]/_/g; eval "&$subName"; # Call configuration subroutine last if !$@; pop @configs; } &AtCfg if $@; # Default configuration ############################################################################### # Public subroutines ############################################################################### $TIME_FORMAT = '%Q%H%M'; # Format for Date::Manip::DateUnix subroutine $TAGID = '##### Please, do not remove this Schedule::At TAG: '; sub add { my %params = @_; my $command = $AT{($params{FILE} ? 'addFile' : 'add')}; return &$command($params{JOBID}) if ref($command) eq 'CODE'; my $atTime = _std2atTime($params{TIME}); $command =~ s/%TIME%/$atTime/g; $command =~ s/%FILE%/$params{FILE}/g; if ($SHELL) { $command = "SHELL=$SHELL $command"; } if ($params{FILE}) { return (system($command) / 256); } else { # Ignore signal to die in case at commands fails local $SIG{'PIPE'} = 'IGNORE'; open (ATCMD, "| $command"); print ATCMD "$TAGID$params{TAG}\n" if $params{TAG}; print ATCMD ref($params{COMMAND}) eq "ARRAY" ? join("\n", @{$params{COMMAND}}) : $params{COMMAND}; close (ATCMD); return $?; } 0; } sub remove { my %params = @_; if ($params{JOBID}) { my $command = $AT{'remove'}; return &$command(@_) if ref($command) eq 'CODE'; $command =~ s/%JOBID%/$params{JOBID}/g; system($command) >> 8; } else { return if !defined $params{TAG}; my %jobs = getJobs(); my %return; foreach my $job (values %jobs) { next if !defined($job->{JOBID}) || !defined($job->{TAG}); if ($job->{JOBID} && $params{TAG} eq $job->{TAG}) { $return{$job->{JOBID}} = remove(JOBID => "$job->{JOBID}") } } return \%return } } sub getJobs { my %param = @_; my %jobs; my $command = $AT{'getJobs'}; return &$command(@_) if ref($command) eq 'CODE'; open (ATCMD, "$command |") or die "Schedule::At: Can't exec getJobs command: $!\n"; line: while (defined (my $atLine = )) { if (defined $AT{'headings'}) { foreach my $head (@{$AT{'headings'}}) { next line if $atLine =~ /$head/; } } chomp $atLine; my %atJob; ($atJob{JOBID}, $atJob{TIME}) = &{$AT{'parseJobList'}}($atLine); $atJob{TAG} = _getTag(JOBID => $atJob{JOBID}); next if $param{TAG} && (!$atJob{TAG} || $atJob{TAG} ne $param{TAG}); next if $param{JOBID} && (!$atJob{JOBID} || $atJob{JOBID} ne $param{JOBID}); $jobs{$atJob{JOBID}} = \%atJob; } close (ATCMD); %jobs; } sub readJobs { my %jobs = getJobs(@_); my @job_ids = map { $_->{JOBID} } values %jobs; my %content; foreach my $jobid (@job_ids) { $content{$jobid} = _readJob(JOBID => $jobid); } %content } ############################################################################### # Private subroutines ############################################################################### sub _readJob { my %params = @_; my $command = $AT{'getCommand'}; $command = &$command($params{JOBID}) if ref($command) eq 'CODE'; $command =~ s/%JOBID%/$params{JOBID}/g; local $/ = undef; # slurp mode open (JOB, "$command") or die "Can't open $command: $!\n"; my $job = ; close (JOB); $job } sub _getTag { my %params = @_; my $job = _readJob(@_); $job =~ /$TAGID(.*)$/m; return $1; my @job = split("\n", _readJob(@_)); foreach my $commandLine (@job) { return $1 if $commandLine =~ /$TAGID(.*)$/; } undef; } sub _std2atTime { my ($stdTime) = @_; # StdTime: YYYYMMDDHHMM my ($year, $month, $day, $hour, $mins) = $stdTime =~ /(....)(..)(..)(..)(..)/; my $timeFormat = $AT{'timeFormat'}; return &$timeFormat($year, $month, $day, $hour, $mins) if ref($timeFormat) eq 'CODE'; $timeFormat =~ s/%YEAR%/$year/g; $timeFormat =~ s/%MONTH%/$month/g; $timeFormat =~ s/%DAY%/$day/g; $timeFormat =~ s/%HOUR%/$hour/g; $timeFormat =~ s/%MINS%/$mins/g; $timeFormat; } =head1 NAME Schedule::At - OS independent interface to the Unix 'at' command =head1 SYNOPSIS require Schedule::At; Schedule::At::add(TIME => $string, COMMAND => $string [, TAG =>$string]); Schedule::At::add(TIME => $string, COMMAND => \@array [, TAG =>$string]); Schedule::At::add(TIME => $string, FILE => $string) %jobs = Schedule::At::getJobs(); %jobs = Schedule::At::getJobs(JOBID => $string); %jobs = Schedule::At::getJobs(TAG => $string); Schedule::At::readJobs(JOBID => $string); Schedule::At::readJobs(TAG => $string); Schedule::At::remove(JOBID => $string); Schedule::At::remove(TAG => $string); =head1 DESCRIPTION This modules provides an OS independent interface to 'at', the Unix command that allows you to execute commands at a specified time. =over 4 =item Schedule::At::add Adds a new job to the at queue. You have to specify a B