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
|
package t::Util;
use strict;
use warnings;
use base qw/Exporter/;
use IO::File qw//;
use Carp;
our @EXPORT = qw/slurp paml_loadfile build_env/;
sub slurp {
my $file = shift;
open my $fh, "<:unix", $file or die "$!";
scalar do { local $/; <$fh> };
}
sub paml_loadfile {
my ($path) = @_;
my $data = do {
my $io = IO::File->new($path, '<')
|| croak(qq[Couldn't open path '$path' in read mode: $!]);
$io->binmode
|| croak(qq[Couldn't binmode filehandle: $!]);
my $exp = -s $path;
my $buf = do { local $/; <$io> };
my $got = length $buf;
$io->close
|| croak(qq[Couldn't close filehandle: $!]);
($exp == $got)
|| croak(qq[I/O read mismatch, expexted: $exp got: $got]);
$buf;
};
if (substr($data, 0, 1) eq '{') {
substr($data, 0, 0, '+');
}
my $struct = eval($data);
(!$@)
|| croak(qq[LoadFile couldn't eval data: $@]);
$struct;
}
sub build_env {
my ($headers, $body_fh) = @_;
my %env;
foreach my $key ( keys %$headers ) {
my $val = $headers->{$key};
$key = uc $key;
$key =~ s/-/_/g;
if ($key !~ /^(?:CONTENT_LENGTH|CONTENT_TYPE)$/) {
$key = "HTTP_" . $key;
}
$env{$key} = $val;
}
$env{'psgi.input'} = $body_fh;
return \%env;
}
1;
|
