From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

MARKOV / MIME-Types-2.27 / lib / MIME / Type.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118

              
# Copyrights 1999-2025 by [Mark Overmeer <mark@overmeer.net>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.
# This code is part of distribution MIME::Types.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.
package MIME::Type;{
our $VERSION = '2.27';
}
use strict;
use Carp 'croak';
#-------------------------------------------
use overload
    '""' => 'type'
  , cmp  => 'cmp';
#-------------------------------------------
sub new(@) { (bless {}, shift)->init( {@_} ) }
sub init($)
{   my ($self, $args) = @_;
    my $type = $self->{MT_type} = $args->{type}
       or croak "ERROR: Type parameter is obligatory.";
    $self->{MT_simplified}      = $args->{simplified}
       || $self->simplified($type);
    $self->{MT_extensions}      = $args->{extensions} || [];
    $self->{MT_encoding}
       = $args->{encoding}          ? $args->{encoding}
       : $self->mediaType eq 'text' ? 'quoted-printable'
       :                              'base64';
    $self->{MT_system}     = $args->{system}
       if defined $args->{system};
    $self;
}
#-------------------------------------------
sub type() {shift->{MT_type}}
sub simplified(;$)
{   my $thing = shift;
    return $thing->{MT_simplified} unless @_;
    my $mime  = shift;
      $mime =~ m!^\s*(?:x\-)?([\w.+-]+)/(?:x\-)?([\w.+-]+)\s*$!i ? lc "$1/$2"
    : $mime eq 'text' ? 'text/plain'          # some silly mailers...
    : undef;
}
sub extensions() { @{shift->{MT_extensions}} }
sub encoding()   {shift->{MT_encoding}}
sub system()     {shift->{MT_system}}
#-------------------------------------------
sub mediaType() {shift->{MT_simplified} =~ m!^([\w.-]+)/! ? $1 : undef}
sub mainType()  {shift->mediaType} # Backwards compatibility
sub subType() {shift->{MT_simplified} =~ m!/([\w+.-]+)$! ? $1 : undef}
sub isRegistered() { lc shift->{MT_type} !~ m{^x\-|/x\-} }
# http://tools.ietf.org/html/rfc4288#section-3
sub isVendor()       {shift->{MT_simplified} =~ m!/vnd\.!}
sub isPersonal()     {shift->{MT_simplified} =~ m!/prs\.!}
sub isExperimental() {shift->{MT_simplified} =~ m!/x\.!  }
sub isBinary() { shift->{MT_encoding} eq 'base64' }
sub isText()   { shift->{MT_encoding} ne 'base64' }
*isAscii = \&isText;
# simplified names only!
my %sigs = map +($_ => 1),
  qw(application/pgp-keys application/pgp application/pgp-signature
     application/pkcs10 application/pkcs7-mime application/pkcs7-signature
     text/vCard);
sub isSignature() { $sigs{shift->{MT_simplified}} }
sub cmp($)
{   my ($self, $other) = @_;
    my $type = ref $other
      ? $other->simplified
      : (ref $self)->simplified($other);
    $self->simplified cmp $type;
}
sub equals($) { $_[0]->cmp($_[1])==0 }
1;