view release on metacpan or  search on metacpan

lib/MP3/M3U/Parser.pm  view on Meta::CPAN

sub new {
    # -parse_path -seconds -search -overwrite
    my($class, @args) = @_;
    my %o    = @args % 2 ? () : @args; # options
    my $self = {
        _M3U_         => [], # for parse()
        TOTAL_FILES   =>  0, # Counter
        TOTAL_TIME    =>  0, # In seconds
        TOTAL_SONGS   =>  0, # Counter
        AVERAGE_TIME  =>  0, # Counter
        ACOUNTER      =>  0, # Counter
        ANON          =>  0, # Counter for SCALAR & GLOB M3U
        INDEX         =>  0, # index counter for _M3U_
        EXPORTF       =>  0, # Export file name counter for anonymous exports
        seconds       => $o{'-seconds'}    || EMPTY_STRING, # format or get seconds.
        search_string => $o{'-search'}     || EMPTY_STRING, # search_string
        parse_path    => $o{'-parse_path'} || EMPTY_STRING, # mixed list?
        overwrite     => $o{'-overwrite'}  ||            0, # overwrite export file if exists?
        encoding      => $o{'-encoding'}   || EMPTY_STRING, # leave it to export() if no param
        expformat     => $o{'-expformat'}  || EMPTY_STRING, # leave it to export() if no param
        expdrives     => $o{'-expdrives'}  || EMPTY_STRING, # leave it to export() if no param
    };
    my $s = $self->{search_string};
    if ( $s && length $s < MINIMUM_SEARCH_LENGTH ) {
        croak 'A search string must be at least three characters long';
    }
    bless  $self, $class;
    return $self;
}

sub parse {
    my($self, @files) = @_;

    foreach my $file ( @files ) {
        $self->_parse_file(
            ref $file ? $file
                      : do {
                            my $new = $self->_locate_file( $file );
                            croak "$new does not exist" if ! -e $new;
                            $new;
                        }
        );
    }

    # Average time of all the parsed songs:
    my($ac, $tt)          = ( $self->{ACOUNTER}, $self->{TOTAL_TIME} );
    $self->{AVERAGE_TIME} = ($ac && $tt) ? $self->_seconds( $tt / $ac ) : 0;
    return defined wantarray ? $self : undef;
}

sub _check_parse_file_params {
    my($self, $file) = @_;

    my $ref = ref $file;
    if ( $ref && $ref ne 'GLOB' && $ref ne 'SCALAR' ) {
        croak "Unknown parameter of type '$ref' passed to parse()";
    }

    my $cd;
    if ( ! $ref ) {
        my @tmp = split m{[\\/]}xms, $file;
        ($cd = pop @tmp) =~ s{ [.] m3u }{}xmsi;
    }

    my $this_file = $ref ? 'ANON'.$self->{ANON}++ : $self->_locate_file($file);

    $self->{'_M3U_'}[ $self->{INDEX} ] = {
        file  => $this_file,
        list  => $ref ? $this_file : ($cd || EMPTY_STRING),
        drive => DEFAULT_DRIVE,
        data  => [],
        total => 0,
    };

    $self->{TOTAL_FILES} += 1; # Total lists counter

    my($fh, @fh);
    if ( $ref eq 'GLOB' ) {
        $fh = $file;
    }
    elsif ( $ref eq 'SCALAR' ) {
        @fh = split m{\n}xms, ${$file};
    }
    else {
        # Open the file to parse:
        require IO::File;
        $fh = IO::File->new;
        $fh->open( $file, '<' ) or croak "I could't open '$file': $!";
    }
    return $ref, $fh, @fh;
}

sub _validate_m3u {
    my($self, $next, $ref, $file) = @_;
    PREPROCESS: while ( my $m3u = $next->() ) {
        # First line is just a comment. But we need it to validate
        # the file as a m3u playlist file.
        chomp $m3u;
        last PREPROCESS if $m3u =~ RE_M3U_HEADER;
        croak $ref ? "The '$ref' parameter does not contain valid m3u data"
                   : "'$file' is not a valid m3u file";
    }
    return;
}

sub _iterator {
    my($self, $ref, $fh, @fh) = @_;
    return $ref eq 'SCALAR' ? sub { return shift @fh } : sub { return <$fh> };
}

sub _extract_path {
    my($self, $i, $m3u, $device_ref, $counter_ref) = @_;

    if ( $m3u =~ RE_DRIVE_PATH  ||
         $m3u =~ RE_NORMAL_PATH ||
         $m3u =~ RE_PARTIAL_PATH
        ) {
        # Get the drive and path info.
        my $path   = $1;
        $i->[PATH] = $self->{parse_path} eq 'asis' ? $m3u : $path;
        if ( ${$device_ref} eq DEFAULT_DRIVE && $m3u =~ m{ \A (\w:) }xms ) {
            ${$device_ref} = $1;
        }
        ${ $counter_ref }++;
    }
    return;
}

