view release on metacpan or  search on metacpan

lib/MPEG/ID3v2Tag.pm  view on Meta::CPAN

    }
    else {
        print $self->frameid(), " (no dump method)\n";
    }
}

###############################################################################
# MPEG::ID3Frame::Text
#    MPEG::ID3Frame::TALB
#    MPEG::ID3Frame::TBPM
#    MPEG::ID3Frame::TCOM
#                ... and so on for all T??? frame types.
#
#  This class is derived from MPEG::ID3Frame, and from this is derived all the
# MPEG::ID3Frame::T??? fields.   It is not useful on its own.
#
# This section of the file will also create derived classes for all the
# Text types (TALB, TBPM, etc).  Note that TEXT is not the same as Text.
###############################################################################
package MPEG::ID3Frame::Text;
use Carp;

use vars '@ISA';

@ISA = qw(MPEG::ID3Frame);

sub new {
    my $package = shift;
    my $self;
    if ( @_ == 1 ) {
        $self = {
            ENCODING => 0,
            DATA     => $_[0]
        };
    }
    elsif ( @_ == 2 ) {
        $self = {
            ENCODING => $_[0],
            DATA     => $_[1]
        };
    }
    else {
        croak "Wrong # arguments to MPEG::ID3Frame::Text::new\n";
    }
    bless $self, $package;
}

####
# Given the body portion of a text-type tag, parse out the encoding and data
# portions.
####
sub parse_data {
    my ( $self, $data ) = @_;

    #  ($self->{ENCODING}, $self->{DATA}) = unpack("CZ*", $data) ;
    $self->{ENCODING} = unpack( "C", substr( $data, 0, 1 ) );

    if ( $self->{ENCODING} == 0 ) {
        $self->{DATA} = unpack( "Z*", substr( $data, 1 ) );
    }
    elsif ( $self->{ENCODING} == 1 ) {    ##with BOM
        ######## a really dirty hack to change the UNICODE to normal ISO-8859-1  this will of course
        ######## destroy the real unicode. so no need to write a UNICODE back to file
        my @text_as_list;
        $self->{BOM} = unpack( "n", substr( $data, 1, 2 ) );
        if ( $self->{BOM} == 0xfeff ) {
            @text_as_list = unpack( "n*", substr( $data, 3 ) );
        }
        else {
            @text_as_list = unpack( "v*", substr( $data, 3 ) );
        }
        $self->{DATA} = pack( "C*", @text_as_list );
        $self->{ENCODING} = 0;    ## now
    }
    elsif ( $self->{ENCODING} == 2 ) {    #no BOM here   ##never tested
        ######## a really dirty hack to change the UNICODE to normal ISO-8859-1  this will of course
        ######## destroy the real unicode. so no need to write a UNICODE back to file

        ## I hope this n is working for ENCODING type 2. else change to back to v like type 1
        my @text_as_list;
        @text_as_list = unpack( "v*", substr( $data, 1 ) );
        $self->{DATA} = pack( "C*", @text_as_list );
        $self->{ENCODING} = 0;    ## now
    }
    elsif ( $self->{ENCODING} == 3 ) {    ##never tested
        my @text_as_list;
        @text_as_list = unpack( "U*", substr( $data, 1 ) );
        $self->{DATA} = pack( "C*", @text_as_list );
        $self->{ENCODING} = 0;    ## now
    }
}

sub encoding { return $_[0]->{ENCODING} }
sub text     { return $_[0]->{DATA} }

####
# Override for MPEG::ID3Frame::frameid().  returns the frame id, the
# four-letter word identifying the frame type.
####
sub frameid {
    my ($self) = @_;
    my $frameid = ref $self;
    $frameid =~ s/^.*:://;
    if ( $frameid eq 'Text' || $frameid eq 'Url' ) {
        confess "Must get frameid() from a derived class";
    }
    return $frameid;
}

####
# Return the data portion of this frame, formatted as a binary string.
####
sub data_as_string {
    my ($self) = @_;

    # zero for encoding=latin-1, and the rest is just the text, nul-terminated.
    return pack( "CZ*", $self->{ENCODING}, $self->{DATA} );
}

sub dump {
    my $self = shift;
    print $self->frameid(), " (enc=", $self->encoding, ") ", $self->text, "\n";
}

# automatically derive a ton of classes from this one.
my @derived_frameids = qw(
    TALB TBPM TCOM TCON TCOP TDAT TDLY TENC TEXT TFLT TIME TIT1 TIT2 
    TIT3 TKEY TLAN TLEN TMED TOAL TOFN TOLY TOPE TORY TOWN TPE1 TPE2 
    TPE3 TPE4 TPOS TPUB TRCK TRDA TRSN TRSO TSIZ TSRC TSSE TYER
);

