r9716 - in /branches/upstream/libschedule-at-perl: ./ current/ current/At.pm current/Changes current/MANIFEST current/Makefile.PL current/README current/t/ current/t/t1.t
vdanjean at users.alioth.debian.org
vdanjean at users.alioth.debian.org
Sat Nov 24 16:50:05 UTC 2007
Author: vdanjean
Date: Sat Nov 24 16:50:05 2007
New Revision: 9716
URL: http://svn.debian.org/wsvn/?sc=1&rev=9716
Log:
[svn-inject] Installing original source of libschedule-at-perl
Added:
branches/upstream/libschedule-at-perl/
branches/upstream/libschedule-at-perl/current/
branches/upstream/libschedule-at-perl/current/At.pm
branches/upstream/libschedule-at-perl/current/Changes
branches/upstream/libschedule-at-perl/current/MANIFEST
branches/upstream/libschedule-at-perl/current/Makefile.PL
branches/upstream/libschedule-at-perl/current/README
branches/upstream/libschedule-at-perl/current/t/
branches/upstream/libschedule-at-perl/current/t/t1.t
Added: branches/upstream/libschedule-at-perl/current/At.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libschedule-at-perl/current/At.pm?rev=9716&op=file
==============================================================================
--- branches/upstream/libschedule-at-perl/current/At.pm (added)
+++ branches/upstream/libschedule-at-perl/current/At.pm Sat Nov 24 16:50:05 2007
@@ -1,0 +1,444 @@
+package Schedule::At;
+
+require 5.004;
+
+# Copyright (c) 1997-2002 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);
+
+$VERSION = '1.06';
+
+###############################################################################
+# Load configuration for this OS
+###############################################################################
+
+use Config;
+
+my @configs = split (/\./, "$Config{'osname'}.$Config{'osvers'}");
+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 ($params{FILE}) {
+ return (system($command) / 256);
+ } else {
+ open (ATCMD, "| $command") or return 1;
+ print ATCMD "$TAGID$params{TAG}\n" if $params{TAG};
+ print ATCMD $params{COMMAND};
+ close (ATCMD);
+ }
+
+ 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();
+
+ foreach my $job (values %jobs) {
+ next if !defined($job->{JOBID}) ||
+ !defined($job->{TAG});
+
+ remove(JOBID => "$job->{JOBID}")
+ if $job->{JOBID} && $params{TAG} eq $job->{TAG};
+ }
+ }
+}
+
+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 = <ATCMD>)) {
+ 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 = <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, FILE => $string)
+
+ %jobs = Schedule::At::getJobs();
+ %jobs = Schedule::At::getJobs(JOBID => $string);
+ %jobs = Schedule::At::getJobs(TAG => $string);
+
+ Schedule::At::readJob(JOBID => $string);
+ Schedule::At::readJob(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<TIME> and a command to execute. The B<TIME> has
+a common format: YYYYMMDDHHmm. Where B<YYYY> is the year (4 digits), B<MM>
+the month (01-12), B<DD> is the day (01-31), B<HH> the hour (00-23) and
+B<mm> the minutes.
+
+The command is passed with the B<COMMAND> or the B<FILE> parameter.
+B<COMMAND> can be used to pass the command as an string, and B<FILE> to
+read the commands from a file.
+
+The optional parameter B<TAG> serves as an application specific way to
+identify a job or a set of jobs.
+
+Returns 0 on success or a value != 0 if an error occurred.
+
+=item Schedule::At::readJob
+
+Read the job content identified by the B<JOBID> or B<TAG> parameters.
+
+Returns an string with the job content. As the operating systems usually
+add a few environment settings, the content is longer than the command
+provided when adding the job.
+
+=item Schedule::At::remove
+
+Remove an at job.
+
+You identify the job to be deleted using the B<JOBID> parameter (an
+opaque string returned by the getJobs subroutine). You can also specify
+a job or a set of jobs to delete with the B<TAG> parameter, removing
+all the jobs that have the same tag (as specified with the add subroutine).
+
+Returns 0 on success or a value != 0 if an error occurred.
+
+=item Schedule::At::getJobs
+
+Called with no params returns a hash with all the current jobs or
+dies if an error has occurred.
+It's possible to specify the B<TAG> or B<JOBID> parameters so only matching
+jobs are returned.
+For each job the key is a JOBID (an OS dependent string that shouldn't be
+interpreted), and the value is a hash reference.
+
+This hash reference points to a hash with the keys:
+
+=over 4
+
+=item TIME
+
+An OS dependent string specifying the time to execute the command
+
+=item TAG
+
+The tag specified in the Schedule::At::add subroutine
+
+=back
+
+=back
+
+=head1 EXAMPLES
+
+ use Schedule::At;
+
+ # 1
+ Schedule::At::add (TIME => '199801181530', COMMAND => 'ls',
+ TAG => 'ScheduleAt');
+ # 2
+ Schedule::At::add (TIME => '199801181630', COMMAND => 'ls',
+ TAG => 'ScheduleAt');
+ # 3
+ Schedule::At::add (TIME => '199801181730', COMMAND => 'ls');
+
+ # This will remove #1 and #2 but no #3
+ Schedule::At::remove (TAG => 'ScheduleAt');
+
+ my %atJobs = Schedule::At::getJobs();
+ foreach my $job (values %atJobs) {
+ print "\t", $job->{JOBID}, "\t", $job->{TIME}, ' ',
+ ($job->{TAG} || ''), "\n";
+ }
+
+=head1 AUTHOR
+
+Jose A. Rodriguez (josear at ac.upc.es)
+
+=cut
+
+###############################################################################
+# OS dependent code
+###############################################################################
+
+sub AtCfg {
+ # Currently the default configuration just aborts
+ die "SORRY! There is no config for this OS.\n";
+}
+
+sub AtCfg_solaris {
+ $AT{'add'} = 'at %TIME% 2> /dev/null';
+ $AT{'addFile'} = 'at -f %FILE% %TIME% 2> /dev/null';
+ $AT{'timeFormat'} = sub {
+ my ($year, $month, $day, $hour, $mins) = @_;
+
+ my @months = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
+ 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
+
+ "$hour:$mins " . $months[$month-1] . " $day, $year";
+ };
+ $AT{'remove'} = 'at -r %JOBID%';
+ $AT{'getJobs'} = 'at -l';
+ $AT{'headings'} = [];
+ $AT{'getCommand'} = '/usr/spool/cron/atjobs/%JOBID%';
+ # Ignore "user = xxx" when executed by root
+ $AT{'parseJobList'} = sub { $_[0] =~ /^.*(\d{10}.a)\s+(.*)$/ };
+}
+
+sub AtCfg_sunos {
+ &AtCfg_solaris;
+ $AT{'getCommand'} = sub {
+ my ($jobid) = @_;
+
+ for my $filename (glob('/usr/spool/cron/atjobs/*')) {
+ return $filename if (stat($filename))[1] == $jobid;
+ }
+
+ undef;
+ }
+}
+
+sub AtCfg_dec_osf {
+ &AtCfg_solaris;
+ # josear.1137594600.a Wed Jan 18 15:30:00 2006
+ $AT{'parseJobList'} = sub { $_[0] =~ /^(\S+)\s+(.*)$/ };
+}
+
+sub AtCfg_hpux {
+ $AT{'add'} = 'at %TIME% 2> /dev/null';
+ $AT{'addFile'} = 'at -f %FILE% %TIME% 2> /dev/null';
+ $AT{'timeFormat'} = '%HOUR%:%MINS% %MONTH%/%DAY%/%YEAR%';
+ $AT{'remove'} = 'at -r %JOBID%';
+ $AT{'getJobs'} = 'at -l';
+ $AT{'headings'} = [];
+ $AT{'getCommand'} = '/usr/spool/cron/atjobs/%JOBID%';
+ $AT{'parseJobList'} = sub { $_[0] =~ /^(\S+)\s+(.*)$/ };
+}
+
+sub AtCfg_linux {
+ $AT{'add'} = 'at %TIME% 2> /dev/null';
+ $AT{'addFile'} = 'at -f %FILE% %TIME% 2> /dev/null';
+ $AT{'timeFormat'} = '%HOUR%:%MINS% %MONTH%/%DAY%/%YEAR%';
+ $AT{'remove'} = 'atrm %JOBID%';
+ $AT{'getJobs'} = 'atq';
+ $AT{'headings'} = ['Date'];
+ $AT{'getCommand'} = 'at -c %JOBID% |';
+ # 1 2003-01-18 15:30 a josear
+ $AT{'parseJobList'} = sub {
+ my @fields = split("\t", $_[0]);
+ ($fields[0], substr($fields[1], 0, 16))
+ };
+}
+
+sub AtCfg_aix {
+ &AtCfg_hpux;
+}
+
+sub AtCfg_dynixptx {
+ $AT{'add'} = 'at %TIME% 2> /dev/null';
+ $AT{'addFile'} = 'at -f %FILE% %TIME% 2> /dev/null';
+ $AT{'timeFormat'} = sub {
+ my ($year, $month, $day, $hour, $mins) = @_;
+
+ my @months = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
+ 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
+
+ "$hour:$mins " . $months[$month-1] . " $day, $year";
+ };
+ $AT{'remove'} = 'at -r %JOBID%';
+ $AT{'getJobs'} = 'at -l';
+ $AT{'headings'} = [];
+ $AT{'getCommand'} = '/usr/spool/cron/atjobs/%JOBID%';
+ $AT{'parseJobList'} = sub {
+ my $user = scalar getpwuid $<;
+ if ($user eq 'root') {
+ $_[0] =~ /^\s*\S+\s*\S+\s*\S+\s*(\S+)\s+(.*)$/
+ }
+ else {
+ $_[0] =~ /(\S+)\s+(.*)$/
+ }
+ };
+}
+
+sub AtCfg_freebsd {
+ $AT{'add'} = 'at %TIME% 2> /dev/null';
+ $AT{'addFile'} = 'at -f %FILE% %TIME% 2> /dev/null';
+ $AT{'timeFormat'} = sub {
+ my ($year, $month, $day, $hour, $mins) = @_;
+
+ my @months = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
+ 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
+
+ "$hour:$mins " . $months[$month-1] . " $day $year";
+ };
+ $AT{'remove'} = 'atrm %JOBID%';
+ $AT{'getJobs'} = 'at -l';
+ $AT{'headings'} = ['Date', 'Owner', 'Queue', 'Job'];
+ $AT{'getCommand'} = 'at -c %JOBID% | ';
+ $AT{'parseJobList'} = sub { $_[0] =~ s/^\s*(.+)\s+\S+\s+\S+\s+(\d+)$/$2_$1/; $_[0] =~ /^(.+)_(.+)$/ };
+}
+
+# Mac OS X (darwin, tiger)
+sub AtCfg_darwin {
+ $AT{'add'} = 'at %TIME% 2> /dev/null';
+ $AT{'addFile'} = 'at -f %FILE% %TIME% 2> /dev/null';
+ $AT{'timeFormat'} = '%HOUR%:%MINS% %MONTH%/%DAY%/%YEAR%';
+ $AT{'remove'} = 'atrm %JOBID%';
+ $AT{'getJobs'} = 'atq';
+ $AT{'headings'} = ['Job','Date'];
+ $AT{'getCommand'} = 'at -c %JOBID% | ';
+ # 74 Wed Jan 18 15:32:00 2006
+ $AT{'parseJobList'} = sub {
+ my @fields = split("\t", $_[0]);
+ ($fields[0], substr($fields[1], 0, 16))
+ };
+}
Added: branches/upstream/libschedule-at-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libschedule-at-perl/current/Changes?rev=9716&op=file
==============================================================================
--- branches/upstream/libschedule-at-perl/current/Changes (added)
+++ branches/upstream/libschedule-at-perl/current/Changes Sat Nov 24 16:50:05 2007
@@ -1,0 +1,43 @@
+Revision history for Perl extension Schedule::At.
+
+1.00 Fri Oct 3 19:36:47 1997
+ - original version; created by Jose A. Rodriguez <josear AT ac.upc.es>
+
+1.01 Wed Nov 12 09:37:16 1997
+ - Removed warning about 'inherited AUTOLOAD for non-methods'
+ (reported by jon AT uns.com.au)
+ - Fixed SunOS settings (bad date specification)
+ - Fixed a few bugs in the test suite
+
+1.02 Thu Feb 12 11:55:49 1998
+ - Fixed test suite expiration bug
+
+1.03 Mon Mar 25 12:53:38 MET 2002
+ - Removed support for AUTOLOAD (and bugs derived...)
+ (reported by ydesyatnik AT digitalthink.com, kar AT webline.dk,
+ william.l.kidd AT VBA.VA.GOV, andreas.koenig AT dubravka.in-berlin.de)
+ - Added support for AIX (not tested by me)
+ (sent by Roger.Kehr AT dresdner-bank.com)
+ - Added support for Dynix/ptx (not tested by me)
+ (sent by william.l.kidd AT VBA.VA.GOV)
+ - Added support for current distributions of Linux
+
+1.04 Wed Jul 17 09:08:28 MEST 2002
+ - getJobs now dies (instead of returning undef) if there is an error
+ (suggested by Bernhard Graf <fisch AT augensalat.de>)
+ - Added subroutine 'readJobs' to get the commands of jobs
+ (feature suggested by Bernhard Graf <fisch AT augensalat.de>)
+ - Added TAG and JOBID params support to 'getJobs'
+ (feature suggested by Aaron Duncan
+ <aaron.duncan AT centrelink.gov.au>)
+ - Fixed documentation bug (when adding a job with 'add', the
+ TAG param does not work with the FILE param). The POD
+ stated the opposite.
+
+1.05 Tue Mar 22 11:34:01 MET 2005
+ - Fixed SunOS support (not working for root, rt.cpan.org: Ticket #4427)
+ - Added support for FreeBSD (Frazer Irving <frazer AT homescreen.com.au>)
+
+1.06 Tue Sep 13 09:10:56 MEST 2005
+ - Added support for Darwin (Felipe Wettstein <karl AT gromski.ch>)
+
Added: branches/upstream/libschedule-at-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libschedule-at-perl/current/MANIFEST?rev=9716&op=file
==============================================================================
--- branches/upstream/libschedule-at-perl/current/MANIFEST (added)
+++ branches/upstream/libschedule-at-perl/current/MANIFEST Sat Nov 24 16:50:05 2007
@@ -1,0 +1,6 @@
+MANIFEST
+README
+Changes
+At.pm
+Makefile.PL
+t/t1.t
Added: branches/upstream/libschedule-at-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libschedule-at-perl/current/Makefile.PL?rev=9716&op=file
==============================================================================
--- branches/upstream/libschedule-at-perl/current/Makefile.PL (added)
+++ branches/upstream/libschedule-at-perl/current/Makefile.PL Sat Nov 24 16:50:05 2007
@@ -1,0 +1,12 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Schedule::At',
+ 'VERSION_FROM' => 'At.pm', # finds $VERSION
+ 'dist' => {
+ TARFLAGS => 'cvf',
+ COMPRESS => 'gzip',
+ SUFFIX => 'gz',
+ },
+);
Added: branches/upstream/libschedule-at-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libschedule-at-perl/current/README?rev=9716&op=file
==============================================================================
--- branches/upstream/libschedule-at-perl/current/README (added)
+++ branches/upstream/libschedule-at-perl/current/README Sat Nov 24 16:50:05 2007
@@ -1,0 +1,48 @@
+
+ Schedule::At - OS independent interface to the Unix 'at' command
+ ===========================================================================
+ Jose A. Rodriguez Garrido
+ josear+perl AT ac.upc.es
+
+ Sometimes when you write a perl script you have to call an external command.
+ That's ok if it's a private script or if you know for sure it will run on a
+ single architecture.
+
+ But if want to distribute the script or you work on a multi-architecture
+ environment you can't simply call to the external command and expect it
+ will work just fine. That only happens in the movies.
+
+ This module privides an OS independent interface to the Unix 'at' command
+ and it will map the calls to real (and OS dependent) commands. It has been
+ configured and tested for:
+
+ Solaris 2.9
+ HPUX 11.00
+ Digital Unix 5.1
+ Digital Unix 4.0
+ Linux (RedHat 7.3)
+
+ Not tested but it should work on:
+ HPUX 10.20
+ SunOs 4.1.4
+ AIX
+ Dynix/ptx
+ FreeBSD
+ Solaris 2.10
+ Linux
+
+ You can configure a new OS very easily (read the end of the At.pm module),
+ and the mechanism used could be used for configuring and adapting other
+ OS dependent commands. Please, feel free to send e-mail to josear AT ac.upc.es
+ to discuss this matter, configure Schedule::At for more Operating Systems or
+ report bugs.
+
+ Installation
+ ---------------------------------------------------------------------------
+ As usual:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
Added: branches/upstream/libschedule-at-perl/current/t/t1.t
URL: http://svn.debian.org/wsvn/branches/upstream/libschedule-at-perl/current/t/t1.t?rev=9716&op=file
==============================================================================
--- branches/upstream/libschedule-at-perl/current/t/t1.t (added)
+++ branches/upstream/libschedule-at-perl/current/t/t1.t Sat Nov 24 16:50:05 2007
@@ -1,0 +1,65 @@
+use Test;
+
+BEGIN { plan tests => 6 }
+
+my $verbose = 0;
+
+use Schedule::At;
+ok(1);
+
+my $rv;
+
+my $nextYear = (localtime)[5] + 1901;
+
+listJobs('Init state') if $verbose;
+my %beforeJobs = Schedule::At::getJobs();
+
+$rv = Schedule::At::add (
+ TIME => $nextYear . '01181530',
+ COMMAND => 'ls /thisIsACommand/',
+ TAG => '_TEST_aTAG'
+);
+my %afterJobs = Schedule::At::getJobs();
+
+listJobs('Added new job') if $verbose;
+ok(!$rv && ((scalar(keys %beforeJobs)+1) == scalar(keys %afterJobs)));
+
+my %atJobs = Schedule::At::getJobs();
+ok(%atJobs);
+
+my ($jobid, $content) = Schedule::At::readJobs(TAG => '_TEST_aTAG');
+ok($content, '/thisIsACommand/');
+
+$rv = Schedule::At::remove (TAG => '_TEST_aTAG');
+my %afterRemoveJobs = Schedule::At::getJobs();
+listJobs('Schedule::At jobs deleted') if $verbose;
+ok(!$rv && scalar(keys %beforeJobs) == scalar(keys %afterRemoveJobs));
+
+# getJobs with TAG param
+$rv = Schedule::At::add (
+ TIME => $nextYear . '01181531',
+ COMMAND => 'ls /cmd1/',
+ TAG => '_TEST_tag1'
+);
+$rv = Schedule::At::add (
+ TIME => $nextYear . '01181532',
+ COMMAND => 'ls /cmd2/',
+ TAG => '_TEST_tag2'
+);
+
+my %tag1Jobs = Schedule::At::getJobs(TAG => '_TEST_tag1');
+my %tag2Jobs = Schedule::At::getJobs(TAG => '_TEST_tag2');
+listJobs('Schedule::At tag1 and tag2 added') if $verbose;
+ok(join('', map { $_->{TAG} } values %tag1Jobs), '/^(_TEST_tag1)+$/');
+$rv = Schedule::At::remove (TAG => '_TEST_tag1');
+$rv = Schedule::At::remove (TAG => '_TEST_tag2');
+listJobs('Schedule::At tag1 and tag2 removed') if $verbose;
+
+sub listJobs {
+ print STDERR "@_\n" if @_;
+ my %atJobs = Schedule::At::getJobs();
+ foreach my $job (values %atJobs) {
+ print STDERR "\tID:$job->{JOBID}, Time:$job->{TIME}, Tag:",
+ ($job->{TAG} || ''), "\n";
+ }
+}
More information about the Pkg-perl-cvs-commits
mailing list