Open-ILS/src/support-scripts/test-scripts/circ_rules.pl

   1 #/usr/bin/perl
   2 use strict; use warnings;
   3 use lib q|../../../perlmods/|;
   4 use OpenILS::Utils::ScriptRunner;
   5 require '../oils_header.pl';
   6 use vars qw/ $user $authtoken $apputils /;
   7
   8
   9 # ---------------------------------------------------------------------
  10 # SCRIPT VARS
  11 # ----------------------------------------------------------------------
  12 my $patronid                                    = 4;
  13 my $copyid                                              = 8000107;
  14 my $patron_items_out                    = 11;
  15 my $patron_overdue_count        = 11;
  16 my $patron_fines                                = 20;
  17
  18 # these are not currently tested in the scripts
  19 my $is_renewal                                  = 0;
  20 my $is_non_cat                                  = 0;
  21 my $is_hold                                             = 0;
  22 my $non_cat_type                                = 1;
  23 # ---------------------------------------------------------------------
  24
  25
  26
  27
  28 my $bsconfig = shift;
  29 my $script = shift;
  30 my $path;
  31
  32 ($path, $script) = ($script =~ m#(/.*/)(.*)#);
  33
  34 osrf_connect($bsconfig);
  35
  36 my $evt                         = 'environment';
  37 my $fatal_events        = 'result.fatalEvents';
  38 my $info_events = 'result.infoEvents';
  39 my $events                      = 'result.events';
  40
  41 my $runner = load_runner();
  42 $runner->add_path($path);
  43
  44
  45
  46 # ---------------------------------------------------------------------
  47 # Run the script
  48 # ---------------------------------------------------------------------
  49 print "\nLoading script: $script\n";
  50 print "\n" . '-'x70 . "\n";
  51
  52 $runner->load($script);
  53 $runner->run or die "Script died: $@";
  54
  55
  56
  57 # ---------------------------------------------------------------------
  58 # Print out any events that occurred
  59 # ---------------------------------------------------------------------
  60 print "\n" . '-'x70 . "\n";
  61
  62 show_events( 'events', $runner->retrieve($events));
  63 show_events( 'fatal_events', $runner->retrieve($fatal_events));
  64 show_events( 'info_events', $runner->retrieve($info_events));
  65
  66
  67 sub show_events {
  68         my $t = shift;
  69         my $e = shift;
  70         my @e;
  71
  72         if($e and @e = split(/,/, $e)) {
  73                 print "$t : $_\n" for @e;
  74
  75         } else {
  76                 print "No $t occurred\n";
  77         }
  78 }
  79
  80 print "\n";
  81
  82
  83
  84 # ---------------------------------------------------------------------
  85 # Fetch data and build the script runner
  86 # ---------------------------------------------------------------------
  87
  88 sub load_runner {
  89
  90         my( $patron, $copy, $org, $e );
  91
  92
  93         ($patron, $e) = $apputils->fetch_user($patronid);
  94         oils_event_die($e);
  95
  96         ($org, $e) = $apputils->fetch_org_unit($patron->home_ou);
  97         oils_event_die($e);
  98
  99         $patron->home_ou($org);
 100
 101         ($copy, $e) = $apputils->fetch_copy($copyid);
 102         oils_event_die($e);
 103
 104         my $groups = $apputils->fetch_permission_group_tree();
 105         $patron->profile( _get_patron_profile($patron, $groups));
 106
 107         my $cp_stats = $apputils->fetch_copy_statuses();
 108         $copy->status( _get_copy_status($copy, $cp_stats) );
 109
 110         my $runner = OpenILS::Utils::ScriptRunner->new;
 111
 112         $runner->insert( "$evt.patronOverdueCount", $patron_overdue_count );
 113         $runner->insert( "$evt.patronItemsOut", $patron_items_out );
 114         $runner->insert( "$evt.patronFines", $patron_fines );
 115         $runner->insert( "$evt.isRenewal", $is_renewal );
 116         $runner->insert( "$evt.isNonCat", $is_non_cat );
 117         $runner->insert( "$evt.isHold", $is_hold );
 118         $runner->insert( "$evt.nonCatType", $non_cat_type );
 119         $runner->insert( "$evt.patron", $patron );
 120         $runner->insert( "$evt.copy", $copy );
 121         $runner->insert( $fatal_events, [] );
 122         $runner->insert( $info_events, [] );
 123         $runner->insert( $events, [] );
 124
 125         # ---------------------------------------------------------------------
 126         # Override the default log functions for convenience
 127         # ---------------------------------------------------------------------
 128         $runner->insert(log_activity    => sub { print "@_\n"; return 1;} );
 129         $runner->insert(log_error               => sub { print "@_\n"; return 1;} );
 130         $runner->insert(log_warn                => sub { print "@_\n"; return 1;} );
 131         $runner->insert(log_info                => sub { print "@_\n"; return 1;} );
 132         $runner->insert(log_debug               => sub { print "@_\n"; return 1;} );
 133         $runner->insert(log_internal    => sub { print "@_\n"; return 1;} );
 134
 135         return $runner;
 136 }
 137
 138
 139 # ---------------------------------------------------------------------
 140 # Utility code for fleshing objects
 141 # ---------------------------------------------------------------------
 142 sub _get_patron_profile {
 143         my( $patron, $group_tree ) = @_;
 144         return $group_tree if ($group_tree->id eq $patron->profile);
 145         return undef unless ($group_tree->children);
 146         for my $child (@{$group_tree->children}) {
 147                 my $ret = _get_patron_profile( $patron, $child );
 148                 return $ret if $ret;
 149         }
 150         return undef;
 151 }
 152
 153
 154 sub _get_copy_status {
 155         my( $copy, $cstatus ) = @_;
 156         my $s = undef;
 157         for my $status (@$cstatus) {
 158                 $s = $status if( $status->id eq $copy->status )
 159         }
 160         return $s;
 161 }
 162
 163
 164