Here's two of my peices of choppy code (QUEUETEST, ENTRYTEST) back from
when I was figuring out VMS::Queue myself.
Obviously, they aren't the prettiest, but they do exercise a lot of
VMS::Queue, which may help you figure it out.
Also, here's the module I was really wanting to get when I was messing
with the two examples (SUBMITJOB.PM). In it a provide to perl subs, one
to submit some random DCL to a queue, and one to submit some DCL, and
wait for it to complete. Parameters are the DCL to submit, and then
optional queue name, optional user to submit as, optionally specify a
temp file name to use, and optionally specify a log file.
I really should have coded these routines to take a sparse hash (e.g.
submitjob ({CMD=>"$ show date", LOGFILE=>'sys$scratch:foo.log'})
instead of using positional parameters, but I was still learning perl at
the time.
-- Pat
Martin Zinser wrote:
>
> Hello!
>
> I just started to play around with VMS::Queue and may be I'm just
> dense
> (most probably even since I've got a bad cold). I try
> something like this:
>
> use VMS::Queue;
> %entry_cond = {jobname=>"BATSER"};
> @entries = VMS::Queue::entry_list(\%entry_cond);
> for ($i==0;$i<=$#entries;$i++) {print $entries[$i], "\n"};
>
> \%entryprop = VMS::Queue::entry_info($entries[0]);
> print \$entryprop{"jobname"},
> foreach $prop (keys(%entryprop)) { printf "%s: %s\n", $prop,
> \$entryprop{$prop};}
>
> Which works fine in the first part (i.e. finds the correct
> queue entry for job
> BATSER), but does not give the properties of the job in
> part 2. Does
> anyone maybe have a working example using VMS::Queue to
> enlighten me?
>
> Thanks a lot, Martin
>
> P.S. OpenVMS Alpha 7.2.1, Perl 5.6.0, VMS::Queue 0.56
--
This message does not represent the policies or positions
of the Mayo Foundation or its subsidiaries.
Patrick Spinler email: [EMAIL PROTECTED]
Mayo Foundation phone: 507/284-9485
queuetest.pl
entrytest.pl
package Submitjob;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
$VERSION = 1.00;
# if using RCS/CVS, this may be preferred
# must be all one line, for MakeMaker
$VERSION = do {my @r = (q$Revision: 1.00 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r,
@r};
@ISA = qw(Exporter);
@EXPORT = qw( );
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
# your exported package globals go here,
# as well as any optionally exported functions
@EXPORT_OK = qw( &submit_job &submit_and_wait );
}
use vars @EXPORT_OK;
# non-exported package globals go here
use vars qw($status);
use strict;
use diagnostics;
use English;
use File::Copy;
use POSIX qw( &cuserid &getpid );
use VMS::Priv;
use VMS::Stdio qw ( &tmpnam );
use VMS::Process qw( &process_list &get_all_proc_info_items );
use VMS::Filespec qw( &rmsexpand &vmsify &unixify );
use VMS::Queue qw( &queue_info &submit &entry_info &entry_bitmap_decode );
use File::Spec::VMS q( catfile catdir );
#==[ submit_job ]======================================================
#
# Submit a DCL string
#
# --- parameters ---
#
# String containing cmd file to submit (eg, my $cmd = q{$ write sys$output hi"};
# Optional string containing queue to submit to, SYS$BATCH if blank/empty
# Optional string containing name specification where command string
# will be written to
# Optional string containing log file specification
# Optional string containing user to submit job as
#
# --- return value ---
#
# Ref to entry_info() hash on success
# Throw a die() on failure
#
sub submit_job
{
my ($cmdstr, $queue, $cmdfilespec, $logfilespec, $user) = @_;
$queue = 'SYS$BATCH' if (!defined ($queue) || $queue eq '');
$cmdfilespec = &tmpnam() . ".com"
if (!defined $cmdfilespec || $cmdfilespec eq '');
$user = &cuserid() if (!defined $user || $user eq '');
$logfilespec = '' if (!defined $logfilespec);
if (cuserid() !~ m/$user/i)
{
my %privset;
tie (%privset, 'VMS::Priv');
$privset{"CMKRNL"} = 1;
die "Error $!:$^E setting needed privs" if (!defined $privset{"CMKRNL"});
}
print ("Submitting to $queue as $user with log $logfilespec\n");
print ("Commands in $cmdfilespec\n");
print ("----\n$cmdstr\n----\n");
my $entry =
{
"QUEUE" => $queue,
};
if ($user ne cuserid()) {$entry->{"USERNAME"} = $user;}
if ($logfilespec ne '')
{
$entry->{"LOG_SPECIFICATION"} = rmsexpand ($logfilespec);
$entry->{"NO_LOG_DELETE"} = 1;
$entry->{"NO_LOG_SPOOL"} = 1;
}
my $entryfile =
{
"FILE_SPECIFICATION" => $cmdfilespec,
};
open (OUTFILE, ">$cmdfilespec") || die ("Error $!:$^E opening $cmdfilespec");
print OUTFILE $cmdstr;
close OUTFILE;
my $entrynum = submit ($entry, $entryfile)
|| die ("Error $!:$^E submitting entry");
my $entryref = entry_info ($entrynum);
$entryref
}
#==[ submit_and_wait ]=================================================
#
# Submit a batch job, and wait for it to complete
#
#
# --- parameters ---
#
# String containing cmd file to submit (eg, my $cmd = q{$ write sys$output hi"};
# Optional string containing queue to submit to, SYS$BATCH if blank/empty
# Optional string containing name specification where command string
# will be written to
# Optional string containing log file specification
# Optional string containing user to submit job as
#
# --- return value ---
#
# none on success & job completion, throw a die() on error or job failure
#
sub submit_and_wait
{
# $" = ","; $, = ","; print "submit & wait ", @_, "\n";
my $entryinforef = submit_job (@_);
my $entrynum = $$entryinforef{'ENTRY_NUMBER'};
my $queue = $$entryinforef{'QUEUE_NAME'};
my $user = $$entryinforef{'USERNAME'};
my $jobpid = $$entryinforef{'JOB_PID'};
my $queueinforef = queue_info ($queue);
my $queuenode = $$queueinforef{'SCSNODE_NAME'};
my $entrystatusref =
entry_bitmap_decode ('JOB_STATUS', $$entryinforef{'JOB_STATUS'});
my %privset;
tie (%privset, 'VMS::Priv');
$privset{"SYSPRV"} = 1;
$privset{"WORLD"} = 1;
die "Error $!:$^E setting needed privs" if (!defined $privset{"WORLD"});
die "Error $!:$^E setting needed privs" if (!defined $privset{"SYSPRV"});
# foreach my $key (sort keys %$entrystatusref)
# {
# print " $key = $$entrystatusref{$key} \n";
# }
if ($jobpid == 0)
{
foreach my $key (sort keys %$entrystatusref)
{
printf " %s = %s\n", $key, $$entrystatusref{$key};
}
while ($$entrystatusref{'JOB_PENDING'} == 1 ||
$$entrystatusref{'JOB_STARTING'} == 1 ||
$$entrystatusref{'JOB_HOLDING'} == 1 ||
$$entrystatusref{'JOB_SUSPENDED'} == 1)
{
print "Sleeping waiting for job\n";
$entryinforef = entry_info ($entrynum);
$entrystatusref =
entry_bitmap_decode ('JOB_STATUS',
$$entryinforef{'JOB_STATUS'});
sleep 1;
}
$jobpid = $$entryinforef{'JOB_PID'};
}
eval
{
printf "Waiting for BATCH_$entrynum pid $jobpid, 0x%08x\n", $jobpid;
my $status = waitpid ($jobpid, 0);
};
$status = 1;
$entryinforef = entry_info ($entrynum);
if (defined $entryinforef)
{
print "Job still here !\n";
$entrystatusref =
entry_bitmap_decode ('JOB_STATUS',
$$entryinforef{'JOB_STATUS'}) ;
if ($$entrystatusref{'JOB_RETAINED'} == 1)
{
print "status = retained !\n";
$status = 0x14;
}
}
return $status;
}
1;
