local-lib5/lib/perl5/MIME/Type.pm

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