Foundations of Action/Triger-based telephony,
authorsenator <senator@dcc99617-32d9-48b4-a31d-7c20da2025e4>
Wed, 26 May 2010 21:26:55 +0000 (21:26 +0000)
committersenator <senator@dcc99617-32d9-48b4-a31d-7c20da2025e4>
Wed, 26 May 2010 21:26:55 +0000 (21:26 +0000)
by Joe Atzberger and Lebbeous Fogle-Weekley

Just as described to the open-ils-dev mailing list on May 21, 2010, with a
whitespace/non-semantic-changes patch to follow.

git-svn-id: svn://svn.open-ils.org/ILS/trunk@16513 dcc99617-32d9-48b4-a31d-7c20da2025e4

19 files changed:
Open-ILS/examples/asterisk/extensions.conf.example [new file with mode: 0644]
Open-ILS/examples/asterisk/sample-greeting.gsm [new file with mode: 0644]
Open-ILS/examples/asterisk/sample-overdue-plural.gsm [new file with mode: 0644]
Open-ILS/examples/asterisk/sample-overdue-singular.gsm [new file with mode: 0644]
Open-ILS/examples/asterisk/sample-thanks.gsm [new file with mode: 0644]
Open-ILS/examples/opensrf.xml.example
Open-ILS/src/asterisk/pbx-daemon/eg-pbx-allocator.pl [new file with mode: 0644]
Open-ILS/src/asterisk/pbx-daemon/eg-pbx-daemon.conf [new file with mode: 0644]
Open-ILS/src/asterisk/pbx-daemon/eg-pbx-mediator.pl [new file with mode: 0644]
Open-ILS/src/asterisk/pbx-daemon/test_client.pl [new file with mode: 0644]
Open-ILS/src/extras/opensrf_settings_puller.pl [new file with mode: 0644]
Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm
Open-ILS/src/perlmods/OpenILS/Application/Trigger/Event.pm
Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/AstCall.pm [new file with mode: 0644]
Open-ILS/src/sql/Pg/002.schema.config.sql
Open-ILS/src/sql/Pg/950.data.seed-values.sql
Open-ILS/src/sql/Pg/upgrade/0279.data.telephony-basics.sql [new file with mode: 0644]
Open-ILS/src/support-scripts/action_trigger_runner.pl
build/tools/script_x_check.sh [new file with mode: 0644]

diff --git a/Open-ILS/examples/asterisk/extensions.conf.example b/Open-ILS/examples/asterisk/extensions.conf.example
new file mode 100644 (file)
index 0000000..65910b8
--- /dev/null
@@ -0,0 +1,41 @@
+; Sample Asterisk configuration
+; To use, include this dialplan in your extensions.conf file and dialplan reload.
+; Note the explicitly numbered line sequences.  This makes it hard to edit or
+; and new lines.  Remember to preserve sequentiality and Goto integrity.
+;
+;
+;
+; First the ${ ... } variables and functions are evaluated and substituted.
+; Then the  $[ ... ] expressions are evaluated and substituted.
+
+[overdue-test]
+exten => s,1,Verbose(titlestring: ${titlestring})
+exten => s,n,Answer()
+; exten => s,n,Set(LOOP=${IF($[foo${x} = "foo"]?1:0${LOOP})})   ;  [${foo${LOOP} = "foo"}?1:0${LOOP}])  ; Buggy trinary ops
+exten => s,n,Set(LOOP=0${LOOP})                 ; Default will be zero if undefined
+exten => s,n,Verbose(LOOP top: ${LOOP})
+exten => s,n,Goto(10)
+exten => s,10,Wait(1)                           ; The beginning of loop.
+exten => s,11,Playback(sample-greeting)
+exten => s,12,SayDigits(${items})
+exten => s,13,GotoIf($[0${items} > 1]?20:30)    ; spaces are important here
+exten => s,20,Playback(sample-overdue-plural)
+exten => s,21,Festival(Your items titles are)
+exten => s,22,Goto(40)
+exten => s,30,Playback(sample-overdue-singular)
+exten => s,31,Festival(The title is)
+exten => s,32,Goto(40)
+exten => s,40,Wait(1)
+exten => s,41,Festival(${titlestring})
+exten => s,42,Wait(1)
+;exten => s,43,Festival(Return these items or else.)
+exten => s,43,Playback(sample-thanks)
+exten => s,44,Set(LOOP=$[${LOOP}-1])            ; LOOP decrements
+exten => s,45,Verbose(LOOP bottom: ${LOOP})
+exten => s,46,GotoIf($[0${LOOP} >= 0]?10:48)    ; spaces are important here, we loop on zero because we already did decrement
+; exten => s,47,Verbose(REASON: ${REASON})
+exten => s,48,Hangup()
+
+exten => failed,1,Verbose(FAILED REASON: ${REASON})
+exten => failed,n,Verbose(CALLFILENAME: ${CALLFILENAME})
+
diff --git a/Open-ILS/examples/asterisk/sample-greeting.gsm b/Open-ILS/examples/asterisk/sample-greeting.gsm
new file mode 100644 (file)
index 0000000..02f781c
Binary files /dev/null and b/Open-ILS/examples/asterisk/sample-greeting.gsm differ
diff --git a/Open-ILS/examples/asterisk/sample-overdue-plural.gsm b/Open-ILS/examples/asterisk/sample-overdue-plural.gsm
new file mode 100644 (file)
index 0000000..4fd5c29
Binary files /dev/null and b/Open-ILS/examples/asterisk/sample-overdue-plural.gsm differ
diff --git a/Open-ILS/examples/asterisk/sample-overdue-singular.gsm b/Open-ILS/examples/asterisk/sample-overdue-singular.gsm
new file mode 100644 (file)
index 0000000..a7a82f4
Binary files /dev/null and b/Open-ILS/examples/asterisk/sample-overdue-singular.gsm differ
diff --git a/Open-ILS/examples/asterisk/sample-thanks.gsm b/Open-ILS/examples/asterisk/sample-thanks.gsm
new file mode 100644 (file)
index 0000000..a63240d
Binary files /dev/null and b/Open-ILS/examples/asterisk/sample-thanks.gsm differ
index 192e94f..6a98594 100644 (file)
@@ -54,6 +54,39 @@ vim:et:ts=4:sw=4:
         <smtp_server>localhost</smtp_server>
         <sender_address>evergreen@localhost</sender_address>
 
+        <!-- global telephony (asterisk) settings -->
+        <telephony>
+            <!-- replace all values below when telephony server is configured -->
+            <enabled>0</enabled>
+            <driver>SIP</driver>    <!-- SIP (default) or multi -->
+            <channels>              <!-- explicit list of channels used if multi -->
+                                    <!-- A channel specifies technology/resource -->
+                <channel>Zap/1</channel>
+                <channel>Zap/2</channel>
+                <channel>IAX/user:secret@widgets.biz</channel>
+            </channels>
+            <host>localhost</host>
+            <port>10080</port>
+            <user>evergreen</user>
+            <pw>evergreen</pw>
+            <!--
+                The overall composition of callfiles is determined by the
+                relevant template, but this section can be invoked for callfile
+                configs common to all outbound calls.
+                callfile_lines will be inserted into ALL generated callfiles
+                after the Channel line.  This content mat be overridden
+                (in whole) by the org unit setting callfile_lines.
+                Warning: Invalid syntax may break ALL outbound calls.
+            -->
+            <!-- <callfile_lines>
+                MaxRetries: 3
+                RetryTime: 60
+                WaitTime: 30
+                Archive: 1
+                Extension: 10
+            </callfile_lines> -->
+        </telephony>
+
         <!-- Overdue notices -->
         <overdue>
 
