File: Run.pm

package info (click to toggle)
libembperl-perl 2.5.0-17
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid
  • size: 7,632 kB
  • sloc: ansic: 21,387; perl: 14,497; javascript: 4,280; cpp: 467; xml: 49; makefile: 35; sh: 24
file content (65 lines) | stat: -rw-r--r-- 1,646 bytes parent folder | download | duplicates (6)
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

###################################################################################
#
#   Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh  www.ecos.de
#   Embperl - Copyright (c) 2008-2014 Gerald Richter
#
#   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.
#
#   $Id: Run.pm 1578075 2014-03-16 14:01:14Z richter $
#
###################################################################################


package Embperl::Run ;

use Embperl ;
use Embperl::Constant ;
use Embperl::Log ;

use Getopt::Long ;



sub run (;\@$)
    
    {
    @ARGV = @{$_[0]} if (ref $_[0] eq 'ARRAY') ;

    eval { Getopt::Long::Configure ('bundling') } ;
    $@ = "" ;
    my %param ;
    my $ret = GetOptions (\%param, 
                          "outputfile|o=s", "inputfile|i=s", 
                          "log|l=s", "debug|d=i", "options|t=i",
                          "param|p=s@", "syntax|s=s", "fdat|f=s%") ;
    
    return undef if (!$ret) ;

    if (@ARGV)
    	{
    	$ENV{PATH_TRANSLATED} = $param{'inputfile'} = shift @ARGV ;
    	}		

    if (@ARGV)
    	{
        $ENV{QUERY_STRING} = shift @ARGV ;
        undef $ENV{CONTENT_LENGTH} if (defined ($ENV{CONTENT_LENGTH})) ;
    	}		
	
   
    $param{'param'} = $_[1] if (defined ($_[1])) ;
    $param{'use_env'} = 1 ;

    $rc = Embperl::Execute (\%param) ;

    return $rc ;
    }

1 ;