view release on metacpan or  search on metacpan

lib/MP3/Tag.pm  view on Meta::CPAN

sub interpolate ($$) {
  my ($self, $pattern) = @_;	# local copy; $pattern is modified
  $self->_interpolate($pattern);
}


=item interpolate_with_flags

  @results = $mp3->interpolate_with_flags($text, $flags);

Processes $text according to directives in the string $flags; $flags is
split into separate flag characters; the meanings (and order of application) of
flags are

   i			interpolate via $mp3->interpolate
   f			interpret (the result) as filename, read from file
   F			if file does not exist, it is not an error
   B			read is performed in binary mode (otherwise
				in text mode, modified per
				'decode_encoding_files' configuration variable)
   l			split result per 'parse_split' configuration variable
   n			as l, using the track-number-th element (1-based)
				in the result
   I			interpolate (again) via $mp3->interpolate
   b			unless present, remove leading and trailing whitespace

With C<l>, may produce multiple results.  May be accessed via
interpolation of C<%{I(flags)text}>.

=cut

sub interpolate_with_flags ($$$) {
    my ($self, $data, $flags) = @_;
#	try::interpolate_with_flags(undef, '__List-j', 'f'); exit;

    $data = $self->interpolate($data) if $flags =~ /i/;
    if ($flags =~ /f/) {
	local *F;
	my $e;
	unless (open F, "< $data") {
	  return if $flags =~ /F/;
	  die "Can't open file `$data' for parsing: $!";
	}
	if ($flags =~ /B/) {
#	  	warn "binmode -> YES";
	  binmode F;
	} else {
#	  	warn "binmode -> NO";
	  my $e;
	  if ($e = $self->get_config('decode_encoding_files') and $e->[0]) {
#	  	warn "binmode -> :encoding($e->[0])";
	    eval "binmode F, ':encoding($e->[0])'"; # old binmode won't compile...
	  }
	}

	local $/;
	my $d = <F>;
#		warn "From file $data (\$^OPEN=${^OPEN}, \$^UNICODE=${^UNICODE}): ", join q( ), map ord, split //, $d;
	CORE::close F or die "Can't close file `$data' for parsing: $!";
	$d =~ s/^(?:\x{FEFF}|\xEF\xBB\xBF)// unless $flags =~ /B/;	# strip BOM
	$data = $d;
    }
    my @data = $data;
    if ($flags =~ /[ln]/) {
	my $p = $self->get_config('parse_split')->[0];
	@data = split $p, $data, -1;
    }
    if ($flags =~ /n/) {
	my $track = $self->track1 or return;
	@data = $data[$track - 1];
    }
    for my $d (@data) {
	$d = $self->interpolate($d) if $flags =~ /I/;
	unless ($flags =~ /b/) {
	    $d =~ s/^\s+//;
	    $d =~ s/\s+$//;
	}
    }
    @data;
}

=item parse_rex($pattern, $string)

Parse $string according to the regular expression $pattern with
C<%>-escapes C<%%, %a, %t, %l, %y, %g, %c, %n, %e, %E> etc.  The meaning
of escapes is the same as for method L<"interpolate">(); but (with
the exception of C<%%>) they are
used not for I<expansion>, but for I<matching> a part of $string
suitable to be a value for these fields.  Returns false on failure, a
hash reference with parsed fields otherwise (with C<%a> setting the
field C<author>, etc).

Some more escapes are supported: C<%=a, %=t, %=l, %=y, %=g, %=c, %=n, %=e,
%=E, %=A, %=B, %=D, %=f, %=F, %=N, %={WHATEVER}> I<match>
substrings which are I<current> values of artist/title/etc (C<%=n> also
matches leading 0s; actual file-name matches ignore the difference
between C</> and C<\>, between one and multiple consequent dots (if
configuration variable C<parse_filename_merge_dots> is true (default))
and are case-insensitive if configuration variable
C<parse_filename_ignore_case> is true (default); moreover, C<%n>,
C<%y>, C<%=n>, C<%=y> will not match if the string-to-match is
adjacent to a digit).  Double C<=> if you want to match to fail when
the corresponding conditional C<%>-escape would fail (a missing field,
or a zero-length field for required fields).

The escapes C<%{UE<lt>numberE<gt>}> and escapes of the forms
C<%{ABCD}> match any string; the
corresponding hash key in the result hash is what is inside braces;
here C<ABCD> is a 4-letter word possibly followed by 2-digit number
(as in names of ID3v2 tags), or what can be put in
C<'%{FRAM(lang,list)[description]}'>.

  $res = $mp3->parse_rex( qr<^%a - %t\.\w{1,4}$>,
			  $mp3->filename_nodir ) or die;
  $author = $res->{author};

2-digit numbers, or I<number1/number2> with number1,2 up to 999 are
allowed for the track number (the leading 0 is stripped); 4-digit
years in the range 1000..2999 are allowed for year.  Alternatively, if
option year_is_timestamp is TRUE (default), year may be a range of