diff --git a/Open-ILS/src/asterisk/pbx-daemon/eg-pbx-allocator.pl b/Open-ILS/src/asterisk/pbx-daemon/eg-pbx-allocator.pl
new file mode 100644 (file)
index 0000000..10d0c17
--- /dev/null
@@ -0,0 +1,223 @@
+#!/usr/bin/perl -w
+#
+# Copyright (C) 2009 Equinox Software, Inc.
+#
+# License:
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+
+=head1 NAME
+
+allocator.pl
+
+=head1 SYNOPSIS
+
+allocator.pl [-h] [-t] [-v] [-c <file>]
+
+ Options:
+   -h         display help message
+   -t         test mode, no files are moved (impies -v)
+   -v         give verbose feedback
+   -c <file>  specify config file to be used
+
+=head1 DESCRIPTION
+
+This script is designed to run from crontab on a very frequent basis, perhaps
+every minute.  It has two purposes:
+
+=over 8
+
+=item B<1>
+Prevent the asterisk server from being overwhelmed by a large number of
+Evergreen callfiles in the queue at once.
+
+=item B<2>
+Allow call window custom scheduling via crontab.  The guarantee is that
+no more than queue_limit calls will be scheduled at the last scheduled run.
+
+=back
+
+By default no output is produced on successful operation.  Error conditions are
+output, which should result in email to the system user via crontab.
+Reads the same config file as the mediator, looks at the
+staging directory for any pending callfiles.  If they exist, checks queue_limit
+
+=head1 CONFIGURATION
+
+See the eg-pbx-daemon.conf.  In particular, set use_allocator to 1 to indicate to
+both processes (this one and the mediator) that the allocator is scheduled to run.
+
+=head1 USAGE EXAMPLES
+
+allocator.pl
+
+allocator.pl -c /path/to/eg-pbx-daemon.conf
+
+allocator.pl -t -c /some/other/config.txt
+
+=head1 TODO
+
+=over 8
+
+=item LOAD TEST!!
+
+=back
+
+=head1 AUTHOR
+
+Joe Atzberger,
+Equinox Software, Inc.
+
+=cut
+
+use warnings;
+use strict;
+
+use Config::General qw/ParseConfig/;
+use Getopt::Std;
+use Pod::Usage;
+use File::Basename qw/basename fileparse/;
+use File::Spec;
+use Sys::Syslog qw/:standard :macros/;
+use Cwd qw/getcwd/;
+
+our %config;
+our %opts = (
+    c => "/etc/eg-pbx-daemon.conf",
+    v => 0,
+    t => 0,
+);
+our $universal_prefix = 'EG';
+
+sub load_config {
+    %config = ParseConfig($opts{c});
+    # validate
+    foreach my $opt (qw/staging_path spool_path/) {
+        if (not -d $config{$opt}) {
+            die $config{$opt} . " ($opt): no such directory";
+        }
+    }
+
+    if (!($config{owner} = getpwnam($config{owner})) > 0) {
+        die $config{owner} . ": invalid owner";
+    }
+
+    if (!($config{group} = getgrnam($config{group})) > 0) {
+        die $config{group} . ": invalid group";
+    }
+
+    if ($config{universal_prefix}) {
+        $universal_prefix = $config{universal_prefix};
+        $universal_prefix =~ /^\D/
+            or die "Config error: universal_prefix ($universal_prefix) must start with non-integer character";
+    }
+    unless ($config{use_allocator} or $opts{t}) {
+        die "use_allocator not enabled in config file (mediator thinks allocator is not in use).  " .
+            "Run in test mode (-t) or enable use_allocator config";
+    }
+}
+
+sub match_files {
+# argument: directory to check for files (default cwd)
+# returns: array of pathnames from a given dir
+    my $root = @_ ? shift : getcwd();
+    my $pathglob = "$root/${universal_prefix}*.call";
+    my @matches  = grep {-f $_} <${pathglob}>;    # don't use <$pathglob>, that looks like ref to HANDLE
+    $opts{v} and             print scalar(@matches) . " match(es) for path: $pathglob\n";
+    $opts{t} or syslog LOG_NOTICE, scalar(@matches) . " match(es) for path: $pathglob";
+    return @matches;
+}
+
+sub prefixer {
+    # guarantee universal prefix on string (but don't add it again)
+    my $string = @_ ? shift : '';
+    $string =~ /^$universal_prefix\_/ and return $string;
+    return $universal_prefix . '_' . $string;
+}
+
+sub queue {
+    my $stage_name = shift or return;
+    $opts{t} or chown($config{owner}, $config{group}, $stage_name) or warn "error changing $stage_name to $config{owner}:$config{group}: $!";
+
+    # if ($timestamp and $timestamp > 0) {
+    #     utime $timestamp, $timestamp, $stage_name or warn "error utime'ing $stage_name to $timestamp: $!";
+    # }
+    my $goodname = prefixer((fileparse($stage_name))[0]);
+    my $finalized_filename = File::Spec->catfile($config{spool_path}, $goodname);
+    my $msg = sprintf "%40s --> %s", $stage_name, $finalized_filename;
+    unless ($opts{t}) {
+        unless (rename $stage_name, $finalized_filename) {
+            print   STDERR  "$msg  FAILED: $!\n";
+            syslog LOG_ERR, "$msg  FAILED: $!";
+            return;
+        }
+        syslog LOG_NOTICE, $msg;
+    }
+    $opts{v} and print $msg . "\n";
+}
+
+###  MAIN  ###
+
+getopts('htvc:', \%opts) or pod2usage(2);
+pod2usage( -verbose => 2 ) if $opts{h};
+
+$opts{t} and $opts{v} = 1;
+$opts{t} and print "TEST MODE\n";
+$opts{v} and print "verbose output ON\n";
+load_config;    # dies on invalid/incomplete config
+openlog basename($0), 'ndelay', LOG_USER;
+
+my $now = time;
+# incoming files sorted by mtime (stat element 9): OLDEST first
+my @incoming = sort {(stat($a))[9] <=> (stat($b))[9]} match_files($config{staging_path});
+my @outgoing = match_files($config{spool_path});
+my @future   = ();
+
+my $raw_count = scalar @incoming;
+for (my $i=0; $i<$raw_count; $i++) {
+    if ((stat($incoming[$i]))[9] - $now > 0 ) { # if this file is from the future, then so are the subsequent ones
+        @future = splice(@incoming,$i);         # i.e., take advantage of having sorted them already
+        last;
+    }
+}
+
+# note: elements of @future not currently used beyond counting them
+
+my  $in_count = scalar @incoming;
+my $out_count = scalar @outgoing;
+my $limit     = $config{queue_limit} || 0;
+my $available = 0;
+
+if ($limit) {
+    $available = $limit - $out_count;
+    if ($in_count > $available) {
+        @incoming = @incoming[0..($available-1)];   # slice down to correct size
+    }
+    if ($available == 0) {
+        $opts{t} or syslog LOG_NOTICE, "Queue is full ($limit)";
+    }
+}
+
+if ($opts{v}) {
+     printf "incoming (total ): %3d\n", $raw_count;
+     printf "incoming (future): %3d\n", scalar @future;
+     printf "incoming (active): %3d\n", $in_count;
+     printf "queued already   : %3d\n", $out_count;
+     printf "queue_limit      : %3d\n", $limit;
+     printf "available spots  : %3s\n", ($limit ? $available : 'unlimited');
+}
+
+foreach (@incoming) {
+    # $opts{v} and print `ls -l $_`;  # '  ', (stat($_))[9], " - $now = ", (stat($_))[9] - $now, "\n";
+    queue($_);
+}
+
diff --git a/Open-ILS/src/asterisk/pbx-daemon/eg-pbx-daemon.conf b/Open-ILS/src/asterisk/pbx-daemon/eg-pbx-daemon.conf
new file mode 100644 (file)
index 0000000..e13f444
--- /dev/null
@@ -0,0 +1,9 @@
+spool_path   /var/spool/asterisk/outgoing
+done_path    /var/spool/asterisk/outgoing_done
+staging_path /var/tmp
+port 10080
+owner asterisk
+group asterisk
+universal_prefix EG01
+queue_limit 30
+use_allocator 1
diff --git a/Open-ILS/src/asterisk/pbx-daemon/eg-pbx-mediator.pl b/Open-ILS/src/asterisk/pbx-daemon/eg-pbx-mediator.pl
new file mode 100644 (file)
index 0000000..ce12821
--- /dev/null
@@ -0,0 +1,359 @@
+#!/usr/bin/perl -w
+#
+# Copyright (C) 2009 Equinox Software, Inc.
+# Author: Lebbeous Fogle-Weekley
+# Author: Joe Atzberger
+#
+# License:
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# Overview:
+#
+#   This script is to be used on an asterisk server as an RPC::XML
+#   daemon targeted by Evergreen.
+#
+# Configuration:
+#
+#   See the eg-pbx-daemon.conf and extensions.conf.example files.
+#
+# Usage:
+#
+#   perl mediator.pl -c /path/to/eg-pbx-daemon.conf
+#
+# TODO:
+#
+# ~ Server retrieval of done files.
+# ~ Option to archive (/etc/asterisk/spool/outgoing_really_done) instead of delete?
+# ~ Accept globby prefix for filtering files to be retrieved.
+# ~ init.d startup/shutdown/status script.
+# ~ More docs.
+# ~ perldoc/POD
+# - command line usage and --help
+#
+
+use warnings;
+use strict;
+
+use RPC::XML::Server;
+use Config::General qw/ParseConfig/;
+use Getopt::Std;
+use File::Basename qw/basename fileparse/;
+use Sys::Syslog qw/:standard :macros/;
+
+our %config;
+our %opts = (c => "/etc/eg-pbx-daemon.conf");
+our $last_n = 0;
+our $universal_prefix = 'EG';
+
+my $failure = sub {
+    syslog LOG_ERR, $_[0];
+
+    return new RPC::XML::fault(
+        faultCode => 500,
+        faultString => $_[0])
+};
+
+my $bad_request = sub {
+    syslog LOG_WARNING, $_[0];
+
+    return new RPC::XML::fault(
+        faultCode => 400,
+        faultString => $_[0])
+};
+
+sub load_config {
+    %config = ParseConfig($opts{c});
+
+    # validate
+    foreach my $opt (qw/staging_path spool_path done_path/) {
+        if (not -d $config{$opt}) {
+            die $config{$opt} . " ($opt): no such directory";
+        }
+    }
+
+    if ($config{port} < 1 || $config{port} > 65535) {
+        die $config{port} . ": not a valid port number";
+    }
+
+    if (!($config{owner} = getpwnam($config{owner})) > 0) {
+        die $config{owner} . ": invalid owner";
+    }
+
+    if (!($config{group} = getgrnam($config{group})) > 0) {
+        die $config{group} . ": invalid group";
+    }
+
+    my $path = $config{done_path};
+    (chdir $path) or die "Cannot open dir '$path': $!";
+
+    if ($config{universal_prefix}) {
+        $universal_prefix = $config{universal_prefix};
+        $universal_prefix =~ /^\D/
+            or die "Config error: universal_prefix ($universal_prefix) must start with non-integer character";
+    }
+}
+
+sub replace_match_possible {
+# arguments: a string (requested_filename), parsed to see if it has the necessary
+#            components to use for finding possible queued callfiles to delete
+# returns: (userid, $noticetype) if either or both is found, else undef;
+    my $breakdown = shift or return;
+    $breakdown =~ s/\..*$//;    # cut everything at the 1st period
+    $breakdown =~ /([^_]*)_([^_]*)$/ or return;
+    return ($1, $2);
+}
+
+sub replace_match_files {
+# arguments: (id_string1, id_string2)
+# returns: array of pathnames (files to be deleted)
+# currently we will only find at most 1 file to replace,
+# but you can see how this could be extended w/ additional namespace and globbing
+    my $userid     = shift or return;   # doesn't have to be userid,     could be any ID string
+    my $noticetype = shift or return;   # doesn't have to be noticetype, could be any extra dimension of uniqueness
+    my $pathglob   = $config{spool_path} . "/" . compose_filename($userid, $noticetype);
+    # my $pathglob = $config{spool_path} . "/$universal_prefix" . "_$userid" . "_$noticetype" . '*.call';
+    my @matches    = grep {-f $_} <${pathglob}>;    # don't use <$pathglob>, that looks like ref to HANDLE
+    warn               scalar(@matches) . " match(es) for path: $pathglob";
+    syslog LOG_NOTICE, scalar(@matches) . " match(es) for path: $pathglob";
+    return @matches;
+}
+
+sub compose_filename {
+    return sprintf "%s_%s_%s.call", $universal_prefix, (@_?shift:''), (@_?shift:'');
+}
+sub auto_filename {
+    return sprintf("%s_%d-%05d.call", $universal_prefix, time, $last_n++);
+}
+sub prefixer {
+    # guarantee universal prefix on string (but don't add it again)
+    my $string = @_ ? shift : '';
+    $string =~ /^$universal_prefix\_/ and return $string;
+    return $universal_prefix . '_' . $string;
+}
+
+sub inject {
+    my ($data, $requested_filename, $timestamp) = @_;
+# Sender can specify filename: [PREFIX . '_' .] id_string1 . '_' . id_string2 [. '.' . time-serial . '.call']
+# TODO: overwrite based on id_strings, possibly controlled w/ extra arg?
+
+    my $ret = {
+        code => 200,    # optimism
+        use_allocator => $config{use_allocator},
+    };
+    my $fname;
+    $requested_filename = fileparse($requested_filename || ''); # no fair trying to get us to write in other dirs
+    if ($requested_filename and $requested_filename ne 'default') {
+        # Check for possible replacement of files
+        my ($userid, $noticetype) = replace_match_possible($requested_filename);
+        $ret->{replace_match} = ($userid and $noticetype) ? 1 : 0;
+        $ret->{userid}        = $userid     if $userid;
+        $ret->{noticetype}    = $noticetype if $noticetype;
+        if ($ret->{replace_match}) {
+            my @hits = replace_match_files($userid, $noticetype);
+            $ret->{replace_match_count} = scalar @hits;
+            $ret->{replace_match_files} = join ',', map {$_=fileparse($_)} @hits;  # strip leading dirs from fullpaths
+            my @fails = ();
+            foreach (@hits) {
+                unlink and next;
+                (-f $_) and push @fails, (fileparse($_))[0] . ": $!";
+                # TODO: refactor to use cleanup() or core of cleanup?
+                # We check again for the file existing since it might *just* have been picked up and finished.
+                # In that case, too bad, the user is going to get our injected call soon also.
+            }
+            if (@fails) {
+                $ret->{replace_match_fails} = join ',', map {$_=fileparse($_)} @fails;  # strip leading dirs from fullpaths
+                syslog LOG_ERR, $_[0];
+                # BAIL OUT?  For now, we treat failure to overwrite matches as non-fatal
+            }
+            $data .= sprintf("; %d of %d queued files replaced\n", scalar(@hits) - scalar(@fails), scalar(@hits));
+        }
+        $fname = $requested_filename;
+    } else {
+        $fname = auto_filename;
+    }
+
+    $fname = prefixer($fname);                  # guarantee universal prefix
+    $fname =~ /\.call$/  or $fname .= '.call';  # guarantee .call suffix
+
+    my $stage_name         = $config{staging_path} . "/" . $fname;
+    my $finalized_filename = $config{spool_path}   . "/" . $fname;
+
+    $data .= ";; added by inject() in the mediator\n";
+    $data .= "Set: callfilename=$fname\n";
+
+    # And now, we're finally ready to begin the actual insertion process
+    open  FH, ">$stage_name" or return &$failure("cannot open $stage_name: $!");
+    print FH $data           or return &$failure("cannot write $stage_name: $!");
+    close FH                 or return &$failure("cannot close $stage_name: $!");
+
+    chown($config{owner}, $config{group}, $stage_name) or
+        return &$failure(
+            "error changing $stage_name to $config{owner}:$config{group}: $!"
+        );
+
+    if ($timestamp and $timestamp > 0) {
+        utime $timestamp, $timestamp, $stage_name or
+            return &$failure("error utime'ing $stage_name to $timestamp: $!");
+    }
+
+    # note: EG doesn't have to care whether the spool is the "real" one or the allocator "pre" spool,
+    #       so the filename is returned under the same key.  EG can check use_allocator though if it
+    #       wants to know for sure.
+
+    if ($config{use_allocator}) {
+        $ret->{spooled_filename} = $stage_name;
+        syslog LOG_NOTICE, "Left $stage_name for allocator";
+    } elsif (rename $stage_name, $finalized_filename) {     # else the rename happens here
+        $ret->{spooled_filename} = $finalized_filename;
+        syslog LOG_NOTICE, "Spooled $finalized_filename sucessfully";
+    } else {
+        syslog LOG_ERR,  "rename $stage_name ==> $finalized_filename: $!";
+        return &$failure("rename $stage_name ==> $finalized_filename: $!");
+    }
+
+    return $ret;
+}
+
+
+sub retrieve {
+    my $globstring = prefixer(@_ ? shift : '*');
+    # We depend on being in the correct (done) directory already, thanks to the config step
+    # This prevents us from having to chdir for each request..
+
+    my @matches = grep {-f $_ } <'./' . ${globstring}>;    # don't use <$pathglob>, that looks like ref to HANDLE
+
+    my $ret = {
+        code => 200,
+        glob_used   => $globstring,
+        match_count => scalar(@matches),
+    };
+    my $i = 0;
+    foreach my $match (@matches) {
+        $i++;
+        # warn "file $i '$match'";
+        unless (open (FILE, "<$match")) {
+            syslog LOG_ERR, "Cannot read done file $i of " . scalar(@matches) . ": '$match'";
+            $ret->{error_count}++;
+            next;
+        }
+        my @content = <FILE>;   #slurpy
+        close FILE;
+
+        $ret->{'file_' . sprintf("%06d",$i++)} = {
+            filename => fileparse($match),
+            content  => join('', @content),
+        };
+    }
+    return $ret;
+}
+
+
+# cleanup: deletes files
+# arguments: string (comma separated filenames), optional int flag
+# returns: struct reporting success/failure
+#
+# The list of files to delete must be explicit, in a comma-separated string.
+# We cannot use globs or any other
+# pattern matching because there might be additional files that match.  Asterisk
+# might be making calls for other people and prodcesses (i.e., non-EG calls) or
+# might have made more calls for us since the last time we checked matches.
+
+sub cleanup {
+    my $targetstring = shift or return &$bad_request(
+        "Must supply at least one filename to cleanup()"     # not empty string!
+    );
+    my $dequeue = @_ ? shift : 0;  # default is to target done files.
+    my @targets = split ',', $targetstring;
+    my $path = $dequeue ? $config{spool_path} : $config{done_path};
+    (-r $path and -d $path) or return &$failure("Cannot open dir '$path': $!");
+
+    my $ret = {
+        code => 200,    # optimism
+        request_count => scalar(@targets),
+        from_queue    => $dequeue,
+        match_count   => 0,
+        delete_count  => 0,
+    };
+
+    my %problems;
+    my $i = 0;
+    foreach my $target (@targets) {
+        $i++;
+        $target = fileparse($target);    # no fair trying to get us to delete in other directories!
+        my $file = $path . '/' . prefixer($target);
+        unless (-f $file) {
+            $problems{$target} = {
+                code => 404,        # NOT FOUND: may or may not be a true error, since our purpose was to delete it anyway.
+                target => $target,
+            };
+            syslog LOG_NOTICE, "Delete request $i of " . $ret->{request_count} . " for file '$file': File not found";
+            next;
+        }
+
+        $ret->{match_count}++;
+        if (unlink $file) {
+            $ret->{delete_count}++;
+            syslog LOG_NOTICE, "Delete request $i of " . $ret->{request_count} . " for file '$file' successful";
+        } else {
+            syslog LOG_ERR,    "Delete request $i of " . $ret->{request_count} . " for file '$file' FAILED: $!";
+            $problems{$target} = {
+                code => 403,        # FORBIDDEN: permissions problem
+                target => $target,
+            };
+            next;
+        }
+    }
+
+    my $prob_count = scalar keys %problems;
+    if ($prob_count) {
+        $ret->{error_count} = $prob_count;
+        if ($prob_count == 1 and $ret->{request_count} == 1) {
+             # We had exactly 1 error and no successes
+            my $one = (values %problems)[0];
+            $ret->{code} = $one->{code};     # So our code is the error's code
+        } else {
+            $ret->{code} = 207;              # otherwise, MULTI-STATUS
+            $ret->{multistatus} = \%problems;
+        }
+    }
+    return $ret;
+}
+
+
+sub main {
+    getopt('c:', \%opts);
+    load_config;    # dies on invalid/incomplete config
+    openlog basename($0), 'ndelay', LOG_USER;
+    my $server = RPC::XML::Server->new(port => $config{port}) or die "Failed to get new RPC::XML::Server: $!";
+
+    # Regarding signatures:
+    #  ~ the first datatype  is  for RETURN value,
+    #  ~ any other datatypes are for INCOMING args
+    #
+    # Everything here returns a struct.
+
+    $server->add_proc({
+        name => 'inject',   code => \&inject,   signature => ['struct string', 'struct string string', 'struct string string int']
+    });
+    $server->add_proc({
+        name => 'retrieve', code => \&retrieve, signature => ['struct string', 'struct']
+    });
+    $server->add_proc({
+        name => 'cleanup',  code => \&cleanup,  signature => ['struct string', 'struct string int']
+    });
+
+    $server->add_default_methods;
+    $server->server_loop;
+    0;
+}
+
+exit main @ARGV;    # do it all!
diff --git a/Open-ILS/src/asterisk/pbx-daemon/test_client.pl b/Open-ILS/src/asterisk/pbx-daemon/test_client.pl
new file mode 100644 (file)
index 0000000..616803d
--- /dev/null
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+#
+
+use warnings;
+use strict;
+
+use Getopt::Long;
+use RPC::XML::Client;
+use Data::Dumper;
+
+# DEFAULTS
+my $host = 'http://localhost';
+my $verbose = 0;
+
+GetOptions(
+    'host=s'  => \$host,
+    'verbose' => \$verbose,
+);
+
+# CLEANUP
+$host =~ /^\S+:\/\// or $host  = 'http://' . $host;
+$host =~ /:\d+$/     or $host .= ':10080';
+
+# MAIN
+print "Trying host: $host\n";
+
+my $client = new RPC::XML::Client($host);
+
+my $insertblock = <<END_OF_CHUNK ;
+Channel: zap1/614260xxxx
+Context: overdue-test
+MaxRetries: 1
+RetryTime: 60
+WaitTime: 30
+Extension: 10
+Archive: 1
+Set: items=2
+Set: titlestring=Akira, Huckleberry Finn
+END_OF_CHUNK
+
+my @commands;
+if (scalar(@ARGV)) {
+    foreach(@ARGV) {
+        push @commands, $_;
+        $_ eq 'inject' and push @commands, $insertblock;
+    }
+} else {
+    push @commands, 'retrieve';    # default
+}
+
+print "Sending request: \n    ", join("\n    ", @commands), "\n\n";
+my $resp = $client->send_request(@commands);
+
+if (ref $resp) {
+    print "Return is " . ref($resp), "\n";
+    # print "Code: ", ($resp->{code}->as_string || 'UNKNOWN'), "\n";
+    foreach (qw(code faultcode)) {
+        my $code = $resp->{$_};
+        if ($code) {
+            print "    ", ucfirst($_), ": ";
+            print $code ? $code->value : 'UNKNOWN';
+        }
+        print "\n";
+    }
+} else {
+    print "ERROR: unrecognized response:\n\n", Dumper($resp), "\n";
+}
+$verbose and print Dumper($resp);
+$verbose and print "\nKEYS (level 1):\n",
+    map {sprintf "%12s: %s\n", $_, scalar $resp->{$_}->value} sort keys %$resp;
+
+# print "spooled_filename: ", $resp->{spooled_filename}->value, "\n";
diff --git a/Open-ILS/src/extras/opensrf_settings_puller.pl b/Open-ILS/src/extras/opensrf_settings_puller.pl
new file mode 100644 (file)
index 0000000..3bdbcc3
--- /dev/null
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Config;
+use OpenSRF::Utils::SettingsParser;
+
+# TODO: GetOpts to set these
+my $config_file = '/openils/conf/opensrf_core.xml';
+my $verbose = 0;
+
+sub usage {
+    return <<USAGE
+
+    usage: $0 xpath/traversing/string
+
+Reads $config_file and dumps the structure found at the element
+located by the xpath argument.  Without argument, dumps whole <config>.
+
+    example: $0 apps/open-ils.search/app_settings
+USAGE
+}
+
+sub die_usage {
+    @_ and print "ERROR: @_\n";
+    print usage();
+    exit 1;
+}
+
+my $load = OpenSRF::Utils::Config->load(
+    config_file => $config_file
+);
+my $booty = $load->bootstrap();
+
+my $conf   = OpenSRF::Utils::Config->current;
+my $cfile  = $conf->bootstrap->settings_config;
+my $parser = OpenSRF::Utils::SettingsParser->new();
+$parser->initialize( $cfile );
+$OpenSRF::Utils::SettingsClient::host_config = $parser->get_server_config($conf->env->hostname);
+
+my $settings = OpenSRF::Utils::SettingsClient->new();
+# scalar(@ARGV) or die_usage("Argument is required");
+my @terms = scalar(@ARGV) ? split('/', shift) : ();
+$verbose and print "Looking under: ", join(', ', map {"<$_>"} @terms), "\n";
+
+my $target = $settings->config_value(@terms);
+print Dumper($target);
+
+# my $lines = $target->{callfile_lines};
+
index ee70b0b..d014c99 100644 (file)
@@ -490,6 +490,7 @@ sub create_batch_events {
             $event->event_def( $def->id );
             $event->run_time( $run_time );
             $event->user_data( OpenSRF::Utils::JSON->perl2JSON($user_data) ) if (defined($user_data));
+            $event->granularity($granularity) if (defined $granularity);
 
             $editor->create_action_trigger_event( $event );
 
index 00d2c10..5faef1b 100644 (file)
@@ -466,7 +466,10 @@ sub _object_by_path {
 
     my $obj = $context->$step(); 
 
-    $logger->debug("_object_by_path(): meth=$meth, obj=$obj, multi=$multi, step=$step, lfield=$lfield");
+    $logger->debug(
+        sprintf "_object_by_path(): meth=%s, obj=%s, multi=%s, step=%s, lfield=%s",
+        map {defined($_)? $_ : ''} ($meth,  $obj,   $multi,   $step,   $lfield)
+    );
 
     if (!ref $obj) {
         $obj = $ed->$meth( 
diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/AstCall.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/AstCall.pm
new file mode 100644 (file)
index 0000000..e664da6
--- /dev/null
@@ -0,0 +1,360 @@
+package OpenILS::Application::Trigger::Reactor::AstCall;
+use base 'OpenILS::Application::Trigger::Reactor';
+use OpenSRF::Utils::Logger qw($logger);
+# use OpenILS::Application::AppUtils;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+
+use strict; use warnings;
+use Error qw/:try/;
+use Data::Dumper;
+
+use OpenSRF::Utils::SettingsClient;
+use RPC::XML::Client;
+$Data::Dumper::Indent = 0;
+
+my $U = 'OpenILS::Application::AppUtils';
+
+my $e = new_editor(xact => 1);
+
+# $last_channel_used is:
+# ~ index (not literal value) of last channel used in a callfile
+# ~ index is of position in @channels (zero-based)
+# ~ cached at package level
+# ~ typically for Zap (PSTN), not VOIP
+
+our @channels;
+our $last_channel_used = 0;
+our $telephony;
+
+sub ABOUT {
+    return <<ABOUT;
+
+    The AstCall reactor module creates a callfile for Asterisk, given a
+    template describing the message and an environment defining
+    necessary information for contacting the Asterisk server and scheduling
+    a call with it.
+
+ABOUT
+}
+
+sub get_conf {
+   # $logger->info(__PACKAGE__ . ": get_conf()");
+    $telephony and return $telephony;
+    my $config = OpenSRF::Utils::SettingsClient->new;
+    # config object cached by package
+    $telephony = $config->config_value('notifications', 'telephony');
+    return $telephony;
+}
+
+sub get_channels {
+    @channels and return @channels;
+    my $config = get_conf();    # populated $telephony object
+    @channels = @{ $config->{channels} };
+    return @channels;
+}
+
+sub next_channel {
+    # Increments $last_channel_used, or resets it to zero, as necessary.
+    # Returns appropriate value from channels array.
+    my @chans = get_channels();
+    unless(@chans) {
+        $logger->error(__PACKAGE__ . ": Cannot build call using " .
+            (shift ||'driver') .
+            ", no notifications.telephony.channels found in config!");
+        return;
+    }
+    if (++$last_channel_used > $#chans) {
+        $last_channel_used = 0;
+    }
+    return $chans[$last_channel_used];     # say, 'Zap/1' or 'Zap/12'
+}
+
+sub channel {
+    my $tech = get_conf()->{driver} || 'SIP';
+    if ($tech !~ /^SIP/) {
+        return next_channel($tech);
+    }
+    return $tech;                          #  say, 'SIP' or 'SIP/ubab33'
+}
+
+sub get_extra_lines {
+    my $lines = get_conf()->{callfile_lines} or return '';
+    my @fixed;
+    foreach (split "\n", $lines) {
+        s/^\s*//g;      # strip leading spaces
+        /\S/ or next;   # skip empty lines
+        push @fixed, $_;
+    }
+    (scalar @fixed) or return '';
+    return join("\n", @fixed) . "\n";
+}
+
+sub host_string {
+    my $conf = get_conf();
+    my $host = $conf->{host};
+    unless ($host) {
+        $logger->error(__PACKAGE__ . ": No telephony/host in config.");
+        return;
+    }
+
+    # prepend http:// if no protocol specified
+    $host =~ /^\S+:\/\// or $host  = 'http://' . $host;
+    # append port number if specified
+    $conf->{port} and $host .= ":" . $conf->{port};
+
+    return $host;
+}
+sub rpc_client {
+    # TODO: caching? (would take testing to ensure memory and
+    # connections are clean/stable)
+    my $host = (@_ ? shift : host_string()) or return;
+    return new RPC::XML::Client($host);
+}
+
+sub handler {
+    my ($self, $env) = @_;
+
+    $logger->info(__PACKAGE__ . ": entered handler");
+
+    # assignment, not comparison
+    unless ($env->{channel_prefix} = channel()) {
+        $logger->error(__PACKAGE__ . ": Cannot find tech/resource in config");
+        return 0;
+    }
+
+    $env->{extra_lines} = get_extra_lines() || '';
+    my $tmpl_output = $self->run_TT($env);
+    if (not $tmpl_output) {
+        $logger->error(__PACKAGE__ . ": no template input");
+        return 0;
+    }
+
+    my @eventids = map {$_->id} @{$env->{event}};
+    @eventids or push @eventids, '';
+
+    my $eo = Fieldmapper::action_trigger::event_output->new;
+
+    # XXX we have to actually create this in the DB now if we expect to use the
+    # ID later
+    $eo->data("");
+    $eo = $e->create_action_trigger_event_output($eo) or return $e->die_event;
+    if ($env->{"extra_lines"}) {
+        $tmpl_output .= ";; added by handler:\n";
+        $tmpl_output .= $env->{"extra_lines"};
+    }
+
+    # or would we prefer distinct lines instead of comma-separated?
+    $tmpl_output .= "; event_ids = " . join(",",@eventids) . "\n";
+    $tmpl_output .= "; event_output = " . $eo->id . "\n";
+
+    #my $filename_fragment = $userid . '_' . $eventids[0] . 'uniq' . time;
+    # not $noticetype,
+    # the event_output.id tells us all we need to know
+    # XXX why is id in here twice?
+    my $filename_fragment = $eo->id . '_' . $eo->id;
+
+    # TODO: add scheduling intelligence and use it here... or not if
+    # relying only on crontab
+    my $client = rpc_client();
+    my $resp = $client->send_request(
+        'inject', $tmpl_output, $filename_fragment, 0
+    ); # FIXME: 0 could be seconds-from-epoch UTC if deferred call needed
+
+    $logger->debug(
+        ref $resp ? ("Response: " . Dumper($resp->value)) : "Error: $resp"
+    );
+
+    if ($resp->{code} and $resp->{code}->value == 200) {
+        $eo->is_error('f');
+        $eo->data('filename: ' . $resp->{spooled_filename}->value);
+        # could look for the file that replaced it
+    } else {
+        $eo->is_error('t');
+        my $msg = $resp->{faultcode} ? $resp->{faultcode}->value :
+                    $resp->{     code} ? $resp->{     code}->value :
+                        " -- UNKNOWN response '$resp'";
+        $msg .= " for $filename_fragment";
+        $eo->data("Error " . $msg);
+        $logger->error(__PACKAGE__ . ": Mediator Error " . $msg);
+    }
+
+    # Now point all our events' async_output to the newly made row
+#    $eo = $env->{EventProcessor}->editor->
+#        create_action_trigger_event_output( $eo );
+    $e->update_action_trigger_event_output($eo) or return $e->die_event;
+    foreach (@eventids) {
+        my $event = $e->retrieve_action_trigger_event($_);
+        $event->async_output($eo->id);
+        $e->update_action_trigger_event($event);
+    }
+    $e->commit;    # defer till after loop?
+
+    # TODO: a sub for saving async_output might belong in Trigger.pm
+    1;
+}
+
+sub _files {
+    my $response = shift or return;
+    return map {$response->{$_}} sort grep {/^file_\d*/} keys %$response;
+}
+
+=head1 EXAMPLE CALFILES
+
+Note: all lines start flush left (no leading whitespace)
+
+=head2 Example callfile (successful)
+
+    Channel: SIP/ubab33/17707775555
+    Context: overdue-test
+    MaxRetries: 1
+    RetryTime: 60
+    WaitTime: 30
+    Extension: 10
+    Archive: 1
+    Set: items=1
+    Set: titlestring=chez nos gens;; added by OpenILS::Application::Trigger::Reactor::AstCall handler:
+    ; event_ids = 123,145
+    ; event_output = 14;; added by inject() in the mediator
+    Set: callfilename=EG_1258060382_6.call
+
+    StartRetry: 2139 1 (1258060442)
+    Status: Completed
+    Channel: SIP/ubab33/17707775555
+
+=head2 Example callfile (FAILED)
+
+    CallerID: "Jack Jackson" <17707775555>
+    Context: overdue-test
+    MaxRetries: 1
+    RetryTime: 60
+    WaitTime: 30
+    Extension: 10
+    Archive: 1
+    Set: items=1
+    Set: titlestring=Land Before Time;; added by OpenILS::Application::Trigger::Reactor::AstCall handler:
+    Set: LOOP=1
+    Set: callfilename=EG_joe_20091109145355.call
+
+    StartRetry: 2139 1 (1257907526)
+    ; FAILED: 0
+
+    EndRetry: 2139 1 (1257907496)
+
+    StartRetry: 2139 2 (1257907617)
+    ; FAILED: 0
+    Status: Expired
+
+=head2 Possible data structure:
+
+ $feedback = {
+     status => val,
+     attempts => [ $attempt1, $attempt2 ... $attemptN ],
+     anything_else => scalar,
+ }
+ ...
+ $attempt = {
+     time => secs from epoch (UTC) for the BEGINNING of the call,
+     duration => secs,
+     failed => code,
+ }
+
+=cut
+
+sub feedback_hash {
+    # parses the done callfile comments from Mediator
+    # return ref to hash
+    my $content  = shift or return;
+    my %hash     = ();
+    # my @attempts = ();
+    my @lines    = split "\n", $content;
+    foreach (shift @lines) {
+        s/^\s*(Set:\s*)?//i;   # strip leading whitespace, and possible "Set:"
+        if (/^StartRetry: \d+ (\d+) \((\d+)\)/) {
+            # go parse  an attempt;
+            # go record an attempt;
+        }
+        if (/^(Status):\s*(\S+)/i or /^;+\s*(FAILED):\s*(\S*)/i) {
+            $hash{lc $1} = $2;
+            next;
+        }
+
+        /^;+\s*(\S+)\s*[=:]\s*([^;]*)$/ and $hash{lc $1} = $2;
+    }
+    if (exists $hash{failed}) {
+        $hash{failcode} = $hash{failed};
+        # b/c "0" is a common failcode and we want a more binary indicator
+        $hash{failed}   = 1;
+    }
+    return \%hash;
+}
+
+sub cleanup {
+    my $self   = shift or return;
+    my $files  = join(',',@_) or return;
+    my $client = rpc_client();
+    return $client->send_request('cleanup', $files);
+    # TODO: more error checking
+}
+
+sub retrieve {
+    my $self   = shift or return;
+    my $client = rpc_client();
+    my $resp   = $client->send_request('retrieve');
+    unless ($resp and ref $resp) {
+         $logger->error(
+             __PACKAGE__ . ": Mediator Error: " .
+             ($resp ? 'Bad' : 'No') . " response to retrieve request"
+         );
+         return;
+    }
+
+    # my $count   = $resp{match_count}; # how many files we should have
+    # my @rm_list = ();
+    my @files   = _files($resp);
+    foreach (@files) {
+        my $content  = $resp->{$_}->content;
+        my $filename = $resp->{$_}->filename;
+        unless ($content) {
+            $logger->error(__PACKAGE__ .
+                ": Mediator sent incomplete/unintelligible message for " .
+                "filename " . ($filename || 'UNKNOWN'));
+            next;
+        }
+        my $feedback = feedback_hash($content);
+        my $output   = $e->retrieve_action_trigger_event_output(
+            $feedback->{event_output}
+        );
+        if ($content == $output->data) {
+            $logger->error(
+                __PACKAGE__ . ": Mediator sent duplicate file "
+                . $resp->{$_}->filename . " for event_output " .
+                $feedback->{event_output}
+            );
+        } else {
+            $output->data($content);
+        }
+        $e->commit;     # defer until after loop? probably not
+        my $clean = $client->send_request('cleanup', $filename);
+        # TODO: deletion by (comma-separated) filenames in chunks
+        # instead of individually?
+        # push @rm_list, $_; $client->send_request('cleanup', join(',',@rm_list));
+        unless ($clean and ref $clean) {
+            $logger->error(
+                __PACKAGE__ . ": Mediator Error: " .
+                ($clean ? 'Bad' : 'No') .
+                " response to cleanup $filename request");
+            next;
+        }
+        unless ($clean->{code}->value == 200 and $clean->{delete_count}) {
+            $logger->error(__PACKAGE__ . ": cleanup $filename returned " . (
+                $resp->{faultcode} ? $resp->{faultcode}->value :
+                    $resp->{     code} ? $resp->{     code}->value :
+                        " -- UNKNOWN response '$resp'"
+            ) . " with delete_count " .
+            (defined $clean->{delete_count} ? $clean->{delete_count} : 'UNDEF'));
+        }
+    }
+    return @files;
+}
+
+1;
index a11a097..132ddaf 100644 (file)
@@ -65,7 +65,7 @@ CREATE TABLE config.upgrade_log (
     install_date    TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT NOW()
 );
 
-INSERT INTO config.upgrade_log (version) VALUES ('0278'); -- Scott McKellar
+INSERT INTO config.upgrade_log (version) VALUES ('0279'); -- atz / senator
 
 CREATE TABLE config.bib_source (
        id              SERIAL  PRIMARY KEY,
index 12a3f57..edcfbc6 100644 (file)
@@ -4847,6 +4847,59 @@ INSERT INTO action_trigger.environment (event_def, path) VALUES
   (23, 'provider'),
   (23, 'provider.edi_default');
 
+INSERT INTO
+    config.org_unit_setting_type (name, label, description, datatype)
+    VALUES (
+        'notice.telephony.callfile_lines',
+        'Telephony: Arbitrary line(s) to include in each notice callfile',
+        $$
+        This overrides lines from opensrf.xml.
+        Line(s) must be valid for your target server and platform
+        (e.g. Asterisk 1.4).
+        $$,
+        'string'
+    );
+
+INSERT INTO action_trigger.reactor (module, description) VALUES (
+    'AstCall', 'Possibly place a phone call with Asterisk'
+);
+
+INSERT INTO
+    action_trigger.event_definition (
+        id, active, owner, name, hook, validator, reactor,
+        cleanup_success, cleanup_failure, delay, delay_field, group_field,
+        max_delay, granularity, usr_field, opt_in_setting, template
+    ) VALUES (
+        24,
+        FALSE,
+        1,
+        'Telephone Overdue Notice',
+        'checkout.due', 'NOOP_True', 'AstCall',
+        DEFAULT, DEFAULT, '5 seconds', 'due_date', 'usr',
+        DEFAULT, DEFAULT, DEFAULT, DEFAULT,
+        $$
+[% phone = target.0.usr.day_phone | replace('[\s\-\(\)]', '') -%]
+[% IF phone.match('^[2-9]') %][% country = 1 %][% ELSE %][% country = '' %][% END -%]
+Channel: [% channel_prefix %]/[% country %][% phone %]
+Context: overdue-test
+MaxRetries: 1
+RetryTime: 60
+WaitTime: 30
+Extension: 10
+Archive: 1
+Set: eg_user_id=[% target.0.usr.id %]
+Set: items=[% target.size %]
+Set: titlestring=[% titles = [] %][% FOR circ IN target %][% titles.push(circ.target_copy.call_number.record.simple_record.title) %][% END %][% titles.join(". ") %]
+$$
+    );
+
+INSERT INTO
+    action_trigger.environment (id, event_def, path)
+    VALUES
+        (DEFAULT, 24, 'target_copy.call_number.record.simple_record'),
+        (DEFAULT, 24, 'usr')
+    ;
+
 INSERT INTO config.org_unit_setting_type ( name, label, description, datatype )
     VALUES ( 
         'circ.offline.username_allowed',
diff --git a/Open-ILS/src/sql/Pg/upgrade/0279.data.telephony-basics.sql b/Open-ILS/src/sql/Pg/upgrade/0279.data.telephony-basics.sql
new file mode 100644 (file)
index 0000000..6f30f09
--- /dev/null
@@ -0,0 +1,58 @@
+BEGIN;
+
+INSERT INTO config.upgrade_log (version) VALUES ('0279'); -- atz / senator
+
+INSERT INTO
+    config.org_unit_setting_type (name, label, description, datatype)
+    VALUES (
+        'notice.telephony.callfile_lines',
+        'Telephony: Arbitrary line(s) to include in each notice callfile',
+        $$
+        This overrides lines from opensrf.xml.
+        Line(s) must be valid for your target server and platform
+        (e.g. Asterisk 1.4).
+        $$,
+        'string'
+    );
+
+INSERT INTO action_trigger.reactor (module, description) VALUES (
+    'AstCall', 'Possibly place a phone call with Asterisk'
+);
+
+INSERT INTO
+    action_trigger.event_definition (
+        id, active, owner, name, hook, validator, reactor,
+        cleanup_success, cleanup_failure, delay, delay_field, group_field,
+        max_delay, granularity, usr_field, opt_in_setting, template
+    ) VALUES (
+        24,
+        FALSE,
+        1,
+        'Telephone Overdue Notice',
+        'checkout.due', 'NOOP_True', 'AstCall',
+        DEFAULT, DEFAULT, '5 seconds', 'due_date', 'usr',
+        DEFAULT, DEFAULT, DEFAULT, DEFAULT,
+        $$
+[% phone = target.0.usr.day_phone | replace('[\s\-\(\)]', '') -%]
+[% IF phone.match('^[2-9]') %][% country = 1 %][% ELSE %][% country = '' %][% END -%]
+Channel: [% channel_prefix %]/[% country %][% phone %]
+Context: overdue-test
+MaxRetries: 1
+RetryTime: 60
+WaitTime: 30
+Extension: 10
+Archive: 1
+Set: eg_user_id=[% target.0.usr.id %]
+Set: items=[% target.size %]
+Set: titlestring=[% titles = [] %][% FOR circ IN target %][% titles.push(circ.target_copy.call_number.record.simple_record.title) %][% END %][% titles.join(". ") %]
+$$
+    );
+
+INSERT INTO
+    action_trigger.environment (id, event_def, path)
+    VALUES
+        (DEFAULT, 24, 'target_copy.call_number.record.simple_record'),
+        (DEFAULT, 24, 'usr')
+    ;
+
+COMMIT;
index 4abffcf..26bdc80 100755 (executable)
@@ -22,28 +22,34 @@ use OpenSRF::Utils::JSON;
 use OpenSRF::EX qw(:try);
 use OpenILS::Utils::Fieldmapper;
 
-my $opt_lockfile = '/tmp/action-trigger-LOCK';
-my $opt_osrf_config = '/openils/conf/opensrf_core.xml';
+# DEFAULT values
+
+my $opt_lockfile      = '/tmp/action-trigger-LOCK';
+my $opt_osrf_config   = '/openils/conf/opensrf_core.xml';
 my $opt_custom_filter = '/openils/conf/action_trigger_filters.json';
-my $opt_max_sleep = 3600;  # default to 1 hour
-my $opt_run_pending = 0;
-my $opt_debug_stdout = 0;
-my $opt_help = 0;
+my $opt_max_sleep     = 3600;  # default to 1 hour
+my $opt_run_pending   = 0;
+my $opt_debug_stdout  = 0;
+my $opt_help          = 0;
+my $opt_verbose;
 my $opt_hooks;
 my $opt_process_hooks = 0;
-my $opt_granularity = undef;
+my $opt_granularity   = undef;
+
+(-f $opt_custom_filter) or undef($opt_custom_filter);   # discard default if no file exists
 
 GetOptions(
-    'osrf-config=s' => \$opt_osrf_config,
-    'run-pending' => \$opt_run_pending,
-    'hooks=s' => \$opt_hooks,
-    'granularity=s' => \$opt_granularity,
-    'process-hooks' => \$opt_process_hooks,
-    'max-sleep' => \$opt_max_sleep,
-    'debug-stdout' => \$opt_debug_stdout,
+    'max-sleep'        => \$opt_max_sleep,
+    'osrf-config=s'    => \$opt_osrf_config,
+    'run-pending'      => \$opt_run_pending,
+    'hooks=s'          => \$opt_hooks,
+    'granularity=s'    => \$opt_granularity,
+    'process-hooks'    => \$opt_process_hooks,
+    'debug-stdout'     => \$opt_debug_stdout,
     'custom-filters=s' => \$opt_custom_filter,
-    'lock-file=s' => \$opt_lockfile,
-    'help' => \$opt_help,
+    'lock-file=s'      => \$opt_lockfile,
+    'verbose'          => \$opt_verbose,
+    'help'             => \$opt_help,
 );
 
 my $max_sleep = $opt_max_sleep;
@@ -128,14 +134,17 @@ HELP
 
 # create events for the specified hooks using the configured filters and context orgs
 sub process_hooks {
+    $opt_verbose and print "process_hooks: " . ($opt_process_hooks ? '(start)' : 'SKIPPING') . "\n";
     return unless $opt_process_hooks;
 
     my @hooks = ($opt_hooks) ? split(',', $opt_hooks) : keys(%$hook_handlers);
     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
 
     for my $hook (@hooks) {
-    
-        my $config = $$hook_handlers{$hook} or next;
+        my $config = $$hook_handlers{$hook};
+        $opt_verbose and print "process_hooks: $hook " . ($config ? ($opt_granularity || '') : ' NO HANDLER') . "\n";
+        $config or next;
+
         my $method = 'open-ils.trigger.passive.event.autocreate.batch';
         $method =~ s/passive/active/ if $config->{active};
         
@@ -149,6 +158,8 @@ sub process_hooks {
 }
 
 sub run_pending {
+    $opt_verbose and print "run_pending: " .
+        ($opt_run_pending ? ($opt_granularity || 'ALL granularity') : 'SKIPPING') . "\n";
     return unless $opt_run_pending;
     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
     my $req = $ses->request('open-ils.trigger.event.run_all_pending' => $opt_granularity);
@@ -202,4 +213,3 @@ if (-e $opt_lockfile) {
     close LF;
     unlink $opt_lockfile if ($contents == $$);
 }
-
diff --git a/build/tools/script_x_check.sh b/build/tools/script_x_check.sh
new file mode 100644 (file)
index 0000000..18e892a
--- /dev/null
@@ -0,0 +1,10 @@
+#!/bin/bash
+#
+# Author: Joe Atzberger
+# Purpose: identify files that should be executable, but aren't.
+#
+# usage: run this from the base directory of your repo,
+#   or wherever you want to check, inclusive of subdirectories
+
+find . \( -name "*.pl" -o -name "*.sh" -o -name "*.py" \) ! -executable -ls
+