use
vars
qw /$VERSION
@ISA
/;
$VERSION
=
"0.95"
;
@ISA
=
'MP3::Tag::__hasparent'
;
sub
new_with_parent {
my
(
$class
,
$filename
,
$parent
) =
@_
;
return
undef
unless
-f
$filename
;
return
bless
{
filename
=>
$filename
,
parent
=>
$parent
},
$class
;
}
*new
= \
&new_with_parent
;
sub
DESTROY {
my
$self
=
shift
;
if
(
exists
$self
->{FH} and
defined
$self
->{FH}) {
$self
->
close
;
}
}
sub
filename {
shift
->{filename} }
sub
open
{
my
$self
=
shift
;
my
$mode
=
shift
;
if
(
defined
$mode
and
$mode
=~ /w/i) {
$mode
=O_RDWR;
}
else
{
$mode
=O_RDONLY;
}
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
{
my
(
$self
,
$data
) =
@_
;
if
(
exists
$self
->{FH}) {
local
$\ =
''
;
print
{
$self
->{FH}}
$data
;
}
}
sub
truncate
{
my
(
$self
,
$length
) =
@_
;
if
(
$length
<0) {
my
@stat
=
stat
$self
->{FH};
$length
=
$stat
[7] +
$length
;
}
if
(
exists
$self
->{FH}) {
truncate
$self
->{FH},
$length
;
}
}
sub
seek
{
my
(
$self
,
$pos
,
$whence
)=
@_
;
$self
->
open
unless
exists
$self
->{FH};
seek
$self
->{FH},
$pos
,
$whence
;
}
sub
tell
{
my
(
$self
,
$pos
,
$whence
)=
@_
;
return
undef
unless
exists
$self
->{FH};
return
tell
$self
->{FH};
}
sub
read
{
my
(
$self
,
$buf_
,
$length
) =
@_
;
$self
->
open
unless
exists
$self
->{FH};
return
read
$self
->{FH},
$$buf_
,
$length
;
}
sub
is_open {
return
exists
shift
->{FH};
}
*isOpen
= \
&is_open
;
sub
get_mp3_frame_header {
my
(
$self
,
$start
) =
@_
;
$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
;
$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}
}
*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
) =
@_
;
$filename
=
$self
->filename
unless
defined
$filename
;
my
$pathandfile
=
$filename
;
$self
->return_parsed(
$what
)
if
exists
$self
->{parsed_filename}
and
$self
->{parsed_filename} eq
$filename
;
my
$ext_rex
=
$self
->get_config(
'extension'
)->[0];
$pathandfile
=~ s/
$ext_rex
//;
$pathandfile
=~ s/ +/ /g;
my
(
$file
,
$path
) = fileparse(
$pathandfile
,
""
);
(
$path
) = fileparse(
$path
,
""
);
my
$orig_file
=
$file
;
unless
(
$file
=~/ /) {
my
$Ndot
=
$file
=~
tr
/././;
my
$Nunderscore
=
$file
=~
tr
/_/_/;
my
$Ndash
=
$file
=~
tr
/-/-/;
if
((
$Ndot
>
$Nunderscore
) && (
$Ndot
>1)) {
$file
=~ s/\./ /g;
}
elsif
(
$Nunderscore
> 1) {
$file
=~ s/_/ /g;
}
elsif
(
$Ndash
>2) {
$file
=~ s/-/ /g;
}
}
my
$partsep
=
" - "
;
unless
(
$file
=~ / - /) {
if
(
$file
=~ /-/) {
$partsep
=
"-"
;
}
elsif
(
$file
=~ /^\(.*\)/) {
$file
=~ s/^\((.*?)\)/$1 - /;
$file
=~ s/ +/ /;
$partsep
=
" - "
;
}
elsif
(
$file
=~ /_/) {
$partsep
=
"_"
;
}
else
{
$partsep
=
"DoesNotExist"
;
}
}
my
(
$title
,
$artist
,
$no
,
$album
,
$year
)=(
""
,
""
,
""
,
""
,
""
);
if
(
$file
=~ /^ *(\d+)[\W_]/) {
$no
=$1;
$file
=~ s/^ *\d+//;
$file
=~ s/^
$partsep
// ||
$file
=~ s/^.//;
$file
=~ s/^ +//;
}
$file
=~ s/_+/ /g
unless
$partsep
=~ /_/;
my
@parts
=
split
/
$partsep
/,
$file
;
if
(
@parts
== 1) {
$title
=
$parts
[0];
$no
=
$file
if
$title
and
$title
=~ /^\d{1,2}$/;
}
elsif
(
@parts
== 2) {
if
(
$parts
[0] =~ /^\d{1,2}$/) {
$no
=
$parts
[0];
$title
=
$file
;
}
elsif
(
$parts
[1] =~ /^\d{1,2}$/) {
$no
=
$parts
[1];
$title
=
$file
;
}
else
{
$artist
=
$parts
[0];
$title
=
$parts
[1];
}
}
elsif
(
@parts
> 2) {
my
$temp
=
""
;
$artist
=
shift
@parts
;
foreach
(
@parts
) {
if
(/^ *(\d+)\.? *$/) {
$artist
.=
$partsep
.
$temp
if
$temp
;
$temp
=
""
;
$no
=$1;
}
else
{
$temp
.=
$partsep
if
$temp
;
$temp
.=
$_
;
}
}
$title
=
$temp
;
}
$title
=~ s/ +$//;
$artist
=~ s/ +$//;
$no
=~ s/ +$//;
$no
= $+
if
not
$no
and
$title
=~ /^(\d+)?(?:audio|track|processed)\s*(\d+)?$/i and $+;
$no
=~ s/^0+//;
if
(
$path
) {
unless
(
$artist
) {
$artist
=
$path
;
}
else
{
$album
=
$path
;
}
}
$year
= $1
if
$title
=~ /\((\d{4})\)/ or
$artist
=~ /\((\d{4})\)/;
$self
->{parsed_filename} =
$filename
;
$self
->{parsed} = {
artist
=>
$artist
,
song
=>
$title
,
no
=>
$no
,
album
=>
$album
,
title
=>
$title
,
year
=>
$year
};
$self
->return_parsed(
$what
);
}
*song
= \
&title
;
sub
title {
my
$self
=
shift
;
return
$self
->parse_filename(
"title"
,
@_
);
}
sub
artist {
my
$self
=
shift
;
return
$self
->parse_filename(
"artist"
,
@_
);
}
sub
track {
my
$self
=
shift
;
return
$self
->parse_filename(
"track"
,
@_
);
}
sub
year {
my
$self
=
shift
;
my
$y
=
$self
->parse_filename(
"year"
,
@_
);
return
$y
if
length
$y
;
return
;
}
sub
album {
my
$self
=
shift
;
return
$self
->parse_filename(
"album"
,
@_
);
}
sub
comment {}
sub
genre {}
1;