Initial Commit

database/perl/vendor/lib/MIME/Charset/Defaults.pm.sample

@@ -0,0 +1,44 @@
+#-*- perl -*-
+
+package MIME::Charset;
+
+=head1 NAME
+
+MIME::Charset::Defaults - Configuration for MIME::Charset
+
+=head1 SYNOPSIS
+
+Edit this file and place it on MIME/Charset/Defaults.pm to activate custom
+settings.
+
+=head1 DESCRIPTION
+
+Following settings are available.
+
+=over 4
+
+=item Detect7bit
+
+=item Replacement
+
+=item Mapping
+
+=back
+
+=head1 SEE ALSO
+
+L<MIME::Charset>
+
+=cut
+
+#--------------------------------------------------------------------------#
+# Add your own settings below.
+#--------------------------------------------------------------------------#
+
+## Default settings on current release are:
+# $Config->{Detect7bit} = 'YES';
+# $Config->{Replacement} = 'DEFAULT';
+# $Config->{Mapping} = 'EXTENDED';
+
+1;
+

database/perl/vendor/lib/MIME/Charset/UTF.pm

@@ -0,0 +1,48 @@
+#-*- perl -*-
+#-*- encoding: utf-8 -*-
+
+package MIME::Charset::UTF;
+
+use strict;
+use Carp qw(croak);
+use Encode::Encoding;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Encode::Encoding);
+$VERSION = '1.010';
+
+__PACKAGE__->Define('x-utf16auto');
+__PACKAGE__->Define('x-utf32auto');
+
+sub perlio_ok { 0 }
+
+sub decode {
+    my ($self, $octets, $check) = @_;
+
+    if ($self->name =~ /16/) {
+	if ($octets =~ /\A\xFE\xFF/ or $octets =~ /\A\xFF\xFE/) {
+	    return Encode::find_encoding('UTF-16')->decode($_[1], $_[2]);
+	} else {
+	    return Encode::find_encoding('UTF-16BE')->decode($_[1], $_[2]);
+	}
+    } elsif ($self->name =~ /32/) {
+	if ($octets =~ /\A\0\0\xFE\xFF/ or $octets =~ /\A\xFF\xFE\0\0/) {
+	    return Encode::find_encoding('UTF-32')->decode($_[1], $_[2]);
+	} else {
+	    return Encode::find_encoding('UTF-32BE')->decode($_[1], $_[2]);
+	}
+    } else {
+	croak 'bug in logic.  Ask developer';
+    }
+}
+
+sub encode {
+    my $self = $_[0];
+
+    if ($self->name =~ /16/) {
+	return Encode::find_encoding('UTF-16')->encode($_[1], $_[2]);
+    } elsif ($self->name =~ /32/) {
+	return Encode::find_encoding('UTF-32')->encode($_[1], $_[2]);
+    } else {
+	croak 'bug in logic.  Ask developer';
+    }
+}

database/perl/vendor/lib/MIME/Charset/_Compat.pm