my $evalstr;
for my $frameid (@derived_frameids) {
    $evalstr .= <<EOT
    \@MPEG::ID3Frame\::$frameid\::ISA = qw(MPEG::ID3Frame::Text) ;

lib/MPEG/ID3v2Tag.pm  view on Meta::CPAN

use vars '@ISA';
@ISA = qw(MPEG::ID3Frame);
use Carp;

sub frameid () { return "USER" }

sub new {
    my ( $package, $encoding, $language, $text ) = @_;
    croak "language must be a three letter code" if length($language) != 3;
    my $self = {
        ENCODING => $encoding,
        LANGUAGE => $language,
        TEXT     => $text
    };
    bless $self, $package;
}

sub data_as_string {
    my $self = shift;

    return pack( "Ca3a*", $self->{ENCODING}, $self->{LANGUAGE}, $self->{TEXT} );
}

##############################################################################
# MPEG::ID3Frame::COMM
#  comment frame.
##############################################################################
package MPEG::ID3Frame::COMM;
use Carp;
use vars '@ISA';
@ISA = qw(MPEG::ID3Frame);
use Carp;

sub frameid () { return "COMM" }

sub new {
    my ( $package, $encoding, $language, $description, $text ) = @_;
    croak "language must be a three letter code" if length($language) != 3;
    my $self = {
        ENCODING    => $encoding,
        LANGUAGE    => $language,
        DESCRIPTION => $description,
        TEXT        => $text
    };
    bless $self, $package;
}

sub parse_data {
    my ( $self, $data ) = @_;

    ( $self->{ENCODING}, $self->{LANGUAGE} ) = unpack( "Ca3", substr( $data, 0, 4 ) );

    my $textpos = index( $data, "\0", 4 ) + 1;
    my $desc = substr( $data, 4, $textpos - 5 );
    my $text = substr( $data, $textpos );

    if ( $self->{ENCODING} == 0 ) {
        $self->{DESCRIPTION} = $desc;
        $self->{TEXT}        = $text;
    }
    elsif ( $self->{ENCODING} == 1 ) {    ##with BOM
        ######## a really dirty hack to change the UNICODE to normal ISO-8859-1  this will of course
        ######## destroy the real unicode. so no need to write a UNICODE back to file
        my @text_as_list_t;
        my @text_as_list_d;

        $self->{BOM} = unpack( "n", substr( $data, 1, 2 ) );
        if ( $self->{BOM} == 0xfeff ) {
            @text_as_list_t = unpack( "n*", substr( $text, 2 ) );
            @text_as_list_d = unpack( "n*", substr( $desc, 2 ) );
        }
        else {
            @text_as_list_t = unpack( "v*", $text );
            @text_as_list_d = unpack( "v*", $desc );
        }
        $self->{DESCRIPTION} = pack( "C*", @text_as_list_d );
        $self->{TEXT}        = pack( "C*", @text_as_list_t );
        $self->{ENCODING} = 0;    ## now
    }

}

sub data_as_string {
    my $self = shift;

    return pack( "Ca3a*", $self->{ENCODING}, $self->{LANGUAGE}, $self->{DESCRIPTION} . "\0" . $self->{TEXT} );
}

##############################################################################
# MPEG::ID3Frame::WXXX
#  User defined URL link frame
##############################################################################
package MPEG::ID3Frame::WXXX;
use Carp;
use vars '@ISA';
@ISA = qw(MPEG::ID3Frame);
use Carp;

sub frameid () { return "WXXX" }

sub new {
    my ( $package, $encoding, $description, $url ) = @_;
    my $self = {
        ENCODING    => $encoding,
        DESCRIPTION => $description,
        URL         => $url
    };
    bless $self, $package;
}

sub parse_data {
    my ( $self, $data ) = @_;
    my $desc_url;

    ( $self->{ENCODING}, $desc_url ) = unpack( "Ca*", $data );
    ( $self->{DESCRIPTION}, $self->{URL} ) = split( "\0", $desc_url );
}

sub encoding    { return $_[0]->{ENCODING} }
sub description { return $_[0]->{DESCRIPTION} }
sub url         { return $_[0]->{URL} }

sub data_as_string {
    my $self = shift;

    return pack( "Ca*", $self->{ENCODING}, $self->{DESCRIPTION} . "\0" . $self->{URL} );
}