view release on metacpan or  search on metacpan

Embperl.pm  view on Meta::CPAN

if ($modperl2)
    {
    if ($modperlapi >= 2) 
        {
        require Apache2::ServerRec ;
        require Apache2::ServerUtil ;
        require Apache2::RequestRec ;
        require Apache2::RequestUtil ;
        require Apache2::SubRequest ;
        require APR::Table ;
        $srv_rec = Apache2::ServerUtil -> server ;
        }
    else
        {
        if (($modperl =~ /_(\d+)/) && $1 < 15)
	    {
            require Apache::Server ;
	    }
        else
	    {
            require Apache::ServerRec ;
	    }
        require Apache::ServerUtil ;
        require Apache::RequestRec ;
        require Apache::RequestUtil ;
        require Apache::SubRequest ;
        $srv_rec = Apache -> server ;
        }
    }
elsif ($modperl)
    {
    require Apache ;    
    $srv_rec = Apache -> server ;
    }

if (!defined(&Embperl::Init))
    {
    bootstrap Embperl $VERSION  ;
    Boot ($VERSION) ;
    Init ($srv_rec, \%initparam) ;
    }


$cwd       = Cwd::fastcwd();

tie *Embperl::LOG, 'Embperl::Log' ;


1 ;

#######################################################################################

sub Execute
    
    {
    my $_ep_param = shift ;

    local $SIG{__WARN__} = \&Warn ;

    # when called inside a Embperl Request, Execute the component only
    return Embperl::Req::ExecuteComponent ($_ep_param, @_) if ($req && $Embperl::coro_req == $Coro::current) ;

    $_ep_param = { inputfile => $_ep_param, param => [@_]} if (!ref $_ep_param) ;

    local $req_rec ;
    if ($modperl && !exists ($_ep_param -> {req_rec}))
        {
        eval
            {
            if ($modperlapi < 2)
                {
                $req_rec = Apache -> request  ;
                }
            else
                {
                $req_rec = Apache2::RequestUtil -> request  ;
                }
            } ;    
        }
    elsif (exists ($_ep_param -> {req_rec}) && defined ($_ep_param -> {req_rec}))
        {    
        $req_rec = $_ep_param -> {req_rec} ;
        }

    
    my $eplguard ;
    if (defined ($Coro::current))
        {
        # make sure that there is only one request at the same time
        $Embperl::coro_semaphore ||= Coro::Semaphore -> new (1) ;
        $eplguard = $Embperl::coro_semaphore -> guard  ;
        $Embperl::coro_req = $Coro::current ;
        }
    my $_ep_rc ;
        {
        $_ep_rc = Embperl::Req::ExecuteRequest (undef, $_ep_param)  ;
        }
    undef $eplguard ;

    return $_ep_rc ;
    }

#######################################################################################

sub handler
    
    {
    local $SIG{__WARN__} = \&Warn ;
    $req_rec = $_[0] ;
    if ($modperlapi < 2)
        {
        Apache -> request ($req_rec) ;
        }
    else
        {
        Apache2::RequestUtil -> request ($req_rec) ;
        }
    
    my $rc = Embperl::Req::ExecuteRequest ($_[0]) ;
    return $rc ;
    }

#######################################################################################

sub Warn 
    {
    local $^W = 0 ;
    my $msg = $_[0] ;
    chop ($msg) ;
    
    my $lineno = getlineno () ;
    my $Inputfile = Sourcefile () ;
    if ($msg =~ /Embperl\.pm/)
        {
        $msg =~ s/at (.*?) line (\d*)/at $Inputfile in block starting at line $lineno/ ;
        }
    logerror (Embperl::Constant::rcPerlWarn, $msg);
    }

#######################################################################################


sub PreLoadFiles 

    {
    my $files = $initparam{preloadfiles} ;
    delete $initparam{preloadfiles} ;
    
    if ($files && ref $files eq 'ARRAY')
        {
        foreach my $file (@$files)
            {