@@ -0,0 +1,106 @@
+
+package MIME::Charset::_Compat;
+use 5.004;
+
+use strict;
+use Carp qw(croak);
+
+use vars qw($VERSION);
+
+$VERSION = "1.003.1";
+
+sub FB_CROAK { 0x1; }
+sub FB_PERLQQ { 0x100; }
+sub FB_HTMLCREF { 0x200; }
+sub FB_XMLCREF { 0x400; }
+sub encode { $_[1]; }
+sub decode { $_[1]; }
+sub from_to {
+    if ((lc($_[2]) eq "us-ascii" or lc($_[1]) eq "us-ascii") and
+	$_[0] =~ s/[^\x01-\x7e]/?/g and $_[3] == 1) {
+	croak "Non-ASCII characters";
+    }
+    $_[0];
+}
+sub is_utf8 { 0; }
+sub resolve_alias {
+    my $cset = lc(shift);
+    if ($cset eq "8bit" or $cset !~ /\S/) {
+	return undef;
+    } elsif ($cset eq '_unicode_') {
+	return $cset;
+    } else {
+	# Taken from Encode-2.24.
+	my %Winlatin2cp = (
+	   'latin1'     => 1252,
+	   'latin2'     => 1250,
+	   'cyrillic'   => 1251,
+	   'greek'      => 1253,
+	   'turkish'    => 1254,
+	   'hebrew'     => 1255,
+	   'arabic'     => 1256,
+	   'baltic'     => 1257,
+	   'vietnamese' => 1258,
+	);
+	my @Latin2iso = ( 0, 1, 2, 3, 4, 9, 10, 13, 14, 15, 16 );
+	$cset =~ s/^(\S+)[\s_]+(.*)$/$1-$2/i;
+	$cset =~ s/^UTF-8$/utf8/i;
+	$cset =~ s/^.*\bhk(?:scs)?[-_]?big5$/big5-hkscs/i;
+	$cset =~ s/^.*\bbig5-?hk(?:scs)?$/big5-hkscs/i;
+	$cset =~ s/^.*\btca[-_]?big5$/big5-eten/i;
+	$cset =~ s/^.*\bbig5-?et(?:en)?$/big5-eten/i;
+	$cset =~ s/^.*\bbig-?5$/big5-eten/i;
+	$cset =~ s/^.*\bks_c_5601-1987$/cp949/i;
+	$cset =~ s/^.*(?:x-)?windows-949$/cp949/i;
+	$cset =~ s/^.*(?:x-)?uhc$/cp949/i;
+	$cset =~ s/^.*\bkr.*euc$/euc-kr/i;
+	$cset =~ s/^.*\beuc.*kr$/euc-kr/i;
+	$cset =~ s/^.*\bsjis$/shiftjis/i;
+	$cset =~ s/^.*\bshift.*jis$/shiftjis/i;
+	$cset =~ s/^.*\bujis$/euc-jp/i;
+	$cset =~ s/^.*\bjp.*euc$/euc-jp/i;
+	$cset =~ s/^.*\beuc.*jp$/euc-jp/i;
+	$cset =~ s/^.*\bjis$/7bit-jis/i;
+	$cset =~ s/^.*\bGB[-_ ]?2312(?!-?raw).*$/euc-cn/i;
+	$cset =~ s/^gbk$/cp936/i;
+	$cset =~ s/^.*\bcn.*euc$/euc-cn/i;
+	$cset =~ s/^.*\beuc.*cn$/euc-cn/i;
+	$cset =~ s/^.*\bkoi8[-\s_]*([ru])$/koi8-$1/i;
+	$cset =~ s/^mac_(.*)$/mac$1/i;
+	$cset =~ s/^.*\b(?:cp|ibm|ms|windows)[-_ ]?(\d{2,4})$/cp$1/i;
+	$cset =~ s/^tis620$/iso-8859-11/i;
+	$cset =~ s/^thai$/iso-8859-11/i;
+	$cset =~ s/^hebrew$/iso-8859-8/i;
+	$cset =~ s/^greek$/iso-8859-7/i;
+	$cset =~ s/^arabic$/iso-8859-6/i;
+	$cset =~ s/^cyrillic$/iso-8859-5/i;
+	$cset =~ s/^ascii$/US-ascii/i;
+	if ($cset =~ /^.*\bwin(latin[12]|cyrillic|baltic|greek|turkish|
+			    hebrew|arabic|baltic|vietnamese)$/ix) {
+	    $cset = "cp" . $Winlatin2cp{lc($1)};
+	}
+	if ($cset =~ /^.*\b(?:iso[-_]?)?latin[-_]?(\d+)$/i) {
+	    $cset = defined $Latin2iso[$1] ? "iso-8859-$Latin2iso[$1]" : undef;
+	}
+	$cset =~ s/^(.+)\@euro$/$1/i;
+	$cset =~ s/^.*\bANSI[-_]?X3\.4[-_]?1968$/ascii/i;
+	$cset =~ s/^.*\b(?:hp-)?(arabic|greek|hebrew|kana|roman|thai|turkish)8$/${1}8/i;
+	$cset =~ s/^.*\biso8859(\d+)$/iso-8859-$1/i;
+	$cset =~ s/^.*\biso[-_]?(\d+)[-_](\d+)$/iso-$1-$2/i;
+	$cset =~ s/^.*\bISO[-_]?646[-_]?US$/ascii/i;
+	$cset =~ s/^C$/ascii/i;
+	$cset =~ s/^(?:US-?)ascii$/ascii/i;
+	$cset =~ s/^UTF(16|32)$/UTF-$1/i;
+	$cset =~ s/^UTF(16|32)-?LE$/UTF-$1LE/i;
+	$cset =~ s/^UTF(16|32)-?BE$/UTF-$1BE/i;
+	$cset =~ s/^iso-10646-1$/UCS-2BE/i;
+	$cset =~ s/^UCS-?4-?(BE|LE)?$/uc("UTF-32$1")/ie;
+	$cset =~ s/^UCS-?2-?(BE)?$/UCS-2BE/i;
+	$cset =~ s/^UCS-?2-?LE$/UCS-2LE/i;
+	$cset =~ s/^UTF-?7$/UTF-7/i;
+	$cset =~ s/^(.*)$/\L$1/;
+	return $cset;
+    }
+}
+
+1;

