APR-Emulate-PSGI
view release on metacpan or search on metacpan
=item content_type
Emulates L<Apache2::RequestRec/content_type>.
If no PSGI enviroment is provided to L</new>, calling this
method with a parameter will cause HTTP headers to be sent.
=cut
=item print
Emulates L<Apache2::RequestIO/print>.
=cut
=item rflush
Emulates L<Apache2::RequestIO/rflush>.
=cut
inc/Module/Install.pm view on Meta::CPAN
$string =~ s/^\n+//s;
return $string;
}
# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
END_NEW
sub _write {
local *FH;
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
# Normalise multipart versions
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
inc/Module/Install/Can.pm view on Meta::CPAN
return 0;
}
# Write a C file representative of what XS becomes
require File::Temp;
my ( $FH, $tmpfile ) = File::Temp::tempfile(
"compilexs-XXXXX",
SUFFIX => '.c',
);
binmode $FH;
print $FH <<'END_C';
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
int main(int argc, char **argv) {
return 0;
}
int boot_sanexs() {
return 1;
inc/Module/Install/Fetch.pm view on Meta::CPAN
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
inc/Module/Install/Fetch.pm view on Meta::CPAN
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;
inc/Module/Install/Makefile.pm view on Meta::CPAN
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
$makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
seek MAKEFILE, 0, SEEK_SET;
truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
1;
}
sub preamble {
my ($self, $text) = @_;
$self->{preamble} = $text . $self->{preamble} if defined $text;
$self->{preamble};
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
my $version = shift @requires;
$self->test_requires( $module => $version );
}
}
# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
sub _perl_version {
my $v = $_[-1];
$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
# Numify
$v = $v + 0;
}
return $v;
}
sub add_metadata {
inc/Module/Install/Metadata.pm view on Meta::CPAN
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.yml\n";
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
sub write_mymeta_json {
my $self = shift;
# We need JSON to write the MYMETA.json file
unless ( eval { require JSON; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.json\n";
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
inc/Module/Install/Win32.pm view on Meta::CPAN
$self->load('get_file');
require Config;
return unless (
$^O eq 'MSWin32' and
$Config::Config{make} and
$Config::Config{make} =~ /^nmake\b/i and
! $self->can_run('nmake')
);
print "The required 'nmake' executable not found, fetching it...\n";
require File::Basename;
my $rv = $self->get_file(
url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
local_dir => File::Basename::dirname($^X),
size => 51928,
run => 'Nmake15.exe /o > nul',
check_for => 'Nmake.exe',
remove => 1,
lib/APR/Emulate/PSGI.pm view on Meta::CPAN
}
}
return $self->{'content_type'};
}
sub _send_http_headers {
my ($self) = @_;
return if ($self->{'headers_sent'});
if (my $status = $self->status_line() || $self->status() || '200 OK') {
my $url_scheme = uc($self->{'psgi_env'}{'psgi.url_scheme'} || 'http');
print $url_scheme . '/1.1 ' . $status . "\n";
}
print 'Content-Type: ' . ($self->{'content_type'} || 'text/html') . "\n";
$self->headers_out()->do(
sub {
my ($key, $value) = @_;
print join(': ', $key, $value) . "\n";
}
);
print "\n\n";
$self->{'headers_sent'} = 1;
return 1;
}
=item print
Emulates L<Apache2::RequestIO/print>.
=cut
sub print {
my ($self, @content) = @_;
my $success = CORE::print @content;
return $success
? length(join('', @content))
: 0;
}
=item rflush
Emulates L<Apache2::RequestIO/rflush>.
=cut
t/10_psgi.t view on Meta::CPAN
is(
exists($headers->{'Cache-control'}),
'',
'Received no Cache-control header.',
);
my $body_fh = IO::File->new_tmpfile();
{
local *STDOUT = $body_fh;
#my $length = $r->print($response_body);
is(
#$length,
$r->print($response_body),
length($response_body),
'Content is printed.',
);
}
$body_fh->seek(0, 0); # Reset filehandle back to the beginning.
is(
$body_fh->getline(),
$response_body,
'Received expected content.',
);
t/20_cgi_mode.t view on Meta::CPAN
is(
$headers_fh->getline(),
"\n",
'Received end-of-headers indicator.',
);
my $body_fh = IO::File->new_tmpfile();
{
local *STDOUT = $body_fh;
#my $length = $r->print($response_body);
is(
#$length,
$r->print($response_body),
length($response_body),
'Content is printed.',
);
}
$body_fh->seek(0, 0); # Reset filehandle back to the beginning.
is(
$body_fh->getline(),
$response_body,
'Received expected content.',
);
( run in 0.580 second using v1.01-cache-2.11-cpan-de7293f3b23 )