"Fossies" - the Fresh Open Source Software Archive

Member "MIME-Types-2.17/lib/MIME/Type.pm" (26 Jan 2018, 2911 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 "Type.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 MIME::Type;
   10 use vars '$VERSION';
   11 $VERSION = '2.17';
   12 
   13 
   14 use strict;
   15 
   16 use Carp 'croak';
   17 
   18 
   19 #-------------------------------------------
   20 
   21 
   22 use overload
   23     '""' => 'type'
   24   , cmp  => 'cmp';
   25 
   26 #-------------------------------------------
   27 
   28 
   29 sub new(@) { (bless {}, shift)->init( {@_} ) }
   30 
   31 sub init($)
   32 {   my ($self, $args) = @_;
   33 
   34     my $type = $self->{MT_type} = $args->{type}
   35        or croak "ERROR: Type parameter is obligatory.";
   36 
   37     $self->{MT_simplified}      = $args->{simplified}
   38        || $self->simplified($type);
   39 
   40     $self->{MT_extensions}      = $args->{extensions} || [];
   41 
   42     $self->{MT_encoding}
   43        = $args->{encoding}          ? $args->{encoding}
   44        : $self->mediaType eq 'text' ? 'quoted-printable'
   45        :                              'base64';
   46 
   47     $self->{MT_system}     = $args->{system}
   48        if defined $args->{system};
   49 
   50     $self;
   51 }
   52 
   53 #-------------------------------------------
   54 
   55 sub type() {shift->{MT_type}}
   56 
   57 
   58 sub simplified(;$)
   59 {   my $thing = shift;
   60     return $thing->{MT_simplified} unless @_;
   61 
   62     my $mime  = shift;
   63 
   64       $mime =~ m!^\s*(?:x\-)?([\w.+-]+)/(?:x\-)?([\w.+-]+)\s*$!i ? lc "$1/$2"
   65     : $mime eq 'text' ? 'text/plain'          # some silly mailers...
   66     : undef;
   67 }
   68 
   69 
   70 sub extensions() { @{shift->{MT_extensions}} }
   71 sub encoding()   {shift->{MT_encoding}}
   72 sub system()     {shift->{MT_system}}
   73 
   74 #-------------------------------------------
   75 
   76 
   77 sub mediaType() {shift->{MT_simplified} =~ m!^([\w.-]+)/! ? $1 : undef}
   78 sub mainType()  {shift->mediaType} # Backwards compatibility
   79 
   80 
   81 sub subType() {shift->{MT_simplified} =~ m!/([\w+.-]+)$! ? $1 : undef}
   82 
   83 
   84 sub isRegistered() { lc shift->{MT_type} !~ m{^x\-|/x\-} }
   85 
   86 
   87 # http://tools.ietf.org/html/rfc4288#section-3
   88 sub isVendor()       {shift->{MT_simplified} =~ m!/vnd\.!}
   89 sub isPersonal()     {shift->{MT_simplified} =~ m!/prs\.!}
   90 sub isExperimental() {shift->{MT_simplified} =~ m!/x\.!  }
   91 
   92 
   93 sub isBinary() { shift->{MT_encoding} eq 'base64' }
   94 sub isText()   { shift->{MT_encoding} ne 'base64' }
   95 *isAscii = \&isText;
   96 
   97 
   98 # simplified names only!
   99 my %sigs = map +($_ => 1),
  100   qw(application/pgp-keys application/pgp application/pgp-signature
  101      application/pkcs10 application/pkcs7-mime application/pkcs7-signature
  102      text/vCard);
  103 
  104 sub isSignature() { $sigs{shift->{MT_simplified}} }
  105 
  106 
  107 sub cmp($)
  108 {   my ($self, $other) = @_;
  109 
  110     my $type = ref $other
  111       ? $other->simplified
  112       : (ref $self)->simplified($other);
  113 
  114     $self->simplified cmp $type;
  115 }
  116 sub equals($) { $_[0]->cmp($_[1])==0 }
  117 
  118 1;