database/perl/vendor/lib/MIME/Type.pm

@@ -0,0 +1,118 @@
+# Copyrights 1999-2020 by [Mark Overmeer <markov@cpan.org>].
+#  For other contributors see ChangeLog.
+# See the manual pages for details on the licensing terms.
+# Pod stripped from pm file by OODoc 2.02.
+# 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;
+use vars '$VERSION';
+$VERSION = '2.18';
+
+
+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;

database/perl/vendor/lib/MIME/Type.pod

@@ -0,0 +1,238 @@
+=encoding utf8
+
+=head1 NAME
+
+MIME::Type - description of one MIME type
+
+=head1 SYNOPSIS
+
+ use MIME::Types;
+ my $mimetypes = MIME::Types->new;
+ my MIME::Type $plaintext = $mimetypes->type('text/plain');
+ print $plaintext->mediaType;   # text
+ print $plaintext->subType;     # plain
+
+ my @ext = $plaintext->extensions;
+ print "@ext"                   # txt asc c cc h hh cpp
+
+ print $plaintext->encoding     # 8bit
+ if($plaintext->isBinary)       # false
+ if($plaintext->isAscii)        # true
+ if($plaintext->equals('text/plain') {...}
+ if($plaintext eq 'text/plain') # same
+
+ print MIME::Type->simplified('x-appl/x-zip') #  'appl/zip'
+
+=head1 DESCRIPTION
+
+MIME types are used in MIME entities, for instance as part of e-mail
+and HTTP traffic.  Sometimes real knowledge about a mime-type is need.
+Objects of C<MIME::Type> store the information on one such type.
+
+=head1 OVERLOADED
+
+=over 4
+
+=item overload: B<string comparison>
+
+When a MIME::Type object is compared to either a string or another
+MIME::TYpe, the L<equals()|MIME::Type/"Knowledge"> method is called.  Comparison is smart,
+which means that it extends common string comparison with some
+features which are defined in the related RFCs.
+
+=item overload: B<stringification>
+
+The stringification (use of the object in a place where a string
+is required) will result in the type name, the same as L<type()|MIME::Type/"Attributes">
+returns.
+
+example: use of stringification
+
+ my $mime = MIME::Type->new('text/html');
+ print "$mime\n";   # explicit stringification
+ print $mime;       # implicit stringification
+
+=back
+
+=head1 METHODS
+
+=head2 Initiation
+
+=over 4
+
+=item MIME::Type-E<gt>B<new>(%options)
+
+Create (I<instantiate>) a new MIME::Type object which manages one
+mime type.
+
+ -Option    --Default
+  encoding    <depends on type>
+  extensions  []
+  simplified  <derived from type>
+  system      undef
+  type        <required>
+
+=over 2
+
+=item encoding => '7bit'|'8bit'|'base64'|'quoted-printable'
+
+How must this data be encoded to be transported safely.  The default
+depends on the type: mimes with as main type C<text/> will default
+to C<quoted-printable> and all other to C<base64>.
+
+=item extensions => REF-ARRAY
+
+An array of extensions which are using this mime.
+
+=item simplified => STRING
+
+The mime types main- and sub-label can both start with C<x->, to indicate
+that is a non-registered name.  Of course, after registration this flag
+can disappear which adds to the confusion.  The simplified string has the
+C<x-> thingies removed and are translated to lower-case.
+
+=item system => REGEX
+
+Regular expression which defines for which systems this rule is valid.  The
+REGEX is matched on C<$^O>.
+
+=item type => STRING
+
+The type which is defined here.  It consists of a I<type> and a I<sub-type>,
+both case-insensitive.  This module will return lower-case, but accept
+upper-case.
+
+=back
+
+=back
+
+=head2 Attributes
+
+=over 4
+
+=item $obj-E<gt>B<encoding>()
+
+Returns the type of encoding which is required to transport data of this
+type safely.
+
+=item $obj-E<gt>B<extensions>()
+
+Returns a list of extensions which are known to be used for this
+mime type.
+
+=item $obj-E<gt>B<simplified>( [$string] )
+
+=item MIME::Type-E<gt>B<simplified>( [$string] )
+
+Returns the simplified mime type for this object or the specified STRING.
+Mime type names can get officially registered.  Until then, they have to
+carry an C<x-> preamble to indicate that.  Of course, after recognition,
+the C<x-> can disappear.  In many cases, we prefer the simplified version
+of the type.
+
+example: results of simplified()
+
+ my $mime = MIME::Type->new(type => 'x-appl/x-zip');
+ print $mime->simplified;                     # 'appl/zip'
+
+ print $mime->simplified('text/PLAIN');       # 'text/plain'
+ print MIME::Type->simplified('x-xyz/x-abc'); # 'xyz/abc'
+
+=item $obj-E<gt>B<system>()
+
+Returns the regular expression which can be used to determine whether this
+type is active on the system where you are working on.
+
+=item $obj-E<gt>B<type>()
+
+Returns the long type of this object, for instance C<'text/plain'>
+
+=back
+
+=head2 Knowledge
+
+=over 4
+
+=item $obj-E<gt>B<equals>($string|$mime)
+
+Compare this mime-type object with a STRING or other object.  In case of
+a STRING, simplification will take place.
+
+=item $obj-E<gt>B<isAscii>()
+
+Old name for L<isText()|MIME::Type/"Knowledge">.
+
+=item $obj-E<gt>B<isBinary>()
+
+Returns true when the type is not known to be text.  See L<isText()|MIME::Type/"Knowledge">.
+
+=item $obj-E<gt>B<isExperimental>()
+
+[2.00] Return C<true> when the type is defined for experimental
+use; the subtype starts with C<x.>
+
+=item $obj-E<gt>B<isPersonal>()
+
+[2.00] Return C<true> when the type is defined by a person for
+private use; the subtype starts with C<prs.>
+
+=item $obj-E<gt>B<isRegistered>()
+
+Mime-types which are not registered by IANA nor defined in RFCs shall
+start with an C<x->.  This counts for as well the media-type as the
+sub-type.  In case either one of the types starts with C<x-> this
+method will return false.
+
+=item $obj-E<gt>B<isSignature>()
+
+Returns true when the type is in the list of known signatures.
+
+=item $obj-E<gt>B<isText>()
+
+[2.05] All types which may have the charset attribute, are text.  However,
+there is currently no record of attributes in this module... so we guess.
+
+=item $obj-E<gt>B<isVendor>()
+
+[2.00] Return C<true> when the type is defined by a vendor; the subtype
+starts with C<vnd.>
+
+=item $obj-E<gt>B<mediaType>()
+
+The media type of the simplified mime.
+For C<'text/plain'> it will return C<'text'>.
+
+For historical reasons, the C<'mainType'> method still can be used
+to retrieve the same value.  However, that method is deprecated.
+
+=item $obj-E<gt>B<subType>()
+
+The sub type of the simplified mime.
+For C<'text/plain'> it will return C<'plain'>.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item Error: Type parameter is obligatory.
+
+When a L<MIME::Type|MIME::Type> object is created, the type itself must be
+specified with the C<type> option flag.
+
+=back
+
+=head1 SEE ALSO
+
+This module is part of MIME-Types distribution version 2.18,
+built on December 09, 2020. Website: F<http://perl.overmeer.net/CPAN/>
+
+=head1 LICENSE
+
+Copyrights 1999-2020 by [Mark Overmeer <markov@cpan.org>]. For other contributors see ChangeLog.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+See F<http://dev.perl.org/licenses/>
+

database/perl/vendor/lib/MIME/Types.pm

@@ -0,0 +1,280 @@
+# Copyrights 1999-2020 by [Mark Overmeer <markov@cpan.org>].
+#  For other contributors see ChangeLog.
+# See the manual pages for details on the licensing terms.
+# Pod stripped from pm file by OODoc 2.02.
+# 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::Types;
+use vars '$VERSION';
+$VERSION = '2.18';
+
+
+use strict;
+
+use MIME::Type     ();
+use File::Spec     ();
+use File::Basename qw(dirname);
+use List::Util     qw(first);
+
+
+my %typedb;
+sub new(@) { (bless {}, shift)->init( {@_} ) }
+
+sub init($)
+{   my ($self, $args) = @_;
+    keys %typedb or $self->_read_db($args);
+    $self;
+}
+
+sub _read_db($)
+{   my ($self, $args)   = @_;
+    my $skip_extensions = $args->{skip_extensions};
+    my $only_complete   = $args->{only_complete};
+    my $only_iana       = $args->{only_iana};
+
+    my $db              = $ENV{PERL_MIME_TYPE_DB}
+      || $args->{db_file}
+      || File::Spec->catfile(dirname(__FILE__), 'types.db');
+
+    local *DB;
+    open DB, '<:encoding(utf8)', $db
+       or die "cannot open type database in $db: $!\n";
+
+    while(1)
+    {   my $header = <DB>;
+        defined $header or last;
+        chomp $header;
+
+        # This logic is entangled with the bin/collect_types script
+        my ($count, $major, $is_iana, $has_ext) = split /\:/, $header;
+        my $skip_section = $major eq 'EXTENSIONS' ? $skip_extensions
+          : (($only_iana && !$is_iana) || ($only_complete && !$has_ext));
+
+#warn "Skipping section $header\n" if $skip_section;
+        (my $section = $major) =~ s/^x-//;
+        if($major eq 'EXTENSIONS')
+        {   local $_;
+            while(<DB>)
+            {   last if m/^$/;
+                next if $skip_section;
+                chomp;
+                $typedb{$section}{$1} = $2 if m/(.*);(.*)/;
+            }
+        }
+        else
+        {   local $_;
+            while(<DB>)
+            {   last if m/^$/;
+                next if $skip_section;
+                chomp;
+                $typedb{$section}{$1} = "$major/$_" if m/^(?:x-)?([^;]+)/;
+            }
+        }
+    }
+
+    close DB;
+}
+
+# Catalyst-Plugin-Static-Simple uses it :(
+sub create_type_index {}
+
+#-------------------------------------------
+
+sub type($)
+{   my $spec    = lc $_[1];
+    $spec       = 'text/plain' if $spec eq 'text';   # old mailers
+
+    $spec =~ m!^(?:x\-)?([^/]+)/(?:x-)?(.*)!
+        or return;
+
+    my $section = $typedb{$1}    or return;
+    my $record  = $section->{$2} or return;
+    return $record if ref $record;   # already extended
+
+    my $simple   = $2;
+    my ($type, $ext, $enc) = split m/\;/, $record;
+    my $os       = undef;   # XXX TODO
+
+    $section->{$simple} = MIME::Type->new
+      ( type       => $type
+      , extensions => [split /\,/, $ext]
+      , encoding   => $enc
+      , system     => $os
+      );
+}
+
+
+sub mimeTypeOf($)
+{   my ($self, $name) = @_;
+    (my $ext = lc $name) =~ s/.*\.//;
+    my $type = $typedb{EXTENSIONS}{$ext} or return;
+    $self->type($type);
+}
+
+
+sub addType(@)
+{   my $self = shift;
+
+    foreach my $type (@_)
+    {   my ($major, $minor) = split m!/!, $type->simplified;
+        $typedb{$major}{$minor} = $type;
+        $typedb{EXTENSIONS}{$_} = $type for $type->extensions;
+    }
+    $self;
+}
+
+
+sub types()
+{   my $self  = shift;
+    my @types;
+    foreach my $section (keys %typedb)
+    {   next if $section eq 'EXTENSIONS';
+        push @types, map $_->type("$section/$_"),
+                         sort keys %{$typedb{$section}};
+    }
+    @types;
+}
+
+
+sub listTypes()
+{   my $self  = shift;
+    my @types;
+    foreach my $section (keys %typedb)
+    {   next if $section eq 'EXTENSIONS';
+        foreach my $sub (sort keys %{$typedb{$section}})
+        {   my $record = $typedb{$section}{$sub};
+            push @types, ref $record            ? $record->type
+                       : $record =~ m/^([^;]+)/ ? $1 : die;
+        }
+    }
+    @types;
+}
+
+
+sub extensions { keys %{$typedb{EXTENSIONS}} }
+sub _MojoExtTable() {$typedb{EXTENSIONS}}
+
+#-------------
+
+sub httpAccept($)
+{   my $self   = shift;
+    my @listed;
+
+    foreach (split /\,\s*/, shift)
+    {
+        m!^   ([a-zA-Z0-9-]+ | \*) / ( [a-zA-Z0-9+-]+ | \* )
+          \s* (?: \;\s*q\=\s* ([0-9]+(?:\.[0-9]*)?) \s* )?
+              (\;.* | )
+          $ !x or next;
+
+        my $mime = "$1/$2$4";
+        my $q    = defined $3 ? $3 : 1;   # q, default=1
+
+        # most complex first
+        $q += $4 ? +0.01 : $1 eq '*' ? -0.02 : $2 eq '*' ? -0.01 : 0;
+
+        # keep order
+        $q -= @listed*0.0001;
+
+        push @listed, [ $mime => $q ];
+    }
+    map $_->[0], sort {$b->[1] <=> $a->[1]} @listed;
+}
+
+
+sub httpAcceptBest($@)
+{   my $self   = shift;
+    my @accept = ref $_[0] eq 'ARRAY' ? @{(shift)} : $self->httpAccept(shift);
+    my $match;
+
+    foreach my $acc (@accept)
+    {   $acc   =~ s/\s*\;.*//;    # remove attributes
+        my $m = $acc !~ s#/\*$## ? first { $_->equals($acc) } @_
+              : $acc eq '*'      ? $_[0]     # $acc eq */*
+              :                    first { $_->mediaType eq $acc } @_;
+        return $m if defined $m;
+    }
+
+    ();
+}
+
+
+sub httpAcceptSelect($@)
+{   my ($self, $accept) = (shift, shift);
+    my $fns  = !@_ ? return () : ref $_[0] eq 'ARRAY' ? shift : [@_];
+
+    unless(defined $accept)
+    {   my $fn = $fns->[0];
+        return ($fn, $self->mimeTypeOf($fn));
+    }
+
+    # create mapping  type -> filename
+    my (%have, @have);
+    foreach my $fn (@$fns)
+    {   my $type = $self->mimeTypeOf($fn) or next;
+        $have{$type->simplified} = $fn;
+        push @have, $type;
+    }
+
+    my $type = $self->httpAcceptBest($accept, @have);
+    defined $type ? ($have{$type}, $type) : ();
+}
+
+#-------------------------------------------
+# OLD INTERFACE (version 0.06 and lower)
+
+
+use base 'Exporter';
+our @EXPORT_OK = qw(by_suffix by_mediatype import_mime_types);
+
+
+my $mime_types;
+
+sub by_suffix($)
+{   my $filename = shift;
+    $mime_types ||= MIME::Types->new;
+    my $mime     = $mime_types->mimeTypeOf($filename);
+
+    my @data     = defined $mime ? ($mime->type, $mime->encoding) : ('','');
+    wantarray ? @data : \@data;
+}
+
+
+sub by_mediatype($)
+{   my $type = shift;
+    $mime_types ||= MIME::Types->new;
+
+    my @found;
+    if(!ref $type && index($type, '/') >= 0)
+    {   my $mime   = $mime_types->type($type);
+        @found     = $mime if $mime;
+    }
+    else
+    {   my $search = ref $type eq 'Regexp' ? $type : qr/$type/i;
+        @found     = map $mime_types->type($_),
+                         grep $_ =~ $search,
+                             $mime_types->listTypes;
+    }
+
+    my @data;
+    foreach my $mime (@found)
+    {   push @data, map [$_, $mime->type, $mime->encoding],
+                        $mime->extensions;
+    }
+
+    wantarray ? @data : \@data;
+}
+
+
+sub import_mime_types($)
+{   my $filename = shift;
+    use Carp;
+    croak <<'CROAK';
+import_mime_types is not supported anymore: if you have types to add
+please send them to the author.
+CROAK
+}
+
+1;

database/perl/vendor/lib/MIME/Types.pod

@@ -0,0 +1,267 @@
+=encoding utf8
+
+=head1 NAME
+
+MIME::Types - Definition of MIME types
+
+=head1 INHERITANCE
+
+ MIME::Types
+   is a Exporter
+
+=head1 SYNOPSIS
+
+ use MIME::Types;
+ my $mt    = MIME::Types->new(...);    # MIME::Types object
+ my $type  = $mt->type('text/plain');  # MIME::Type  object
+ my $type  = $mt->mimeTypeOf('gif');
+ my $type  = $mt->mimeTypeOf('picture.jpg');
+ my @types = $mt->httpAccept('text/html, application/json;q=0.1')
+
+=head1 DESCRIPTION
+
+MIME types are used in many applications (for instance as part of e-mail
+and HTTP traffic) to indicate the type of content which is transmitted.
+or expected.  See RFC2045 at F<https://www.ietf.org/rfc/rfc2045.txt>
+
+Sometimes detailed knowledge about a mime-type is need, however this
+module only knows about the file-name extensions which relate to some
+filetype.  It can also be used to produce the right format: types
+which are not registered at IANA need to use 'x-' prefixes.
+
+This object administers a huge list of known mime-types, combined
+from various sources.  For instance, it contains B<all IANA> types
+and the knowledge of Apache.  Probably the most complete table on
+the net!
+
+=head2 MIME::Types and daemons (fork)
+
+If your program uses fork (usually for a daemon), then you want to have
+the type table initialized before you start forking. So, first call
+
+   my $mt = MIME::Types->new;
+
+Later, each time you create this object (you may, of course, also reuse
+the object you create here) you will get access to B<the same global table>
+of types.
+
+=head1 METHODS
+
+=head2 Constructors
+
+=over 4
+
+=item MIME::Types-E<gt>B<new>(%options)
+
+Create a new C<MIME::Types> object which manages the data.  In the current
+implementation, it does not matter whether you create this object often
+within your program, but in the future this may change.
+
+ -Option         --Default
+  db_file          <installed source>
+  only_complete    <false>
+  only_iana        <false>
+  skip_extensions  <false>
+
+=over 2
+
+=item db_file => FILENAME
+
+The location of the database which contains the type information.  Only the
+first instantiation of this object will have this parameter obeyed.
+
+[2.10] This parameter can be globally overruled via the C<PERL_MIME_TYPE_DB>
+environment variable, which may be needed in case of PAR or other tricky
+installations.  For PAR, you probably set this environment variable to
+"inc/lib/MIME/types.db"
+
+=item only_complete => BOOLEAN
+
+Only include complete MIME type definitions: requires at least one known
+extension.  This will reduce the number of entries --and with that the
+amount of memory consumed-- considerably.
+
+In your program you have to decide: the first time that you call
+the creator (C<new>) determines whether you get the full or the partial
+information.
+
+=item only_iana => BOOLEAN
+
+Only load the types which are currently known by IANA.
+
+=item skip_extensions => BOOLEAN
+
+Do not load the table to map extensions to types, which is quite large.
+
+=back
+
+=back
+
+=head2 Knowledge
+
+=over 4
+
+=item $obj-E<gt>B<addType>($type, ...)
+
+Add one or more TYPEs to the set of known types.  Each TYPE is a
+C<MIME::Type> which must be experimental: either the main-type or
+the sub-type must start with C<x->.
+
+Please inform the maintainer of this module when registered types
+are missing.  Before version MIME::Types version 1.14, a warning
+was produced when an unknown IANA type was added.  This has been
+removed, because some people need that to get their application
+to work locally... broken applications...
+
+=item $obj-E<gt>B<extensions>()
+
+Returns a list of all defined extensions.
+
+=item $obj-E<gt>B<listTypes>()
+
+Returns a list of all defined mime-types by name only.  This will B<not>
+instantiate L<MIME::Type|MIME::Type> objects.  See L<types()|MIME::Types/"Knowledge">
+
+=item $obj-E<gt>B<mimeTypeOf>($filename)
+
+Returns the C<MIME::Type> object which belongs to the FILENAME (or simply
+its filename extension) or C<undef> if the file type is unknown.  The extension
+is used and considered case-insensitive.
+
+In some cases, more than one type is known for a certain filename extension.
+In that case, the preferred one is taken (for an unclear definition of
+preference)
+
+example: use of mimeTypeOf()
+
+ my $types = MIME::Types->new;
+ my $mime = $types->mimeTypeOf('gif');
+
+ my $mime = $types->mimeTypeOf('picture.jpg');
+ print $mime->isBinary;
+
+=item $obj-E<gt>B<type>($string)
+
+Returns the C<MIME::Type> which describes the type related to STRING.
+[2.00] Only one type will be returned.
+
+[before 2.00] One type may be described more than once.  Different
+extensions may be in use for this type, and different operating systems
+may cause more than one C<MIME::Type> object to be defined.  In scalar
+context, only the first is returned.
+
+=item $obj-E<gt>B<types>()
+
+Returns a list of all defined mime-types.  For reasons of backwards
+compatibility, this will instantiate L<MIME::Type|MIME::Type> objects, which will
+be returned.  See L<listTypes()|MIME::Types/"Knowledge">.
+
+=back
+
+=head2 HTTP support
+
+=over 4
+
+=item $obj-E<gt>B<httpAccept>($header)
+
+[2.07] Decompose a typical HTTP-Accept header, and sort it based on the
+included priority information.  Returned is a sorted list of type names,
+where the highest priority type is first.  The list may contain '*/*'
+(accept any) or a '*' as subtype.
+
+Ill-formated typenames are ignored.  On equal qualities, the order is
+kept.  See RFC2616 section 14.1
+
+example: 
+
+  my @types = $types->httpAccept('text/html, application/json;q=0.9');
+
+=item $obj-E<gt>B<httpAcceptBest>($accept|\@types, @have)
+
+[2.07] The C<$accept> string is processed via L<httpAccept()|MIME::Types/"HTTP support"> to order the
+types on preference.  You may also provide a list of ordered C<@types>
+which may have been the result of that method, called earlier.
+
+As second parameter, you pass a LIST of types you C<@have> to offer.
+Those need to be L<MIME::Type|MIME::Type> objects. The preferred type will get
+selected.  When none of these are accepted by the client, this will
+return C<undef>.  It should result in a 406 server response.
+
+example: 
+
+   my $accept = $req->header('Accept');
+   my @have   = map $mt->type($_), qw[text/plain text/html];
+   my @ext    = $mt->httpAcceptBest($accept, @have);
+
+=item $obj-E<gt>B<httpAcceptSelect>($accept|\@types, @filenames|\@filenames)
+
+[2.07] Like L<httpAcceptBest()|MIME::Types/"HTTP support">, but now we do not return a pair with mime-type
+and filename, not just the type.  If $accept is C<undef>, the first
+filename is returned.
+
+example: 
+
+   use HTTP::Status ':constants';
+   use File::Glob   'bsd_glob';    # understands blanks in filename
+
+   my @filenames   = bsd_glob "$imagedir/$fnbase.*;
+   my $accept      = $req->header('Accept');
+   my ($fn, $mime) = $mt->httpAcceptSelect($accept, @filenames);
+   my $code        = defined $mime ? HTTP_NOT_ACCEPTABLE : HTTP_OK;
+
+=back
+
+=head1 FUNCTIONS
+
+The next functions are provided for backward compatibility with MIME::Types
+versions [0.06] and below.  This code originates from Jeff Okamoto
+F<okamoto@corp.hp.com> and others.
+
+=over 4
+
+=item B<by_mediatype>(TYPE)
+
+This function takes a media type and returns a list or anonymous array of
+anonymous three-element arrays whose values are the file name suffix used to
+identify it, the media type, and a content encoding.
+
+TYPE can be a full type name (contains '/', and will be matched in full),
+a partial type (which is used as regular expression) or a real regular
+expression.
+
+=item B<by_suffix>(FILENAME|SUFFIX)
+
+Like C<mimeTypeOf>, but does not return an C<MIME::Type> object. If the file
++type is unknown, both the returned media type and encoding are empty strings.
+
+example: use of function by_suffix()
+
+ use MIME::Types 'by_suffix';
+ my ($mediatype, $encoding) = by_suffix('image.gif');
+
+ my $refdata = by_suffix('image.gif');
+ my ($mediatype, $encoding) = @$refdata;
+
+=item B<import_mime_types>()
+
+This method has been removed: mime-types are only useful if understood
+by many parties.  Therefore, the IANA assigns names which can be used.
+In the table kept by this C<MIME::Types> module all these names, plus
+the most often used temporary names are kept.  When names seem to be
+missing, please contact the maintainer for inclusion.
+
+=back
+
+=head1 SEE ALSO
+
+This module is part of MIME-Types distribution version 2.18,
+built on December 09, 2020. Website: F<http://perl.overmeer.net/CPAN/>
+
+=head1 LICENSE
+
+Copyrights 1999-2020 by [Mark Overmeer <markov@cpan.org>]. For other contributors see ChangeLog.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+See F<http://dev.perl.org/licenses/>
+