File Coverage

blib/lib/Newsletter/Html/Upload.pm
Criterion Covered Total %
statement 6 22 27.2
branch 0 4 0.0
condition n/a
subroutine 2 4 50.0
pod 0 1 0.0
total 8 31 25.8


line stmt bran cond sub pod time code
1             package Newsletter::Html::Upload;
2              
3 1     1   1923 use warnings;
  1         2  
  1         25  
4              
5 1     1   4 use strict;
  1         1  
  1         283  
6              
7             sub fileUpload {
8 0     0 0   my ($self, $cgiParamName ) = @_;
9              
10 0           my $file = $self->{'cgi'}->param( $cgiParamName );
11              
12 0 0         return "No File !" if(!$file);
13              
14 0           my $saveFile = $file;
15 0           $saveFile =~s/^.*\\([\w\d_\- \(\)]+\.[\w]+)$/$1/g;
16 0           $saveFile =~s/ /_/g;
17              
18 0           my $savePath = $self->{'uploadPath'}.'/'.$saveFile;
19              
20 0 0         open (FILE, '>'.$savePath) or die "Error processing file: $savePath, $!\n";
21 0           binmode FILE;
22            
23 0           $self->_lowRead( \$file, \*FILE );
24              
25 0           close FILE;
26              
27             # return file+path on server
28 0           return $saveFile;
29             }
30              
31              
32             sub _lowRead {
33 0     0     my ($self, $file, $FILE_HANLDE) = @_;
34 0           my $data;
35 0           while(read $$file, $data, 32768) { #1 #1024
36 0           print $FILE_HANLDE $data;
37             }
38             }
39              
40              
41              
42             =head1 NAME
43              
44             Newsletter::Html::Upload - Fileupload!
45              
46             =head1 VERSION
47              
48             Version 0.01
49              
50             =cut
51              
52             our $VERSION = '0.01';
53              
54             =head1 SYNOPSIS
55              
56             Attchments and embedded files inside of the mails
57              
58             Perhaps a little code snippet.
59              
60             use Newsletter::Html::Upload;
61              
62             my $foo = Newsletter::Html::Upload->new();
63             ...
64              
65             =head1 EXPORT
66              
67             A list of functions that can be exported. You can delete this section
68             if you don't export anything, such as for a purely object-oriented module.
69              
70             =head1 FUNCTIONS
71              
72             =head1 AUTHOR
73              
74             Dominik Hochreiter, C<< >>
75              
76             =head1 BUGS
77              
78             Please report any bugs or feature requests to
79             C, or through the web interface at
80             L.
81             I will be notified, and then you'll automatically be notified of progress on
82             your bug as I make changes.
83              
84             =head1 SUPPORT
85              
86             You can find documentation for this module with the perldoc command.
87              
88             perldoc Newsletter
89              
90             You can also look for information at:
91              
92             =over 4
93              
94             =item * AnnoCPAN: Annotated CPAN documentation
95              
96             L
97              
98             =item * CPAN Ratings
99              
100             L
101              
102             =item * RT: CPAN's request tracker
103              
104             L
105              
106             =item * Search CPAN
107              
108             L
109              
110             =back
111              
112             =head1 ACKNOWLEDGEMENTS
113              
114             =head1 COPYRIGHT & LICENSE
115              
116             Copyright 2006 Dominik Hochreiter, all rights reserved.
117              
118             This program is free software; you can redistribute it and/or modify it
119             under the same terms as Perl itself.
120              
121             =cut
122              
123             1; # End of Newsletter::Html::Upload