view release on metacpan or  search on metacpan

mimetype  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
our $VERSION = '0.37';
$|++;

# ########## #
# Parse ARGV #
# ########## #
use Encode::Locale;
use Encode;
use B qw(cstring);
@ARGV = map { my $d = eval { decode(locale => $_, 1) }; defined $d ? $d : $_ } @ARGV;

# Set up output encoding
if (-t) {
    binmode(STDIN, ":encoding(console_in)");
    binmode(STDOUT, ":encoding(console_out)");
    binmode(STDERR, ":encoding(console_out)");
}

my %args = ();
my %opts = (
    'help'          => ['h'],
    'usage'         => ['u'],
    'version'       => ['v'],
    'stdin'         => [''],
    'brief'         => ['b'],
    'namefile'      => ['f', 1],
    'noalign'       => ['N'],
    'describe'      => ['d'],
    'file-compat'   => [''],
    'output-format' => ['', 1],
    'language'      => ['l', 1],
    'mimetype'      => ['i'],
    'dereference'   => ['L'],
    'separator'     => ['F',1],
    'debug'         => ['D'],
    'database'      => ['', 1],
    'all'           => ['a'],
    'magic-only'    => ['M'],
);

$args{'file-compat'}++ if $0 =~ m#(^|/)file$#;

while ((@ARGV) && ($ARGV[0] =~ /^-/)) {
    my $opt = shift @ARGV;
    if ($opt =~ /^--?$/) {
        $args{stdin}++ if $args{'file-compat'} && $opt eq '-';
        last;
    }
    elsif ($opt =~ s/^--([\w-]+)(?:=(.*))?/$1/) {
        if (exists $opts{$opt}) {
            if ($opts{$opt}[1]) {
                my $arg = $2 || shift @ARGV;
                complain('--'.$opt, 2) unless defined $arg;
                $args{$opt} .= ( $args{$opt} ? ' ' : '' ) . $arg;
            }
            else { $args{$opt}++ }
        }
        else { complain('--'.$opt) }
    }
    elsif ($opt =~ s/^-(?!-)//) {
        foreach my $o (split //, $opt) {
            my ($key) = grep { $opts{$_}[0] eq $o } keys %opts;
            complain($o) unless $key;

            if ($opts{$key}[1]) {
                my $arg = shift @ARGV;
                complain('-'.$o, 2) unless defined $arg;
                $args{$key} .= ( $args{$key} ? ' ' : '' ).$arg; # join with whitespace
            }
            else { $args{$key}++; }