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 | BEGIN@13 | MIME::Types::
1 | 1 | 1 | 15µs | 42µs | BEGIN@7 | MIME::Types::
1 | 1 | 1 | 15µs | 60µs | BEGIN@190 | MIME::Types::
1 | 1 | 1 | 13µs | 57µs | BEGIN@137 | MIME::Types::
1 | 1 | 1 | 11µs | 63µs | BEGIN@14 | MIME::Types::
1 | 1 | 1 | 11µs | 15µs | BEGIN@11 | MIME::Types::
0 | 0 | 0 | 0s | 0s | addType | MIME::Types::
0 | 0 | 0 | 0s | 0s | by_mediatype | MIME::Types::
0 | 0 | 0 | 0s | 0s | by_suffix | MIME::Types::
0 | 0 | 0 | 0s | 0s | create_type_index | MIME::Types::
0 | 0 | 0 | 0s | 0s | extensions | MIME::Types::
0 | 0 | 0 | 0s | 0s | import_mime_types | MIME::Types::
0 | 0 | 0 | 0s | 0s | init | MIME::Types::
0 | 0 | 0 | 0s | 0s | mimeTypeOf | MIME::Types::
0 | 0 | 0 | 0s | 0s | new | MIME::Types::
0 | 0 | 0 | 0s | 0s | type | MIME::Types::
0 | 0 | 0 | 0s | 0s | types | MIME::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__ |