view release on metacpan or  search on metacpan

lib/MasonX/Apache2Handler.pm  view on Meta::CPAN

	# DocumentRoot is only available inside requests
	    $defaults{comp_root} = $req->document_root;
	} else {
	    $defaults{comp_root} =
		Apache->server->dir_config( '_MasonDefaultDocumentRoot' );
	}
    }
=cut

    if (exists $allowed_params->{data_dir} and not exists $params{data_dir})
    {
	# constructs path to <server root>/mason
	my $def = $defaults{data_dir} = Apache->server->server_root_relative('mason');
	param_error "Default data_dir (MasonDataDir) '$def' must be an absolute path"
	    unless File::Spec->file_name_is_absolute($def);
	  
	my @levels = File::Spec->splitdir($def);
	param_error "Default data_dir (MasonDataDir) '$def' must be more than two levels deep (or must be set explicitly)"
	    if @levels <= 3;
    }

    # Set default error_format based on error_mode
    if (exists($params{error_mode}) and $params{error_mode} eq 'fatal') {
	$defaults{error_format} = 'line';
    } else {
	$defaults{error_mode} = 'output';
	$defaults{error_format} = 'html';
    }

    # Push $r onto default allow_globals
    if (exists $allowed_params->{allow_globals}) {
	if ( $params{allow_globals} ) {
	    push @{ $params{allow_globals} }, '$r';
	} else {
	    $defaults{allow_globals} = ['$r'];
	}
    }

    my $self = eval { $class->SUPER::new(%defaults, %params) };

    # We catch & throw this exception just to provide a better error message
    if ( $@ && isa_mason_exception( $@, 'Params' ) && $@->message =~ /comp_root/ )
    {
	param_error "No comp_root specified and cannot determine DocumentRoot." .
                    " Please provide comp_root explicitly.";
    }
    rethrow_exception $@;

    unless ( $self->interp->resolver->can('apache_request_to_comp_path') )
    {
	error "The resolver class your Interp object uses does not implement " .
              "the 'apache_request_to_comp_path' method.  This means that Apache2Handler " .
              "cannot resolve requests.  Are you using a handler.pl file created ".
	      "before version 1.10?  Please see the handler.pl sample " .
              "that comes with the latest version of Mason.";
    }

    # If we're running as superuser, change file ownership to http user & group
    if (!($> || $<) && $self->interp->files_written)
    {
	chown getpwnam( Apache->server->dir_config( '_MasonUser' ) ),
	getgrnam( Apache->server->dir_config( '_MasonGroup' ) ),
	$self->interp->files_written
	    or system_error( "Can't change ownership of files written by interp object: $!\n" );
    }

    $self->_initialize;
    return $self;
}

# Register with Apache::Status at module startup.  Will get replaced
# with a more informative status once an interpreter has been created.
my $status_name = 'mason0001';
if ( load_pkg('Apache::Status') )
{
    Apache::Status->menu_item
	($status_name => __PACKAGE__->allowed_params->{apache_status_title}{default},
         sub { ["<b>(no interpreters created in this child yet)</b>"] });
}


sub _initialize {
    my ($self) = @_;

    if ($self->args_method eq 'mod_perl') {
	unless (defined $Apache::Request::VERSION) {
	    warn "Loading Apache::Request at runtime.  You could " .
                 "increase shared memory between Apache processes by ".
                 "preloading it in your httpd.conf or handler.pl file\n";
	    require Apache::Request;
	}
    } else {
	unless (defined $CGI::VERSION) {
	    warn "Loading CGI at runtime.  You could increase shared ".
                 "memory between Apache processes by preloading it in ".
                 "your httpd.conf or handler.pl file\n";

	    require CGI;
	}
    }

    # Add an HTML::Mason menu item to the /perl-status page.
    if (defined $Apache::Status::VERSION) {
	# A closure, carries a reference to $self
	my $statsub = sub {
	    my ($r,$q) = @_; # request and CGI objects
	    return [] if !defined($r);

	    if ($r->path_info and $r->path_info =~ /expire_code_cache=(.*)/) {
		$self->interp->delete_from_code_cache($1);
	    }

	    return ["<center><h2>" . $self->apache_status_title . "</h2></center>" ,
		    $self->status_as_html
		    (apache_req => $r),
		    $self->interp->status_as_html
		    (ah => $self, $r) ];
	};
	local $^W = 0; # to avoid subroutine redefined warnings
	Apache::Status->menu_item($status_name, $self->apache_status_title, $statsub);
    }