App-Context

 view release on metacpan or  search on metacpan

lib/App.pm  view on Meta::CPAN

sub new {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    if ($#_ == -1) {
        my $context = $self->context();
        &App::sub_exit($context) if ($App::trace);
        return($context);
    }
    my $class = shift;
    if ($class =~ /^([A-Za-z0-9:_]+)$/) {
        $class = $1;  # untaint the $class
        if (! $used{$class}) {
            $self->use($class);
        }
        my $method = ($#_ > -1) ? shift : "new";
        if (wantarray) {
            my @values = $class->$method(@_);
            &App::sub_exit(@values) if ($App::trace);
            return(@values);
        }
        else {

lib/App/Conf/File.pm  view on Meta::CPAN

                $conf = $serializer_class->deserialize($text);
                if (! %$conf) {
                    App::Exception::Conf->throw(
                        error => "create(): $serializer_class produced empty config\n"
                    );
                }
            }
            else { # don't bother with a serializer
                $conf = {};
                if ($text =~ /^[ \t\n]*\$[a-zA-Z][a-zA-Z0-9_]* *= *(\{.*\};[ \n]*)$/s) {
                    $text = "\$conf = $1";   # untainted now
                    eval($text);
                    if ($@) {
                        App::Exception::Conf->throw(
                            error => "create(): [$conf_file] error eval'ing config text: $@\n"
                        );
                    }
                }
                else {
                    App::Exception::Conf->throw(
                        error => "create(): [$conf_file] config text doesn't match '\$var = {...};'\n"

lib/App/Request/CGI.pm  view on Meta::CPAN

=cut

sub _init {
    &App::sub_entry if ($App::trace);
    my ($self, $options) = @_;
    my ($cgi, $var, $value, $app, $file);
    $options = {} if (!defined $options);

    $app = $options->{app};
    if (!defined $app) {
        # untaint the $app
        $0 =~ /(.*)/;
        $app = $1;
        $app =~ s!\\!/!g;
        $app =~ s!\.[a-z]+$!!i;
        $app =~ s!.*/!!;
    }

    my $debug_request = $options->{debug_request} || "";
    my $replay = ($debug_request eq "replay" || $options->{replay});
    my $record = ($debug_request eq "record" && !$replay);

lib/App/Request/CGI.pm  view on Meta::CPAN

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

    if ($replay) {
        $file = $options->{replay_env} || "$app.env";
        if (open(App::FILE, "< $file")) {
            foreach $var (keys %ENV) {
                delete $ENV{$var};     # unset all environment variables
            }
            while (<App::FILE>) {
                chop;
                /^([^=]+)=(.*)/;       # parse variable, value (and untaint)
                $var = $1;             # get variable name
                $value = $2;           # get variable value
                $ENV{$var} = $value;   # restore environment variable
            }
            close(App::FILE);
        }
    }

    if ($record) {
       $file = "$app.env";

lib/App/Serializer.pm  view on Meta::CPAN

        eval "use $serializer_class;";
        if ($@) {
            App::Exception::Serializer->throw(
                error => "create(): error loading $serializer_class serializer class\n"
            );
        }
        $data = $serializer_class->deserialize($serialized_data);
    }
    else {
        if ($serialized_data =~ /^\$[a-zA-Z][a-zA-Z0-9_]* *= *(.*)$/s) {
            $serialized_data = "\$data = $1";   # untainted now
            eval($serialized_data);
            die "Deserialization Error: $@" if ($@);
        }
        else {
            die "Deserialization Error: Data didn't have \"\$var = {...};\" or \"\$var = [ ... ];\" format.";
        }
    }

    $data;
}