← Back to branch summary

~ubuntu-branches/ubuntu/edgy/libwww-perl/edgy

« back to all changes in this revision

Viewing changes to lib/LWP/MediaTypes.pm

  • Committer: Bazaar Package Importer
  • Author(s): Jay Bonci
  • Date: 2005-02-13 18:45:32 UTC
  • mfrom: (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050213184532-67qvopi4wre3010u
Tags: 5.803-4
http://bugs.debian.org/294597
http://bugs.debian.org/294595
* Make GET/POST/HEAD symlinks (Closes: #294597)
* lwp-requests now honors -b when dumping links (Closes: #294595)
  - Thanks to giuseppe bonacci for the patch
* Moved symlinks to a libwww-perl.links file

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/LWP/MediaTypes.pm
1
 
#
2
 
# $Id: MediaTypes.pm,v 1.27 1999/11/16 14:36:24 gisle Exp $
3
 
 
4
1
package LWP::MediaTypes;
5
2
 
6
 
=head1 NAME
7
 
 
8
 
LWP::MediaTypes - guess media type for a file or a URL
9
 
 
10
 
=head1 SYNOPSIS
11
 
 
12
 
 use LWP::MediaTypes qw(guess_media_type);
13
 
 $type = guess_media_type("/tmp/foo.gif");
14
 
 
15
 
=head1 DESCRIPTION
16
 
 
17
 
This module provides functions for handling media (also known as
18
 
MIME) types and encodings.  The mapping from file extentions to media
19
 
types is defined by the F<media.types> file.  If the F<~/.media.types>
20
 
file exists it is used instead.
21
 
For backwards compatability we will also look for F<~/.mime.types>.
22
 
 
23
 
The following functions are exported by default:
24
 
 
25
 
=over 4
26
 
 
27
 
=cut
28
 
 
29
 
####################################################################
 
3
# $Id: MediaTypes.pm,v 1.32 2004/11/17 11:04:09 gisle Exp $
30
4
 
31
5
require Exporter;
32
6
@ISA = qw(Exporter);
33
7
@EXPORT = qw(guess_media_type media_suffix);
34
8
@EXPORT_OK = qw(add_type add_encoding read_media_types);
35
 
$VERSION = sprintf("%d.%02d", q$Revision: 1.27 $ =~ /(\d+)\.(\d+)/);
 
9
$VERSION = sprintf("%d.%02d", q$Revision: 1.32 $ =~ /(\d+)\.(\d+)/);
36
10
 
37
11
require LWP::Debug;
38
12
use strict;
64
38
    'bz2' => 'x-bzip2',
65
39
);
66
40
 
 
41
read_media_types();
 
42
 
 
43
 
 
44
 
67
45
sub _dump {
68
46
    require Data::Dumper;
69
47
    Data::Dumper->new([\%suffixType, \%suffixExt, \%suffixEncoding],
70
48
                      [qw(*suffixType *suffixExt *suffixEncoding)])->Dump;
71
49
}
72
50
 
73
 
read_media_types();
74
 
 
75
 
 
76
 
 
77
 
=item guess_media_type($filename_or_url, [$header_to_modify])
78
 
 
79
 
This function tries to guess media type and encoding for a file or url.
80
 
It returns the content-type, which is a string like C<"text/html">.
81
 
In array context it also returns any content-encodings applied (in the
82
 
order used to encode the file).  You can pass a URI object
83
 
reference, instead of the file name.
84
 
 
85
 
If the type can not be deduced from looking at the file name,
86
 
then guess_media_type() will let the C<-T> Perl operator take a look.
87
 
If this works (and C<-T> returns a TRUE value) then we return
88
 
I<text/plain> as the type, otherwise we return
89
 
I<application/octet-stream> as the type.
90
 
 
91
 
The optional second argument should be a reference to a HTTP::Headers
92
 
object or any object that implements the $obj->header method in a
93
 
similar way.  When it is present the values of the
94
 
'Content-Type' and 'Content-Encoding' will be set for this header.
95
 
 
96
 
=cut
97
51
 
98
52
sub guess_media_type
99
53
{
105
59
        # assume URI object
106
60
        $file = $file->path;
107
61
        #XXX should handle non http:, file: or ftp: URIs differently
108
 
    } else {
 
62
    }
 
63
    else {
109
64
        $fullname = $file;  # enable peek at actual file
110
65
    }
111
66
 
139
94
        # Take a look at the file
140
95
        if (defined $fullname) {
141
96
            $ct = (-T $fullname) ? "text/plain" : "application/octet-stream";
142
 
        } else {
 
97
        }
 
98
        else {
143
99
            $ct = "application/octet-stream";
144
100
        }
145
101
    }
153
109
}
154
110
 
155
111
 
156
 
=item media_suffix($type,...)
157
 
 
158
 
This function will return all suffixes that can be used to denote the
159
 
specified media type(s).  Wildcard types can be used.  In a scalar
160
 
context it will return the first suffix found.
161
 
 
162
 
Examples:
163
 
 
164
 
  @suffixes = media_suffix('image/*', 'audio/basic');
165
 
  $suffix = media_suffix('text/html');
166
 
 
167
 
