update for MailTools v2.00
[freeside.git] / htetc / handler.pl
1 #!/usr/bin/perl
2
3 package HTML::Mason;
4
5 use strict;
6 use vars qw($r);
7 use HTML::Mason 1.27; #http://www.masonhq.com/?ApacheModPerl2Redirect
8 use HTML::Mason::Interp;
9 use HTML::Mason::Compiler::ToObject;
10
11 # Bring in ApacheHandler, necessary for mod_perl integration.
12 # Uncomment the second line (and comment the first) to use
13 # Apache::Request instead of CGI.pm to parse arguments.
14 use HTML::Mason::ApacheHandler;
15 # use HTML::Mason::ApacheHandler (args_method=>'mod_perl');
16
17 ###use Module::Refresh;###
18
19 # List of modules that you want to use from components (see Admin
20 # manual for details)
21 #{  package HTML::Mason::Commands;
22 #   use CGI;
23 #}
24
25 if ( %%%RT_ENABLED%%% ) {
26  eval '
27    use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
28    use RT;
29    use vars qw($Nobody $SystemUser);
30    RT::LoadConfig();
31  ';
32  die $@ if $@;
33 }
34
35 # Create Mason objects
36
37 my %interp = (
38   request_class        => 'HTML::Mason::Request::ApacheHandler',
39   data_dir             => '%%%MASONDATA%%%',
40   error_mode           => 'output',
41   error_format         => 'html',
42   ignore_warnings_expr => '.',
43   comp_root            => [
44                             [ 'freeside' => '%%%FREESIDE_DOCUMENT_ROOT%%%'    ],
45                             [ 'rt'       => '%%%FREESIDE_DOCUMENT_ROOT%%%/rt' ],
46                           ],
47 );
48
49 my $fs_interp = new HTML::Mason::Interp (
50   %interp,
51   escape_flags => { 'js_string' => sub {
52                       #${$_[0]} =~ s/(['\\\n])/'\\'.($1 eq "\n" ? 'n' : $1)/ge;
53                       ${$_[0]} =~ s/(['\\])/\\$1/g;
54                       ${$_[0]} =~ s/\n/\\n/g;
55                       ${$_[0]} = "'". ${$_[0]}. "'";
56                     }
57                   },
58 );
59
60 my $rt_interp = new HTML::Mason::Interp (
61   %interp,
62   escape_flags => { 'h' => \&RT::Interface::Web::EscapeUTF8 },
63   compiler     => HTML::Mason::Compiler::ToObject->new(
64                     default_escape_flags => 'h',
65                     allow_globals        => [qw(%session)],
66                   ),
67 );
68
69 my $ah = new HTML::Mason::ApacheHandler (
70   interp      => $fs_interp,
71   args_method => 'CGI', #(and FS too)
72 );
73
74 # Activate the following if running httpd as root (the normal case).
75 # Resets ownership of all files created by Mason at startup.
76 #
77 #chown (Apache->server->uid, Apache->server->gid, $interp->files_written);
78
79 sub handler
80 {
81     ($r) = @_;
82
83     # If you plan to intermix images in the same directory as
84     # components, activate the following to prevent Mason from
85     # evaluating image files as components.
86     #
87     #return -1 if $r->content_type && $r->content_type !~ m|^text/|i;
88
89     #rar
90     { package HTML::Mason::Commands;
91       use strict;
92       use vars qw( $cgi $p $fsurl);
93       use vars qw( %session );
94       use CGI 2.47 qw(-private_tempfiles);
95       #use CGI::Carp qw(fatalsToBrowser);
96       use CGI::Cookie;
97       use List::Util qw( max min );
98       use Data::Dumper;
99       use Date::Format;
100       use Date::Parse;
101       use Time::Local;
102       use Time::Duration;
103       use DateTime;
104       use DateTime::Format::Strptime;
105       use Lingua::EN::Inflect qw(PL);
106       use Tie::IxHash;
107       use URI::Escape;
108       use HTML::Entities;
109       use JSON;
110       use MIME::Base64;
111       use IO::Handle;
112       use IO::File;
113       use IO::Scalar;
114       #not actually using this yet anyway...# use IPC::Run3 0.036;
115       use Net::Whois::Raw qw(whois);
116       if ( $] < 5.006 ) {
117         eval "use Net::Whois::Raw 0.32 qw(whois)";
118         die $@ if $@;
119       }
120       use Text::CSV_XS;
121       use Spreadsheet::WriteExcel;
122       use Business::CreditCard 0.30; #for mask-aware cardtype()
123       use NetAddr::IP;
124       use String::Approx qw(amatch);
125       use Chart::LinesPoints;
126       use Chart::Mountain;
127       use Color::Scheme;
128       use HTML::Widgets::SelectLayers 0.07;
129       use Locale::Country;
130       use FS;
131       use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name);
132       use FS::Record qw(qsearch qsearchs fields dbdef str2time_sql);
133       use FS::Conf;
134       use FS::CGI qw(header menubar popurl rooturl table itable ntable idiot
135                      eidiot small_custview myexit http_header);
136       use FS::UI::Web qw(svc_url);
137       use FS::UI::bytecount;
138       use FS::Msgcat qw(gettext geterror);
139       use FS::Misc qw( send_email send_fax states_hash counties state_label );
140       use FS::Report::Table::Monthly;
141       use FS::TicketSystem;
142
143       use FS::agent;
144       use FS::agent_type;
145       use FS::domain_record;
146       use FS::cust_bill;
147       use FS::cust_bill_pay;
148       use FS::cust_credit;
149       use FS::cust_credit_bill;
150       use FS::cust_main qw(smart_search);
151       use FS::cust_main_county;
152       use FS::cust_pay;
153       use FS::cust_pkg;
154       use FS::cust_pkg_reason;
155       use FS::cust_refund;
156       use FS::cust_svc;
157       use FS::nas;
158       use FS::part_bill_event;
159       use FS::part_event;
160       use FS::part_event_condition;
161       use FS::part_pkg;
162       use FS::part_referral;
163       use FS::part_svc;
164       use FS::part_svc_router;
165       use FS::part_virtual_field;
166       use FS::pay_batch;
167       use FS::pkg_svc;
168       use FS::port;
169       use FS::queue qw(joblisting);
170       use FS::raddb;
171       use FS::session;
172       use FS::svc_acct;
173       use FS::svc_acct_pop qw(popselector);
174       use FS::acct_rt_transaction;
175       use FS::svc_domain;
176       use FS::svc_forward;
177       use FS::svc_www;
178       use FS::router;
179       use FS::addr_block;
180       use FS::svc_broadband;
181       use FS::svc_external;
182       use FS::type_pkgs;
183       use FS::part_export;
184       use FS::part_export_option;
185       use FS::export_svc;
186       use FS::msgcat;
187       use FS::rate;
188       use FS::rate_region;
189       use FS::rate_prefix;
190       use FS::payment_gateway;
191       use FS::agent_payment_gateway;
192       use FS::XMLRPC;
193       use FS::payby;
194       use FS::cdr;
195       use FS::inventory_class;
196       use FS::inventory_item;
197       use FS::pkg_class;
198       use FS::access_user;
199       use FS::access_user_pref;
200       use FS::access_group;
201       use FS::access_usergroup;
202       use FS::access_groupagent;
203       use FS::access_right;
204       use FS::AccessRight;
205       use FS::svc_phone;
206       use FS::reason_type;
207       use FS::reason;
208       use FS::cust_main_note;
209
210       if ( %%%RT_ENABLED%%% ) {
211         eval '
212           use RT::Tickets;
213           use RT::Transactions;
214           use RT::Users;
215           use RT::CurrentUser;
216           use RT::Templates;
217           use RT::Queues;
218           use RT::ScripActions;
219           use RT::ScripConditions;
220           use RT::Scrips;
221           use RT::Groups;
222           use RT::GroupMembers;
223           use RT::CustomFields;
224           use RT::CustomFieldValues;
225           use RT::ObjectCustomFieldValues;
226
227           use RT::Interface::Web;
228           use MIME::Entity;
229           use Text::Wrapper;
230           use Time::ParseDate;
231           use HTML::Scrubber;
232           #use Text::Quoted; #slow, unreliable, segfaults and is optional
233           use Time::HiRes;
234         ';
235         die $@ if $@;
236       }
237
238       *CGI::redirect = sub {
239         my $self = shift;
240         my $cookie = '';
241         if ( $_[0] eq '-cookie' ) { #this isn't actually used at the moment
242           (my $x, $cookie) = (shift, shift);
243           $HTML::Mason::r->err_headers_out->add( 'Set-cookie' => $cookie );
244         }
245         my $location = shift;
246
247         use vars qw($m);
248
249         # false laziness w/below
250         if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect
251
252           my $page =
253             qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
254             '<BR><BR><PRE>'.
255               ( UNIVERSAL::can(dbh, 'sprintProfile')
256                   ? encode_entities(dbh->sprintProfile())
257                   : 'DBIx::Profile missing sprintProfile method;'.
258                     'unpatched or too old?'                        ).
259             #"\n\n". &sprintAutoProfile().  '</PRE>'.
260             "\n\n".                         '</PRE>'.
261             '</BODY></HTML>';
262           dbh->{'private_profile'} = {};
263           return $page;
264
265         } else { #normal redirect
266
267           $m->redirect($location);
268           '';
269
270         }
271
272       };
273       
274       unless ( $HTML::Mason::r->filename =~ /\/rt\/.*NoAuth/ ) { #RT
275         $cgi = new CGI;
276         &cgisuidsetup($cgi);
277         #&cgisuidsetup($r);
278         $p = popurl(2);
279         $fsurl = rooturl();
280       }
281
282       sub include {
283         use vars qw($m);
284         $m->scomp(@_);
285       }
286
287       sub errorpage {
288         use vars qw($m);
289         $m->comp('/elements/errorpage.html', @_);
290       }
291
292       sub redirect {
293         my( $location ) = @_;
294         use vars qw($m);
295         $m->clear_buffer;
296         #false laziness w/above
297         if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect
298
299           $m->print(
300             qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
301             '<BR><BR><PRE>'.
302               ( UNIVERSAL::can(dbh, 'sprintProfile')
303                   ? encode_entities(dbh->sprintProfile())
304                   : 'DBIx::Profile missing sprintProfile method;'.
305                     'unpatched or too old?'                        ).
306             #"\n\n". &sprintAutoProfile().  '</PRE>'.
307             "\n\n".                         '</PRE>'.
308             '</BODY></HTML>'
309           );
310           dbh->{'private_profile'} = {};
311
312           #whew.  removing this is all that's needed to fix the annoying
313           #blank-page-instead-of-profiling-redirect-when-called-from-an-include
314           #bug triggered by mason 1.32
315           #my $rv = $m->abort(200);
316
317         } else { #normal redirect
318
319           $m->redirect($location);
320
321         }
322
323       }
324
325     } # end package HTML::Mason::Commands;
326
327     ###Module::Refresh->refresh;###
328
329     $r->content_type('text/html');
330     #eorar
331
332     my $headers = $r->headers_out;
333     $headers->{'Cache-control'} = 'no-cache';
334     #$r->no_cache(1);
335     $headers->{'Expires'} = '0';
336
337 #    $r->send_http_header;
338
339     if ( $r->filename =~ /\/rt\// ) { #RT
340
341       $ah->interp($rt_interp);
342
343       local $SIG{__WARN__};
344       local $SIG{__DIE__};
345
346       RT::Init();
347
348       # We don't need to handle non-text, non-xml items
349       return -1 if defined( $r->content_type )
350                 && $r->content_type !~ m!(^text/|\bxml\b)!io;
351
352     } else {
353
354       $ah->interp($fs_interp);
355
356     }
357
358     my %session;
359     my $status;
360     eval { $status = $ah->handle_request($r); };
361 #!!
362 #    if ( $@ ) {
363 #       $RT::Logger->crit($@);
364 #    }
365     warn $@ if $@;
366
367     undef %session;
368
369 #!!
370 #    if ($RT::Handle->TransactionDepth) {
371 #       $RT::Handle->ForceRollback;
372 #       $RT::Logger->crit(
373 #"Transaction not committed. Usually indicates a software fault. Data loss may have occurred"
374 #       );
375 #    }
376
377     $status;
378 }
379
380 1;