diff options
Diffstat (limited to 'htetc')
-rw-r--r-- | htetc/global.asa | 55 | ||||
-rw-r--r-- | htetc/handler.pl | 83 | ||||
-rw-r--r-- | htetc/handler.pl-1.0x | 158 |
3 files changed, 114 insertions, 182 deletions
diff --git a/htetc/global.asa b/htetc/global.asa index 6f76fd256..8027ae3e5 100644 --- a/htetc/global.asa +++ b/htetc/global.asa @@ -4,7 +4,8 @@ BEGIN { eval "use Devel::AutoProfiler;"; } #only if installed... use strict; use vars qw( $cgi $p ); -use CGI; +use Apache::ASP 2.55; +use CGI 2.47; #use CGI::Carp qw(fatalsToBrowser); use Date::Format; use Date::Parse; @@ -15,13 +16,14 @@ use IO::Handle; use IO::File; use String::Approx qw(amatch); use Chart::LinesPoints; -use HTML::Widgets::SelectLayers 0.02; +use HTML::Widgets::SelectLayers 0.03; use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name); use FS::Record qw(qsearch qsearchs fields dbdef); use FS::Conf; use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot small_custview myexit http_header); use FS::Msgcat qw(gettext geterror); +use FS::Misc qw( send_email ); use FS::agent; use FS::agent_type; @@ -56,6 +58,7 @@ use FS::svc_www; use FS::router; use FS::addr_block; use FS::svc_broadband; +use FS::svc_external; use FS::type_pkgs; use FS::part_export; use FS::part_export_option; @@ -72,7 +75,8 @@ sub Script_OnStart { &cgisuidsetup($cgi); $p = popurl(2); #print $cgi->header( '-expires' => 'now' ); - dbh->{'private_profile'} = {} if dbh->can('sprintProfile'); + #dbh->{'private_profile'} = {} if dbh->can('sprintProfile'); + dbh->{'private_profile'} = {} if UNIVERSAL::can(dbh, 'sprintProfile'); #really should check for FS::Profiler or something # Devel::AutoProfiler _our_ VERSION? thanks a fucking lot @@ -109,7 +113,7 @@ sub Script_OnFlush { #$$ref = $cgi->header() . $$ref; #warn "Script_OnFlush called with dbh ". dbh. "\n"; #if ( dbh->can('sprintProfile') ) { - if ( UNIVERSAL::can(dbh,'sprintProfile') ) { + if ( UNIVERSAL::can(dbh, 'sprintProfile') ) { #warn "dbh can sprintProfile\n"; if ( lc($Response->{ContentType}) eq 'text/html' ) { #con #warn "contenttype is sprintProfile\n"; @@ -136,8 +140,12 @@ if ( defined(@DBIx::Profile::ISA) ) { my( $self, $location) = @_; my $page = $cgi->header. - qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A><BR><BR>!. - '<PRE>'. encode_entities(dbh->sprintProfile()). + qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!. + '<BR><BR><PRE>'. + ( UNIVERSAL::can(dbh, 'sprintProfile') + ? encode_entities(dbh->sprintProfile()) + : 'DBIx::Profile missing sprintProfile method;'. + 'unpatched or too old?' ). "\n\n". &sprintAutoProfile(). '</PRE>'. '</BODY></HTML>'; dbh->{'private_profile'} = {}; @@ -186,5 +194,40 @@ sub sprintAutoProfile { } +sub include { + $Response->Include(@_); +} + +if ( defined(@DBIx::Profile::ISA) ) { + + #false laziness w/above + *redirect = sub { + my($location) = @_; + + ${$Response->{BinaryRef}} = + $cgi->header. + qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!. + '<BR><BR><PRE>'. + ( UNIVERSAL::can(dbh, 'sprintProfile') + ? encode_entities(dbh->sprintProfile()) + : 'DBIx::Profile missing sprintProfile method;'. + 'unpatched or too old?' ). + "\n\n". &sprintAutoProfile(). '</PRE>'. + '</BODY></HTML>'; + + dbh->{'private_profile'} = {}; + + $Response->End; + + }; + +} else { + + *redirect = sub { + $Response->Redirect(@_); + } + +} + 1; diff --git a/htetc/handler.pl b/htetc/handler.pl index c81db8664..618c5856f 100644 --- a/htetc/handler.pl +++ b/htetc/handler.pl @@ -7,7 +7,7 @@ package HTML::Mason; # Bring in main Mason package. -use HTML::Mason; +use HTML::Mason 1.1; # Bring in ApacheHandler, necessary for mod_perl integration. # Uncomment the second line (and comment the first) to use @@ -62,7 +62,7 @@ sub handler { package HTML::Mason::Commands; use strict; use vars qw( $cgi $p ); - use CGI; + use CGI 2.47; #use CGI::Carp qw(fatalsToBrowser); use Date::Format; use Date::Parse; @@ -73,13 +73,14 @@ sub handler use IO::File; use String::Approx qw(amatch); use Chart::LinesPoints; - use HTML::Widgets::SelectLayers 0.02; + use HTML::Widgets::SelectLayers 0.03; use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name); use FS::Record qw(qsearch qsearchs fields dbdef); use FS::Conf; use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot small_custview myexit http_header); use FS::Msgcat qw(gettext geterror); + use FS::Misc qw( send_email ); use FS::agent; use FS::agent_type; @@ -108,13 +109,13 @@ sub handler use FS::session; use FS::svc_acct; use FS::svc_acct_pop qw(popselector); - use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_forward; use FS::svc_www; use FS::router; use FS::addr_block; use FS::svc_broadband; + use FS::svc_external; use FS::type_pkgs; use FS::part_export; use FS::part_export_option; @@ -124,26 +125,72 @@ sub handler *CGI::redirect = sub { my( $self, $location ) = @_; use vars qw($m); - #http://www.masonhq.com/docs/faq/#how_do_i_do_an_external_redirect - $m->clear_buffer; - # The next two lines are necessary to stop Apache from re-reading - # POSTed data. - $r->method('GET'); - $r->headers_in->unset('Content-length'); - $r->content_type('text/html'); - #$r->err_header_out('Location' => $location); - $r->header_out('Location' => $location); - $r->header_out('Content-Type' => 'text/html'); - $m->abort(302); - - ''; + + if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect + + my $page = + qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!. + '<BR><BR><PRE>'. + ( UNIVERSAL::can(dbh, 'sprintProfile') + ? encode_entities(dbh->sprintProfile()) + : 'DBIx::Profile missing sprintProfile method;'. + 'unpatched or too old?' ). + #"\n\n". &sprintAutoProfile(). '</PRE>'. + "\n\n". '</PRE>'. + '</BODY></HTML>'; + dbh->{'private_profile'} = {}; + return $page; + + } else { #normal redirect + + $m->redirect($location); + ''; + + } + }; $cgi = new CGI; &cgisuidsetup($cgi); #&cgisuidsetup($r); $p = popurl(2); - } + + sub include { + use vars qw($m); + $m->scomp(@_); + } + + sub redirect { + my( $location ) = @_; + use vars qw($m); + $m->clear_buffer; + #false laziness w/above + if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect + + $m->print( + qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!. + '<BR><BR><PRE>'. + ( UNIVERSAL::can(dbh, 'sprintProfile') + ? encode_entities(dbh->sprintProfile()) + : 'DBIx::Profile missing sprintProfile method;'. + 'unpatched or too old?' ). + #"\n\n". &sprintAutoProfile(). '</PRE>'. + "\n\n". '</PRE>'. + '</BODY></HTML>' + ); + dbh->{'private_profile'} = {}; + + $m->abort(200); + + } else { #normal redirect + + $m->redirect($location); + + } + + } + + } # end package HTML::Mason::Commands; $r->content_type('text/html'); #eorar diff --git a/htetc/handler.pl-1.0x b/htetc/handler.pl-1.0x deleted file mode 100644 index def579f49..000000000 --- a/htetc/handler.pl-1.0x +++ /dev/null @@ -1,158 +0,0 @@ -#!/usr/bin/perl -# -# This is a basic, fairly fuctional Mason handler.pl. -# -# For something a little more involved, check out session_handler.pl - -package HTML::Mason; - -# Bring in main Mason package. -use HTML::Mason; - -# Bring in ApacheHandler, necessary for mod_perl integration. -# Uncomment the second line (and comment the first) to use -# Apache::Request instead of CGI.pm to parse arguments. -use HTML::Mason::ApacheHandler; -# use HTML::Mason::ApacheHandler (args_method=>'mod_perl'); - -# Uncomment the next line if you plan to use the Mason previewer. -#use HTML::Mason::Preview; - -use strict; - -# List of modules that you want to use from components (see Admin -# manual for details) -#{ package HTML::Mason::Commands; -# use CGI; -#} - -# Create Mason objects -# -my $parser = new HTML::Mason::Parser; -my $interp = new HTML::Mason::Interp (parser=>$parser, - comp_root=>'/var/www/freeside', - data_dir=>'/usr/local/etc/freeside/masondata', - out_mode=>'stream', - ); -my $ah = new HTML::Mason::ApacheHandler ( interp => $interp, - #auto_send_headers => 0, - ); - -# Activate the following if running httpd as root (the normal case). -# Resets ownership of all files created by Mason at startup. -# -chown (Apache->server->uid, Apache->server->gid, $interp->files_written); - -sub handler -{ - my ($r) = @_; - - # If you plan to intermix images in the same directory as - # components, activate the following to prevent Mason from - # evaluating image files as components. - # - #return -1 if $r->content_type && $r->content_type !~ m|^text/|i; - - #rar - { package HTML::Mason::Commands; - use strict; - use vars qw( $cgi $p ); - use CGI; - #use CGI::Carp qw(fatalsToBrowser); - use Date::Format; - use Date::Parse; - use Time::Local; - use Tie::IxHash; - use HTML::Entities; - use IO::Handle; - use IO::File; - use String::Approx qw(amatch); - use Chart::LinesPoints; - use HTML::Widgets::SelectLayers 0.02; - use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name); - use FS::Record qw(qsearch qsearchs fields dbdef); - use FS::Conf; - use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot - small_custview myexit http_header); - use FS::Msgcat qw(gettext geterror); - - use FS::agent; - use FS::agent_type; - use FS::domain_record; - use FS::cust_bill; - use FS::cust_bill_pay; - use FS::cust_credit; - use FS::cust_credit_bill; - use FS::cust_main; - use FS::cust_main_county; - use FS::cust_pay; - use FS::cust_pkg; - use FS::cust_refund; - use FS::cust_svc; - use FS::nas; - use FS::part_bill_event; - use FS::part_pkg; - use FS::part_referral; - use FS::part_svc; - use FS::part_svc_router; - use FS::part_virtual_field; - use FS::pkg_svc; - use FS::port; - use FS::queue qw(joblisting); - use FS::raddb; - use FS::session; - use FS::svc_acct; - use FS::svc_acct_pop qw(popselector); - use FS::svc_acct_sm; - use FS::svc_domain; - use FS::svc_forward; - use FS::svc_www; - use FS::router; - use FS::addr_block; - use FS::svc_broadband; - use FS::type_pkgs; - use FS::part_export; - use FS::part_export_option; - use FS::export_svc; - use FS::msgcat; - - *CGI::redirect = sub { - my( $self, $location ) = @_; - - #http://www.masonhq.com/docs/faq/#how_do_i_do_an_external_redirect - $m->clear_buffer; - # The next two lines are necessary to stop Apache from re-reading - # POSTed data. - $r->method('GET'); - $r->headers_in->unset('Content-length'); - $r->content_type('text/html'); - #$r->err_header_out('Location' => $location); - $r->header_out('Location' => $location); - $r->header_out('Content-Type' => 'text/html'); - $m->abort(302); - - ''; - }; - - $cgi = new CGI; - &cgisuidsetup($cgi); - #&cgisuidsetup($r); - $p = popurl(2); - } - - $r->content_type('text/html'); - #eorar - - my $headers = $r->headers_out; - $headers->{'Pragma'} = $headers->{'Cache-control'} = 'no-cache'; - #$r->no_cache(1); - $headers->{'Expires'} = '0'; - -# $r->send_http_header; - - my $status = $ah->handle_request($r); - - $status; -} - -1; |