view release on metacpan or  search on metacpan

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

    $mp3->get_tags;
    $data = $mp3->autoinfo('from') unless defined $data;

#    $mp3->new_tag("ID3v1") unless $wr1 = exists $mp3->{ID3v1};
    unless (exists $mp3->{ID3v1}) {
	$mp3->can_write_or_die('update_tags() doing ID3v1: ');
	$wr2 = 1;
	$mp3->new_tag("ID3v1");
    }
    my $elt;
    for $elt (qw/title artist album year comment track genre/) {
	my $d = $data->{$elt};
	next unless defined $d;
	$d = [$d, ''] unless ref $d;
        $mp3->{ID3v1}->$elt( $d->[0] ) if $d->[1] ne 'ID3v1';
    }				# Skip what is already there...
    $mp3->{ID3v1}->write_tag;

    my $do_length
      = (defined $mp3->{ms}) ? ($mp3->get_config('update_length'))->[0] : 0;

    return $mp3
      if not $force2 and $mp3->{ID3v1}->fits_tag($data)
	and not exists $mp3->{ID3v2} and $do_length < 2;

#    $mp3->new_tag("ID3v2") unless exists $mp3->{ID3v2};
    unless (exists $mp3->{ID3v2}) {
	if (defined $wr2) {
	    $mp3->die_cant_write('update_tags() doing ID3v2: ') unless $wr2;
	} else {
	    $mp3->can_write_or_die('update_tags() doing ID3v2: ');
	}
	$mp3->new_tag("ID3v2");
    }
    for $elt (qw/title artist album year comment track genre/) {
	my $d = $data->{$elt};
	next unless defined $d;
	$d = [$d, ''] unless ref $d;
        $mp3->{ID3v2}->$elt( $d->[0] ) if $d->[1] ne 'ID3v2';
    }				# Skip what is already there...
    # $mp3->{ID3v2}->comment($data->{comment}->[0]);

    $mp3->set_id3v2_frame('TLEN', $mp3->{ms})
      if $do_length and not $mp3->have_id3v2_frame('TLEN');
    $mp3->{ID3v2}->write_tag;
    return $mp3;
}

sub _massage_genres ($;$) {   # Thanks to neil verplank for the prototype
    require MP3::Tag::ID3v1;
    my($data, $how) = (shift, shift);
    my $firstnum = (($how || 0) eq 'num');
    my $prefer_num = (($how || 0) eq 'prefer_num');
    my (%seen, @genres);	# find all genres in incoming data
    $data = $data->[0] if ref $data;
    # clean and split line on both null and parentheses
    $data =~ s/\s+/ /g;
    $data =~ s/\s*\0[\0\s]*/\0/g;
    $data =~ s/^[\s\0]+//;
    $data =~ s/[\s\0]+$//;
    my @data = split m<\0|\s+/\s+>, $data;
    @data = split /\( ( \d+ | rx | cr ) \)/xi, $data[0] if @data == 1;

    # review array, produce a clean, ordered list of unique genres for output
    foreach my $genre (@data) {
        next if $genre eq "";  # (12)(13) ==> in front, and between

        # convert text to number to eliminate collisions, and produce consistent output
        if ($genre =~ /\D/) {{	# Not a pure number
            # return id number
            my $genre_num = MP3::Tag::ID3v1::genres($genre); 
            # 255 is "non-standard text" in ID3v1; pass the rest through
            last if $genre_num eq '255' or $genre_num eq '';
	    return $genre_num if $firstnum;
	    $genre = $genre_num, last if $prefer_num;
	    $genre_num = MP3::Tag::ID3v1::genres($genre_num);
            last unless defined $genre_num;
            $genre = $genre_num;
        }}	# Now converted to a number - if possible
        unless ($prefer_num or $genre =~ /\D/) {{ # Here $genre is a number
	    my $genre_str = MP3::Tag::ID3v1::genres($genre) or last;
	    return $genre if $firstnum;
            $genre = $genre_str;
        }}
        # 2.4 defines these conversions
        $genre = "Remix" if lc $genre eq "rx";
        $genre = "Cover" if lc $genre eq "cr";
        $genre = "($genre)" if length $genre and not $genre =~ /\D/;	# Only digits
        push @genres, $genre unless $seen{$genre}++;
    }
    return if $firstnum;
    @genres;
}

=item extension_is

  $mp3->extension_is(@EXT_LIST)

returns TRUE if the extension of the filename coincides (case-insensitive)
with one of the elements of the list.

=cut

sub extension_is ($@) {
  my ($self) = (shift);
  my $ext = lc($self->filename_extension_nodot());
  return 1 if grep $ext eq lc, @_;
  return;
}

sub DESTROY {
    my $self=shift;
    if (exists $self->{filename} and defined $self->{filename}) {
	$self->{filename}->close;
    }
}

sub parse_cfg_line ($$$) {
  my ($self, $line, $data) = (shift,shift,shift);
  return if $line =~ /^\s*(#|$)/;
  die "Unrecognized configuration file line: <<<$line>>>"