"Fossies" - the Fresh Open Source Software Archive

Member "MIME-Types-2.17/lib/MojoX/MIME/Types.pm" (26 Jan 2018, 1468 Bytes) of package /linux/privat/MIME-Types-2.17.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Types.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.16_vs_2.17.

    1 # Copyrights 1999-2018 by [Mark Overmeer <markov@cpan.org>].
    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 2.02.
    5 # This code is part of distribution MIME::Types.  Meta-POD processed with
    6 # OODoc into POD and HTML manual-pages.  See README.md
    7 # Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.
    8 
    9 package MojoX::MIME::Types;
   10 use vars '$VERSION';
   11 $VERSION = '2.17';
   12 
   13 use Mojo::Base -base;
   14 
   15 use MIME::Types   ();
   16 
   17 
   18 sub new(%)
   19 {   # base new() constructor incorrect: should call init()
   20     my $self        = shift->SUPER::new(@_);
   21     $self->{MMT_mt} = delete $self->{mime_types} || MIME::Types->new;
   22     $self;
   23 }
   24 
   25 #----------
   26 
   27 sub mimeTypes() { shift->{MMT_mt} }
   28 
   29 
   30 sub types(;$)
   31 {   my $self = shift;
   32     return $self->{MMT_ext} if $self->{MMT_ext};
   33 
   34     my %exttable;
   35     my $t = MIME::Types->_MojoExtTable;
   36     while(my ($ext, $type) = each %$t) { $exttable{$ext} = [$type] }
   37     $self->{MMT_ext} = \%exttable;
   38 }
   39 
   40 #----------
   41 
   42 sub detect($$;$)
   43 {   my ($self, $accept, $prio) = @_;
   44     my $mt  = $self->mimeTypes;
   45     my @ext = map $_->extensions, grep defined, map $mt->type($_),
   46         grep !/\*/, $mt->httpAccept($accept);
   47     \@ext;
   48 }
   49 
   50 
   51 sub type($;$)
   52 {   my ($self, $ext, $types) = @_;
   53 
   54     my $mt  = $self->mimeTypes;
   55     defined $types
   56         or return $mt->mimeTypeOf($ext);
   57 
   58     # stupid interface compatibility!
   59     $self;
   60 }
   61 
   62 #---------------
   63 
   64 1;