line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package FileUpload::Filename; |
2
|
6
|
|
|
6
|
|
293966
|
use strict; |
|
6
|
|
|
|
|
16
|
|
|
6
|
|
|
|
|
260
|
|
3
|
6
|
|
|
6
|
|
31
|
use warnings; |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
221
|
|
4
|
|
|
|
|
|
|
|
5
|
6
|
|
|
6
|
|
43
|
use Carp qw(carp croak); |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
675
|
|
6
|
6
|
|
|
6
|
|
12266
|
use HTTP::BrowserDetect; |
|
6
|
|
|
|
|
115968
|
|
|
6
|
|
|
|
|
329
|
|
7
|
6
|
|
|
6
|
|
84
|
use File::Basename (); |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
139
|
|
8
|
6
|
|
|
6
|
|
32
|
use List::Util qw(first); |
|
6
|
|
|
|
|
94
|
|
|
6
|
|
|
|
|
1613
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
BEGIN { |
11
|
6
|
50
|
|
6
|
|
39
|
if (!defined &DEBUG ) { |
12
|
6
|
|
|
37
|
1
|
380
|
eval "sub DEBUG { 0 }"; |
|
37
|
|
|
|
|
161
|
|
13
|
|
|
|
|
|
|
} |
14
|
6
|
100
|
|
|
|
1005
|
if (!defined &VERBOSE ) { |
15
|
4
|
|
|
0
|
1
|
2231
|
eval "sub VERBOSE { 1 }"; |
|
0
|
|
|
|
|
0
|
|
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
}; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $BROWSER_TO_BASENAME = { |
23
|
|
|
|
|
|
|
windows => 'MSWin32', |
24
|
|
|
|
|
|
|
mac => 'MacOS', |
25
|
|
|
|
|
|
|
os2 => 'os2', |
26
|
|
|
|
|
|
|
unix => 'unix', |
27
|
|
|
|
|
|
|
vms => 'VMS', |
28
|
|
|
|
|
|
|
amiga => 'AmigaOS', |
29
|
|
|
|
|
|
|
}; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub name { |
33
|
39
|
|
|
39
|
1
|
36080
|
my $class = shift; |
34
|
39
|
|
|
|
|
106
|
my $args = shift; |
35
|
|
|
|
|
|
|
|
36
|
39
|
100
|
|
|
|
343
|
my $filename = exists $args->{'filename'} ? $args->{'filename'} |
37
|
|
|
|
|
|
|
: croak 'Must provide a file name' |
38
|
|
|
|
|
|
|
; |
39
|
38
|
100
|
|
|
|
318
|
my $agent |
|
|
100
|
|
|
|
|
|
40
|
|
|
|
|
|
|
= exists $args->{'agent'} ? $args->{'agent'} : |
41
|
|
|
|
|
|
|
exists $ENV{'HTTP_USER_AGENT'} ? $ENV{'HTTP_USER_AGENT'} : |
42
|
|
|
|
|
|
|
croak "Can't get a UA to work with"; |
43
|
|
|
|
|
|
|
|
44
|
37
|
|
|
|
|
180
|
my $browser = HTTP::BrowserDetect->new($agent); |
45
|
|
|
|
|
|
|
|
46
|
37
|
|
|
92
|
|
29731
|
my ($os) = first { $browser->$_ } keys %{ $BROWSER_TO_BASENAME }; |
|
92
|
|
|
|
|
975
|
|
|
37
|
|
|
|
|
284
|
|
47
|
|
|
|
|
|
|
|
48
|
37
|
100
|
|
|
|
574
|
unless ($os) { |
49
|
3
|
50
|
|
|
|
16
|
carp "Can't determine OS for given User Agent, defaulting to Unix\n" |
50
|
|
|
|
|
|
|
if VERBOSE; |
51
|
3
|
|
|
|
|
29
|
$os = 'unix'; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
37
|
50
|
|
|
|
1679
|
if ( DEBUG ) { |
55
|
0
|
0
|
|
|
|
0
|
print "DEBUG => Agent: $agent\n" if $agent; |
56
|
0
|
0
|
|
|
|
0
|
print "DEBUG => OS: $os\n" if $os; |
57
|
|
|
|
|
|
|
}; |
58
|
|
|
|
|
|
|
|
59
|
37
|
|
|
|
|
3031
|
File::Basename::fileparse_set_fstype( $BROWSER_TO_BASENAME->{$os} ); |
60
|
|
|
|
|
|
|
|
61
|
37
|
|
|
|
|
1360
|
my $name = File::Basename::basename($filename); |
62
|
37
|
|
|
|
|
233
|
$name =~ tr/a-zA-Z0-9.&+-/_/cs; |
63
|
|
|
|
|
|
|
|
64
|
37
|
|
|
|
|
1316
|
return $name; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
1; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
__END__ |