The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

GRICHTER / Embperl-3.0.1 / Embperl / Util.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138

              
###################################################################################
#
#   Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh  www.ecos.de
#   Embperl - Copyright (c) 2008-2015 Gerald Richter
#   Embperl - Copyright (c) 2015-2023 actevy.io
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
###################################################################################
package Embperl::Util ;
use strict ;
use vars qw{@AliasScalar @AliasHash @AliasArray %NameSpace} ;
no warnings "uninitialized" ;
#######################################################################################
sub AddCompartment ($)
    {
    my ($sName) = @_ ;
    my $cp ;
     
    return $cp if (defined ($cp = $NameSpace{$sName})) ;
    #eval 'require Safe' ;
    #die "require Safe failed: $@" if ($@); 
    require Safe ;
    $cp = new Safe ($sName) ;
     
    $NameSpace{$sName} = $cp ;
    return $cp ;
    }
#######################################################################################
sub MailFormTo
    {
    $Embperl::req -> app -> mail_form_to (@_) ;
    }
#######################################################################################
@AliasScalar = qw{row col cnt tabmode escmode req_rec maxrow maxcol req_rec 
                    dbgAll            dbgAllCmds        dbgCmd            dbgDefEval        dbgEarlyHttpHeader
                    dbgEnv            dbgEval           dbgFlushLog       dbgFlushOutput    dbgForm           
                    dbgFunc           dbgHeadersIn      dbgImport         dbgInput          dbgLogLink        
                    dbgMem            dbgProfile        dbgShowCleanup    dbgSource         dbgStd            
                    dbgSession        dbgTab            dbgWatchScalar    dbgParse          dbgObjectSearch   
                    optDisableChdir           optDisableEmbperlErrorPage    optReturnError             optDisableFormData        
                    optDisableHtmlScan        optDisableInputScan       optDisableMetaScan        optDisableTableScan       
                    optDisableSelectScan      optDisableVarCleanup      optEarlyHttpHeader        optOpcodeMask             
                    optRawInput               optSafeNamespace          optSendHttpHeader         optAllFormData            
                    optRedirectStdout         optUndefToEmptyValue      optNoHiddenEmptyValue     optAllowZeroFilesize      
                    optKeepSrcInMemory        optKeepSpaces            optOpenLogEarly           optNoUncloseWarn              
                    _ep_node
                    } ;
@AliasHash   = qw{fdat udat mdat sdat idat http_headers_out fsplitdat} ;
@AliasArray  = qw{ffld param} ;
#######################################################################################
sub CreateAliases
    {
    my $package = caller ;
    my $dummy ;
         
    no strict ;
    if (!defined(${"$package\:\:row"}))
        { # create new aliases for Embperl magic vars
        foreach (@AliasScalar)
            {
            *{"$package\:\:$_"}    = \${"Embperl\:\:$_"} ;
            $dummy = ${"$package\:\:$_"} ; # necessary to make sure variable exists!
            }
        *{"$package\:\:epreq"} = \$Embperl::req ;
        *{"$package\:\:epapp"} = \$Embperl::app ;
        foreach (@AliasHash)
            {
            *{"$package\:\:$_"}    = \%{"Embperl\:\:$_"} ;
            }
        foreach (@AliasArray)
            {
            *{"$package\:\:$_"}    = \@{"Embperl\:\:$_"} ;
            }
        my $sess ;
        $sess = $Embperl::req -> app -> udat ;
        *{"$package\:\:udat"} = $sess if ($sess) ;
        $sess = $Embperl::req -> app -> mdat ;
        *{"$package\:\:mdat"} = $sess if ($sess) ;
        $sess = $Embperl::req -> app -> sdat ;
        *{"$package\:\:sdat"} = $sess if ($sess) ;
        *{"$package\:\:exit"}       = \&Embperl::exit ;
        *{"$package\:\:MailFormTo"} = \&Embperl::Util::MailFormTo ;
        *{"$package\:\:Execute"}    = \&Embperl::Req::ExecuteComponent ;
        tie *{"$package\:\:LOG"}, 'Embperl::Log' ;
        tie *{"$package\:\:OUT"}, 'Embperl::Out' ;
        my $addcleanup = \%{"$package\:\:CLEANUP"} ;
        $addcleanup -> {'CLEANUP'} = 0 ;
        $addcleanup -> {'EXPIRES'} = 0 ;
        $addcleanup -> {'CACHE_KEY'} = 0 ;
        $addcleanup -> {'OUT'} = 0 ;
        $addcleanup -> {'LOG'} = 0 ;
        }
    use strict ;
    }
#######################################################################################
1;