htetc/handler.pl

   1 #!/usr/bin/perl
   2 #
   3 # This is a basic, fairly fuctional Mason handler.pl.
   4 #
   5 # For something a little more involved, check out session_handler.pl
   6
   7 package HTML::Mason;
   8
   9 # Bring in main Mason package.
  10 use HTML::Mason 1.1;
  11
  12 # Bring in ApacheHandler, necessary for mod_perl integration.
  13 # Uncomment the second line (and comment the first) to use
  14 # Apache::Request instead of CGI.pm to parse arguments.
  15 use HTML::Mason::ApacheHandler;
  16 # use HTML::Mason::ApacheHandler (args_method=>'mod_perl');
  17
  18 # Uncomment the next line if you plan to use the Mason previewer.
  19 #use HTML::Mason::Preview;
  20
  21 use strict;
  22
  23 # List of modules that you want to use from components (see Admin
  24 # manual for details)
  25 #{  package HTML::Mason::Commands;
  26 #   use CGI;
  27 #}
  28
  29 # Create Mason objects
  30 #
  31
  32 #my $parser = new HTML::Mason::Parser;
  33 #my $interp = new HTML::Mason::Interp (parser=>$parser,
  34 #                                      comp_root=>'/var/www/masondocs',
  35 #                                      data_dir=>'/usr/local/etc/freeside/masondata',
  36 #                                      out_mode=>'stream',
  37 #                                     );
  38 my $ah = new HTML::Mason::ApacheHandler (
  39   #interp => $interp,
  40   #auto_send_headers => 0,
  41   comp_root=>'%%%FREESIDE_DOCUMENT_ROOT%%%',
  42   data_dir=>'/usr/local/etc/freeside/masondata',
  43   #out_mode=>'stream',
  44 );
  45
  46 # Activate the following if running httpd as root (the normal case).
  47 # Resets ownership of all files created by Mason at startup.
  48 #
  49 #chown (Apache->server->uid, Apache->server->gid, $interp->files_written);
  50
  51 sub handler
  52 {
  53     my ($r) = @_;
  54
  55     # If you plan to intermix images in the same directory as
  56     # components, activate the following to prevent Mason from
  57     # evaluating image files as components.
  58     #
  59     #return -1 if $r->content_type && $r->content_type !~ m|^text/|i;
  60
  61     #rar
  62     { package HTML::Mason::Commands;
  63       use strict;
  64       use vars qw( $cgi $p );
  65       use CGI 2.47;
  66       #use CGI::Carp qw(fatalsToBrowser);
  67       use Date::Format;
  68       use Date::Parse;
  69       use Time::Local;
  70       use Tie::IxHash;
  71       use HTML::Entities;
  72       use IO::Handle;
  73       use IO::File;
  74       use Net::Whois::Raw qw(whois);
  75       use Business::CreditCard;
  76       use String::Approx qw(amatch);
  77       use Chart::LinesPoints;
  78       use HTML::Widgets::SelectLayers 0.03;
  79       use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name);
  80       use FS::Record qw(qsearch qsearchs fields dbdef);
  81       use FS::Conf;
  82       use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot
  83                      small_custview myexit http_header);
  84       use FS::Msgcat qw(gettext geterror);
  85       use FS::Misc qw( send_email );
  86       use FS::Report::Table::Monthly;
  87
  88       use FS::agent;
  89       use FS::agent_type;
  90       use FS::domain_record;
  91       use FS::cust_bill;
  92       use FS::cust_bill_pay;
  93       use FS::cust_credit;
  94       use FS::cust_credit_bill;
  95       use FS::cust_main;
  96       use FS::cust_main_county;
  97       use FS::cust_pay;
  98       use FS::cust_pkg;
  99       use FS::cust_refund;
 100       use FS::cust_svc;
 101       use FS::nas;
 102       use FS::part_bill_event;
 103       use FS::part_pkg;
 104       use FS::part_referral;
 105       use FS::part_svc;
 106       use FS::part_svc_router;
 107       use FS::part_virtual_field;
 108       use FS::pkg_svc;
 109       use FS::port;
 110       use FS::queue qw(joblisting);
 111       use FS::raddb;
 112       use FS::session;
 113       use FS::svc_acct;
 114       use FS::svc_acct_pop qw(popselector);
 115       use FS::svc_domain;
 116       use FS::svc_forward;
 117       use FS::svc_www;
 118       use FS::router;
 119       use FS::addr_block;
 120       use FS::svc_broadband;
 121       use FS::svc_external;
 122       use FS::type_pkgs;
 123       use FS::part_export;
 124       use FS::part_export_option;
 125       use FS::export_svc;
 126       use FS::msgcat;
 127
 128       *CGI::redirect = sub {
 129         my( $self, $location ) = @_;
 130         use vars qw($m);
 131
 132         if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect
 133
 134           my $page =
 135             qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
 136             '<BR><BR><PRE>'.
 137               ( UNIVERSAL::can(dbh, 'sprintProfile')
 138                   ? encode_entities(dbh->sprintProfile())
 139                   : 'DBIx::Profile missing sprintProfile method;'.
 140                     'unpatched or too old?'                        ).
 141             #"\n\n". &sprintAutoProfile().  '</PRE>'.
 142             "\n\n".                         '</PRE>'.
 143             '</BODY></HTML>';
 144           dbh->{'private_profile'} = {};
 145           return $page;
 146
 147         } else { #normal redirect
 148
 149           $m->redirect($location);
 150           '';
 151
 152         }
 153
 154       };
 155
 156       $cgi = new CGI;
 157       &cgisuidsetup($cgi);
 158       #&cgisuidsetup($r);
 159       $p = popurl(2);
 160
 161       sub include {
 162         use vars qw($m);
 163         $m->scomp(@_);
 164       }
 165
 166       sub redirect {
 167         my( $location ) = @_;
 168         use vars qw($m);
 169         $m->clear_buffer;
 170         #false laziness w/above
 171         if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect
 172
 173           $m->print(
 174             qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
 175             '<BR><BR><PRE>'.
 176               ( UNIVERSAL::can(dbh, 'sprintProfile')
 177                   ? encode_entities(dbh->sprintProfile())
 178                   : 'DBIx::Profile missing sprintProfile method;'.
 179                     'unpatched or too old?'                        ).
 180             #"\n\n". &sprintAutoProfile().  '</PRE>'.
 181             "\n\n".                         '</PRE>'.
 182             '</BODY></HTML>'
 183           );
 184           dbh->{'private_profile'} = {};
 185
 186           $m->abort(200);
 187
 188         } else { #normal redirect
 189
 190           $m->redirect($location);
 191
 192         }
 193
 194       }
 195
 196     } # end package HTML::Mason::Commands;
 197
 198     $r->content_type('text/html');
 199     #eorar
 200
 201     my $headers = $r->headers_out;
 202     $headers->{'Cache-control'} = 'no-cache';
 203     #$r->no_cache(1);
 204     $headers->{'Expires'} = '0';
 205
 206 #    $r->send_http_header;
 207
 208     my $status = $ah->handle_request($r);
 209
 210     $status;
 211 }
 212
 213 1;