File: Helper.pm

package info (click to toggle)
libmojolicious-plugin-cgi-perl 0.36-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 208 kB
  • ctags: 17
  • sloc: perl: 300; makefile: 2
file content (93 lines) | stat: -rw-r--r-- 2,469 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
package t::Helper;
use Mojo::Base -strict;

use File::Basename;
use File::Spec::Functions qw(catdir catfile);
use Mojolicious;
use Mojo::Loader;
use Test::Mojo;
use Test::More;

sub cgi_script {
  my $template = shift;
  my $script = catfile 't', 'cgi-bin', $template;
  mkdir catdir qw(t cgi-bin);
  open my $CGI_BIN, '>', $script or Test::More::plan(skip_all => "write $script: $!");
  print $CGI_BIN "#!$^X\n";
  print $CGI_BIN "use strict;\nuse warnings;\n";
  print $CGI_BIN Mojo::Loader::data_section(__PACKAGE__, $template);
  close $CGI_BIN;
  eval { chmod 0755, $script };
  return $script;
}

sub import {
  my $class  = shift;
  my $caller = caller;

  Test::More::plan(skip_all => 'Skipping tests on Windows.') if $^O eq 'Win32';

  eval <<"HERE";
package $caller;
use Mojo::Base -strict;
use Test::Mojo;
use Test::More;
HERE

  Mojo::Util::monkey_patch($caller => cgi_script => \&cgi_script);
}

1;

__DATA__
@@ basic.pl
print "Content-Type: text/custom\n\r\n\rbasic stuff\n";
@@ env
print "Content-Type: text/plain\n\r";
print "\n\rENVIRON";
print "MENT\n";
print "$_=$ENV{$_}\n" for sort keys %ENV;
@@ env.cgi
print "Content-Type: text/plain\n\r";
print "\n\rENVIRON";
print "MENT\n";
print "$_=$ENV{$_}\n" for sort keys %ENV;
@@ errlog
warn "yikes!";
print "Content-Type: text/plain\n\r\n\r";
print "yayayyaya\n";
@@ file_upload
print "Content-Type: text/custom\n\r\n\r";
print "$$\n";
print "=== $ENV{$_}\n" for qw/CONTENT_TYPE CONTENT_LENGTH/;
print "--- $_" while <STDIN>;
@@ not-found.pl
print "Status: 404 Not Found\r\n";
print "Content-Type: text/html; charset=ISO-8859-1\r\n";
print "\r\n";
print "<body><p>This page is missing\n";
@@ not-modified.pl
print "Status: 304 Not Modified\r\n";
print "X-Test: if-none-match seen: $ENV{HTTP_IF_NONE_MATCH}\r\n";
print "\r\n";
@@ nph-borked.pl
# When SERVER_PROTOCOL is set to "HTTP", the CGI module will just print HTTP and
# no version!
print "HTTP 403 Payment Required\r\n";
print "Content-Type: text/html; charset=ISO-8859-1\r\n";
print "\r\n";
print "<body><p>This is the borked paywall.\n";
@@ nph.pl
print "HTTP/1.1 403 Payment Required\r\n";
print "Content-Type: text/html; charset=ISO-8859-1\r\n";
print "\r\n";
print "<body><p>This is the paywall.\n";
@@ postman
print "Content-Type: text/custom\n\r\n\r";
print "$$\n";
print "--- $_" while <STDIN>;
@@ redirect.pl
print "Location: http://somewhereelse.com\n\r\n\r";
@@ slow.pl
sleep 1;
print "Content-Type: text/custom\n\r\n\rHello Morbo!\n";