summaryrefslogtreecommitdiff
path: root/htetc
diff options
context:
space:
mode:
Diffstat (limited to 'htetc')
-rw-r--r--htetc/freeside-base1.99.conf21
-rw-r--r--htetc/freeside-base1.conf (renamed from htetc/freeside-base.conf)5
-rw-r--r--htetc/freeside-base2.conf21
-rw-r--r--htetc/global.asa263
-rw-r--r--htetc/handler.pl49
5 files changed, 86 insertions, 273 deletions
diff --git a/htetc/freeside-base1.99.conf b/htetc/freeside-base1.99.conf
new file mode 100644
index 000000000..c1c187c8d
--- /dev/null
+++ b/htetc/freeside-base1.99.conf
@@ -0,0 +1,21 @@
+PerlModule Apache::compat
+
+#PerlModule Apache::DBI
+
+PerlModule HTML::Mason
+PerlSetVar MasonArgsMethod CGI
+PerlModule HTML::Mason::ApacheHandler
+
+PerlRequire "%%%MASON_HANDLER%%%"
+
+<Directory %%%FREESIDE_DOCUMENT_ROOT%%%>
+AuthName Freeside
+AuthType Basic
+AuthUserFile /usr/local/etc/freeside/htpasswd
+require valid-user
+<Files ~ (\.cgi|\.html)>
+SetHandler perl-script
+PerlHandler HTML::Mason
+</Files>
+</Directory>
+
diff --git a/htetc/freeside-base.conf b/htetc/freeside-base1.conf
index f8ebece9e..3f6bd0ee3 100644
--- a/htetc/freeside-base.conf
+++ b/htetc/freeside-base1.conf
@@ -1,4 +1,7 @@
+#PerlModule Apache::DBI
+
PerlModule HTML::Mason
+
<Directory %%%FREESIDE_DOCUMENT_ROOT%%%>
AuthName Freeside
AuthType Basic
@@ -9,7 +12,7 @@ AddHandler perl-script .cgi .html
PerlHandler HTML::Mason
</Files>
<Perl>
-require "/usr/local/etc/freeside/handler.pl";
+require "%%%MASON_HANDLER%%%";
</Perl>
</Directory>
diff --git a/htetc/freeside-base2.conf b/htetc/freeside-base2.conf
new file mode 100644
index 000000000..38f784068
--- /dev/null
+++ b/htetc/freeside-base2.conf
@@ -0,0 +1,21 @@
+PerlModule Apache2::compat
+
+#PerlModule Apache::DBI
+
+PerlModule HTML::Mason
+PerlSetVar MasonArgsMethod CGI
+PerlModule HTML::Mason::ApacheHandler
+
+PerlRequire "%%%MASON_HANDLER%%%"
+
+<Directory %%%FREESIDE_DOCUMENT_ROOT%%%>
+AuthName Freeside
+AuthType Basic
+AuthUserFile /usr/local/etc/freeside/htpasswd
+require valid-user
+<Files ~ (\.cgi|\.html)>
+SetHandler perl-script
+PerlHandler HTML::Mason
+</Files>
+</Directory>
+
diff --git a/htetc/global.asa b/htetc/global.asa
deleted file mode 100644
index bb30608a4..000000000
--- a/htetc/global.asa
+++ /dev/null
@@ -1,263 +0,0 @@
-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 URI::Escape;
-use HTML::Entities;
-use JSON;
-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.05;
-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 qw(smart_search);
-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;
-use FS::payment_gateway;
-use FS::agent_payment_gateway;
-
-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;
-
diff --git a/htetc/handler.pl b/htetc/handler.pl
index 2f2b0af4a..c1ca954e1 100644
--- a/htetc/handler.pl
+++ b/htetc/handler.pl
@@ -60,7 +60,7 @@ my $ah = new HTML::Mason::ApacheHandler (
[ 'freeside' => '%%%FREESIDE_DOCUMENT_ROOT%%%' ],
[ 'rt' => '%%%FREESIDE_DOCUMENT_ROOT%%%/rt' ],
],
- data_dir=>'/usr/local/etc/freeside/masondata',
+ data_dir=>'%%%MASONDATA%%%',
#out_mode=>'stream',
#RT
@@ -88,14 +88,18 @@ sub handler
#rar
{ package HTML::Mason::Commands;
use strict;
- use vars qw( $cgi $p );
+ use vars qw( $cgi $p $fsurl);
use vars qw( %session );
use CGI 2.47 qw(-private_tempfiles);
#use CGI::Carp qw(fatalsToBrowser);
+ use List::Util qw( max min );
use Date::Format;
use Date::Parse;
use Time::Local;
use Time::Duration;
+ use DateTime;
+ use DateTime::Format::Strptime;
+ use Lingua::EN::Inflect qw(PL);
use Tie::IxHash;
use URI::Escape;
use HTML::Entities;
@@ -110,19 +114,23 @@ sub handler
}
use Text::CSV_XS;
use Spreadsheet::WriteExcel;
- use Business::CreditCard;
+ use Business::CreditCard 0.30; #for mask-aware cardtype()
use String::Approx qw(amatch);
use Chart::LinesPoints;
- use HTML::Widgets::SelectLayers 0.05;
+ use Chart::Mountain;
+ use Color::Scheme;
+ use HTML::Widgets::SelectLayers 0.06;
+ #use HTML::Widgets::SelectLayers 0.07; # after 1.7.2
+ use Locale::Country;
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::CGI qw(header menubar popurl rooturl 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 send_fax );
+ use FS::Misc qw( send_email send_fax states_hash counties state_label );
use FS::Report::Table::Monthly;
use FS::TicketSystem;
@@ -137,6 +145,7 @@ sub handler
use FS::cust_main_county;
use FS::cust_pay;
use FS::cust_pkg;
+ use FS::cust_pkg_reason;
use FS::cust_refund;
use FS::cust_svc;
use FS::nas;
@@ -146,6 +155,7 @@ sub handler
use FS::part_svc;
use FS::part_svc_router;
use FS::part_virtual_field;
+ use FS::pay_batch;
use FS::pkg_svc;
use FS::port;
use FS::queue qw(joblisting);
@@ -171,6 +181,21 @@ sub handler
use FS::payment_gateway;
use FS::agent_payment_gateway;
use FS::XMLRPC;
+ use FS::payby;
+ use FS::cdr;
+ use FS::inventory_class;
+ use FS::inventory_item;
+ use FS::pkg_class;
+ use FS::access_user;
+ use FS::access_group;
+ use FS::access_usergroup;
+ use FS::access_groupagent;
+ use FS::access_right;
+ use FS::AccessRight;
+ use FS::svc_phone;
+ use FS::reason_type;
+ use FS::reason;
+ use FS::cust_main_note;
if ( %%%RT_ENABLED%%% ) {
eval '
@@ -204,6 +229,7 @@ sub handler
my( $self, $location ) = @_;
use vars qw($m);
+ # false laziness w/below
if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect
my $page =
@@ -233,9 +259,9 @@ sub handler
&cgisuidsetup($cgi);
#&cgisuidsetup($r);
$p = popurl(2);
+ $fsurl = rooturl();
}
-
sub include {
use vars qw($m);
$m->scomp(@_);
@@ -261,7 +287,10 @@ sub handler
);
dbh->{'private_profile'} = {};
- $m->abort(200);
+ #whew. removing this is all that's needed to fix the annoying
+ #blank-page-instead-of-profiling-redirect-when-called-from-an-include
+ #bug triggered by mason 1.32
+ #my $rv = $m->abort(200);
} else { #normal redirect
@@ -307,6 +336,8 @@ sub handler
$ah->interp->set_escape( 'h' => sub { ${$_[0]}; } );
}
+ $ah->interp->ignore_warnings_expr('.');
+
my %session;
my $status;
eval { $status = $ah->handle_request($r); };