MP3::Tag::ParseData - Module for parsing arbitrary data associated with music files.

MP3-Tag documentation Contained in the MP3-Tag distribution.

Index

Code Index:

NAME

Top

MP3::Tag::ParseData - Module for parsing arbitrary data associated with music files.

SYNOPSIS

Top

   # parses the file name according to one of the patterns:
   $mp3->config('parse_data', ['i', '%f', '%t - %n - %a.%e', '%t - %y.%e']);
   $title = $mp3->title;

see MP3::Tag

DESCRIPTION

Top

MP3::Tag::ParseData is designed to be called from the MP3::Tag module.

Each option of configuration item parse_data should be of the form [$flag, $string, $pattern1, ...]. For each of the option, patterns of the option are matched agains the $string of the option, until one of them succeeds. The information obtained from later options takes precedence over the information obtained from earlier ones.

The meaning of the patterns is the same as for parse() or parse_rex() methods of MP3::Tag. Since the default for parse_data is empty, by default this handler has no effect.

$flag is split into 1-character-long flags (unknown flags are ignored):

i

the string-to-parse is interpolated first;

f

the string-to-parse is interpreted as the name of the file to read;

F

added to f, makes it non-fatal if the file does not exist;

B

the file should be read in binary mode;

n

the string-to-parse is interpreted as collection of lines, one per track;

l

the string-to-parse is interpreted as collection of lines, and the first matched is chosen;

I

the resulting string is interpolated before parsing.

b

Do not strip the leading and trailing blanks. (With output to file, the output is performed in binary mode too.)

R

the patterns are considered as regular expressions.

m

one of the patterns must match.

o, O, D

With o or O interpret the pattern as a name of file to output parse-data to. With O the name of output file is interpolated. When D is present, intermediate directories are created.

z

Do not ignore a field even if the result is a 0-length string.

Unless b option is given, the resulting values have starting and trailing whitespace trimmed. (Actually, split()ing into lines is done using the configuration item parse_split; it defaults to "\n".)

If the configuration item parse_data has multiple options, the $strings which are interpolated will use information set by preceding options; similarly, any interolated option may use information obtained by other handlers - even if these handers are later in the pecking order than MP3::Tag::ParseData (which by default is the first handler). For example, with

  ['i', '%t' => '%t (%y)'], ['i', '%t' => '%t - %c']

and a local CDDB file which identifies title to 'Merry old - another interpretation (1905)', the first field will interpolate '%t' into this title, then will split it into the year and the rest. The second field will split the rest into a title-proper and comment.

Note that one can use fields of the form

  ['mz', 'This is a forced title' => '%t']

to force particular values for parts of the MP3 tag.

The usual methods artist, title, album, comment, year, track, year can be used to access the results of the parse.

It is possible to set individual id3v2 frames; use %{TIT1} or some such. Setting to an empty string deletes the frame if config parameter id3v2_frame_empty_ok is false (the default value). Setting ID3v2 frames uses the same translation rules as select_id3v2_frame_by_descr().

SEE ALSO

The flags i f F B l m I b are identical to flags of the method interpolate_with_flags() of MP3::Tag (see "interpolate_with_flags" in MP3::Tag). Essentially, the other flags (R m o O D z) are applied to the result of calling the latter method.

MP3-Tag documentation Contained in the MP3-Tag distribution. 
package MP3::Tag::ParseData;

use strict;
use vars qw /$VERSION @ISA/;

$VERSION="1.00";
@ISA = 'MP3::Tag::__hasparent';



# Constructor

sub new_with_parent {
    my ($class, $filename, $parent) = @_;
    $filename = $filename->filename if ref $filename;
    bless {filename => $filename, parent => $parent}, $class;
}

# Destructor

sub DESTROY {}

