title: Perl CGI::Simple under PSGI
body: <p>I am using CGI::Simple in a simple application that I want it to support PSGI, I am not going to use any ready made frameworks, I did a lot of search a bout PSGI support for CGI::Simple but did not find any module on CPAN. By luck I found someone on <a href="http://d.hatena.ne.jp/tociyuki/20100131/1264918747" rel="nofollow">this site</a> with a module named <code>CGI::Simple::PSGI</code> which does not exist on CPAN. Is it safe to include this module with my app, I am not sure why the authors did not upload it to cpan site. I contacted the emails of the modules but got not reply.</p>
  
  <p>Below is the content of this module in case the link is changed.</p>
  
  <pre><code>package CGI::Simple::PSGI;
  use strict;
  use 5.008_001;
  our $VERSION = '0.001_002';
  
  use base qw(CGI::Simple);
  
  if ($CGI::Simple::VERSION lt '1.111') {
      no warnings 'redefine';
      *CGI::Simple::_internal_read = sub($\$;$) {
          my ($self, $buffer, $len) = @_;
          $len = 4096 if !defined $len;
          if (exists $self-&gt;{psgi_env}{'psgi.input'}) {
              $self-&gt;{psgi_env}{'psgi.input'}-&gt;read($$buffer, $len);
          }
          elsif ( $self-&gt;{'.mod_perl'} ) {
              my $r = $self-&gt;_mod_perl_request();
              $r-&gt;read( $$buffer, $len );
          }
          else {
              read STDIN, $$buffer, $len;
          }
      };
  }
  
  sub new {
      my($class, $env) = @_;
      my $self = bless {
          psgi_env     =&gt; $env,
          use_tempfile =&gt; 1,
      }, $class;
  
      local *ENV = $env;
      $self-&gt;_initialize_globals;
      $self-&gt;_store_globals;
      $self-&gt;_read_parse($self-&gt;env-&gt;{'psgi.input'});
  
      $self;
  }
  
  sub _mod_perl { return 0 }
  
  sub env {
      $_[0]-&gt;{psgi_env};
  }
  
  # copied and rearanged from CGI::Simple::header
  sub psgi_header {
      my($self, @p) = @_;
      require CGI::Simple::Util;
      my @header;
      my(
          $type, $status, $cookie, $target, $expires, $nph, $charset,
          $attachment, $p3p, @other
      ) = CGI::Simple::Util::rearrange([
          ['TYPE', 'CONTENT_TYPE', 'CONTENT-TYPE'],
          'STATUS', ['COOKIE', 'COOKIES'], 'TARGET',
          'EXPIRES', 'NPH', 'CHARSET',
          'ATTACHMENT','P3P',
      ], @p);
  
      $type ||= 'text/html' unless defined($type);
      if (defined $charset) {
          $self-&gt;charset($charset);
      } else {
          $charset = $self-&gt;charset if $type =~ /^text\//;
      }
      $charset ||= '';
  
      # rearrange() was designed for the HTML portion, so we
      # need to fix it up a little.
      my @other_headers;
      for (@other) {
          # Don't use \s because of perl bug 21951
          next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
          $header =~ s/^(\w)(.*)/"\u$1\L$2"/e;
          push @other_headers, $header, $self-&gt;unescapeHTML($value);
      }
  
      $type .= "; charset=$charset"
          if     $type ne ''
             and $type !~ /\bcharset\b/
             and defined $charset
             and $charset ne '';
  
      # Maybe future compatibility.  Maybe not.
      my $protocol = $self-&gt;{psgi_env}{SERVER_PROTOCOL} || 'HTTP/1.0';
  
      push @header, "Status", $status if $status;
      push @header, "Window-Target", $target if $target;
      if ($p3p) {
          $p3p = join ' ',@$p3p if ref $p3p eq 'ARRAY';
          push @header, "P3P", qq{policyref="/w3c/p3p.xml", CP="$p3p"};
      }
  
      # push all the cookies -- there may be several
      if ($cookie) {
          my(@cookie) = ref $cookie eq 'ARRAY' ? @{$cookie} : $cookie;
          for (@cookie) {
              my $cs = eval{ $_-&gt;can('as_string') } ? $_-&gt;as_string : "$_";
              push @header, "Set-Cookie", $cs if $cs ne '';
          }
      }
      # if the user indicates an expiration time, then we need
      # both an Expires and a Date header (so that the browser is
      # uses OUR clock)
      $expires = 'now'
        if $self-&gt;no_cache;    # encourage no caching via expires now
      push @header, 'Expires', CGI::Simple::Util::expires($expires, 'http')
        if $expires;
      push @header, 'Date', CGI::Simple::Util::expires(0, 'http')
        if defined $expires || $cookie || $nph;
      push @header, 'Pragma', 'no-cache' if $self-&gt;cache or $self-&gt;no_cache;
      push @header, 'Content-Disposition', "attachment; filename=\"$attachment\""
        if $attachment;
      push @header, @other;
      push @header, 'Content-Type', $type if $type;
  
      $status ||= "200";
      $status =~ s/\D*$//;
  
      return $status, \@header;
  }
  
  # The list is auto generated and modified with:
  # perl -nle '/^sub (\w+)/ and $sub=$1; \
  #   /^}\s*$/ and do { print $sub if $code{$sub} =~ /([\%\$]ENV|http\()/; undef $sub };\
  #   $code{$sub} .= "$_\n" if $sub; \
  #   /^\s*package [^C]/ and exit' \
  # `perldoc -l CGI`
  for my $method (qw(
      url_param
      upload
      upload_info
      parse_query_string
      cookie
      raw_cookie
      header
      MyFullUrl
      PrintEnv
      auth_type
      content_length
      content_type
      document_root
      gateway_interface
      path_translated
      referer
      remote_addr
      remote_host
      remote_ident
      remote_user
      request_method
      script_name
      server_name
      server_port
      server_protocol
      server_software
      user_name
      user_agent
      virtual_host
      path_info
      accept
      http
      https
      protocol
      url
  )) {
      no strict 'refs';
      *$method = sub {
          my $self  = shift;
          my $super = "SUPER::$method";
          local *ENV = $self-&gt;{psgi_env};
          $self-&gt;$super(@_);
      };
  }
  
  sub DESTROY {
      my $self = shift;
      CGI::Simple::_initialize_globals();
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  CGI::Simple::PSGI - Enable your CGI/Simple.pm aware applications to adapt PSGI protocol
  
  =head1 VERSION
  
  0.001_002
  
  =head1 SYNOPSIS
  
    use CGI::Simple::PSGI;
  
    sub app {
        my $env = shift;
        # set CGI::Simple's global control variables
        local $CGI::Simple::DISABLE_UPLOADS = 0;    # enable upload
        local $CGI::Simple::POST_MAX = 1024;        # max size on POST
        my $q = CGI::Simple::PSGI-&gt;new($env);
        return [ $q-&gt;psgi_header, [ $body ] ];
    }
  
  =head1 DESCRIPTION
  
  This module extends L&lt;CGI::Simple&gt; to use in some web applications
  under the PSGI servers. This is a experimental branch from L&lt;CGI::PSGI&gt;
  module for L&lt;CGI&gt; by Tatsuhiko Miyagawa.
  
  =head1 AUTHOR
  
  MIZUTANI Tociyuki C&lt;&lt; tociyuki@google.com &gt;&gt;.
  Tatsuhiko Miyagawa E&lt;lt&gt;miyagawa@bulknews.netE&lt;gt&gt;
  
  =head1 LICENSE
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  L&lt;CGI::Simple&gt; L&lt;CGI::PSGI&gt;
  
  =cut
  </code></pre>