=cut
168
 
 
169
112
sub media_suffix {
170
113
    if (!wantarray && @_ == 1 && $_[0] !~ /\*/) {
171
114
        return $suffixExt{$_[0]};
177
120
            while(($ext,$type) = each(%suffixType)) {
178
121
                push(@suffix, $ext) if $type =~ /^$_$/;
179
122
            }
180
 
        } else {
 
123
        }
 
124
        else {
181
125
            while(($ext,$type) = each(%suffixType)) {
182
126
                push(@suffix, $ext) if $type eq $_;
183
127
            }
196
140
}
197
141
 
198
142
 
199
 
=back
200
 
 
201
 
The following functions are only exported by explict request:
202
 
 
203
 
=over 4
204
 
 
205
 
=item add_type($type, @exts)
206
 
 
207
 
Associate a list of file extensions with the given media type.
208
 
 
209
 
Example:
210
 
 
211
 
    add_type("x-world/x-vrml" => qw(wrl vrml));
212
 
 
213
 
=cut
214
 
 
215
143
sub add_type 
216
144
{
217
145
    my($type, @exts) = @_;
223
151
}
224
152
 
225
153
 
226
 
=item add_encoding($type, @ext)
227
 
 
228
 
Associate a list of file extensions with an encoding type.
229
 
 
230
 
Example:
231
 
 
232
 
 add_encoding("x-gzip" => "gz");
233
 
 
234
 
=cut
235
 
 
236
154
sub add_encoding
237
155
{
238
156
    my($type, @exts) = @_;
243
161
}
244
162
 
245
163
 
246
 
=item read_media_types(@files)
247
 
 
248
 
Parse media types files and add the type mappings found there.
249
 
 
250
 
Example:
251
 
 
252
 
    read_media_types("conf/mime.types");
253
 
 
254
 
=cut
255
 
 
256
164
sub read_media_types 
257
165
{
258
166
    my(@files) = @_;
263
171
    if($^O eq "MacOS") {
264
172
        push(@priv_files, "$ENV{HOME}:media.types", "$ENV{HOME}:mime.types")
265
173
            if defined $ENV{HOME};  # Some does not have a home (for instance Win32)
266
 
    } else {
 
174
    }
 
175
    else {
267
176
        push(@priv_files, "$ENV{HOME}/.media.types", "$ENV{HOME}/.mime.types")
268
177
            if defined $ENV{HOME};  # Some doesn't have a home (for instance Win32)
269
178
    }
273
182
    unless (@files) {
274
183
        if($^O eq "MacOS") {
275
184
            @files = map {$_."LWP:media.types"} @INC;
276
 
        } else {
 
185
        }
 
186
        else {
277
187
            @files = map {"$_/LWP/media.types"} @INC;
278
188
        }
279
189
        push @files, @priv_files;
295
205
 
296
206
1;
297
207
 
298
 
=back 
 
208
 
 
209
__END__
 
210
 
 
211
=head1 NAME
 
212
 
 
213
LWP::MediaTypes - guess media type for a file or a URL
 
214
 
 
215
=head1 SYNOPSIS
 
216
 
 
217
 use LWP::MediaTypes qw(guess_media_type);
 
218
 $type = guess_media_type("/tmp/foo.gif");
 
219
 
 
220
=head1 DESCRIPTION
 
221
 
 
222
This module provides functions for handling media (also known as
 
223
MIME) types and encodings.  The mapping from file extensions to media
 
224
types is defined by the F<media.types> file.  If the F<~/.media.types>
 
225
file exists it is used instead.
 
226
For backwards compatibility we will also look for F<~/.mime.types>.
 
227
 
 
228
The following functions are exported by default:
 
229
 
 
230
=over 4
 
231
 
 
232
=item guess_media_type( $filename )
 
233
 
 
234
=item guess_media_type( $uri )
 
235
 
 
236
=item guess_media_type( $filename_or_uri, $header_to_modify )
 
237
 
 
238
This function tries to guess media type and encoding for a file or a URI.
 
239
It returns the content type, which is a string like C<"text/html">.
 
240
In array context it also returns any content encodings applied (in the
 
241
order used to encode the file).  You can pass a URI object
 
242
reference, instead of the file name.
 
243
 
 
244
If the type can not be deduced from looking at the file name,
 
245
then guess_media_type() will let the C<-T> Perl operator take a look.
 
246
If this works (and C<-T> returns a TRUE value) then we return
 
247
I<text/plain> as the type, otherwise we return
 
248
I<application/octet-stream> as the type.
 
249
 
 
250
The optional second argument should be a reference to a HTTP::Headers
 
251
object or any object that implements the $obj->header method in a
 
252
similar way.  When it is present the values of the
 
253
'Content-Type' and 'Content-Encoding' will be set for this header.
 
254
 
 
255
=item media_suffix( $type, ... )
 
256
 
 
257
This function will return all suffixes that can be used to denote the
 
258
specified media type(s).  Wildcard types can be used.  In a scalar
 
259
context it will return the first suffix found. Examples:
 
260
 
 
261
  @suffixes = media_suffix('image/*', 'audio/basic');
 
262
  $suffix = media_suffix('text/html');
 
263
 
 
264
=back
 
265
 
 
266
The following functions are only exported by explicit request:
 
267
 
 
268
=over 4
 
269
 
 
270
=item add_type( $type, @exts )
 
271
 
 
272
Associate a list of file extensions with the given media type.
 
273
Example:
 
274
 
 
275
    add_type("x-world/x-vrml" => qw(wrl vrml));
 
276
 
 
277
=item add_encoding( $type, @ext )
 
278
 
 
279
Associate a list of file extensions with an encoding type.
 
280
Example:
 
281
 
 
282
 add_encoding("x-gzip" => "gz");
 
283
 
 
284
=item read_media_types( @files )
 
285
 
 
286
Parse media types files and add the type mappings found there.
 
287
Example:
 
288
 
 
289
    read_media_types("conf/mime.types");
 
290
 
 
291
=back
299
292
 
300
293
=head1 COPYRIGHT
301
294
 
304
297
This library is free software; you can redistribute it and/or
305
298
modify it under the same terms as Perl itself.
306
299
 
307
 
=cut