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 Time::HiRes qw/time/;
   5 use OpenILS::Application::Circ::ScriptBuilder;
   6 require '../oils_header.pl';
   7 use vars qw/ $user $authtoken $apputils /;
   8
   9 # ---------------------------------------------------------------------
  10 # SCRIPT VARS
  11 # ----------------------------------------------------------------------
  12 #my $patronid                                   = 3;
  13 my $patronid                                    = 1000502;
  14 my $copyid                                              = 8000107;
  15 my $patron_items_out                    = 11;
  16 my $patron_overdue_count        = 11;
  17 my $patron_fines                                = 20;
  18
  19 # these are not currently tested in the scripts
  20 my $is_renewal                                  = 0;
  21 my $is_non_cat                                  = 0;
  22 my $is_hold                                             = 0;
  23 my $non_cat_type                                = 1;
  24 # ---------------------------------------------------------------------
  25
  26
  27
  28 my $bsconfig = shift;
  29 my $script = shift;
  30
  31 die "$0: <bootstrap> <script>\n" unless $script;
  32
  33 my $path;
  34
  35 ($path, $script) = ($script =~ m#(/.*/)(.*)#);
  36
  37 osrf_connect($bsconfig);
  38
  39
  40 #use OpenILS::Utils::ScriptRunner;
  41 #my $r = OpenILS::Utils::ScriptRunner->new;
  42 #$r->add_path($path);
  43 #$r->load($script) or die "Script died: $@";
  44 #$r->run or die "Script died: $@";
  45 #exit;
  46
  47
  48 my $s = time;
  49 my $runner = OpenILS::Application::Circ::ScriptBuilder->build(
  50         {
  51                 copy_id                                         => $copyid,
  52                 patron_id                                       => $patronid,
  53                 fetch_patron_circ_info  => 1,
  54                 _direct                                         => {
  55                         isNonCat                => $is_non_cat,
  56                         isRenewal       => $is_renewal,
  57                         nonCatType      => $non_cat_type,
  58                 }
  59         }
  60 );
  61
  62
  63 # ---------------------------------------------------------------------
  64 # Override the default log functions for convenience
  65 # ---------------------------------------------------------------------
  66 $runner->insert(log_activity    => sub { print "@_\n"; return 1;} );
  67 $runner->insert(log_error               => sub { print "@_\n"; return 1;} );
  68 $runner->insert(log_warn                => sub { print "@_\n"; return 1;} );
  69 $runner->insert(log_info                => sub { print "@_\n"; return 1;} );
  70 $runner->insert(log_debug               => sub { print "@_\n"; return 1;} );
  71 $runner->insert(log_internal    => sub { print "@_\n"; return 1;} );
  72
  73
  74 $runner->add_path('/openils/var/web/opac/common/js');
  75 $runner->add_path($path);
  76 $runner->add_path("$path/../catalog/");
  77
  78
  79 # ---------------------------------------------------------------------
  80 # Run the script
  81 # ---------------------------------------------------------------------
  82 print "\nLoading script: $script\n";
  83 print "\n" . '-'x70 . "\n";
  84
  85 $runner->load($script);
  86 my $result = $runner->run or die "Script died: $@";
  87
  88 my $end = time - $s;
  89
  90
  91 # ---------------------------------------------------------------------
  92 # Print out any events that occurred
  93 # ---------------------------------------------------------------------
  94 print "\n" . '-'x70 . "\n";
  95
  96 my $events = $result->{events};
  97 my $ievents = $result->{infoEvents};
  98 my $fevents = $result->{fatalEvents};
  99
 100 print "events = @$events\n";
 101 print "info events = @$ievents\n";
 102 print "fatal events = @$fevents\n";
 103
 104 print "\ntime = $end\n";
 105
 106 sub show_events {
 107         my $t = shift;
 108         my $e = shift;
 109         my @e;
 110
 111         if($e and @e = split(/,/, $e)) {
 112                 print "$t : $_\n" for @e;
 113
 114         } else {
 115                 print "No $t occurred\n";
 116         }
 117 }
 118
 119 print "\n";
 120
 121
 122
 123