X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=htetc%2Fglobal.asa;h=f550560eed10fd118df288628b49686e71fe932e;hb=7bd42d6a73d2f21cffb9f0e3071e2527237c9e25;hp=21e112e6b34f3683d76f68706fb8fe3409ae78c4;hpb=abf5c5442afce5198f6289840791c96f58254e85;p=freeside.git diff --git a/htetc/global.asa b/htetc/global.asa index 21e112e6b..f550560ee 100644 --- a/htetc/global.asa +++ b/htetc/global.asa @@ -4,7 +4,7 @@ BEGIN { eval "use Devel::AutoProfiler;"; } #only if installed... use strict; use vars qw( $cgi $p ); -use CGI; +use CGI 2.47; #use CGI::Carp qw(fatalsToBrowser); use Date::Format; use Date::Parse; @@ -56,6 +56,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; @@ -73,7 +74,7 @@ sub Script_OnStart { $p = popurl(2); #print $cgi->header( '-expires' => 'now' ); #dbh->{'private_profile'} = {} if dbh->can('sprintProfile'); - dbh->{'private_profile'} = {} if UNIVERSAL::can(dbh, '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 @@ -137,8 +138,8 @@ if ( defined(@DBIx::Profile::ISA) ) { my( $self, $location) = @_; my $page = $cgi->header. - qq!
Redirect to $location'. + qq!Redirect to $location!. + ''. ( UNIVERSAL::can(dbh, 'sprintProfile') ? encode_entities(dbh->sprintProfile()) : 'DBIx::Profile missing sprintProfile method;'. @@ -191,5 +192,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!Redirect to $location!. + ''. + ( UNIVERSAL::can(dbh, 'sprintProfile') + ? encode_entities(dbh->sprintProfile()) + : 'DBIx::Profile missing sprintProfile method;'. + 'unpatched or too old?' ). + "\n\n". &sprintAutoProfile(). ''. + ''; + + dbh->{'private_profile'} = {}; + + $Response->End; + + }; + +} else { + + *redirect = sub { + $Response->Redirect(@_); + } + +} + 1;