sub parse_one {
    my ($self, $in) = @_;

    my @patterns = @$in;		# Apply shift to a copy, not original...
    my $flags = shift @patterns;
    my $data  = shift @patterns;

    my @data = $self->{parent}->interpolate_with_flags($data, $flags);
    my $res;
    my @opatterns = @patterns;

    if ($flags =~ /[oO]/) {
	@patterns = map $self->{parent}->interpolate($_), @patterns
	    if $flags =~ /O/;
	return unless length $data[0] or $flags =~ /z/;
	for my $file (@patterns) {
	    if ($flags =~ /D/ and $file =~ m,(.*)[/\\],s) {
		require File::Path;
		File::Path::mkpath($1);
	    }
	    open OUT, "> $file" or die "open(`$file') for write: $!";
	    if ($flags =~ /b/) {
	      binmode OUT;
	    } else {
	      my $e;
	      if ($e = $self->get_config('encode_encoding_files') and $e->[0]) {
		eval "binmode OUT, ':encoding($e->[0])'"; # old binmode won't compile...
	      }
	    }
	    local ($/, $,) = ('', '');
	    print OUT $data[0];
	    close OUT or die "close(`$file') for write: $!";
	}
	return;
    }
    if ($flags =~ /R/) {
	@patterns = map $self->{parent}->parse_rex_prepare($_), @patterns;
    } else {
	@patterns = map $self->{parent}->parse_prepare($_), @patterns;
    }
    for $data (@data) {
	my $pattern;
	for $pattern (@patterns) {
	    last if $res = $self->{parent}->parse_rex_match($pattern, $data);
	}
	last if $res;
    }
    {   local $" = "' `";
	die "Pattern(s) `@opatterns' did not succeed vs `@data'"
	    if $flags =~ /m/ and not $res;
    }
    my $k;
    for $k (keys %$res) {
	unless ($flags =~ /b/) {
	  $res->{$k} =~ s/^\s+//;
	  $res->{$k} =~ s/\s+$//;
	}
	delete $res->{$k} unless length $res->{$k} or $flags =~ /z/;
    }
    return unless $res and keys %$res;
    return $res;
}

# XXX Two decisions: which entries can access results of which ones,
# and which entries overwrite which ones; the user can reverse one of them
# by sorting config('parse_data') in the opposite order; but not both.
# Only practice can show whether our choice is correct...   How to customize?

sub parse {	# Later recipies can access results of earlier ones.
    my ($self,$what) = @_;

    return $self->{parsed}->{$what}	# Recalculate during recursive calls
	if not $self->{parsing} and exists $self->{parsed}; # Do not recalc after finish

    my $data = $self->get_config('parse_data');
    return unless $data and @$data;
    my $parsing = $self->{parsing};
    local $self->{parsing};

    my (%res, $d, $c);
    for $d (@$data) {
	$c++;
	$self->{parsing} = $c;
	# Protect against recursion: later $d can access results of earlier ones
	last if $parsing and $parsing <= $c;
	my $res = $self->parse_one($d);
	# warn "Failure: [@$d]\n" unless $res;
	# Set user-scratch space data immediately
	for my $k (keys %$res) {
	  if ($k eq 'year') {	# Do nothing
	  } elsif ($k =~ /^U(\d{1,2})$/) {
	    $self->{parent}->set_user($1, delete $res->{$k})
	  } elsif (0 and $k =~ /^\w{4}(\d{2,})?$/) {
	    if (length $res->{$k}
		or $self->get_config('id3v2_frame_empty_ok')->[0]) {
	      $self->{parent}->set_id3v2_frame($k, delete $res->{$k})
	    } else {
	      delete $res->{$k};
	      $self->{parent}->set_id3v2_frame($k);	# delete
	    }
	  } elsif ($k =~ /^\w{4}(\d{2,}|(?:\(([^()]*(?:\([^()]+\)[^()]*)*)\))?(?:\[(\\.|[^]\\]*)\])?)$/) {
	    my $r = delete $res->{$k};
	    $r = undef unless length $r or $self->get_config('id3v2_frame_empty_ok')->[0];
	    if (defined $r or $self->{parent}->_get_tag('ID3v2')) {
	      $self->{parent}->select_id3v2_frame_by_descr($k, $r);
	    }
	  }
	}
	# later ones overwrite earlier
	%res = (%res, %$res) if $res;
    }
    $self->{parsed} = \%res;
    # return unless keys %res;
    return $self->{parsed}->{$what};
}

for my $elt ( qw( title track artist album comment year genre ) ) {
  no strict 'refs';
  *$elt = sub (;$) {
    my $self = shift;
    $self->parse($elt, @_);
  }
}

1;