sub _extract_artist_song {
    my($self, $i) = @_;
    # Try to extract artist and song info
    # and remove leading and trailing spaces
    # Some artist names can also have a "-" in it.
    # For this reason; require that the data has " - " in it.
    # ... but the spaces can be one or more.
    # So, things like "artist-song" does not work...
    my($artist, @xsong) = split m{\s{1,}-\s{1,}}xms, $i->[ID3] || $i->[PATH];
    if ( $artist ) {
        $artist = $self->_trim( $artist );
        $artist =~ s{.*[\\/]}{}xms; # remove path junk
        $i->[ARTIST] = $artist;
    }
    if ( @xsong ) {
        my $song = join q{-}, @xsong;
        $song = $self->_trim( $song );
        $song =~ s{ [.] [a-zA-Z0-9]+ \z }{}xms; # remove extension if exists
        $i->[SONG] = $song;
    }
    return;
}

sub _initialize {
    my($self, $i);
    foreach my $CHECK ( 0..MAXDATA ) {
        $i->[$CHECK] = EMPTY_STRING if ! defined $i->[$CHECK];
    }
    return;
}

sub _parse_file {
    # supports disk files, scalar variables and filehandles (typeglobs)
    my($self, $file)   = @_;
    my($ref, $fh, @fh) = $self->_check_parse_file_params( $file );
    my $next           = $self->_iterator( $ref, $fh, @fh );

    $self->_validate_m3u( $next, $ref, $file );

    my $dkey   =  $self->{_M3U_}[ $self->{INDEX} ]{data};  # data key
    my $device = \$self->{_M3U_}[ $self->{INDEX} ]{drive}; # device letter

    # These three variables are used when there is a '-search' parameter.
    # long: total_time, total_songs, total_average_time
    my($ttime,$tsong,$taver) = (0,0,0);
    my $index = 0; # index number of the list array
    my $temp_sec;  # must be defined outside

    RECORD: while ( my $m3u = $next->() ) {
        chomp $m3u;
        next if ! $m3u; # Record may be blank if it is not a disk file.
        $#{$dkey->[$index]} = MAXDATA; # For the absence of EXTINF line.
        # If the extra information exists, parse it:
        if ( $m3u =~ RE_INF_HEADER ) {
            my($j, $sec, @song);
            ($j ,@song) = split m{\,}xms, $m3u;
            ($j ,$sec)  = split m{:}xms, $j;
            $temp_sec   = $sec;
            $ttime     += $sec;
            $dkey->[$index][ID3] = join q{,}, @song;
            $dkey->[$index][LEN] = $self->_seconds($sec || 0);
            $taver++;
            next RECORD; # jump to path info
        }

        my $i = $dkey->[$index];
        $self->_extract_path(        $i, $m3u, $device, \$tsong );
        $self->_extract_artist_song( $i );
        $self->_initialize(          $i );

        # If we are searching something:
        if ( $self->{search_string} ) {
            my $matched = $self->_search( $i->[PATH], $i->[ID3] );
            if ( $matched ) {
                $index++; # if we got a match, increase the index
            }
            else {
                # if we didnt match anything, resize these counters ...
                $tsong--;
                $taver--;
                $ttime -= $temp_sec;
                delete $dkey->[$index]; # ... and delete the empty index
            }
        }
        else {
            $index++; # If we are not searching, just increase the index
        }
    }

    $fh->close if ! $ref;
    return $self->_set_parse_file_counters( $ttime, $tsong, $taver );
}

sub _set_parse_file_counters {
    my($self, $ttime, $tsong, $taver) = @_;

    # Calculate the total songs in the list:
    my $k = $self->{_M3U_}[ $self->{INDEX} ];
    $k->{total} = @{ $k->{data} };

    # Adjust the global counters:
    $self->{TOTAL_FILES}-- if $self->{search_string} && $k->{total} == 0;
    $self->{TOTAL_TIME}  += $ttime;
    $self->{TOTAL_SONGS} += $tsong;
    $self->{ACOUNTER}    += $taver;
    $self->{INDEX}++;

    return $self;
}

sub reset { ## no critic (ProhibitBuiltinHomonyms)
    # reset the object
    my $self   = shift;
    my @zeroes = qw(
        TOTAL_FILES
        TOTAL_TIME
        TOTAL_SONGS