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 this site with a module named CGI::Simple::PSGI
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.
Below is the content of this module in case the link is changed.
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->{psgi_env}{'psgi.input'}) {
$self->{psgi_env}{'psgi.input'}->read($$buffer, $len);
}
elsif ( $self->{'.mod_perl'} ) {
my $r = $self->_mod_perl_request();
$r->read( $$buffer, $len );
}
else {
read STDIN, $$buffer, $len;
}
};
}
sub new {
my($class, $env) = @_;
my $self = bless {
psgi_env => $env,
use_tempfile => 1,
}, $class;
local *ENV = $env;
$self->_initialize_globals;
$self->_store_globals;
$self->_read_parse($self->env->{'psgi.input'});
$self;
}
sub _mod_perl { return 0 }
sub env {
$_[0]->{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->charset($charset);
} else {
$charset = $self->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->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->{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{ $_->can('as_string') } ? $_->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->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->cache or $self->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->{psgi_env};
$self->$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->new($env);
return [ $q->psgi_header, [ $body ] ];
}
=head1 DESCRIPTION
This module extends L<CGI::Simple> to use in some web applications
under the PSGI servers. This is a experimental branch from L<CGI::PSGI>
module for L<CGI> by Tatsuhiko Miyagawa.
=head1 AUTHOR
MIZUTANI Tociyuki C<< tociyuki@google.com >>.
Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<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<CGI::Simple> L<CGI::PSGI>
=cut
Tatsuhiko Miyagawa is the author of PSGI and Plack, and MIZUTANI Tociyuki has made contributions to CPAN. It looks like the latter's email address is not correct in the code you have pasted above, though.
There is also Nile::HTTP::PSGI on CPAN which appears to be from the same codebase with a couple of tweaks and an additional method added.
As with any free software, it's up to you whether or not you use it, but at least there is some credibility behind the authors of this code.