re-usage of LWP::MediaTypes
Doug MacEachern (dougm@pobox.com)
Wed, 08 Jul 1998 17:11:22 -0400
The patch below just makes LWP::MediaTypes a bit more re-usable, if
you wanted to, say, replace Apache's mod_mime.c with an Apache::MIME
module.
-Doug
--- MediaTypes.pm.orig Tue Jan 6 04:58:05 1998
+++ MediaTypes.pm Wed Jul 8 17:00:54 1998
@@ -31,6 +31,7 @@
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(guess_media_type media_suffix);
+@EXPORT_OK = qw(add_type add_encoding);
$VERSION = sprintf("%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/);
require LWP::Debug;
@@ -62,32 +63,86 @@
'z' => 'x-pack'
);
-local($/, $_) = ("\n", undef); # ensure correct $INPUT_RECORD_SEPARATOR
+=item add_type($type, @exts)
-my @priv_files = ();
-push(@priv_files, "$ENV{HOME}/.media.types", "$ENV{HOME}/.mime.types")
- if defined $ENV{HOME}; # Some does not have a home (for instance Win32)
-
-# Try to locate "media.types" file, and initialize %suffixType from it
-my $typefile;
-for $typefile ((map {"$_/LWP/media.types"} @INC), @priv_files) {
- local(*TYPE);
- open(TYPE, $typefile) || next;
- LWP::Debug::debug("Reading media types from $typefile");
- while (<TYPE>) {
- next if /^\s*#/; # comment line
- next if /^\s*$/; # blank line
- s/#.*//; # remove end-of-line comments
- my($type, @exts) = split(' ', $_);
- $suffixExt{$type} = $exts[0] if @exts;
- my $ext;
- for $ext (@exts) {
- $suffixType{$ext} = $type;
+Associate a list of file extensions with the given media type.
+
+Example:
+
+ add_type("x-world/x-vrml" => qw(wrl vrml));
+
+=cut
+
+sub add_type
+{
+ my($type, @exts) = @_;
+ $suffixExt{$type} = $exts[0] if @exts;
+ for my $ext (@exts) {
+ $suffixType{$ext} = $type;
+ }
+}
+
+=item add_encoding($type, @ext)
+
+Associate a list of file extensions with and encoding type.
+
+ Example:
+
+ add_encoding("x-gzip" => "gz");
+
+=cut
+
+sub add_encoding
+{
+ my $type = shift;
+ for my $ext (@_) {
+ $ext =~ s/^\.//;
+ $suffixEncoding{$ext} = $type;
+ }
+}
+
+=item read_media_types(@files)
+
+Parse a media types file from disk.
+
+Example:
+
+ read_media_types("conf/mime.types");
+
+=cut
+
+sub read_media_types
+{
+ my(@files) = @_;
+
+ local($/, $_) = ("\n", undef); # ensure correct $INPUT_RECORD_SEPARATOR
+
+ my @priv_files = ();
+ push(@priv_files, "$ENV{HOME}/.media.types", "$ENV{HOME}/.mime.types")
+ if defined $ENV{HOME}; # Some does not have a home (for instance Win32)
+
+ # Try to locate "media.types" file, and initialize %suffixType from it
+ my $typefile;
+ unless (@files) {
+ @files = map {"$_/LWP/media.types"} @INC;
+ push @files, @priv_files;
+ }
+ for $typefile (@files) {
+ local(*TYPE);
+ open(TYPE, $typefile) || next;
+ LWP::Debug::debug("Reading media types from $typefile");
+ while (<TYPE>) {
+ next if /^\s*#/; # comment line
+ next if /^\s*$/; # blank line
+ s/#.*//; # remove end-of-line comments
+ my($type, @exts) = split(' ', $_);
+ add_type($type, @exts);
}
+ close(TYPE);
}
- close(TYPE);
}
+read_media_types();
####################################################################
@@ -113,6 +168,15 @@
=cut
+sub file_exts
+{
+ my($file) = @_;
+ $file =~ s,.*/,,; # only basename left
+ my @parts = reverse split(/\./, $file);
+ pop(@parts); # never concider first part
+ @parts;
+}
+
sub guess_media_type
{
my($file, $header) = @_;
@@ -126,13 +190,10 @@
} else {
$fullname = $file; # enable peek at actual file
}
- $file =~ s,.*/,,; # only basename left
- my @parts = reverse split(/\./, $file);
- pop(@parts); # never concider first part
my @encoding = ();
my $ct = undef;
- for (@parts) {
+ for (file_exts($file)) {
# first check this dot part as encoding spec
if (exists $suffixEncoding{$_}) {
unshift(@encoding, $suffixEncoding{$_});