Open-ILS/src/perlmods/lib/OpenILS/WWW/BadDebt.pm

   1 package OpenILS::WWW::BadDebt;
   2 use strict;
   3 use warnings;
   4 use bytes;
   5
   6 use Apache2::Log;
   7 use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
   8 use APR::Const    -compile => qw(:error SUCCESS);
   9 use APR::Table;
  10
  11 use Apache2::RequestRec ();
  12 use Apache2::RequestIO ();
  13 use Apache2::RequestUtil;
  14 use CGI;
  15
  16 use OpenSRF::EX qw(:try);
  17 use OpenSRF::System;
  18 use OpenSRF::AppSession;
  19 use XML::LibXML;
  20 use XML::LibXSLT;
  21
  22 use Encode;
  23 use Unicode::Normalize;
  24 use OpenILS::Utils::Fieldmapper;
  25 use OpenSRF::Utils::Logger qw/$logger/;
  26
  27 use UNIVERSAL::require;
  28
  29 # set the bootstrap config when this module is loaded
  30 my $bootstrap;
  31
  32 sub import {
  33         my $self = shift;
  34         $bootstrap = shift;
  35 }
  36
  37
  38 sub child_init {
  39         OpenSRF::System->bootstrap_client( config_file => $bootstrap );
  40         return Apache2::Const::OK;
  41 }
  42
  43 sub handler {
  44     my $r = shift;
  45     my $cgi = new CGI;
  46     my $auth_ses = $cgi->cookie('ses') || $cgi->param('ses') || $cgi->cookie('eg.auth.token');
  47     if ($auth_ses =~ /^"(.+)"$/) {
  48         $auth_ses = $1;
  49     }
  50
  51     # find some IDs ...
  52     my @xacts;
  53
  54     my $user = verify_login($auth_ses);
  55     return 403 unless $user;
  56
  57     my $mark_bad = $cgi->param('action') eq 'unmark' ? 'f' : 't';
  58     my $format = $cgi->param('format') || 'csv';
  59
  60     my $file = $cgi->param('idfile');
  61     if ($file) {
  62         my $col = $cgi->param('idcolumn') || 0;
  63         my $csv = new Text::CSV;
  64
  65         while (<$file>) {
  66             $csv->parse($_);
  67             my @data = $csv->fields;
  68             my $id = $data[$col];
  69             $id =~ s/\D+//o;
  70             next unless ($id);
  71             push @xacts, $id;
  72         }
  73     }
  74
  75     if (!@xacts) { # try pathinfo
  76         my $path_rec = $cgi->path_info();
  77         if ($path_rec) {
  78             @xacts = map { $_ ? ($_) : () } split '/', $path_rec;
  79         }
  80     }
  81
  82     return 404 unless @xacts;
  83
  84     my @lines;
  85
  86     my ($yr,$mon,$day) = (localtime())[5,4,3]; $yr += 1900;
  87     my $date = sprintf('%d-%02d-%02d',$yr,$mon,$day);
  88
  89     my @header = ( '"Transaction ID"', '"Message"', '"Amount Owed"', '"Transaction Start Date"', '"User Barcode"' );
  90
  91     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
  92     my $actor = OpenSRF::AppSession->create('open-ils.actor');
  93
  94     $cstore->connect();
  95     $cstore->request('open-ils.cstore.transaction.begin')->gather(1);
  96     $cstore->request('open-ils.cstore.set_audit_info', $auth_ses, $user->id, $user->wsid)->gather(1);
  97
  98     for my $xact ( @xacts ) {
  99         try {
 100
 101             my $x = $cstore->request('open-ils.cstore.direct.money.billable_xact.retrieve' => $xact)->gather(1);
 102             my $s = $cstore->request('open-ils.cstore.direct.money.billable_xact_summary.retrieve' => $xact)->gather(1);
 103             my $u = $cstore->request('open-ils.cstore.direct.actor.usr.retrieve' => $s->usr)->gather(1);
 104             my $c = $cstore->request('open-ils.cstore.direct.actor.card.retrieve' => $u->card)->gather(1);
 105             my $w;
 106
 107             if ($s->xact_type eq 'circulation') {
 108                 $w = $cstore->request('open-ils.cstore.direct.action.circulation.retrieve' => $xact)->gather(1)->circ_lib;
 109             } elsif ($s->xact_type eq 'grocery') {
 110                 $w = $cstore->request('open-ils.cstore.direct.money.grocery.retrieve' => $xact)->gather(1)->billing_location;
 111             } elsif ($s->xact_type eq 'reservation') {
 112                 $w = $cstore->request('open-ils.cstore.direct.booking.reservation.retrieve' => $xact)->gather(1)->pickup_lib;
 113             } else {
 114                 die;
 115             }
 116
 117             my $failures = $actor->request('open-ils.actor.user.perm.check', $auth_ses, $user->id, $w, ['MARK_BAD_DEBT'])->gather(1);
 118
 119             if (@$failures) {
 120                 push @lines, [ $xact, '"Permission Failure"', '""', '""', '""' ];
 121             } else {
 122                 $x->unrecovered($mark_bad);
 123                 my $result = $cstore->request('open-ils.cstore.direct.money.billable_xact.update' => $x)->gather(1);
 124                 if ($result != $x->id) {
 125                     push @lines, [ $xact, '"Update Failure"', '""', '""', '""' ];
 126                 } else {
 127                     my $amount = $s->balance_owed;
 128                     my $start = $s->xact_start;
 129                     my $barcode = $c->barcode;
 130
 131                     if ( $mark_bad eq 't' ) {
 132                         push @lines, [ $xact, '"Marked Bad Debt"', $amount, "\"$start\"", "\"$barcode\"" ];
 133                     } else {
 134                         push @lines, [ $xact, '"Unmarked Bad Debt"', $amount, "\"$start\"", "\"$barcode\"" ];
 135                     }
 136                 }
 137             }
 138         } otherwise {
 139             push @lines, [ $xact, '"Update Failure"', '""', '""', '""' ];
 140         };
 141     }
 142
 143     $cstore->request('open-ils.cstore.transaction.commit')->gather(1);
 144     $cstore->disconnect();
 145
 146     if ($format eq 'csv') {
 147         $r->headers_out->set("Content-Disposition" => "inline; filename=bad_debt_$date.csv");
 148         $r->content_type('application/octet-stream');
 149
 150         $r->print( join(',', @header) . "\n" );
 151         $r->print( join(',', @$_    ) . "\n" ) for (@lines);
 152
 153     } elsif ($format eq 'json') {
 154
 155         $r->content_type('application/json');
 156
 157         $r->print( '[' );
 158
 159         my $first = 1;
 160         for my $line ( @lines ) {
 161             $r->print( ',' ) if $first;
 162             $first = 0;
 163
 164             $r->print( '{' );
 165             for my $field ( 0 .. 4 ) {
 166                 $r->print( "$header[$field] : $$line[$field]" );
 167                 $r->print( ',' ) if ($field < 4);
 168             }
 169             $r->print( '}' );
 170         }
 171
 172         $r->print( ']' );
 173     }
 174
 175     return Apache2::Const::OK;
 176
 177 }
 178
 179 sub verify_login {
 180         my $auth_token = shift;
 181         return undef unless $auth_token;
 182
 183         my $user = OpenSRF::AppSession
 184                 ->create("open-ils.auth")
 185                 ->request( "open-ils.auth.session.retrieve", $auth_token )
 186                 ->gather(1);
 187
 188         if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
 189                 return undef;
 190         }
 191
 192         return $user if ref($user);
 193         return undef;
 194 }
 195
 196 sub show_template {
 197     my $r = shift;
 198
 199     $r->content_type('text/html');
 200     $r->print(<<HTML);
 201
 202 <html>
 203     <head>
 204         <title>Record Export</title>
 205     </head>
 206     <body>
 207         <form method="POST" enctype="multipart/form-data">
 208             Use field number <input type="text" size="2" maxlength="2" name="idcolumn" value="0"/> (starting from 0)
 209             from CSV file <input type="file" name="idfile"/>
 210             <input type="submit" value="Mark Transactions Unrecoverable"/>
 211         </form>
 212     </body>
 213 </html>
 214
 215 HTML
 216
 217     return Apache2::Const::OK;
 218 }
 219
 220 1;