view release on metacpan or  search on metacpan

examples/mp3info2  view on Meta::CPAN

  } 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
		 (?:
		   \d\d		# 3: Frame number
		 |
		   (?: \( [^()]* (?:\([^()]+\)[^()]*)* \) )? # 4: Language part
		   (?: \[ (?: \\. | [^]\\] )* \] )? # 5: Description part
		 )?
	       )
	      /x;
my $FNAME_human = join '|', keys %F_human;

my @set_f;
my %textish = map +($_, 1), qw( _encoding Text Language Description URL );
for my $F (@{ $opt{F} }) {
  my ($lead, @s) = ($F =~ /^(\W)/);
  if (defined $lead) {
    @s = split /\Q$lead$lead$lead/, substr $F, 1;
  } else {
    @s = $F;
  }
  for my $s (@s) {
    $s =~ /^($FNAME|$FNAME_human|(?:TAGS|ID3v[12])(?=\s+[\?<>]))(?:=|\s+(\??<|>)\s+)(.*)/so
      or die "unrecognized part of -F option: `$s'";
    my $FF = $F_human{$1} || $1;
    push @set_f, [$FF, $3, ($2 || '')];
  }
}

my (@del, @del_tag);
for my $o (@{ $opt{d} }) {
  my @D;
  push @D, $1 while $o =~ s/^ ( $FNAME | ID3v[12] ) (,|$) //xo;
  die "Unrecognized part of -d option: `$o'" if length $o;
  push @del_tag, grep  /^ID3v[12]$/, @D;
  push @del,     grep !/^ID3v[12]$/, @D;
}