lib/NonameTV/Job.pm

   1 package NonameTV::Job;
   2
   3 use strict;
   4
   5 =pod
   6
   7 StartJob( $type, $name, $deleteafter );
   8
   9 EndJob( $fail );  # Fail is optional. If fail is not supplied, it is set based on whether there was any output on stderr from the job.
  10
  11 DeleteJob( $type, $name ); # Used to expire old jobs.
  12
  13 Keep the following info about a job:
  14
  15 type
  16 name
  17 starttime (datetime)
  18 duration (int seconds)
  19 lastok (datetime)
  20 lastfail (datetime)
  21 message
  22 success (0,1)
  23 deleteafter
  24
  25 type+name must be unique.
  26
  27 Between StartJob and EndJob, N::L::error is logged
  28 and subsequently stored in the message field. This is true regardless
  29 of the use of --verbose parameters. If any errors are logged,
  30 the job is regarded as failed (success=0)
  31
  32 =cut
  33
  34 BEGIN
  35 {
  36   use Exporter   ();
  37   our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  38
  39   @ISA         = qw(Exporter);
  40   @EXPORT      = qw( );
  41   %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  42   @EXPORT_OK   = qw/StartJob EndJob/;
  43
  44 }
  45 our @EXPORT_OK;
  46
  47 use NonameTV::Factory qw/CreateDataStore/;
  48 use NonameTV::Log qw/StartLogSection EndLogSection/;
  49
  50 use DateTime;
  51
  52 my $curr = undef;
  53
  54 sub StartJob {
  55   my( $type, $name, $deleteafter ) = @_;
  56
  57   die "StartJob called twice" if defined $curr;
  58
  59   my $ddt = DateTime->now()->add( days => $deleteafter );
  60
  61   $curr = {
  62     type => $type,
  63     name => $name,
  64     starttime => DateTime->now(),
  65     deleteafter => $ddt->ymd() . " " . $ddt->hms(),
  66   };
  67
  68   StartLogSection( $name, 1 );
  69 }
  70
  71 sub EndJob {
  72   die if not defined $curr;
  73
  74   my $message = EndLogSection( $curr->{name} );
  75
  76   delete $curr->{h};
  77
  78   $curr->{success} = $message eq "";
  79   $curr->{message} = $message;
  80
  81   my $duration = DateTime->now()->subtract_datetime_absolute(
  82                    $curr->{starttime} );
  83
  84   $curr->{duration} = $duration->delta_seconds();
  85   $curr->{starttime} = $curr->{starttime}->ymd() . " " .
  86       $curr->{starttime}->hms();
  87
  88   if( $curr->{success} ) {
  89     $curr->{lastok} = $curr->{starttime};
  90   }
  91   else {
  92     $curr->{lastfail} = $curr->{starttime};
  93   }
  94
  95   my $ds = CreateDataStore();
  96
  97   if( $ds->sa->Update( "jobs", { type => $curr->{type},
  98                                  name => $curr->{name} },
  99                        $curr ) != 1 ) {
 100     $ds->sa->Add( "jobs", $curr );
 101   }
 102
 103   $curr = undef;
 104 }
 105
 106 =pod
 107
 108 Notes while trying to capture STDERR
 109
 110 The perl-module Filter::Handle lets you define a sub that will be
 111 called each time anything is written to stderr. Unfortunately the
 112 Filter::Handle tests in version 0.03 of the module eats up all
 113 available memory and dies...
 114
 115 The perl-module Tie::STDERR allows you to do the same thing.  See
 116 test/tie-stderr for an example. However, Tie::STDERR will also catch
 117 errors inside an eval, which is not desired. evals are used to try
 118 things that may fail and still be ok, and we don't want to hear about
 119 errors in these blocks. Sigh.
 120
 121 The only sane option is probably to wrap each job in an eval and catch
 122 the output from the eval. Is this possible?
 123
 124 =cut
 125
 126 1;