diff options
Diffstat (limited to 'htetc')
| -rw-r--r-- | htetc/global.asa | 167 | ||||
| -rw-r--r-- | htetc/handler.pl | 84 | ||||
| -rw-r--r-- | htetc/handler.pl-1.0x | 161 |
3 files changed, 187 insertions, 225 deletions
diff --git a/htetc/global.asa b/htetc/global.asa index e05701d56..3d9aae437 100644 --- a/htetc/global.asa +++ b/htetc/global.asa @@ -1,7 +1,3 @@ -BEGIN { eval "use Devel::AutoProfiler;"; } #only if installed... -#BEGIN { package Devel::AutoProfiler; use vars qw(%caller_info); } -#use Devel::AutoProfiler; - use strict; use vars qw( $cgi $p ); use CGI 2.47; @@ -14,7 +10,6 @@ use HTML::Entities; use IO::Handle; use IO::File; use String::Approx qw(amatch); -use Chart::LinesPoints; use HTML::Widgets::SelectLayers 0.03; use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name); use FS::Record qw(qsearch qsearchs fields dbdef); @@ -41,8 +36,6 @@ 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); @@ -50,13 +43,10 @@ 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::svc_external; use FS::type_pkgs; use FS::part_export; use FS::part_export_option; @@ -73,159 +63,22 @@ sub Script_OnStart { &cgisuidsetup($cgi); $p = popurl(2); #print $cgi->header( '-expires' => 'now' ); - #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 - if ( Devel::AutoProfiler->can('__recursively_fetch_subs_in_package') ) { - #should check to see it's my special version. well, switch to FS::Profiler - - #nicked from Devel::AutoProfiler::INIT - my %subs = Devel::AutoProfiler::__recursively_fetch_subs_in_package('main'); - - - SUB : while( my ($name, $ref) = each(%subs) ) - { - #next if $name =~ /^(main::)?Apache::/; - next unless $name =~ /FS/; - foreach my $sub (@Devel::AutoProfiler::do_not_instrument_this_sub) - { - if ($name =~ /$sub/) - { - next SUB; - } - } - next if ($Devel::AutoProfiler::do_not_instrument_this_sub{$name}); - #warn "INIT name is $name \n"; - Devel::AutoProfiler::__instrument_sub($name, $ref); - } - - } - } sub Script_OnFlush { my $ref = $Response->{BinaryRef}; #$$ref = $cgi->header( @FS::CGI::header ) . $$ref; - #$$ref = $cgi->header() . $$ref; - #warn "Script_OnFlush called with dbh ". dbh. "\n"; - #if ( dbh->can('sprintProfile') ) { - if ( UNIVERSAL::can(dbh, 'sprintProfile') ) { - #warn "dbh can sprintProfile\n"; - if ( lc($Response->{ContentType}) eq 'text/html' ) { #con - #warn "contenttype is sprintProfile\n"; - $$ref =~ s/<\/BODY>[\s\n]*<\/HTML>[\s\n]*$//i - or warn "can't remove"; - - #$$ref .= '<PRE>'. ("\n"x96). encode_entities(dbh->sprintProfile()). '</PRE>'; - # wtf? konqueror... - $$ref .= '<PRE>'. ("\n"x4096). encode_entities(dbh->sprintProfile()). - "\n\n". &sprintAutoProfile(). '</PRE>'; - - $$ref .= '</BODY></HTML>'; - } - dbh->{'private_profile'} = {}; - } -} - -#if ( defined(@DBIx::Profile::ISA) && DBIx::Profile::db->can('sprintProfile') ) { -#if ( defined(@DBIx::Profile::ISA) && UNIVERSAL::can('DBIx::Profile::db', 'sprintProfile') ) { -if ( defined(@DBIx::Profile::ISA) ) { - - #warn "enabling profiling redirects"; - *CGI::redirect = sub { - my( $self, $location) = @_; - my $page = - $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'} = {}; - return $page; - }; - -} - -sub by_total_time -{ - return $a->{total_time_in_sub} <=> $b->{total_time_in_sub}; -} - -sub sprintAutoProfile { - my %caller_info = %Devel::AutoProfiler::caller_info; - return unless keys %caller_info; - - %Devel::AutoProfiler::caller_info = (); - - my @keys = keys(%caller_info); + if ( dbh->can('sprintProfile') ) { - foreach my $key (@keys) - { - my $href = $caller_info{$key}; - - $href->{who_am_i} = $key; - } - - my @subs = values(%caller_info); - - #my @sorted = sort by_total_time ( @subs ); - my @sorted = reverse sort by_total_time ( @subs ); - - # print Dumper \@sorted; - - my @readable_info; - - foreach my $sort (@sorted) - { - push(@readable_info, delete($sort->{who_am_i})); - push(@readable_info, $sort); - } - - use Data::Dumper; - return encode_entities(Dumper(\@readable_info)); - -} - -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>'; + $$ref =~ s/<\/BODY>[\s\n]*<\/HTML>[\s\n]*$//i + or warn "can't remove"; + + #$$ref .= '<PRE>'. ("\n"x96). encode_entities(dbh->sprintProfile()). '</PRE>'; + # wtf? konqueror... + $$ref .= '<PRE>'. ("\n"x4096). encode_entities(dbh->sprintProfile()). '</PRE>'; + $$ref .= '</BODY></HTML>'; + dbh->{'private_profile'} = {}; - - $Response->End; - - }; - -} else { - - *redirect = sub { - $Response->Redirect(@_); } - } - -1; - diff --git a/htetc/handler.pl b/htetc/handler.pl index 584d930b1..d7b41139d 100644 --- a/htetc/handler.pl +++ b/htetc/handler.pl @@ -7,7 +7,7 @@ package HTML::Mason; # Bring in main Mason package. -use HTML::Mason 1.1; +use HTML::Mason; # Bring in ApacheHandler, necessary for mod_perl integration. # Uncomment the second line (and comment the first) to use @@ -72,7 +72,6 @@ sub handler use IO::Handle; use IO::File; use String::Approx qw(amatch); - use Chart::LinesPoints; use HTML::Widgets::SelectLayers 0.03; use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name); use FS::Record qw(qsearch qsearchs fields dbdef); @@ -99,8 +98,6 @@ sub handler 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); @@ -108,13 +105,10 @@ 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,72 +118,26 @@ sub handler *CGI::redirect = sub { my( $self, $location ) = @_; use vars qw($m); - - 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); - ''; - - } - + #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); - - 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 new file mode 100644 index 000000000..8840b0816 --- /dev/null +++ b/htetc/handler.pl-1.0x @@ -0,0 +1,161 @@ +#!/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::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::part_router_field; + use FS::router_field; + use FS::addr_block; + use FS::part_sb_field; + use FS::sb_field; + 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; |