line
stmt
bran
cond
sub
pod
time
code
1
package CGI::UploadEngine;
2
1
1
23921
use Class::Std;
1
14270
1
7
3
1
1
984
use Class::Std::Utils;
1
3736
1
7
4
1
1
529
use DBIx::MySperql qw(DBConnect SQLExec $dbh);
0
0
5
use YAML::Any qw(LoadFile);
6
7
use warnings;
8
use strict;
9
use Carp;
10
11
use version; our $VERSION = qv('0.9.3');
12
13
our $token_length = 60;
14
our @token_chars = ('a'..'z','A'..'Z','0'..'9','_');
15
our $config_file = '/var/www/.uploadengine';
16
17
{
18
my %db_of :ATTR( :get :set :default<''> :init_arg );
19
my %host_of :ATTR( :get :set :default<'localhost'> :init_arg );
20
my %user_of :ATTR( :get :set :default<''> :init_arg );
21
my %pass_of :ATTR( :get :set :default<''> :init_arg );
22
my %config_of :ATTR( :get :set :default<''> :init_arg );
23
my %verbose_of :ATTR( :get :set :default<'0'> );
24
25
sub verbose { my ( $self ) = @_; return $self->get_verbose(); }
26
27
sub START {
28
my ($self, $ident, $arg_ref) = @_;
29
30
# Loads the YAML configuration file
31
warn "CONFIG: $config_file";
32
my $config = LoadFile($config_file);
33
34
# Set verbose
35
if ( $config->{verbose} ) { $self->set_verbose( 1 ); }
36
37
# Report config if verbose
38
if ( $self->verbose() ) { foreach my $key ( keys %$config ) { warn "CONFIG: $key -> " . $config->{$key}; } }
39
40
# Store the file descriptor in member variable
41
$self->set_config($config);
42
43
# Check to see if database info was passed
44
if ( $self->get_db() ne '' and $self->get_user() ne '' and $self->get_pass() ne '') {
45
$dbh = DBConnect( database => $self->get_db(),
46
host => $self->get_host(),
47
user => $self->get_user(),
48
pass => $self->get_pass() );
49
# If not then use the database info from the config file
50
} else {
51
$dbh = DBConnect( database => $self->get_config()->{database},
52
host => $self->get_config()->{host},
53
user => $self->get_config()->{user},
54
pass => $self->get_config()->{pass} );
55
56
# Set configured connection parameters
57
$self->set_db( $config->{database} );
58
$self->set_host( $config->{host} );
59
$self->set_user( $config->{user} );
60
$self->set_pass( $config->{pass} );
61
}
62
63
return;
64
}
65
66
sub upload_prepare {
67
my ( $self, $arg_ref ) = @_;
68
69
my $file_path = defined $arg_ref->{file_path} ? $arg_ref->{file_path} : '/tmp';
70
my $max_size = defined $arg_ref->{max_size} ? $arg_ref->{max_size} : 5000000;
71
my $min_size = defined $arg_ref->{min_size} ? $arg_ref->{min_size} : 1;
72
my $allowed_types = defined $arg_ref->{allowed_types} ? $arg_ref->{allowed_types} : '';
73
my $disallowed_types = defined $arg_ref->{disallowed_types} ? $arg_ref->{disallowed_types} : '';
74
75
# Save the file_path and token
76
my $token = $self->_generate_token();
77
my $sql = "insert into upload_files ( ";
78
$sql .= 'file_path, attempt_token, max_size, min_size, allowed_types, disallowed_types, created ';
79
$sql .= ') values ("';
80
$sql .= $file_path . '", "';
81
$sql .= $token . '", ';
82
$sql .= $max_size . ', ';
83
$sql .= $min_size . ', "';
84
$sql .= $allowed_types . '", "';
85
$sql .= $disallowed_types . '", now() )';
86
SQLExec( $sql ) or die("failed to write file parameters to database");
87
88
return $self->_generate_html({ token => $token });
89
}
90
91
sub upload_validate {
92
my ( $self, $arg_ref ) = @_;
93
my $token = defined $arg_ref->{token} ? $arg_ref->{token} : '';
94
95
# Save the file_path and token and the parameters given in upload_prepare back to controller
96
my $sql = "select file_path,";
97
$sql .= "max_size,";
98
$sql .= "min_size, ";
99
$sql .= "allowed_types,";
100
$sql .= "disallowed_types,";
101
$sql .= "created from upload_files ";
102
$sql .= "where attempt_token = '$token'";
103
my ( $file_path, $max_size, $min_size, $allowed_types, $disallowed_types, $created) = SQLExec( $sql, '@' ) or die("ERROR: failed to exec sql statement");
104
105
# Check to make sure variables from database are valid
106
( length( $file_path ) > 0 ) or die( "ERROR: file_path is blank" );
107
( length( $max_size ) > 0 ) or die( "ERROR: max_size is blank" );
108
( length( $min_size ) > 0 ) or die( "ERROR: min_size is blank" );
109
( length( $created ) != 0 ) or die( "ERROR: created is blank" );
110
return { file_path => $file_path,
111
max_size => $max_size,
112
min_size => $min_size,
113
allowed_types => $allowed_types,
114
disallowed_types => $disallowed_types,
115
created => $created };
116
}
117
118
sub upload_success {
119
my ( $self, $arg_ref ) = @_;
120
121
my $attempt_token = defined $arg_ref->{token} ? $arg_ref->{token} : '';
122
my $file_name = defined $arg_ref->{file_name} ? $arg_ref->{file_name} : '';
123
my $file_size = defined $arg_ref->{file_size} ? $arg_ref->{file_size} : '';
124
125
# Check to make sure there isn't already a success token for htis attempt token
126
my $sql = "select success_token from upload_files where attempt_token='$attempt_token'";
127
my ( $success_token ) = SQLExec( $sql,'@' ); # and die("could not execute sql command: $sql");
128
if ( $success_token ) { die( "ERROR: success_token already exists for attempt_token: $attempt_token" ); }
129
130
# Create success token
131
$success_token = $self->_generate_token();
132
133
# Save the file_path and token and file size
134
$sql = "update upload_files set success_token = '$success_token', file_name = '$file_name', file_size='$file_size' where attempt_token = '$attempt_token'";
135
SQLExec( $sql ) or die( "could not execute sql command: $sql" );
136
137
return $success_token;
138
}
139
140
sub upload_retrieve {
141
my ( $self, $arg_ref ) = @_;
142
my $token = defined $arg_ref->{token} ? $arg_ref->{token} : '';
143
144
# Save the file_path and token
145
my $sql = "select file_path, file_name, file_size, max_size, min_size, allowed_types, disallowed_types, created from upload_files where success_token = '$token'";
146
my ( $file_path, $file_name, $file_size, $max_size, $min_size, $allowed_types, $disallowed_types, $created ) = SQLExec( $sql, '@' ) or die("could not execute sql command: $sql");
147
148
return { file_path => $file_path, file_name => $file_name, file_size=> $file_size, max_size=>$max_size, min_size=>$min_size, allowed_types=>$allowed_types, disallowed_types=>$disallowed_types, created => $created };
149
}
150
151
sub _generate_token {
152
my ( $self, $arg_ref ) = @_;
153
my $token;
154
155
# Random string created from global package variables
156
foreach (1..$token_length) { $token .= $token_chars[rand @token_chars]; }
157
158
return $token;
159
}
160
161
sub _generate_html {
162
my ( $self, $arg_ref ) = @_;
163
my $token = defined $arg_ref->{token} ? $arg_ref->{token} : '';
164
my $root_url = $self->get_config()->{root_url};
165
my $action = $root_url . 'upload';
166
my $success_message = $self->get_config()->{success_message};
167
my $error_image = $self->get_config()->{error_image};
168
169
my $html = <
170
171
217
218
219
220
221
222
END_OF_HTML
223
return $html;
224
}
225
}
226
227
1; # Magic true value required at end of module
228
__END__