← Back to branch summary

~ubuntu-branches/debian/sid/libembperl-perl/sid

« back to all changes in this revision

Viewing changes to Embperl/Util.pm

  • Committer: Bazaar Package Importer
  • Author(s): Angus Lees
  • Date: 2004-02-15 14:23:39 UTC
  • Revision ID: james.westby@ubuntu.com-20040215142339-n21gqf7mx9tmyb8d
Tags: upstream-2.0b10
Import upstream version 2.0b10

Show diffs side-by-side

added added

removed removed

Lines of Context:
Embperl/Util.pm
 
1
 
 
2
###################################################################################
 
3
#
 
4
#   Embperl - Copyright (c) 1997-2004 Gerald Richter / ecos gmbh   www.ecos.de
 
5
#
 
6
#   You may distribute under the terms of either the GNU General Public
 
7
#   License or the Artistic License, as specified in the Perl README file.
 
8
#
 
9
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
 
10
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
 
11
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 
12
#
 
13
#   $Id: Util.pm,v 1.4 2004/01/23 06:50:56 richter Exp $
 
14
#
 
15
###################################################################################
 
16
 
 
17
 
 
18
package Embperl::Util ;
 
19
 
 
20
use strict ;
 
21
use vars qw{@AliasScalar @AliasHash @AliasArray %NameSpace} ;
 
22
 
 
23
#######################################################################################
 
24
 
 
25
sub AddCompartment ($)
 
26
 
 
27
    {
 
28
    my ($sName) = @_ ;
 
29
    my $cp ;
 
30
    
 
31
    return $cp if (defined ($cp = $NameSpace{$sName})) ;
 
32
 
 
33
    #eval 'require Safe' ;
 
34
    #die "require Safe failed: $@" if ($@); 
 
35
    require Safe ;
 
36
 
 
37
    $cp = new Safe ($sName) ;
 
38
    
 
39
    $NameSpace{$sName} = $cp ;
 
40
 
 
41
    return $cp ;
 
42
    }
 
43
 
 
44
#######################################################################################
 
45
 
 
46
sub MailFormTo
 
47
 
 
48
    {
 
49
    $Embperl::req -> app -> mail_form_to (@_) ;
 
50
    }
 
51
 
 
52
#######################################################################################
 
53
 
 
54
 
 
55
@AliasScalar = qw{row col cnt tabmode escmode req_rec maxrow maxcol req_rec 
 
56
                    dbgAll            dbgAllCmds        dbgCmd            dbgDefEval        dbgEarlyHttpHeader
 
57
                    dbgEnv            dbgEval           dbgFlushLog       dbgFlushOutput    dbgForm           
 
58
                    dbgFunc           dbgHeadersIn      dbgImport         dbgInput          dbgLogLink        
 
59
                    dbgMem            dbgProfile        dbgShowCleanup    dbgSource         dbgStd            
 
60
                    dbgSession        dbgTab            dbgWatchScalar    dbgParse          dbgObjectSearch   
 
61
                    optDisableChdir           optDisableEmbperlErrorPage    optReturnError             optDisableFormData        
 
62
                    optDisableHtmlScan        optDisableInputScan       optDisableMetaScan        optDisableTableScan       
 
63
                    optDisableSelectScan      optDisableVarCleanup      optEarlyHttpHeader        optOpcodeMask             
 
64
                    optRawInput               optSafeNamespace          optSendHttpHeader         optAllFormData            
 
65
                    optRedirectStdout         optUndefToEmptyValue      optNoHiddenEmptyValue     optAllowZeroFilesize      
 
66
                    optKeepSrcInMemory        optKeepSpaces            optOpenLogEarly           optNoUncloseWarn              
 
67
                    _ep_node
 
68
                    } ;
 
69
@AliasHash   = qw{fdat udat mdat sdat idat http_headers_out fsplitdat} ;
 
70
@AliasArray  = qw{ffld param} ;
 
71
 
 
72
 
 
73
#######################################################################################
 
74
 
 
75
 
 
76
sub CreateAliases
 
77
 
 
78
    {
 
79
    my $package = caller ;
 
80
 
 
81
    my $dummy ;
 
82
        
 
83
    no strict ;
 
84
 
 
85
    if (!defined(${"$package\:\:row"}))
 
86
        { # create new aliases for Embperl magic vars
 
87
 
 
88
        foreach (@AliasScalar)
 
89
            {
 
90
            *{"$package\:\:$_"}    = \${"Embperl\:\:$_"} ;
 
91
            $dummy = ${"$package\:\:$_"} ; # necessary to make sure variable exists!
 
92
            }
 
93
        *{"$package\:\:epreq"} = \$Embperl::req ;
 
94
        *{"$package\:\:epapp"} = \$Embperl::app ;
 
95
 
 
96
        foreach (@AliasHash)
 
97
            {
 
98
            *{"$package\:\:$_"}    = \%{"Embperl\:\:$_"} ;
 
99
            }
 
100
        foreach (@AliasArray)
 
101
            {
 
102
            *{"$package\:\:$_"}    = \@{"Embperl\:\:$_"} ;
 
103
            }
 
104
 
 
105
 
 
106
        my $sess ;
 
107
        $sess = $Embperl::req -> app -> udat ;
 
108
        *{"$package\:\:udat"} = $sess if ($sess) ;
 
109
        $sess = $Embperl::req -> app -> mdat ;
 
110
        *{"$package\:\:mdat"} = $sess if ($sess) ;
 
111
        $sess = $Embperl::req -> app -> sdat ;
 
112
        *{"$package\:\:sdat"} = $sess if ($sess) ;
 
113
 
 
114
        *{"$package\:\:exit"}       = \&Embperl::exit ;
 
115
        *{"$package\:\:MailFormTo"} = \&Embperl::Util::MailFormTo ;
 
116
        *{"$package\:\:Execute"}    = \&Embperl::Req::ExecuteComponent ;
 
117
 
 
118
        tie *{"$package\:\:LOG"}, 'Embperl::Log' ;
 
119
        tie *{"$package\:\:OUT"}, 'Embperl::Out' ;
 
120
 
 
121
        my $addcleanup = \%{"$package\:\:CLEANUP"} ;
 
122
        $addcleanup -> {'CLEANUP'} = 0 ;
 
123
        $addcleanup -> {'EXPIRES'} = 0 ;
 
124
        $addcleanup -> {'CACHE_KEY'} = 0 ;
 
125
        $addcleanup -> {'OUT'} = 0 ;
 
126
        $addcleanup -> {'LOG'} = 0 ;
 
127
        }
 
128
 
 
129
 
 
130
 
 
131
    use strict ;
 
132
    }
 
133
 
 
134
#######################################################################################
 
135
 
 
136
1;