view release on metacpan or  search on metacpan

examples/mp3info2  view on Meta::CPAN

my $opts = 'c:a:t:l:n:g:y:uDp:C:P:E:G@Rr:I2e:d:F:xNU';
my %o;
tie %o, 'MULTIV';
exec 'perldoc', '-F', $0 unless @ARGV;

sub massage_o {
  getopts($opts, \%o);
  for my $o (keys %opt) {
    if (-1 == index $opts, "$o:") {
      $opt{$o} = @{$opt{$o}};		# Number of occurences
    } elsif ($o =~ /[PFCd]/) {		# Keep as is
    } else {
      die "Multiple option `-$o' not supported" if @{$opt{$o}} > 1;
      $opt{$o} = $opt{$o}[0];
    }
  }
  %opt = (%opt_d, %opt);
}
massage_o();

sub my_decode($$) {	# If file names are utf-ized, glob fails???
  # De-utf-ize if possible...
  join '', map chr ord, split //, &Encode::decode;
}

sub my_decode_deep($$);
sub my_decode_deep($$) {
  my($e,$t) = (shift, shift);
  if (ref $t eq 'ARRAY') {
    return [map my_decode_deep($e, $_), @$t];
  } elsif ('Regexp' eq ref $t) {	# do nothing
    return $t
  } elsif (ref $t) {
    die "panic: reference of type `$t' unexpected"
  }
  # De-utf-ize if possible...
  join '', map chr ord, split //, Encode::decode($e, $t);
}

# if ($opt{e} and exists $opt{p} ? 0 == length $opt{p} : 1) {
my $uE = (($ENV{LANG}||'') =~ /\.utf-8$/i and not (${^UNICODE} & 0x20) and not $ENV{"MP3INFO_DECODE_ARGV_DEFAULT_RESET"});
$opt{e} = 15 if ($opt{U} or $uE) and not defined $opt{e};
if ($opt{e}) {
  my $skip;
  if ($opt{e} =~ /^(\d+)$/ and $1 <= 15 ) {
    require Encode;
    my $locale;
    if ($opt{U}) {
      $locale = 'UTF-8';
    } else {
      $locale = $ENV{LC_CTYPE} || $ENV{LC_ALL} || $ENV{LANG};
      if ($^O eq 'os2' and not eval {Encode::resolve_alias($locale)} ) {
        require OS2::Process;
        $locale = 'cp' . OS2::Process::out_codepage();
      }
    }
    MP3::Tag->reset_encode_decode_config($locale) if $locale and $opt{e} & 0x08;
#    warn "LOCALE=$locale: e=$opt{e}";
    $skip = !($opt{e} & 1);
    # Reinterpret @ARGV
    @ARGV = map my_decode($locale, $_), @ARGV if $opt{e} & 4;
    # Reinterpret opts
    @opt{keys %opt} = map my_decode_deep($locale, $_), values %opt
      if $opt{e} & 2;
    $opt{e} = $locale;
  } elsif ($opt{e} eq 'binary') {
    binmode STDOUT;
    $skip = 1;
  }
  binmode STDOUT, ":encoding($opt{e})" if defined $opt{e} and not $skip;
}

my $e_opt = MP3::Tag->get_config('extra_config_keys');
MP3::Tag->config('extra_config_keys', @$e_opt, qw(empty-F-deletes frames_write_creates_dirs));
MP3::Tag->config('empty-F-deletes', 1)
  unless defined MP3::Tag->get_config1('empty-F-deletes');

# keys of %opt to the MP3::Tag keywords:
my %trans = (	't' => 'title',
		'a' => 'artist',
		'l' => 'album',
		'y' => 'year',
		'g' => 'genre',
		'c' => 'comment',
		'n' => 'track'  );

# Interprete Escape sequences:
my %r = ( 'n' => "\n", 't' => "\t", '\\' => "\\"  );
my ($e_backsl, $e_interp);
if ($opt{E} =~ s/^\+//) {
  ($e_backsl, $e_interp) = ((split m(/i:), $opt{E}, 2), '');
  $e_backsl .= 'p' unless $e_backsl =~ /p/;
  $e_interp =~ s/[Fp]//g;
  $e_interp .= 'Fp';
} else {
  ($e_backsl, $e_interp) = ((split m(/i:), $opt{E}, 2), '');
}
for my $e (split //, $e_backsl) {
  $opt{$e} =~ s/\\([nt\\])/$r{$1}/g if defined $opt{$e};
}
$e_interp = {map +($_, 1), split //, $e_interp};

if ($opt{'@'}) {
  for my $k (keys %opt) {
    if (ref $opt{$k}) {
      s/\@/%/g for @{ $opt{$k} };
    } else {
      $opt{$k} =~ s/\@/%/g;
    }
  }
}

my %F_human = qw( composer	TCOM
		  text_by	TEXT
		  orchestra	TPE2
		  conductor	TPE3
		  track		TRCK
		  disk_n	TPOS);	# Only most useful, and not -l etc...

my $FNAME = qr/(?:		# 1: Whole specifier
		 \w{4}		# 2: Frame name