view release on metacpan or  search on metacpan

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

Checks that extension is (case-insensitively) in the list given by
configuration variable C<writable_extensions>.

=cut

sub can_write ($) {
    my $self = shift;
    my @wr = @{ $self->get_config('is_writable') };	# Make copy
    return $wr[0] if @wr == 1 and not $wr[0] =~ /\D/;
    my $meth = shift @wr;
    $self->$meth(@wr);
}

sub writable_by_extension ($) {
    my $self = shift;
    my $wr = $self->get_config('writable_extensions');	# Make copy
    $self->extension_is(@$wr);
}

sub die_cant_write ($$) {
    my($self, $what) = (shift, shift);
    die $what, $self->interpolate("File %F is not writable per `is_writable' confuration variable, current value is `"),
		join(', ', @{$self->get_config('is_writable')}), "'";
}

sub can_write_or_die ($$) {
    my($self, $what) = (shift, shift);
    my $wr = $self->can_write;
    return $wr if $wr;
    $self->die_cant_write($what);
}

=item update_tags( [ $data,  [ $force2 ]] )

  $mp3 = MP3::Tag->new($filename);
  $mp3->update_tags();			# Fetches the info, and updates tags

  $mp3->update_tags({});		# Updates tags if needed/changed

  $mp3->update_tags({title => 'This is not a song'});	# Updates tags

This method updates ID3v1 and ID3v2 tags (the latter only if in-memory copy
contains any data, or $data does not fit ID3v1 restrictions, or $force2
argument is given)
with the the information about title, artist, album, year, comment, track,
genre from the hash reference $data.  The format of $data is the same as
one returned from autoinfo() (with or without the optional argument 'from').
The fields which are marked as coming from ID3v1 or ID3v2 tags are not updated
when written to the same tag.

If $data is not defined or missing, C<autoinfo('from')> is called to obtain
the data.  Returns the object reference itself to simplify chaining of method
calls.

This is probably the simplest way to set data in the tags: populate
$data and call this method - no further tinkering with subtags is
needed.

=cut

sub update_tags {
    my ($mp3, $data, $force2, $wr2) = (shift, shift, shift);

    $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;