background process manager
authorTony Cook <tony@develop-help.com>
Mon, 2 Nov 2009 09:08:45 +0000 (09:08 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Mon, 2 Nov 2009 09:08:45 +0000 (09:08 +0000)
19 files changed:
MANIFEST
schema/bse.sql
site/cgi-bin/admin/backmon.pl [new file with mode: 0755]
site/cgi-bin/bse.cfg
site/cgi-bin/modules/BSE/DB.pm
site/cgi-bin/modules/BSE/DB/Mysql.pm
site/cgi-bin/modules/BSE/TB/BackgroundTask.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/BackgroundTasks.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/OwnedFile.pm
site/cgi-bin/modules/BSE/UI/Background.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/UserReg.pm
site/cgi-bin/modules/BSE/Util/Tags.pm
site/data/db/bse_background_tasks.data [new file with mode: 0644]
site/data/db/bse_background_tasks.pkey [new file with mode: 0644]
site/data/db/sql_statements.data
site/templates/admin/back/detail.tmpl [new file with mode: 0644]
site/templates/admin/back/list.tmpl [new file with mode: 0644]
site/util/bse_back.pl [new file with mode: 0644]
site/util/mysql.str

index ad389cc..a632821 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -16,6 +16,7 @@ site/cgi-bin/admin/add.pl
 site/cgi-bin/admin/admin.pl
 site/cgi-bin/admin/admin_seminar.pl
 site/cgi-bin/admin/adminusers.pl
+site/cgi-bin/admin/backmon.pl
 site/cgi-bin/admin/bse_timeout.pl
 site/cgi-bin/admin/bse_modules.pl
 site/cgi-bin/admin/changepw.pl
@@ -131,6 +132,8 @@ site/cgi-bin/modules/BSE/TB/AdminPerm.pm
 site/cgi-bin/modules/BSE/TB/AdminPerms.pm
 site/cgi-bin/modules/BSE/TB/AdminUser.pm
 site/cgi-bin/modules/BSE/TB/AdminUsers.pm
+site/cgi-bin/modules/BSE/TB/BackgroundTask.pm
+site/cgi-bin/modules/BSE/TB/BackgroundTasks.pm
 site/cgi-bin/modules/BSE/TB/FileAccessLog.pm
 site/cgi-bin/modules/BSE/TB/FileAccessLogEntry.pm
 site/cgi-bin/modules/BSE/TB/Location.pm
@@ -163,6 +166,7 @@ site/cgi-bin/modules/BSE/Template.pm
 site/cgi-bin/modules/BSE/Thumb/Imager.pm
 site/cgi-bin/modules/BSE/Thumb/Imager/RandomCrop.pm
 site/cgi-bin/modules/BSE/ThumbLow.pm
+site/cgi-bin/modules/BSE/UI/Background.pm
 site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
 site/cgi-bin/modules/BSE/UI/AdminNewsletter.pm
 site/cgi-bin/modules/BSE/UI/AdminReport.pm
@@ -258,8 +262,10 @@ site/cgi-bin/thumb.fcgi
 site/cgi-bin/thumb.pl
 site/cgi-bin/user.pl
 site/data/stopwords.txt
-site/data/db/sql_statements.pkey
+site/data/db/bse_background_tasks.data
+site/data/db/bse_background_tasks.pkey
 site/data/db/sql_statements.data
+site/data/db/sql_statements.pkey
 site/docs/BSE::UI::Affiliate.html
 site/docs/Generate.html
 site/docs/Generate::Article.html
@@ -372,6 +378,8 @@ site/templates/admin/addgroup.tmpl
 site/templates/admin/adduser.tmpl
 # site/templates/admin/article_custom.tmpl
 site/templates/admin/article_img.tmpl
+site/templates/admin/back/detail.tmpl
+site/templates/admin/back/list.tmpl
 site/templates/admin/base.tmpl
 site/templates/admin/catalog.tmpl  # embedded in the shopadmin catalog/product display
 # site/templates/admin/catalog_custom.tmpl
@@ -383,9 +391,9 @@ site/templates/admin/edit_1.tmpl
 # site/templates/admin/edit_4.tmpl
 # site/templates/admin/edit_5.tmpl
 site/templates/admin/edit_catalog.tmpl
-site/templates/admin/edit_dragdrop.tmpl
+#site/templates/admin/edit_dragdrop.tmpl
 site/templates/admin/edit_groups.tmpl
-site/templates/admin/edit_kidsof.tmpl
+$#ite/templates/admin/edit_kidsof.tmpl
 site/templates/admin/edit_prodopts.tmpl
 site/templates/admin/edit_product.tmpl
 site/templates/admin/edit_seminar.tmpl
@@ -612,6 +620,7 @@ site/templates/user/unsubone_base.tmpl
 site/templates/user/userpage_base.tmpl
 site/templates/xbase.tmpl
 site/util/bseaddimages.pl
+site/util/bse_back.pl
 site/util/bse_notify_files.pl
 site/util/bse_s3.pl
 site/util/bse_storage.pl
index cfec520..12fbabf 100644 (file)
@@ -943,3 +943,43 @@ create table bse_file_access_log (
   index by_file(file_id),
   index by_user(siteuser_id, when_at)
 );
+
+-- configuration of background tasks
+drop table if exists bse_background_tasks;
+create table bse_background_tasks (
+  -- static, doesn't change at runtime
+  -- string id of the task
+  id varchar(20) not null primary key,
+
+  -- description suitable for users
+  description varchar(80) not null,
+
+  -- module that implements the task, or
+  modname varchar(80) not null default '',
+
+  -- binary (relative to base) that implements the task and options
+  binname varchar(80) not null default '',
+  bin_opts varchar(255) not null default '',
+
+  -- whether the task can be stopped
+  stoppable integer not null default 0,
+
+  -- bse right required to start it
+  start_right varchar(40),
+
+  -- dynamic, changes over time
+  -- non-zero if running
+  running integer not null default 0,
+
+  -- pid of the task
+  task_pid integer null,
+
+  -- last exit code
+  last_exit integer null,
+
+  -- last time started
+  last_started datetime null,
+
+  -- last completion time
+  last_completion datetime null
+);
diff --git a/site/cgi-bin/admin/backmon.pl b/site/cgi-bin/admin/backmon.pl
new file mode 100755 (executable)
index 0000000..025b8ec
--- /dev/null
@@ -0,0 +1,18 @@
+#!/usr/bin/perl -w
+# -d:ptkdb
+BEGIN { $ENV{DISPLAY} = '192.168.32.51:0.0' }
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../modules";
+use BSE::DB;
+use BSE::Request;
+use BSE::Template;
+use Carp 'confess';
+use BSE::UI::Background;
+
+$SIG{__DIE__} = sub { confess $@ };
+
+my $req = BSE::Request->new;
+
+my $result = BSE::UI::Background->dispatch($req);
+$req->output_result($result);
index a66faa0..782550d 100644 (file)
@@ -13,6 +13,7 @@ access_control=0
 downloads = /somewhere
 siteuser_images = $(paths/downloads)
 dynamic_cache=$(paths/downloads)/../cache
+backgroundlogs=$(downloads)/../backlogs
 
 [pregenerate]
 
index faf87d6..9427d10 100644 (file)
@@ -52,6 +52,14 @@ sub dbh {
   $_[0]{dbh};
 }
 
+sub forked {
+  my $self = shift;
+
+  $self = BSE::DB->single unless ref $self;
+
+  $self->_forked;
+}
+
 sub _query_expr {
   my ($args, $map, $table_name, $op, @terms) = @_;
 
index 8cf2f54..bbfdf9d 100644 (file)
@@ -615,6 +615,15 @@ sub _single
   $self;
 }
 
+sub _forked {
+  my $self = shift;
+
+  $self->{dbh}{InactiveDestroy} = 1;
+  delete $self->{dbh};
+  $self->{dbh} = $self->_connect;
+}
+
+
 my $get_sql_by_name = 'select sql_statement from sql_statements where name=?';
 
 sub stmt_sql {
diff --git a/site/cgi-bin/modules/BSE/TB/BackgroundTask.pm b/site/cgi-bin/modules/BSE/TB/BackgroundTask.pm
new file mode 100644 (file)
index 0000000..3978f3a
--- /dev/null
@@ -0,0 +1,167 @@
+package BSE::TB::BackgroundTask;
+use strict;
+use base 'Squirrel::Row';
+use BSE::Util::SQL qw(now_sqldatetime);
+use Carp qw(confess);
+use Errno qw(EPERM EACCES);
+
+sub columns {
+  return qw/id description modname binname bin_opts stoppable start_right running task_pid last_exit last_started last_completion/;
+}
+
+sub table {
+  "bse_background_tasks";
+}
+
+sub logfilename {
+  my ($self, $cfg) = @_;
+
+  my $base_path = $cfg->entryVar("paths", "backgroundlogs");
+  return $base_path . "/" . $self->id . ".log";
+}
+
+sub _find_script {
+  my ($cfg, $binname) = @_;
+
+  if ($binname =~ m!^/!) {
+    -f $binname
+      or return;
+
+    return $binname;
+  }
+
+  use File::Spec;
+  my @relpath;
+  my $filename = join("/", @relpath, $binname);
+  while (!-f $filename && @relpath < 10) {
+    push @relpath, "..";
+    $filename = join("/", @relpath, $binname);
+  }
+
+  -f $filename
+    or return;
+
+  return File::Spec->rel2abs($filename);
+}
+
+sub start {
+  my ($self, %opts) = @_;
+
+  my $cfg = delete $opts{cfg};
+  my $msg = delete $opts{msg};
+
+  # find the binary
+  my $binname = $self->binname;
+  my @args = split ' ', $self->bin_opts;
+  if ($binname =~ s/^perl //) {
+    my $script = _find_script($cfg, $binname);
+    unless ($script) {
+      $$msg = "Cannot find script $binname";
+      return;
+    }
+    $binname = $^X;
+    unshift @args, $script;
+  }
+  else {
+    my $foundname = _find_script($cfg, $binname);
+    unless ($foundname) {
+      $$msg = "Cannot find binary $binname";
+      return;
+    }
+    $binname = $foundname;
+  }
+  
+  require POSIX;
+  my $logfilename = $self->logfilename($cfg);
+  require IO::File;
+  my $outfh = IO::File->new($logfilename, "w");
+  if (!$outfh && ($! == EACCES || $! == EPERM)) {
+    unlink $logfilename;
+    $outfh = IO::File->new($logfilename, "w");
+  }
+
+  unless ($outfh) {
+    $$msg = "Cannot open logfile $logfilename: $!";
+    return;
+  }
+  
+  my $pid = fork;
+  unless (defined $pid) {
+    $$msg = "Could not fork: $!";
+    return;
+  }
+  my $task_id = $self->id;
+  if ($pid) {
+    # parent process
+    $self->set_task_pid($pid);
+    $self->set_running(1);
+    $self->set_last_started(now_sqldatetime());
+    $self->save;
+
+    return $pid;
+  }
+  else {
+    BSE::DB->forked;
+
+    # child process
+    my $null = $^O eq 'MSWin32' ? "NUL" : "/dev/null";
+    untie *STDIN;
+    open STDIN, "<$null" 
+      or die "Cannot open $null: $!";
+    untie *STDOUT;
+    open STDOUT, ">&".fileno($outfh)
+      or die "Cannot redirect stdout: $!";
+    untie *STDERR;
+    open STDERR, ">&STDOUT" or die "Cannot redirect STDOUT: $!";
+    POSIX::setsid();
+
+    my $pid2 = fork;
+    unless (defined $pid) {
+      print STDERR "Cannot start second child: $!\n";
+      $self->set_running(0);
+      $self->set_task_pid(undef);
+      $self->save;
+      exit;
+    }
+
+    if ($pid2) {
+      waitpid $pid2, 0;
+      if ($?) {
+       print STDERR "Task exited with non-zero-status: $?\n";
+      }
+      # this can happen hours or minutes after the original task changes
+      # and it's in a different process too
+      my $task = BSE::TB::BackgroundTasks->getByPkey($task_id);
+      $task->set_running(0);
+      $task->set_task_pid(undef);
+      $task->set_last_exit($?);
+      $task->set_last_completion(now_sqldatetime());
+      $task->save;
+      exit;
+    }
+    else {
+      BSE::DB->forked;
+      {  exec $binname, @args; } # suppress warning
+      print STDERR "Exec of $binname failed: $!\n";
+      exit 1;
+    }
+  }
+}
+
+sub check_running {
+  my ($self) = @_;
+
+  if ($self->running) {
+    if ($self->task_pid) {
+      # check if it's running
+      if (!kill(0, $self->task_pid)
+         && !$!{EPERM}) {
+       return 0;
+      }
+    }
+  }
+
+  return $self->running;
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/BackgroundTasks.pm b/site/cgi-bin/modules/BSE/TB/BackgroundTasks.pm
new file mode 100644 (file)
index 0000000..7f92449
--- /dev/null
@@ -0,0 +1,10 @@
+package BSE::TB::BackgroundTasks;
+use strict;
+use base 'Squirrel::Table';
+use BSE::TB::BackgroundTask;
+
+sub rowClass {
+  'BSE::TB::BackgroundTask';
+}
+
+1;
index cf9ecfc..c1105d9 100644 (file)
@@ -2,6 +2,7 @@ package BSE::TB::OwnedFile;
 use strict;
 use base 'Squirrel::Row';
 use BSE::Util::SQL qw(now_sqldatetime);
+use Carp qw(confess);
 
 sub columns {
   return qw/id owner_type owner_id category filename display_name content_type download title body modwhen size_in_bytes/;
@@ -20,4 +21,49 @@ sub defaults {
     );
 }
 
+sub download_result {
+  my ($self, %opts) = @_;
+
+  my $download = delete $opts{download} || $self->download;
+  my $cfg = delete $opts{cfg} or confess "Missing cfg parameter";
+  my $rmsg = delete $opts{msg} or confess "Missing msg parameter";
+  my $user = delete $opts{user};
+
+  my $filebase = $cfg->entryVar('paths', 'downloads');
+  require IO::File;
+  my $fh = IO::File->new("$filebase/" . $self->filename, "r");
+  unless ($fh) {
+    $$rmsg = "Cannot open stored file: $!";
+    return;
+  }
+
+  my @headers;
+  my %result =
+    (
+     content_fh => $fh,
+     headers => \@headers,
+    );
+  if ($download) {
+    push @headers, "Content-Disposition: attachment; filename=".$self->display_name;
+    $result{type} = "application/octet-stream";
+  }
+  else {
+    push @headers, "Content-Disposition: inline; filename=" . $self->display_name;
+    $result{type} = $self->content_type;
+  }
+  if ($cfg->entry("download", "log_downuload", 0) && $user) {
+    my $max_age = $cfg->entry("download", "log_downuload_maxage", 30);
+    BSE::DB->run(bseDownloadLogAge => $max_age);
+    require BSE::TB::FileAccessLog;
+    BSE::TB::FileAccessLog->log_download
+       (
+        user => $user,
+        file => $self,
+        download => $download,
+       );
+  }
+
+  return \%result;
+}
+
 1;
diff --git a/site/cgi-bin/modules/BSE/UI/Background.pm b/site/cgi-bin/modules/BSE/UI/Background.pm
new file mode 100644 (file)
index 0000000..e4d9a6e
--- /dev/null
@@ -0,0 +1,130 @@
+package BSE::UI::Background;
+use strict;
+use base "BSE::UI::AdminDispatch";
+use BSE::TB::BackgroundTasks;
+use BSE::Util::Iterate;
+use BSE::Util::Tags;
+use BSE::Util::SQL qw(now_sqldatetime);
+use DevHelp::HTML;
+use IO::File;
+use BSE::Util::Tags qw(tag_hash);
+
+my %actions =
+  (
+   list => "",
+   start => "bse_back_start",
+   stop => "bse_back_stop",
+   detail => "bse_back_detail",
+  );
+
+sub actions { \%actions }
+
+sub rights { \%actions }
+
+sub default_action { "list" }
+
+sub req_list {
+  my ($self, $req, $errors) = @_;
+
+  my @all = BSE::TB::BackgroundTasks->all;
+  my $it = BSE::Util::Iterate->new;
+  my $message = $req->message($errors);
+  my $current_task;
+  my %acts =
+    (
+     BSE::Util::Tags->basic(undef, $req->cgi, $req->cfg),
+     BSE::Util::Tags->secure($req),
+     BSE::Util::Tags->admin(undef, $req->cfg),
+     $it->make
+     (
+      single => "task",
+      plural => "tasks",
+      data => \@all,
+      store => \$current_task,
+     ),
+     message => $message,
+     task_running => [ tag_task_running => $self, \$current_task ],
+    );
+
+  return $req->dyn_response("admin/back/list", \%acts);
+}
+
+sub tag_task_running {
+  my ($self, $rcurrent) = @_;
+
+  $$rcurrent or return '';
+
+  return $$rcurrent->check_running;
+}
+
+sub _get_task {
+  my ($req, $msg) = @_;
+
+  my $id = $req->cgi->param("id");
+  unless ($id) {
+    $$msg = "Missing id parameter";
+    return;
+  }
+
+  my $task = BSE::TB::BackgroundTasks->getByPkey($id);
+  unless ($task) {
+    $$msg = "Task not found";
+    return;
+  }
+
+  return $task;
+}
+
+sub req_start {
+  my ($self, $req) = @_;
+
+  my $msg;
+  my $task = _get_task($req, \$msg)
+    or return $self->req_list($req, { _ => $msg });
+
+  $task->check_running
+    and return $self->req_list($req, { _ => $task->description . " is already running" });
+
+  my $pid = $task->start
+    (
+     cfg => $req->cfg,
+     msg => \$msg,
+    );
+  if ($pid) {
+    return BSE::Template->get_refresh("$ENV{SCRIPT_NAME}?m=Started+".escape_uri($task->description), $req->cfg);
+  }
+  else {
+    return $self->req_list($req, { _ => $msg });
+  }
+}
+
+sub req_detail {
+  my ($self, $req) = @_;
+
+  my $msg;
+  my $task = _get_task($req, \$msg)
+    or return $self->req_list($req, { _ => $msg });
+
+  my $logfilename = $task->logfilename($req->cfg);
+  my $logtext = '';
+  if (-f $logfilename) {
+    my $fh = IO::File->new($logfilename, "r");
+    if ($fh) {
+      local $/;
+      $logtext = <$fh>;
+    }
+  }
+  my %acts =
+    (
+     BSE::Util::Tags->basic(undef, $req->cgi, $req->cfg),
+     BSE::Util::Tags->secure($req),
+     BSE::Util::Tags->admin(undef, $req->cfg),
+     task => [ \&tag_hash, $task ],
+     task_running => scalar($task->check_running),
+     log => escape_html($logtext),
+    );
+
+  return $req->dyn_response("admin/back/detail", \%acts);
+}
+
+1;
index 8dfcd33..f758c6c 100644 (file)
@@ -2002,39 +2002,17 @@ sub req_downufile {
   $accessible
     or return $self->error($req, "Sorry, you don't have access to this file");
 
-  my $filebase = $cfg->entryVar('paths', 'downloads');
-  require IO::File;
-  my $fh = IO::File->new("$filebase/" . $file->filename, "r")
-    or return $self->error($req, "Cannot open stored file: $!");
-
-  my @headers;
-  my %result =
+  my $msg;
+  my $result = $file->download_result
     (
-     content_fh => $fh,
-     headers => \@headers,
-    );
-  my $download = $cgi->param("force_download") || $file->download;
-  if ($download) {
-    push @headers, "Content-Disposition: attachment; filename=".$file->display_name;
-    $result{type} = "application/octet-stream";
-  }
-  else {
-    push @headers, "Content-Disposition: inline; filename=" . $file->display_name;
-    $result{type} = $file->content_type;
-  }
-  if ($cfg->entry("download", "log_downuload", 0)) {
-    my $max_age = $cfg->entry("download", "log_downuload_maxage", 30);
-    BSE::DB->run(bseDownloadLogAge => $max_age);
-    require BSE::TB::FileAccessLog;
-    BSE::TB::FileAccessLog->log_download
-       (
-        user => $user,
-        file => $file,
-        download => $download,
-       );
-  }
+     cfg => $req->cfg,
+     download => scalar($cgi->param("force_download")),
+     msg => \$msg,
+     user => $user,
+    )
+      or return $self->error($req, $msg);
 
-  BSE::Template->output_result($req, \%result);
+  BSE::Template->output_result($req, $result);
 }
 
 1;
index 7225e62..c108541 100644 (file)
@@ -370,6 +370,7 @@ sub tag_arithmetic {
   my $result = eval $arg;
 
   if ($@) {
+    print STDERR "code generated by arithmetic: >>$arg<<\n";
     return escape_html("** arithmetic error ".$@." **");
   }
 
diff --git a/site/data/db/bse_background_tasks.data b/site/data/db/bse_background_tasks.data
new file mode 100644 (file)
index 0000000..5293489
--- /dev/null
@@ -0,0 +1,7 @@
+--
+id: gen
+description: Regenerate Site
+binname: perl util/gen.pl
+bin_opts: -v
+start_right: regen_all
+
diff --git a/site/data/db/bse_background_tasks.pkey b/site/data/db/bse_background_tasks.pkey
new file mode 100644 (file)
index 0000000..074d1ee
--- /dev/null
@@ -0,0 +1 @@
+id
index 393ea78..cc3f28b 100644 (file)
@@ -191,3 +191,6 @@ from bse_file_notifies
 where owner_type = 'U'
   and owner_id = ?
 SQL
+
+name: BackgroundTasks
+sql_statement: select * from bse_background_tasks
diff --git a/site/templates/admin/back/detail.tmpl b/site/templates/admin/back/detail.tmpl
new file mode 100644 (file)
index 0000000..cd8d6c2
--- /dev/null
@@ -0,0 +1,32 @@
+<:wrap admin/xbase.tmpl title=>"Background task detail", showtitle => 1 :>
+<p>| <a href="/cgi-bin/admin/menu.pl">Admin Menu</a> |
+<a href="<:script:>">Task list</a> |
+<:if Task running:>
+<:ifTask stoppable:><a href="<:script:>?a_stop=1&amp;id=<:task id:>">Stop</a> |<:or:><:eif:>
+
+<:or Task:>
+<a href="<:script:>?a_start=1&amp;id=<:task id:>">Start</a> |
+<:eif Task:>
+</p>
+<table class="editform">
+<tr>
+  <th>Task</th>
+  <td><:task description:></td>
+</tr>
+<tr>
+  <th>Status</th>
+  <td><:ifTask_running:>Running (<:task task_pid:>)<:or:>Stopped<:eif:></td>
+</tr>
+<tr>
+  <th>Last Started</th>
+  <td><:task last_started:></td>
+</tr>
+<tr>
+  <th>Last Completed</th>
+  <td><:task last_completion:></td>
+</tr>
+<tr>
+  <th>Log:</th>
+  <td><textarea rows="20" class="wide"><:log:></textarea>
+</tr>
+</table>
\ No newline at end of file
diff --git a/site/templates/admin/back/list.tmpl b/site/templates/admin/back/list.tmpl
new file mode 100644 (file)
index 0000000..d882b19
--- /dev/null
@@ -0,0 +1,35 @@
+<:wrap admin/xbase.tmpl title=>"Background tasks", showtitle => 1 :>
+<:ifMessage:><p><:message:></p><:or:><:eif:>
+<table class="editform">
+<tr>
+  <th>Task</th>
+  <th>Status</th>
+  <th>Last Started</th>
+  <th>Last Completed</th>
+  <th>Completion Status</th>
+  <th>Admin</th>
+</tr>
+<:if Tasks:>
+<:iterator begin tasks:>
+<tr>
+  <td><:task description:></td>
+  <td><:ifTask running:>Running (<:task task_pid:>)<:or:>Stopped<:eif:></td>
+  <td><:task last_started:></td>
+  <td><:task last_completion:></td>
+  <td><:switch:><:case Eq [task last_exit] "":><:case task last_exit:>Failed<:case default:>Success<:endswitch:></td>
+  <td><:if Task_running:>
+<:ifTask stoppable:><a href="<:script:>?a_stop=1&amp;id=<:task id:>">Stop</a><:or:><:eif:>
+
+<:or Task_running:>
+<a href="<:script:>?a_start=1&amp;id=<:task id:>">Start</a>
+<:eif Task_running:>
+<a href="<:script:>?a_detail=1&amp;id=<:task id:>">Details</a>
+</td>
+</tr>
+<:iterator end tasks:>
+<:or Tasks:>
+<tr>
+  <td colspan="3">No tasks available.</td>
+</tr>
+<:eif Tasks:>
+</table>
\ No newline at end of file
diff --git a/site/util/bse_back.pl b/site/util/bse_back.pl
new file mode 100644 (file)
index 0000000..07d4f9d
--- /dev/null
@@ -0,0 +1,115 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/../cgi-bin/modules";
+use BSE::Cfg;
+use BSE::TB::BackgroundTasks;
+
+{
+  chdir "$FindBin::Bin/../cgi-bin"
+    or warn "Could not change to cgi-bin directory: $!\n";
+  
+  my $cfg = BSE::Cfg->new;
+
+  my $cmd = shift
+    or usage();
+
+  if ($cmd eq "start") {
+    do_start(\@ARGV, $cfg);
+  }
+  elsif ($cmd eq "status") {
+    do_status(\@ARGV, $cfg);
+  }
+  elsif ($cmd eq "running") {
+    do_running(\@ARGV, $cfg);
+  }
+  elsif ($cmd eq "ls" or $cmd eq "list") {
+    do_list(\@ARGV, $cfg);
+  }
+  else {
+    usage();
+  }
+
+  exit;
+}
+
+sub _get_task {
+  my ($args, $cmd) = @_;
+
+  my $task_id = shift @$args
+    or usage("start missing taskid parameter");
+  my $task = BSE::TB::BackgroundTasks->getByPkey($task_id)
+    or usage("Unknown taskid");
+
+  return $task;
+}
+
+sub do_start {
+  my ($args, $cfg) = @_;
+
+  my $task = _get_task($args);
+
+  $task->check_running
+    and die "Task ", $task->id, " is already running\n";
+
+  my $msg;
+  my $pid = $task->start
+    (
+     cfg => $cfg,
+     msg => \$msg,
+    );
+  $pid
+    or die "$msg\n";
+}
+
+sub do_status {
+  my ($args, $cfg) = @_;
+
+  my $task = _get_task($args);
+
+  print "Task Id: ", $task->id, "\n";
+  print "Description: ", $task->description, "\n";
+  print "Running: ", $task->check_running ? "Yes" : "No", "\n";
+  print "Last-Started: ", $task->last_started, "\n"
+    if $task->last_started;
+  print "Last-Completion: ", $task->last_completion, "\n"
+    if $task->last_completion;
+  print "Last-Exit: ", $task->last_exit, "\n"
+    if $task->last_exit;
+}
+
+sub do_running {
+  my ($args, $cfg) = @_;
+
+  my $task = _get_task($args);
+
+  exit $task->check_running ? 0 : 1;
+}
+
+sub do_list {
+  my ($args, $cfg) = @_;
+
+  for my $task (BSE::TB::BackgroundTasks->all) {
+    print $task->id, "\t", 
+      $task->check_running ? "Yes" : "No", "\t",
+       $task->last_started || "", "\t", 
+         $task->last_completion || "", "\t",
+           $task->last_exit || "", "\t", 
+             $task->task_pid || "", "\n";
+  }
+}
+
+sub usage {
+  my $msg = shift;
+  $msg
+    and print STDERR "$msg\n";
+  die <<EOS;
+Usage: $0 <cmd> ...
+$0 start <taskid> - start the given task
+$0 status <taskid> - display status of the task
+$0 running <taskid> - test if running (for shell scripts)
+$0 ls
+$0 list - list all configured tasks
+EOS
+}
index 94a7538..78d5306 100644 (file)
@@ -102,6 +102,20 @@ Table bse_article_groups
 Column article_id;int(11);NO;NULL;
 Column group_id;int(11);NO;NULL;
 Index PRIMARY;1;[article_id;group_id]
+Table bse_background_tasks
+Column id;varchar(20);NO;NULL;
+Column description;varchar(80);NO;NULL;
+Column modname;varchar(80);NO;;
+Column binname;varchar(80);NO;;
+Column bin_opts;varchar(255);NO;;
+Column stoppable;int(11);NO;0;
+Column start_right;varchar(40);YES;NULL;
+Column running;int(11);NO;0;
+Column task_pid;int(11);YES;NULL;
+Column last_exit;int(11);YES;NULL;
+Column last_started;datetime;YES;NULL;
+Column last_completion;datetime;YES;NULL;
+Index PRIMARY;1;[id]
 Table bse_file_access_log
 Column id;int(11);NO;NULL;auto_increment
 Column when_at;datetime;NO;NULL;