view release on metacpan or  search on metacpan

mimeopen  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;


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'       => [''],
    'dereference' => ['L'],
    'debug'       => ['D'],
    'database'    => ['', 1],
    'magic-only'  => ['M'],
    'ask'         => ['a'],
    'ask-default' => ['d'],
    'no-ask'      => ['n'],
);

while ((@ARGV) && ($ARGV[0] =~ /^-/)) {
    my $opt = shift @ARGV;
    if ($opt =~ /^--?$/) {
        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}++; }
        }
    }
    else { complain($opt) }
}

if ($args{help} || $args{usage}) {
    eval 'use Pod::Usage';
    die "Could not find perl module Pod::Usage\n" if $@;
    pod2usage( {
        -verbose => 1,