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 Apache::ASP 2.55;
use CGI 2.47;
#use CGI::Carp qw(fatalsToBrowser);
use Date::Format;
use Date::Parse;
use Time::Local;
use Time::Duration;
use Tie::IxHash;
use HTML::Entities;
use IO::Handle;
use IO::File;
use IO::Scalar;
use Net::Whois::Raw qw(whois);
if ( $] < 5.006 ) {
  eval "use Net::Whois::Raw 0.32 qw(whois)";
  die $@ if $@;
}
use Text::CSV_XS;
use Spreadsheet::WriteExcel;
use Business::CreditCard;
use String::Approx qw(amatch);
use Chart::LinesPoints;
use HTML::Widgets::SelectLayers 0.03;
use FS;
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::UI::Web;
use FS::Msgcat qw(gettext geterror);
use FS::Misc qw( send_email );
use FS::Report::Table::Monthly;
use FS::TicketSystem;

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_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;
use FS::export_svc;
use FS::msgcat;
use FS::rate;
use FS::rate_region;
use FS::rate_prefix;

sub Script_OnStart {
  $Response->AddHeader('Cache-control' => 'no-cache');
#  $Response->AddHeader('Expires' => 0);
  $Response->{Expires} = -36288000;

  $cgi = new CGI;
  &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);

  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 {
  my $file = shift;
  my $shift = 0;
  if ( $file =~ m(^([^/].*)/[^/]+) ) {
    unshift @{$Response->{asp}{includes_dir}}, "./$1";
    $shift = 1;
  }
  $file =~ s(^/)(%%%FREESIDE_DOCUMENT_ROOT%%%/);
  #broken in 5.005# ${$Response->TrapInclude($file, @_)};
  my $ref = $Response->TrapInclude($file, @_);
  shift @{$Response->{asp}{includes_dir}} if $shift;
  $$ref;
}

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;