File Coverage

blib/lib/SWISH/Filter/MIMETypes.pm
Criterion Covered Total %
statement 12 25 48.0
branch 0 8 0.0
condition 0 3 0.0
subroutine 4 5 80.0
pod 0 2 0.0
total 16 43 37.2


line stmt bran cond sub pod time code
1             package SWISH::Filter::MIMETypes;
2 2     2   10 use strict;
  2         5  
  2         62  
3 2     2   12 use warnings;
  2         4  
  2         57  
4 2     2   9 use Carp;
  2         3  
  2         727  
5              
6             eval { require MIME::Types };
7             my $has_mime_types;
8             if ($@) {
9             carp(
10             "Failed to load MIME::Types\n$@\nInstall MIME::Types for more complete MIME support"
11             );
12             }
13             else {
14             $has_mime_types = MIME::Types->new;
15             }
16              
17             # class data (caches from MIME::Types if available)
18             my %mime_types = (
19             doc => 'application/msword',
20             gz => 'application/x-gzip',
21             htm => 'text/html',
22             html => 'text/html',
23             json => 'application/json',
24             mp3 => 'audio/mpeg',
25             pdf => 'application/pdf',
26             ppt => 'application/vnd.ms-powerpoint',
27             text => 'text/plain',
28             txt => 'text/plain',
29             xls => 'application/vnd.ms-excel',
30             xml => 'text/xml',
31             yaml => 'text/x-yaml',
32             yml => 'text/x-yaml',
33             zip => 'application/zip',
34             );
35              
36             sub new {
37 2     2 0 4 my $class = shift;
38 2         7 my $self = bless {}, $class;
39 2         8 return $self;
40             }
41              
42             sub get_mime_type {
43 0     0 0   my $self = shift;
44 0 0         my $file = shift or croak "file required";
45 0           my ($ext) = ( $file =~ m/.*\.(.+)$/ );
46 0   0       $ext ||= $file;
47 0 0         if ( exists $mime_types{$ext} ) {
48 0           return $mime_types{$ext};
49             }
50 0 0         if ($has_mime_types) {
51 0           my $mime = $has_mime_types->mimeTypeOf($file);
52 0 0         if ( !$mime ) {
53 0           return;
54             }
55             else {
56 0           $mime_types{$ext} = "$mime"; # cache string not object
57 0           return $mime_types{$ext};
58             }
59             }
60 0           return;
61             }
62              
63             1;
64              
65             =head1 SUPPORT
66              
67             Please contact the Swish-e discussion list. http://swish-e.org
68              
69             =head1 AUTHOR
70              
71             Peter Karman C
72              
73             =head1 COPYRIGHT
74              
75             This library is free software; you can redistribute it
76             and/or modify it under the same terms as Perl itself.
77              
78             =cut