more metadata generalization and modification
[bse.git] / site / cgi-bin / modules / BSE / Request / Test.pm
1 package BSE::Request::Test;
2 use strict;
3 use base 'BSE::Request::Base';
4
5 our $VERSION = "1.004";
6
7 sub new {
8   my ($class, %opts) = @_;
9
10   my $params = delete $opts{params} || {};
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';
21   $opts{is_ajax} ||= 0;
22   my $self = $class->SUPER::new(%opts);
23
24   $self;
25 }
26
27 sub _make_cgi {
28   bless {}, 'BSE::Request::Test::CGI';
29 }
30
31 sub _make_session {
32   my ($self) = @_;
33
34   $self->{session} = {};
35 }
36
37 sub is_ajax {
38   $_[0]{is_ajax};
39 }
40
41 package BSE::Request::Test::CGI;
42 use Carp qw(confess);
43 use File::Temp qw(:seekable);
44
45 sub param {
46   my $self = shift;
47   if (@_) {
48     my $name = shift;
49     if (@_) {
50       die "Unabled to delete $name key in test";
51     }
52     else {
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           }
62         }
63         else {
64           return $value;
65         }
66       }
67       else {
68         return;
69       }
70     }
71   }
72   else {
73     return keys %$self;
74   }
75 }
76
77 sub 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
105 sub uploadInfo {
106   my ($self, $name) = @_;
107
108   my $entry = $self->{files}{$name}
109     or return;
110
111   return $entry->{info} || {};
112 }
113
114 package BSE::Request::CGI::File;
115 use base 'File::Temp';
116
117 sub handle {
118   $_[0];
119 }
120
121 1;