File Coverage

blib/lib/PowerTools/Upload/Blob.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package PowerTools::Upload::Blob;
2            
3 1     1   37136 use 5.000005;
  1         4  
  1         44  
4 1     1   6 use strict;
  1         2  
  1         32  
5 1     1   5 use warnings;
  1         6  
  1         35  
6 1     1   12253 use DBI;
  1         24812  
  1         77  
7 1     1   500 use File::Scan::ClamAV;
  0            
  0            
8            
9             require Exporter;
10            
11             our @ISA = qw(Exporter DBI);
12            
13             # Items to export into callers namespace by default. Note: do not export
14             # names by default without a very good reason. Use EXPORT_OK instead.
15             # Do not simply export all your public functions/methods/constants.
16            
17             # This allows declaration use PowerTools::Upload::Blob ':all';
18             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
19             # will save memory.
20             our %EXPORT_TAGS = ( 'all' => [ qw(upload
21            
22             ) ] );
23            
24             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
25            
26             our @EXPORT = qw(
27             upload
28             );
29            
30             our $VERSION = '0.03';
31            
32             # Below is stub documentation for your module. You'd better edit it!
33            
34             =head1 NAME
35            
36             PowerTools::Upload::Blob - Additional Perl tool for Apache::ASP data uploading
37            
38             =head1 SYNOPSIS
39            
40             default table
41            
42             CREATE TABLE `files`.`file` (
43             `file_id` int(10) unsigned NOT NULL auto_increment,
44             `file_name` varchar(255) NOT NULL,
45             `file_type` varchar(255) NOT NULL,
46             `file_blob` longblob NOT NULL,
47             `file_size` int(10) unsigned NOT NULL,
48             PRIMARY KEY (`file_id`)
49             ) ENGINE=InnoDB DEFAULT CHARSET=latin1;
50            
51             .asp file
52            
53             use PowerTools::Upload::Blob;
54            
55             my $up = PowerTools::Upload::File->new( # Create new object
56             path => 'E:/instale/test', # Path to directory where files will be stored (default: '/tmp')
57             field => 'plik', # Form field name (, default: 'file')
58             limit => $Server->Config("FileUploadMax"), # File size limit (default 100000000)
59             request => $Request, # Request object
60             clamav => 1, # Scan with ClamAV when uploading (0 -> no / 1 -> yes, default: 0)
61             overwrite => 0 # Overwrite file (0 -> no / 1 -> yes, default: 1)
62             );
63            
64             my $ret = $up->upload(); # Upload file
65             print $ret->{'filename'}."
"; # Returns filename
66             print $ret->{'filesize'}."
"; # Returns filesize
67             print $ret->{'filepath'}."
"; # Returns filepath
68             print $ret->{'filescan'}."
"; # Returns filescan
69             print $ret->{'filemime'}."
"; # Returns filemime
70             print $ret->{'copytime'}."
"; # Returns copytime
71             print $ret->{'status'}; # Returns upload status
72            
73            
74             =head1 AUTHOR
75            
76             Piotr Ginalski, Eoffice@gbshouse.comE
77            
78             =head1 COPYRIGHT AND LICENSE
79            
80             Copyright (C) 2007 by Piotr Ginalski
81            
82             This library is free software; you can redistribute it and/or modify
83             it under the same terms as Perl itself, either Perl version 5.8.8 or,
84             at your option, any later version of Perl 5 you may have available.
85            
86            
87             =cut
88            
89             sub new {
90             my $class = shift;
91             my (%options) = @_;
92             return bless \%options, $class;
93             }
94            
95             sub upload {
96             my $self = shift;
97            
98             my $field = $self->{field} || "file";
99             my $limit = $self->{limit} || 100000000;
100             my $r = $self->{request};
101            
102             my $db_user = $self->{db_user} || "root";
103             my $db_pass = $self->{db_pass} || "";
104             my $db_name = $self->{db_name} || "files";
105            
106             my $db_host = $self->{db_host} || "localhost";
107             my $db_port = $self->{db_port} || 3306;
108             my $db_type = $self->{db_type} || "mysql";
109            
110             my $dsn = "DBI:$db_type:database=$db_name;host=$db_host";
111            
112             my $dbh = DBI->connect($dsn, $db_user, $db_pass, { RaiseError => 1, AutoCommit => 1 }) || carp $DBI::errstr;
113            
114             my $tname = $self->{table_file} || 'files';
115            
116             my $fid = $self->{field_file_id} || 'file_id';
117            
118             my $fname = $self->{field_file_name} || 'file_name';
119             my $ftype = $self->{field_file_type} || 'file_type';
120             my $fblob = $self->{field_file_blob} || 'file_blob';
121             my $fsize = $self->{field_file_size} || 'file_size';
122            
123             $self->{'filename'} = '';
124             $self->{'filesize'} = '';
125             $self->{'filescan'} = '';
126             $self->{'filemime'} = '';
127             $self->{'copytime'} = '';
128             $self->{'insertid'} = '';
129             $self->{'status'} = '';
130            
131             if($r) {
132            
133             my $ct = $r->FileUpload( $field, 'ContentType');
134             my $bf = $r->FileUpload( $field, 'BrowserFile');
135             my $fh = $r->FileUpload( $field, 'FileHandle');
136             my $mh = $r->FileUpload( $field, 'Mime-Header');
137             my $tf = $r->FileUpload( $field, 'TempFile');
138            
139             $self->{'filemime'} = $ct;
140            
141             my $file = $bf;
142             $file =~ s/.*[\/\\](.*)/$1/;
143            
144             $self->{'filename'} = $file;
145            
146             my $code = "OK";
147             my ($virus,$var);
148             binmode $fh;
149             read($fh, $var, -s $fh);
150            
151             my $size = -s $fh;
152             $self->{'filesize'} = $size;
153            
154             if($self->{clamav} == 1) {
155             my $av = new File::Scan::ClamAV(port => 3310);
156             if($av->ping){
157             my ($code,$virus) = $av->streamscan($var);
158             $self->{'filescan'} = $code;
159             }
160             }
161            
162             if( ($code eq 'OK') && ($size <= $limit) ) {
163            
164             my $start_time = time();
165             my $sql = "INSERT INTO $tname ($fname,$ftype,$fblob,$fsize) VALUES (?,?,?,?)";
166             my $sth = $dbh->prepare($sql);
167             $sth->execute($file,$ct,$var,$size);
168             $sth->finish();
169             $self->{'insertid'} = $dbh->{'mysql_insertid'};
170             my $time_took = time() - $start_time;
171             $self->{'copytime'} = $time_took;
172             $self->{'status'} = 'OK';
173            
174             } else {
175             $self->{'status'} = 'File containing virus or size overlimit';
176             carp $self->{'status'};
177             }
178            
179             $dbh->disconnect;
180            
181             } else {
182             $self->{'status'} = 'No request object found';
183             carp $self->{'status'};
184             }
185            
186             return $self;
187            
188             }
189            
190             1;
191             __END__