ASP4

 view release on metacpan or  search on metacpan

lib/ASP4/Request.pm  view on Meta::CPAN

  my ($class, %args) = @_;
  
  my $cgi = $class->context->cgi;
  my $s = bless {
    %args,
    form  => {
      (
        map {
          # CGI->Vars joins multi-value params with a null byte.  Which sucks.
          # To avoid that behavior, we do this instead:
          my @val = map { $cgi->unescape( $_ ) } ( $cgi->param($_) );
          $cgi->unescape($_) => scalar(@val) > 1 ? \@val : shift(@val)
        } $cgi->param
      ),
      (
        map {
          # CGI->Vars joins multi-value params with a null byte.  Which sucks.
          # To avoid that behavior, we do this instead:
          my @val = map { $cgi->unescape( $_ ) } ( $cgi->url_param($_) );
          $cgi->unescape($_) => scalar(@val) > 1 ? \@val : shift(@val)
        } $cgi->url_param
      ),
    },
  }, $class;
  
  return $s;
}# end new()


sub context { ASP4::HTTPContext->current }

lib/ASP4/Request.pm  view on Meta::CPAN

  $s->context->r->uri( $uri );
  my $args = $s->context->r->args;
  $args .= $args ? "&$querystring" : $querystring;
  $s->context->r->args( $args );
  $ENV{QUERY_STRING} = $args;
  
  my $cgi = $s->context->cgi;
  my $Form = $s->context->request->Form;
  map {
    my ($k,$v) = split /\=/, $_;
    $Form->{ $cgi->unescape($k) } = $cgi->unescape( $v );
  } split /&/, $querystring;
  
  ( my $path = $s->context->server->MapPath( $uri ) ) =~ s{/+$}{};
  $path .= "/index.asp" if -f "$path/index.asp";
  $ENV{SCRIPT_FILENAME} = $path;
  $ENV{SCRIPT_NAME} = $path;
  return $s->context->response->Declined;
}# end Reroute()

lib/ASP4/Server.pm  view on Meta::CPAN

{
  return bless { }, shift;
}# end new()


sub context { ASP4::HTTPContext->current }


sub URLEncode
{
  ASP4::HTTPContext->current->cgi->escape( $_[1] );
}# end URLEncode()


sub URLDecode
{
  ASP4::HTTPContext->current->cgi->unescape( $_[1] );
}# end URLDecode()


sub HTMLEncode
{
  my ($s, $str) = @_;
  no warnings 'uninitialized';
  $str =~ s/&/&/g;
  $str =~ s/</&lt;/g;
  $str =~ s/>/&gt;/g;

lib/ASP4/SimpleCGI.pm  view on Meta::CPAN

{
  my ($s, %args) = @_;
  
  my %params = ();
  my %upload_data = ();
  no warnings 'uninitialized';
  if( length($args{querystring}) )
  {
    foreach my $part ( split /&/, $args{querystring} )
    {
      my ($k,$v) = map { $s->unescape($_) } split /\=/, $part;
      
      if( exists($params{$k}) )
      {
        if( ref($params{$k}) )
        {
          push @{$params{$k}}, $v;
        }
        else
        {
          $params{$k} = [ $params{$k}, $v ];

lib/ASP4/SimpleCGI.pm  view on Meta::CPAN

        $params{$name} = $ifh;
      }# end foreach()
    }# end if()
  }# end if()
  
  my $cookies = { };
  if( my $cookie_str = $ENV{HTTP_COOKIE} )
  {
    foreach my $part ( split /;\s*/, $cookie_str )
    {
      my ($name,$val) = map { $s->unescape( $_ ) } split /\=/, $part;
      $cookies->{$name} = $val;
    }# end foreach()
  }# end if()
  
  return bless {
    params  => \%params,
    uploads => \%upload_data,
    cookies => $cookies,
    %args
  }, $s;

lib/ASP4/SimpleCGI.pm  view on Meta::CPAN

      return;
    }# end if()
  }
  else
  {
    return %{ $s->{cookies} };
  }# end if()
}# end cookies()


sub escape
{
  my $toencode = $_[1];
  no warnings 'uninitialized';
  $toencode =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/esg;
  $toencode;
}# end escape()


sub unescape
{
  my ($s, $todecode) = @_;
  return unless defined($todecode);
  $todecode =~ tr/+/ /;       # pluses become spaces
  $todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
  defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
  return $todecode;
}# end unescape()


sub DESTROY
{
  my $s = shift;
  
  map {
    close($s->{uploads}->{$_}->{filehandle});
    unlink($s->{uploads}->{$_}->{tempname});
  } keys(%{$s->{uploads}});

lib/ASP4/SimpleCGI.pm  view on Meta::CPAN

    querystring     => 'mode=create&uploadID=234234',
    body            => ...
  );
  
  my $val = $cgi->param('mode');
  foreach my $key ( $cgi->param )
  {
    print $key . ' --> ' . $cgi->param( $key ) . "\n";
  }# end foreach()
  
  my $escaped = $cgi->escape( 'Hello world' );
  my $unescaped = $cgi->unescape( 'Hello+world' );
  
  my $upload = $cgi->upload('filename');
  
  my $filehandle = $cgi->upload_info('filename', 'filehandle' );

=head1 DESCRIPTION

This package provides basic CGI functionality and is also used for testing and
in the API enironment.

lib/ASP4/SimpleCGI.pm  view on Meta::CPAN

Returns a new C<ASP4::SimpleCGI> object.

C<%args> can contain C<content_type>, C<content_length>, C<querystring> and C<body>.

=head2 param( [$key] )

If C<$key> is given, returns the value of the form or querystring parameter by that name.

If C<$key> is not given, returns a list of all parameter names.

=head2 escape( $str )

Returns a URL-encoded version of C<$str>.

=head2 unescape( $str )

Returns a URL-decoded version of C<$str>.

=head2 upload( $field_name )

Returns all of the information we have about a file upload named C<$field_name>.

=head2 upload_info( $field_name, $item_name )

Returns just that part of C<$field_name>'s upload info.

lib/ASP4/UserAgent.pm  view on Meta::CPAN

  
  delete( $s->{cookies}->{$name} );
}# end remove_cookie()


sub http_cookie
{
  my $s = shift;
  
  join '; ',
    map { ASP4::SimpleCGI->escape($_) . '=' . ASP4::SimpleCGI->escape($s->{cookies}->{$_}) }
    keys %{$s->{cookies}};
}# end http_cookie()


sub _setup_response
{
  my ($s, $response_code) = @_;
  
  $response_code = 200 if ($response_code || 0) eq '0';
  my $response = HTTP::Response->new( $response_code );

lib/ASP4/UserAgent.pm  view on Meta::CPAN

          @cookies = @$v;
        }
        else
        {
          @cookies = ( $v );
        }# end if()
        
        foreach $v ( @cookies )
        {
          my ($data) = split /;/, $v;
          my ($name,$val) = map { ASP4::SimpleCGI->unescape( $_ ) } split /\=/, $data;
          $s->add_cookie( $name => $val );
        }# end foreach()
      }# end if()
    }# end while()
  }# end foreach()
  
  $s->context->r->pool->call_cleanup_handlers();
  
#  $s->context->DESTROY;