| Filename | /usr/share/perl5/MIME/Types.pm |
| Statements | Executed 26 statements in 1.21ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 805µs | 1.01ms | MIME::Types::BEGIN@13 |
| 1 | 1 | 1 | 15µs | 42µs | MIME::Types::BEGIN@7 |
| 1 | 1 | 1 | 15µs | 60µs | MIME::Types::BEGIN@190 |
| 1 | 1 | 1 | 13µs | 57µs | MIME::Types::BEGIN@137 |
| 1 | 1 | 1 | 11µs | 63µs | MIME::Types::BEGIN@14 |
| 1 | 1 | 1 | 11µs | 15µs | MIME::Types::BEGIN@11 |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::addType |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::by_mediatype |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::by_suffix |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::create_type_index |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::extensions |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::import_mime_types |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::init |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::mimeTypeOf |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::new |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::type |
| 0 | 0 | 0 | 0s | 0s | MIME::Types::types |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | # Copyrights 1999,2001-2010 by Mark Overmeer. | ||||
| 2 | # For other contributors see ChangeLog. | ||||
| 3 | # See the manual pages for details on the licensing terms. | ||||
| 4 | # Pod stripped from pm file by OODoc 1.06. | ||||
| 5 | |||||
| 6 | package MIME::Types; | ||||
| 7 | 3 | 41µs | 2 | 68µs | # spent 42µs (15+26) within MIME::Types::BEGIN@7 which was called:
# once (15µs+26µs) by C4::Letters::BEGIN@23 at line 7 # spent 42µs making 1 call to MIME::Types::BEGIN@7
# spent 26µs making 1 call to vars::import |
| 8 | 1 | 600ns | $VERSION = '1.30'; | ||
| 9 | |||||
| 10 | |||||
| 11 | 3 | 25µs | 2 | 19µs | # spent 15µs (11+4) within MIME::Types::BEGIN@11 which was called:
# once (11µs+4µs) by C4::Letters::BEGIN@23 at line 11 # spent 15µs making 1 call to MIME::Types::BEGIN@11
# spent 4µs making 1 call to strict::import |
| 12 | |||||
| 13 | 3 | 123µs | 1 | 1.01ms | # spent 1.01ms (805µs+203µs) within MIME::Types::BEGIN@13 which was called:
# once (805µs+203µs) by C4::Letters::BEGIN@23 at line 13 # spent 1.01ms making 1 call to MIME::Types::BEGIN@13 |
| 14 | 3 | 638µs | 2 | 115µs | # spent 63µs (11+52) within MIME::Types::BEGIN@14 which was called:
# once (11µs+52µs) by C4::Letters::BEGIN@23 at line 14 # spent 63µs making 1 call to MIME::Types::BEGIN@14
# spent 52µs making 1 call to Exporter::import |
| 15 | |||||
| 16 | |||||
| 17 | 1 | 300ns | my %list; | ||
| 18 | sub new(@) { (bless {}, shift)->init( {@_} ) } | ||||
| 19 | |||||
| 20 | sub init($) | ||||
| 21 | { my ($self, $args) = @_; | ||||
| 22 | |||||
| 23 | unless(keys %list) # already read | ||||
| 24 | { local $_; | ||||
| 25 | local $/ = "\n"; | ||||
| 26 | |||||
| 27 | while(<DATA>) | ||||
| 28 | { chomp; | ||||
| 29 | next if !length $_ or substr($_, 0, 1) eq '#'; | ||||
| 30 | |||||
| 31 | my $os = s/^(\w+)\:// ? qr/$1/i : undef; | ||||
| 32 | my ($type, $extensions, $encoding) = split /\;/; | ||||
| 33 | |||||
| 34 | next if $args->{only_complete} && ! $extensions; | ||||
| 35 | my $extent = $extensions ? [ split /\,/, $extensions ] : undef; | ||||
| 36 | |||||
| 37 | my $simplified = MIME::Type->simplified($type); | ||||
| 38 | push @{$list{$simplified}}, MIME::Type->new | ||||
| 39 | ( type => $type | ||||
| 40 | , extensions => $extent | ||||
| 41 | , encoding => $encoding | ||||
| 42 | , system => $os | ||||
| 43 | ); | ||||
| 44 | } | ||||
| 45 | close DATA; | ||||
| 46 | } | ||||
| 47 | |||||
| 48 | $self; | ||||
| 49 | } | ||||
| 50 | |||||
| 51 | 1 | 200ns | my %type_index; | ||
| 52 | sub create_type_index() | ||||
| 53 | { my $self = shift; | ||||
| 54 | |||||
| 55 | my @os_specific; | ||||
| 56 | while(my ($simple, $definitions) = each %list) | ||||
| 57 | { foreach my $def (@$definitions) | ||||
| 58 | { if(defined(my $sys = $def->system)) | ||||
| 59 | { # OS specific definitions will overrule the | ||||
| 60 | # unspecific definitions, so must be postponed till | ||||
| 61 | # the end. | ||||
| 62 | push @os_specific, $def if $^O =~ $sys; | ||||
| 63 | } | ||||
| 64 | else | ||||
| 65 | { $type_index{$_} = $def foreach $def->extensions; | ||||
| 66 | } | ||||
| 67 | } | ||||
| 68 | } | ||||
| 69 | |||||
| 70 | foreach my $def (@os_specific) | ||||
| 71 | { $type_index{$_} = $def foreach $def->extensions; | ||||
| 72 | } | ||||
| 73 | |||||
| 74 | $self; | ||||
| 75 | } | ||||
| 76 | |||||
| 77 | #------------------------------------------- | ||||
| 78 | |||||
| 79 | |||||
| 80 | sub type($) | ||||
| 81 | { my $mime = MIME::Type->simplified($_[1]) or return; | ||||
| 82 | return () unless exists $list{$mime}; | ||||
| 83 | wantarray ? @{$list{$mime}} : $list{$mime}[0]; | ||||
| 84 | } | ||||
| 85 | |||||
| 86 | #------------------------------------------- | ||||
| 87 | |||||
| 88 | |||||
| 89 | sub mimeTypeOf($) | ||||
| 90 | { my ($self, $name) = @_; | ||||
| 91 | $self->create_type_index unless keys %type_index; | ||||
| 92 | $name =~ s/.*\.//; | ||||
| 93 | $type_index{lc $name}; | ||||
| 94 | } | ||||
| 95 | |||||
| 96 | #------------------------------------------- | ||||
| 97 | |||||
| 98 | |||||
| 99 | sub addType(@) | ||||
| 100 | { my $self = shift; | ||||
| 101 | |||||
| 102 | foreach my $type (@_) | ||||
| 103 | { my $simplified = $type->simplified; | ||||
| 104 | push @{$list{$simplified}}, $type; | ||||
| 105 | } | ||||
| 106 | |||||
| 107 | %type_index = (); | ||||
| 108 | $self; | ||||
| 109 | } | ||||
| 110 | |||||
| 111 | #------------------------------------------- | ||||
| 112 | |||||
| 113 | |||||
| 114 | sub types | ||||
| 115 | { my $self = shift; | ||||
| 116 | |||||
| 117 | $self->create_type_index unless keys %type_index; | ||||
| 118 | return values %type_index; | ||||
| 119 | } | ||||
| 120 | |||||
| 121 | #------------------------------------------- | ||||
| 122 | |||||
| 123 | |||||
| 124 | sub extensions | ||||
| 125 | { my $self = shift; | ||||
| 126 | $self->create_type_index unless keys %type_index; | ||||
| 127 | |||||
| 128 | return keys %type_index; | ||||
| 129 | } | ||||
| 130 | |||||
| 131 | #------------------------------------------- | ||||
| 132 | |||||
| 133 | |||||
| 134 | #------------------------------------------- | ||||
| 135 | |||||
| 136 | 1 | 900ns | require Exporter; | ||
| 137 | 3 | 278µs | 2 | 100µs | # spent 57µs (13+44) within MIME::Types::BEGIN@137 which was called:
# once (13µs+44µs) by C4::Letters::BEGIN@23 at line 137 # spent 57µs making 1 call to MIME::Types::BEGIN@137
# spent 44µs making 1 call to vars::import |
| 138 | 1 | 10µs | @ISA = qw(Exporter); | ||
| 139 | 1 | 1µs | @EXPORT_OK = qw(by_suffix by_mediatype import_mime_types); | ||
| 140 | |||||
| 141 | #------------------------------------------- | ||||
| 142 | |||||
| 143 | |||||
| 144 | 1 | 200ns | my $mime_types; | ||
| 145 | |||||
| 146 | sub by_suffix($) | ||||
| 147 | { my $filename = shift; | ||||
| 148 | $mime_types ||= MIME::Types->new; | ||||
| 149 | my $mime = $mime_types->mimeTypeOf($filename); | ||||
| 150 | |||||
| 151 | my @data = defined $mime ? ($mime->type, $mime->encoding) : ('',''); | ||||
| 152 | wantarray ? @data : \@data; | ||||
| 153 | } | ||||
| 154 | |||||
| 155 | #------------------------------------------- | ||||
| 156 | |||||
| 157 | |||||
| 158 | sub by_mediatype($) | ||||
| 159 | { my $type = shift; | ||||
| 160 | my @found; | ||||
| 161 | |||||
| 162 | %list or init {}; | ||||
| 163 | |||||
| 164 | if(index($type, '/') >= 0) | ||||
| 165 | { my $simplified = MIME::Type->simplified($type); | ||||
| 166 | my $mime = $list{$simplified}; | ||||
| 167 | push @found, @$mime if defined $mime; | ||||
| 168 | } | ||||
| 169 | else | ||||
| 170 | { my $mime = ref $type ? $type : qr/$type/i; | ||||
| 171 | @found = map {@{$list{$_}}} | ||||
| 172 | grep {$_ =~ $mime} | ||||
| 173 | keys %list; | ||||
| 174 | } | ||||
| 175 | |||||
| 176 | my @data; | ||||
| 177 | foreach my $mime (@found) | ||||
| 178 | { push @data, map { [$_, $mime->type, $mime->encoding] } | ||||
| 179 | $mime->extensions; | ||||
| 180 | } | ||||
| 181 | |||||
| 182 | wantarray ? @data : \@data; | ||||
| 183 | } | ||||
| 184 | |||||
| 185 | #------------------------------------------- | ||||
| 186 | |||||
| 187 | |||||
| 188 | sub import_mime_types($) | ||||
| 189 | { my $filename = shift; | ||||
| 190 | 3 | 92µs | 2 | 106µs | # spent 60µs (15+46) within MIME::Types::BEGIN@190 which was called:
# once (15µs+46µs) by C4::Letters::BEGIN@23 at line 190 # spent 60µs making 1 call to MIME::Types::BEGIN@190
# spent 46µs making 1 call to Exporter::import |
| 191 | croak <<'CROAK'; | ||||
| 192 | import_mime_types is not supported anymore: if you have types to add | ||||
| 193 | please send them to the author. | ||||
| 194 | CROAK | ||||
| 195 | } | ||||
| 196 | |||||
| 197 | 1 | 5µs | 1; | ||
| 198 | |||||
| 199 | #------------------------------------------- | ||||
| 200 | # Internet media type registry is at | ||||
| 201 | # http://www.iana.org/assignments/media-types/ | ||||
| 202 | # Another list can be found at: http://ftyps.com | ||||
| 203 | |||||
| 204 | __DATA__ |