Whitespace. gah.
[working/Evergreen.git] / Open-ILS / src / perlmods / 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 }
41
42 sub handler {
43         my $r = shift;
44         my $cgi = new CGI;
45     my $auth_ses = $cgi->cookie('ses') || $cgi->param('ses');
46
47         # find some IDs ...
48         my @xacts;
49
50     my $user = verify_login($auth_ses);
51     return 403 unless $user;
52
53         my $mark_bad = $cgi->param('action') eq 'unmark' ? 'f' : 't';
54         my $format = $cgi->param('format') || 'csv';
55
56         my $file = $cgi->param('idfile');
57         if ($file) {
58                 my $col = $cgi->param('idcolumn') || 0;
59                 my $csv = new Text::CSV;
60
61                 while (<$file>) {
62                         $csv->parse($_);
63                         my @data = $csv->fields;
64                         my $id = $data[$col];
65                         $id =~ s/\D+//o;
66                         next unless ($id);
67                         push @xacts, $id;
68                 }
69         }
70
71         if (!@xacts) { # try pathinfo
72                 my $path_rec = $cgi->path_info();
73                 if ($path_rec) {
74                         @xacts = map { $_ ? ($_) : () } split '/', $path_rec;
75                 }
76         }
77
78     return 404 unless @xacts;
79
80     my @lines;
81
82     my ($yr,$mon,$day) = (localtime())[5,4,3]; $yr += 1900;
83     my $date = sprintf('%d-%02d-%02d',$yr,$mon,$day);
84
85     my @header = ( '"Transaction ID"', '"Message"', '"Amount Owed"', '"Transaction Start Date"', '"User Barcode"' );
86
87         my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
88     my $actor = OpenSRF::AppSession->create('open-ils.actor');
89
90     $cstore->connect();
91     $cstore->request('open-ils.cstore.transaction.begin')->gather(1);
92
93     for my $xact ( @xacts ) {
94         try {
95     
96             my $x = $cstore->request('open-ils.cstore.direct.money.billable_xact.retrieve' => $xact)->gather(1);
97             my $s = $cstore->request('open-ils.cstore.direct.money.billable_xact_summary.retrieve' => $xact)->gather(1);
98             my $u = $cstore->request('open-ils.cstore.direct.actor.usr.retrieve' => $s->usr)->gather(1);
99             my $c = $cstore->request('open-ils.cstore.direct.actor.card.retrieve' => $u->card)->gather(1);
100             my $w;
101
102             if ($s->xact_type eq 'circulation') {
103                 $w = $cstore->request('open-ils.cstore.direct.action.circulation.retrieve' => $xact)->gather(1)->circ_lib :
104             } elsif ($s->xact_type eq 'grocery') {
105                 $w = $cstore->request('open-ils.cstore.direct.money.grocery.retrieve' => $xact)->gather(1)->billing_location;
106             } elsif ($s->xact_type eq 'reservation') {
107                 $w = $cstore->request('open-ils.cstore.direct.booking.reservation.retrieve' => $xact)->gather(1)->pickup_lib;
108             } else {
109                 die;
110             }
111     
112             my $failures = $actor->request('open-ils.actor.user.perm.check', $auth_ses, $user->id, $w, ['MARK_BAD_DEBT'])->gather(1);
113     
114             if (@$failures) {
115                 push @lines, [ $xact, '"Permission Failure"', '""', '""', '""' ];
116             } else {
117                 $x->unrecovered($mark_bad);
118                 my $result = $cstore->request('open-ils.cstore.direct.money.billable_xact.update' => $x)->gather(1);
119                 if ($result != $x->id) {
120                     push @lines, [ $xact, '"Update Failure"', '""', '""', '""' ];
121                 } else {
122                     my $amount = $s->balance_owed;
123                     my $start = $s->xact_start;
124                     my $barcode = $c->barcode;
125
126                     if ( $mark_bad eq 't' ) {
127                         push @lines, [ $xact, '"Marked Bad Debt"', $amount, "\"$start\"", "\"$barcode\"" ];
128                     } else {
129                         push @lines, [ $xact, '"Unmarked Bad Debt"', $amount, "\"$start\"", "\"$barcode\"" ];
130                     }
131                 }
132             }
133         } otherwise {
134             push @lines, [ $xact, '"Update Failure"', '""', '""', '""' ];
135         };
136     }
137
138     $cstore->request('open-ils.cstore.transaction.commit')->gather(1);
139     $cstore->disconnect();
140
141     if ($format eq 'csv') {
142         $r->headers_out->set("Content-Disposition" => "inline; filename=bad_debt_$date.csv");
143             $r->content_type('application/octet-stream');
144
145         $r->print( join(',', @header) . "\n" );
146         $r->print( join(',', @$_    ) . "\n" ) for (@lines);
147
148     } elsif ($format eq 'json') {
149
150             $r->content_type('application/json');
151
152         $r->print( '[' );
153
154         my $first = 1;
155         for my $line ( @lines ) {
156             $r->print( ',' ) if $first;
157             $first = 0;
158
159             $r->print( '{' );
160             for my $field ( 0 .. 4 ) {
161                 $r->print( "$header[$field] : $$line[$field]" );
162                 $r->print( ',' ) if ($field < 4);
163             }
164             $r->print( '}' );
165         }
166
167         $r->print( ']' );
168     }
169
170         return Apache2::Const::OK;
171
172 }
173
174 sub verify_login {
175         my $auth_token = shift;
176         return undef unless $auth_token;
177
178         my $user = OpenSRF::AppSession
179                 ->create("open-ils.auth")
180                 ->request( "open-ils.auth.session.retrieve", $auth_token )
181                 ->gather(1);
182
183         if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
184                 return undef;
185         }
186
187         return $user if ref($user);
188         return undef;
189 }
190
191 sub show_template {
192         my $r = shift;
193
194         $r->content_type('text/html');
195         $r->print(<<HTML);
196
197 <html>
198         <head>
199                 <title>Record Export</title>
200         </head>
201         <body>
202                 <form method="POST" enctype="multipart/form-data">
203                         Use field number <input type="text" size="2" maxlength="2" name="idcolumn" value="0"/> (starting from 0)
204                         from CSV file <input type="file" name="idfile"/>
205                         <input type="submit" value="Mark Transactions Unrecoverable"/>
206                 </form>
207         </body>
208 </html>
209
210 HTML
211
212         return Apache2::Const::OK;
213 }
214
215 1;