view release on metacpan or  search on metacpan

lib/CGI/Simple.pm  view on Meta::CPAN

    # hack to fix broken path info in IIS source CGI.pm
    $self->{'.path_info'} =~ s/^\Q$ENV{'SCRIPT_NAME'}\E//
     if defined( $ENV{'SERVER_SOFTWARE'} )
       && $ENV{'SERVER_SOFTWARE'} =~ /IIS/;
  }
  return $self->{'.path_info'};
}

sub accept {
  my ( $self, $search ) = @_;
  my %prefs;
  for my $accept ( split ',', $ENV{'HTTP_ACCEPT'} ) {
    ( my $pref ) = $accept =~ m|q=([\d\.]+)|;
    ( my $type ) = $accept =~ m|(\S+/[^;]+)|;
    next unless $type;
    $prefs{$type} = $pref || 1;
  }
  return keys %prefs unless $search;
  return $prefs{$search} if $prefs{$search};

  # Didn't get it, so try pattern matching.
  for my $pref ( keys %prefs ) {
    next unless $pref =~ m/\*/;    # not a pattern match
    ( my $pat = $pref ) =~ s/([^\w*])/\\$1/g;   # escape meta characters
    $pat =~ s/\*/.*/g;                          # turn it into a pattern
    return $prefs{$pref} if $search =~ /$pat/;
  }
}

sub Accept { my $self = shift; $self->accept( @_ ) }

sub http {
  my ( $self, $parameter ) = @_;
  if ( defined $parameter ) {
    ( $parameter = uc $parameter ) =~ tr/-/_/;
    return $ENV{$parameter} if $parameter =~ m/^HTTP/;