File Coverage

blib/lib/FileUpload/Filename.pm
Criterion Covered Total %
statement 39 42 92.8
branch 13 20 65.0
condition n/a
subroutine 10 11 90.9
pod 3 3 100.0
total 65 76 85.5


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__