more metadata generalization and modification
[bse.git] / site / cgi-bin / modules / BSE / Request / Test.pm
CommitLineData
70789617
TC
1package BSE::Request::Test;
2use strict;
3use base 'BSE::Request::Base';
4
4029e8ab 5our $VERSION = "1.004";
cb7fd78d 6
70789617
TC
7sub new {
8 my ($class, %opts) = @_;
9
12cbbf27 10 my $params = delete $opts{params} || {};
4029e8ab
TC
11 my %params = %$params;
12 my $files = delete $opts{files} || {};
13 for my $key (%$files) {
14 $params{$key} = $files->{$key}{name};
15 }
16 $opts{cgi} = bless
17 {
18 params => \%params,
19 files => $files,
20 }, 'BSE::Request::Test::CGI';
12cbbf27 21 $opts{is_ajax} ||= 0;
70789617 22 my $self = $class->SUPER::new(%opts);
70789617
TC
23
24 $self;
25}
26
27sub _make_cgi {
28 bless {}, 'BSE::Request::Test::CGI';
29}
30
d37dd861 31sub _make_session {
93be7b6a
TC
32 my ($self) = @_;
33
34 $self->{session} = {};
d37dd861
TC
35}
36
12cbbf27
TC
37sub is_ajax {
38 $_[0]{is_ajax};
39}
40
76c6b28e
TC
41package BSE::Request::Test::CGI;
42use Carp qw(confess);
4029e8ab 43use File::Temp qw(:seekable);
70789617
TC
44
45sub param {
12cbbf27
TC
46 my $self = shift;
47 if (@_) {
48 my $name = shift;
49 if (@_) {
76c6b28e 50 die "Unabled to delete $name key in test";
12cbbf27
TC
51 }
52 else {
76c6b28e
TC
53 my $value = $self->{$name};
54 if (defined $value) {
55 if (ref $value) {
56 if (wantarray) {
57 return @{$self->{$name}};
58 }
59 else {
60 return $self->{$name}[-1];
61 }
12cbbf27
TC
62 }
63 else {
76c6b28e 64 return $value;
12cbbf27
TC
65 }
66 }
67 else {
76c6b28e 68 return;
12cbbf27
TC
69 }
70 }
71 }
72 else {
73 return keys %$self;
74 }
70789617
TC
75}
76
4029e8ab
TC
77sub upload {
78 my ($self, $name) = @_;
79
80 my $entry = $self->{files}{$name}
81 or return;
82
83 $entry->{handle}
84 and return $entry->{handle};
85
86 my $fh;
87 if ($entry->{content}) {
88 my $temp = BSE::Request::CGI::File->new;
89 binmode $temp;
90 print $temp $entry->{content};
91 $temp->seek(0, SEEK_SET);
92
93 $fh = $temp;
94 }
95 else {
96 open $fh, "<", $entry->{filename}
97 or die "Cannot open file $entry->{filename}: $!";
98 binmode $fh;
99 }
100 $entry->{handle} = $fh;
101
102 return $fh;
103}
104
105sub uploadInfo {
106 my ($self, $name) = @_;
107
108 my $entry = $self->{files}{$name}
109 or return;
110
111 return $entry->{info} || {};
112}
113
114package BSE::Request::CGI::File;
115use base 'File::Temp';
116
117sub handle {
118 $_[0];
119}
120
70789617 1211;