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