fix 'Can't call method "setup" on an undefined value' error when using into rates...
[freeside.git] / htetc / handler.pl
index 33f9c48..e065f09 100644 (file)
@@ -1,13 +1,12 @@
 #!/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 1.1;
+use strict;
+use warnings;
+use FS::Mason qw( mason_interps );
+
+#use vars qw($r);
 
 # Bring in ApacheHandler, necessary for mod_perl integration.
 # Uncomment the second line (and comment the first) to use
@@ -15,57 +14,16 @@ use HTML::Mason 1.1;
 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;
-#}
+###use Module::Refresh;###
 
 # Create Mason objects
-#
-
-#my $parser = new HTML::Mason::Parser;
-#my $interp = new HTML::Mason::Interp (parser=>$parser,
-#                                      comp_root=>'/var/www/masondocs',
-#                                      data_dir=>'/usr/local/etc/freeside/masondata',
-#                                      out_mode=>'stream',
-#                                     );
-
-use vars qw($r);
-
-if ( %%%RT_ENABLED%%% ) {
- eval '
-   use lib ("/opt/rt3/local/lib", "/opt/rt3/lib");
-   use RT;
-   use vars qw($Nobody $SystemUser);
-   RT::LoadConfig();
- ';
- die $@ if $@;
-
-
-}
 
+my( $fs_interp, $rt_interp ) = mason_interps('apache');
 
 my $ah = new HTML::Mason::ApacheHandler (
-  #interp => $interp,
-  #auto_send_headers => 0,
-  comp_root=> [
-                [ 'freeside' => '%%%FREESIDE_DOCUMENT_ROOT%%%'    ],
-                [ 'rt'       => '%%%FREESIDE_DOCUMENT_ROOT%%%/rt' ],
-              ],
-  data_dir=>'/usr/local/etc/freeside/masondata',
-  #out_mode=>'stream',
-
-  #RT
-  args_method => 'CGI',
-  default_escape_flags => 'h',
-  allow_globals => [qw(%session)],
-  #autoflush => 1,
+  interp        => $fs_interp,
+  request_class => 'FS::Mason::Request',
+  args_method   => 'CGI', #(and FS too)
 );
 
 # Activate the following if running httpd as root (the normal case).
@@ -75,7 +33,8 @@ my $ah = new HTML::Mason::ApacheHandler (
 
 sub handler
 {
-    ($r) = @_;
+    #($r) = @_;
+    my $r = shift;
 
     # If you plan to intermix images in the same directory as
     # components, activate the following to prevent Mason from
@@ -83,178 +42,10 @@ sub handler
     #
     #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 vars qw( %session );
-      use CGI 2.47 qw(-private_tempfiles);
-      #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 Net::Whois::Raw qw(whois);
-      if ( $] < 5.006 ) {
-        eval "use Net::Whois::Raw 0.32 qw(whois)";
-        die $@ if $@;
-      }
-      use Business::CreditCard;
-      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);
-      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::Report::Table::Monthly;
-
-      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;
-
-      if ( %%%RT_ENABLED%%% ) {
-        eval '
-          use RT::Tickets;
-          use RT::Transactions;
-          use RT::Users;
-          use RT::CurrentUser;
-          use RT::Templates;
-          use RT::Queues;
-          use RT::ScripActions;
-          use RT::ScripConditions;
-          use RT::Scrips;
-          use RT::Groups;
-          use RT::GroupMembers;
-          use RT::CustomFields;
-          use RT::CustomFieldValues;
-          use RT::TicketCustomFieldValues;
-      
-          use RT::Interface::Web;
-          use MIME::Entity;
-          use Text::Wrapper;
-          use CGI::Cookie;
-          use Time::ParseDate;
-        ';
-        die $@ if $@;
-      }
-
-      *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);
-          '';
-
-        }
-
-      };
-      
-      unless ( $HTML::Mason::r->filename =~ /\/rt\/.*NoAuth/ ) { #RT
-        $cgi = new CGI;
-        &cgisuidsetup($cgi);
-        #&cgisuidsetup($r);
-      }
+    ###Module::Refresh->refresh;###
 
-      $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');
+    $r->content_type('text/html; charset=utf-8');
+    #$r->content_type('text/html; charset=iso-8859-1');
     #eorar
 
     my $headers = $r->headers_out;
@@ -264,26 +55,36 @@ sub handler
 
 #    $r->send_http_header;
 
-    #$ah->interp->remove_escape('h');
-
     if ( $r->filename =~ /\/rt\// ) { #RT
-      #warn "processing RT file". $r->filename. "; escaping for RT\n";
 
-      # MasonX::Request::ExtendedCompRoot
-      #$ah->interp->comp_root( '/rt'. $ah->interp->comp_root() );
+      # We don't need to handle non-text, non-xml items
+      return -1 if defined( $r->content_type )
+                && $r->content_type !~ m!(^text/|\bxml\b)!io;
 
-      $ah->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
 
       local $SIG{__WARN__};
       local $SIG{__DIE__};
 
       RT::Init();
 
-      # We don't need to handle non-text items
-      return -1 if defined( $r->content_type ) && $r->content_type !~ m|^text/|io;
+      $ah->interp($rt_interp);
 
     } else {
-      $ah->interp->set_escape( 'h' => sub { ${$_[0]}; } );
+
+      local $SIG{__WARN__};
+      local $SIG{__DIE__};
+
+      RT::Init() if $RT::VERSION; #for lack of something else
+
+      #we don't want the RT error handlers under FS
+      {
+        no warnings 'uninitialized';
+        undef($SIG{__WARN__}) if defined($SIG{__WARN__});
+        undef($SIG{__DIE__})  if defined($SIG{__DIE__} );
+      }
+
+      $ah->interp($fs_interp);
+
     }
 
     my %session;
@@ -293,13 +94,16 @@ sub handler
 #    if ( $@ ) {
 #      $RT::Logger->crit($@);
 #    }
+    warn $@ if $@;
 
     undef %session;
 
 #!!
 #    if ($RT::Handle->TransactionDepth) {
 #      $RT::Handle->ForceRollback;
-#      $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") ;
+#      $RT::Logger->crit(
+#"Transaction not committed. Usually indicates a software fault. Data loss may have occurred"
+#       );
 #    }
 
     $status;