view release on metacpan or  search on metacpan

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

package MP3::Tag::File;

use strict;
use Fcntl;
use File::Basename;
use vars qw /$VERSION @ISA/;

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

=pod

=head1 NAME

MP3::Tag::File - Module for reading / writing files

=head1 SYNOPSIS

  my $mp3 = MP3::Tag->new($filename);

  ($title, $artist, $no, $album, $year) = $mp3->parse_filename();

see L<MP3::Tag>

=head1 DESCRIPTION

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

It offers possibilities to read/write data from files via read(), write(),
truncate(), seek(), tell(), open(), close(); one can find the filename via
the filename() method.

=cut


# Constructor

sub new_with_parent {
    my ($class, $filename, $parent) = @_;
    return undef unless -f $filename or -c $filename;
    return bless {filename => $filename, parent => $parent}, $class;
}
*new = \&new_with_parent;	# Obsolete handler

# Destructor

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

# File subs

sub filename { shift->{filename} }

sub open {
    my $self=shift;
    my $mode= shift;
    if (defined $mode and $mode =~ /w/i) {
	$mode=O_RDWR;    # read/write mode
    } else {
	$mode=O_RDONLY;  # read only mode
    }
    unless (exists $self->{FH}) {
	local *FH;
	if (sysopen (FH, $self->filename, $mode)) {
	    $self->{FH} = *FH;
	    binmode $self->{FH};
	} else {
	    warn "Open `" . $self->filename() . "' failed: $!\n";
	}
    }
    return exists $self->{FH};
}


sub close {
    my $self=shift;
    if (exists $self->{FH}) {
	close $self->{FH};
	delete $self->{FH};
    }
}

sub write {

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

    $start = 0 unless $start;

    if (exists $self->{mp3header}) {
	return $self->{mp3header};
    }

    $self->seek($start, 0);
    my ($data, $bits)="";
    while (1) {
	my $nextdata;
	$self->read(\$nextdata, 512);
	return unless $nextdata; # no header found
	$data .= $nextdata;
	if ($data =~ /(\xFF[\xE0-\xFF]..)/) {
	    $bits = unpack("B32", $1);
	    last;
	}
	$data = substr $data, -3
    }

    my @fields;
    for (qw/11 2 2 1 4 2 1 1 1 2 2 1 1 2/) {
	push @fields, oct "0b" . substr $bits, 0, $_;
	$bits = substr $bits, $_ if length $bits > $_;
    }

    $self->{mp3header}={};
    for (qw/sync version layer proctection bitrate_id sampling_rate_id padding private
	 channel_mode mode_ext copyright original emphasis/) {
	$self->{mp3header}->{$_}=shift @fields;
    }

    return $self->{mp3header}
}


# use filename to determine information about song/artist/album

=pod

=over 4

=item parse_filename()

  ($title, $artist, $no, $album, $year) = $mp3->parse_filename($what, $filename);

parse_filename() tries to extract information about artist, title,
track number, album and year from the filename.  (For backward
compatibility it may be also called by deprecated name
read_filename().)

This is likely to fail for a lot of filenames, especially the album will
be often wrongly guessed, as the name of the parent directory is taken as
album name.

$what and $filename are optional. $what maybe title, track, artist, album
or year. If $what is defined parse_filename() will return only this element.

If $filename is defined this filename will be used and not the real
filename which was set by L<MP3::Tag> with
C<MP3::Tag-E<gt>new($filename)>.  Otherwise the actual filename is used
(subject to configuration variable C<decode_encoding_filename>).

Following formats will be hopefully recognized:

- album name/artist name - song name.mp3

- album_name/artist_name-song_name.mp3

- album.name/artist.name_song.name.mp3

- album name/(artist name) song name.mp3

- album name/01. artist name - song name.mp3

- album name/artist name - 01 - song.name.mp3

If artist or title end in C<(NUMBER)> with 4-digit NUMBER, it is considered
the year.

=cut

*read_filename = \&parse_filename;

sub return_parsed {
    my ($self,$what) = @_;
    if (defined $what) {
	return $self->{parsed}{album}  if $what =~/^al/i;
	return $self->{parsed}{artist} if $what =~/^a/i;
	return $self->{parsed}{no}     if $what =~/^tr/i;
	return $self->{parsed}{year}   if $what =~/^y/i;
	return $self->{parsed}{title};
    }

    return $self->{parsed} unless wantarray;
    return map $self->{parsed}{$_} , qw(title artist no album year);
}

sub parse_filename {
    my ($self,$what,$filename) = @_;
    unless (defined $filename) {
      $filename = $self->filename;
      my $e;
      if ($e = $self->get_config('decode_encoding_filename') and $e->[0]) {
	require Encode;
	$filename = Encode::decode($e->[0], $filename);
      }
    }
    my $pathandfile = $filename;

    $self->return_parsed($what)	if exists $self->{parsed_filename}
				   and $self->{parsed_filename} eq $filename;

    # prepare pathandfile for easier use
    my $ext_rex = $self->get_config('extension')->[0];
    $pathandfile =~ s/$ext_rex//;		# remove extension
    $pathandfile =~ s/ +/ /g; # replace several spaces by one space

    # Keep two last components of the file name
    my ($file, $path) = fileparse($pathandfile, "");
    ($path) = fileparse($path, "");