lib/perl/BEX/Job.pm

   1 # Batch EXecutor -- Jobs
   2 # (c) 2011-2015 Martin Mares <mj@ucw.cz>
   3
   4 use strict;
   5 use warnings;
   6
   7 package BEX::Job;
   8
   9 use POSIX ();
  10 use Digest::SHA;
  11
  12 our $job_cnt = 0;
  13
  14 sub check_id($) {
  15         my ($id) = @_;
  16         return $id =~ /^([0-9A-Za-z-]+)$/;
  17 }
  18
  19 sub new($;$) {
  20         my ($class, $id) = @_;
  21         my $job = { };
  22         bless $job;
  23         if (defined $id) {
  24                 check_id($id) or die "Invalid job ID";
  25                 $job->{'ID'} = $id;
  26         } else {
  27                 $job_cnt++;
  28                 my $dt = POSIX::strftime("%Y%m%d-%H%M%S", localtime);
  29                 my $hash = Digest::SHA::sha1_hex(join(":", $dt, $$, $job_cnt));
  30                 $job->{'ID'} = $dt . '-' . substr($hash, 0, 8);
  31         }
  32         $job->{'Subject'} = '';
  33         return $job;
  34 }
  35
  36 sub new_from_file($$;$) {
  37         my ($class, $file, $header_only) = @_;
  38         my $job = { };
  39         open T, '<', $file or die "Cannot open $file: $!";
  40         while (<T>) {
  41                 chomp;
  42                 /^$/ and last;
  43                 /^([A-Z][A-Za-z0-9-]*):\s*(.*)/ or die "Cannot load $file: Header syntax error";
  44                 !defined $job->{$1} or die "Cannot load $file: Header $1 re-defined";
  45                 $job->{$1} = $2;
  46         }
  47         if (!$header_only) {
  48                 my @cmds = <T>;
  49                 $job->{'body'} = join("", @cmds);
  50         }
  51         close T;
  52         $job->{'Subject'} //= '';
  53         $job->{'ID'} or die "Cannot load $file: Missing ID";
  54         check_id($job->{'ID'}) or die "Cannot load $file: Invalid ID syntax";
  55         return bless $job;
  56 }
  57
  58 sub id($) {
  59         return $_[0]->{'ID'};
  60 }
  61
  62 sub name($) {
  63         my ($job) = @_;
  64         my $name = $job->{'ID'};
  65         my $subj = $job->{'Subject'} // "";
  66         $name .= " ($subj)" if $subj !~ /^\s*$/;
  67         return $name;
  68 }
  69
  70 sub attr($$;$) {
  71         my ($job, $attr, $val) = @_;
  72         $job->{$attr} = $val if defined $val;
  73         return $job->{$attr};
  74 }
  75
  76 sub dump($) {
  77         my ($job) = @_;
  78         for my $k (sort keys %$job) {
  79                 print "$k: ", $job->{$k}, "\n";
  80         }
  81 }
  82
  83 sub save($;$) {
  84         my ($job, $fn) = @_;
  85         my $tmp = $BEX::Config::home . "/tmp";
  86         -d $tmp or mkdir $tmp or die "Cannot create directory $tmp: $!";
  87         $fn //= $tmp . '/' . $job->id;
  88         open T, '>', $fn or die "Cannot create $fn: $!";
  89         for my $k (sort grep { /^[A-Z]/ } keys %$job) {
  90                 print T "$k: ", $job->{$k}, "\n";
  91         }
  92         print T "\n";
  93         print T $job->{'body'} if defined $job->{'body'};
  94         close T;
  95         return $fn;
  96 }
  97
  98 42;