view release on metacpan or  search on metacpan

lib/Apache2/ASP/Request.pm  view on Meta::CPAN

  return $s;
}# end new()


#==============================================================================
sub context
{
  $Apache2::ASP::HTTPContext::ClassName->current;
}# end context()


#==============================================================================
sub ServerVariables
{
  my $s = shift;
  @_ ? $ENV{$_[0]} : \%ENV;
}# end ServerVariables()


#==============================================================================
sub Form
{
  my $s = shift;
  
  if( my $cgi = $s->context->cgi )
  {
    my $form = { };
    foreach my $param ( eval { $cgi->param } )
    {
      my @val = $cgi->param( $param );
      $form->{$param} = scalar(@val) > 1 ? [ @val ] : $val[0];
    }# end foreach()
    return $s->{_form} = $form;
  }
  else
  {
    return $s->{_form} || { };
  }# end if()
}# end Form()


#==============================================================================
sub QueryString
{
  my $s = shift;
  
  return $s->context->r->args;
}# end QueryString()


#==============================================================================
sub Cookies
{
  my $s = shift;
  
  return { } unless $s->context->headers_in->{cookie};
  
  my %out = ( );
  foreach my $item ( split /;\s*/, $s->context->headers_in->{cookie} )
  {
    my ( $name, $val ) = map { $s->context->cgi->unescape( $_ ) } split /\=/, $item;
    $out{$name} = $val;
  }# end foreach()
  
  @_ ? $out{$_[0]} : \%out;
}# end Cookies()


#==============================================================================
sub FileUpload
{
  my ($s, $field) = @_;
  
  confess "Request.FileUpload called without arguments"
    unless defined($field);
  
  my $cgi = $s->context->cgi;
  
  my $ifh = $cgi->upload($field);
  my %info = ();
  my $upInfo = { };
  
  if( $cgi->isa('Apache2::ASP::SimpleCGI') )
  {
    no warnings 'uninitialized';
    my $up = $cgi->upload_info( $field, 'mime' )
      or return;
    %info = (
      ContentType           => $up,
      FileHandle            => $ifh,
      FileName           => $s->Form->{ $field } . "",
      'ContentDisposition' => 'attachment',
# Mime-Header is deprecated as of v2.46
#      'Mime-Header'         => $cgi->upload_info( $field, 'mime' ),
    );
  }
  else
  {
    $upInfo = $cgi->uploadInfo( $ifh )
      or return;
    no warnings 'uninitialized';
    %info = (
      ContentType           => $upInfo->{'Content-Type'},
      FileHandle            => $ifh,
      FileName              => $s->Form->{ $field } . "",
      'ContentDisposition' => $upInfo->{'Content-Disposition'},
# Mime-Header is deprecated as of v2.46
#      'Mime-Header'         => $upInfo->{type},
    );
  }# end if()
  
  return wantarray ? %info : \%info;
}# end FileUpload()


#==============================================================================
sub DESTROY
{
  my $s = shift;
  undef(%$s);
}# end DESTROY()