htetc/handler.pl

   1 #!/usr/bin/perl
   2
   3 package HTML::Mason;
   4
   5 use strict;
   6 use warnings;
   7 use FS::Mason qw( mason_interps );
   8 use FS::Trace;
   9
  10 #use vars qw($r);
  11
  12 # Bring in ApacheHandler, necessary for mod_perl integration.
  13 # Uncomment the second line (and comment the first) to use
  14 # Apache::Request instead of CGI.pm to parse arguments.
  15 use HTML::Mason::ApacheHandler;
  16 # use HTML::Mason::ApacheHandler (args_method=>'mod_perl');
  17
  18 ###use Module::Refresh;###
  19
  20 # Create Mason objects
  21
  22 my( $fs_interp, $rt_interp ) = mason_interps('apache');
  23
  24 my $ah = new HTML::Mason::ApacheHandler (
  25   interp        => $fs_interp,
  26   request_class => 'FS::Mason::Request',
  27   args_method   => 'CGI', #(and FS too)
  28 );
  29
  30 # Activate the following if running httpd as root (the normal case).
  31 # Resets ownership of all files created by Mason at startup.
  32 #
  33 #chown (Apache->server->uid, Apache->server->gid, $interp->files_written);
  34
  35 my $protect_fds;
  36
  37 sub handler
  38 {
  39     #($r) = @_;
  40     my $r = shift;
  41
  42     FS::Trace->log('protecting fds');
  43
  44     #from rt/bin/webmux.pl(.in)
  45     if ( !$protect_fds && $ENV{'MOD_PERL'} && exists $ENV{'MOD_PERL_API_VERSION'}
  46         && $ENV{'MOD_PERL_API_VERSION'} >= 2
  47     ) {
  48         # under mod_perl2, STDIN and STDOUT get closed and re-opened,
  49         # however they are not on FD 0 and 1.  In this case, the next
  50         # socket that gets opened will occupy one of these FDs, and make
  51         # all system() and open "|-" calls dangerous; for example, the
  52         # DBI handle can get this FD, which later system() calls will
  53         # close by putting garbage into the socket.
  54         $protect_fds = [];
  55         push @{$protect_fds}, IO::Handle->new_from_fd(0, "r")
  56             if fileno(STDIN) != 0;
  57         push @{$protect_fds}, IO::Handle->new_from_fd(1, "w")
  58             if fileno(STDOUT) != 1;
  59     }
  60
  61     # If you plan to intermix images in the same directory as
  62     # components, activate the following to prevent Mason from
  63     # evaluating image files as components.
  64     #
  65     #return -1 if $r->content_type && $r->content_type !~ m|^text/|i;
  66
  67     ###Module::Refresh->refresh;###
  68
  69     FS::Trace->log('setting content_type / headers');
  70
  71     $r->content_type('text/html; charset=utf-8');
  72     #$r->content_type('text/html; charset=iso-8859-1');
  73     #eorar
  74
  75     my $headers = $r->headers_out;
  76     $headers->{'Cache-control'} = 'no-cache';
  77     #$r->no_cache(1);
  78     $headers->{'Expires'} = '0';
  79
  80 #    $r->send_http_header;
  81
  82     if ( $r->filename =~ /\/rt\// ) { #RT
  83
  84       FS::Trace->log('handling RT file');
  85
  86       # We don't need to handle non-text, non-xml items
  87       return -1 if defined( $r->content_type )
  88                 && $r->content_type !~ m!(^text/|\bxml\b)!io;
  89
  90
  91       local $SIG{__WARN__};
  92       local $SIG{__DIE__};
  93
  94       FS::Trace->log('initializing RT');
  95       my_rt_init();
  96
  97       FS::Trace->log('setting RT interpreter');
  98       $ah->interp($rt_interp);
  99
 100     } else {
 101
 102       FS::Trace->log('handling Freeside file');
 103
 104       local $SIG{__WARN__};
 105       local $SIG{__DIE__};
 106
 107       FS::Trace->log('initializing RT');
 108       my_rt_init();
 109
 110       #we don't want the RT error handlers under FS
 111       {
 112         no warnings 'uninitialized';
 113         undef($SIG{__WARN__}) if defined($SIG{__WARN__});
 114         undef($SIG{__DIE__})  if defined($SIG{__DIE__} );
 115       }
 116
 117       FS::Trace->log('setting Freeside interpreter');
 118       $ah->interp($fs_interp);
 119
 120     }
 121
 122     FS::Trace->log('handling request');
 123     my %session;
 124     my $status;
 125     eval { $status = $ah->handle_request($r); };
 126 #!!
 127 #    if ( $@ ) {
 128 #       $RT::Logger->crit($@);
 129 #    }
 130     warn $@ if $@;
 131
 132     undef %session;
 133
 134 #!!
 135 #    if ($RT::Handle->TransactionDepth) {
 136 #       $RT::Handle->ForceRollback;
 137 #       $RT::Logger->crit(
 138 #"Transaction not committed. Usually indicates a software fault. Data loss may have occurred"
 139 #       );
 140 #    }
 141
 142     FS::Trace->log('done');
 143
 144     FS::Trace->dumpfile( "%%%FREESIDE_EXPORT%%%/profile/$$.".time,
 145                          FS::Trace->total. ' '. $r->filename
 146                        )
 147       if FS::Trace->total > 5; #10?
 148
 149     FS::Trace->reset;
 150
 151     $status;
 152 }
 153
 154 my $rt_initialized = 0;
 155
 156 sub my_rt_init {
 157   return unless $RT::VERSION;
 158
 159   if ( $rt_initialized ) {
 160     RT::ConnectToDatabase();
 161     RT::InitSignalHandlers();
 162   } else {
 163     RT::LoadConfig();
 164     RT::Init();
 165     $rt_initialized++;
 166   }
 167 }
 168
 169 1;