view release on metacpan or  search on metacpan

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

    my $encoding  = $opt{'-encoding'}  || $self->{encoding}    || $DEFAULT{encoding };
    my $drives    = $opt{'-drives'}    || $self->{expdrives}   || $DEFAULT{drives   };
    my $overwrite = $opt{'-overwrite'} || $self->{overwrite}   || $DEFAULT{overwrite};
    my $to_scalar = $opt{'-toscalar'}  || $self->{exptoscalar} || $DEFAULT{toscalar };
    my $file      = $opt{'-file'}      || $self->_default_filename( $format );

    $file = $self->_locate_file($file) if ! $to_scalar;
    my $OUTPUT = $format eq 'xml'
               ? $self->_export_to_xml(  $encoding )
               : $self->_export_to_html( $encoding, $drives, $to_scalar, $file)
               ;

    if ( $to_scalar ) {
        ${$to_scalar} = $OUTPUT;
    }
    else {
        my $fh = $self->_check_export_params( $file, $to_scalar, $overwrite );
        print {$fh} $OUTPUT or croak "Can't print to FH: $!";
        $fh->close;
    }

   $self->{EXPORTF}++;
   return $self if defined wantarray;
   return;
}

sub _default_filename {
    my($self, $format) = @_;
    croak 'Export format is missing' if ! $format;
    return sprintf $DEFAULT{filename}, $self->{EXPORTF}, $format;
}

sub _check_export_params {
    my($self, $file, $to_scalar, $overwrite) = @_;
    my $fh;
    if ( $to_scalar && ( ! ref $to_scalar || ref $to_scalar ne 'SCALAR' ) ) {
        croak '-toscalar must be a SCALAR reference';
    }
    if ( ! $to_scalar ) {
        if ( -e $file && ! $overwrite ) {
           croak "The export file '$file' exists & overwrite option is not set";
        }
        require IO::File;
        $fh = IO::File->new;
        $fh->open( $file, '>' )
            or croak "I can't open export file '$file' for writing: $!";
    }
    return $fh;
}

sub _export_to_html {
    my($self, $encoding, $drives, $to_scalar, $file) = @_;
    my $OUTPUT = EMPTY_STRING;
    # I don't think that weird numbers in the html mean anything 
    # to anyone. So, if you didn't want to format seconds in your 
    # code, I'm overriding it here (only for export(); Outside 
    # export(), you'll get the old value):
    my $old_seconds = $self->{seconds};
    $self->{seconds} = 'format';
    my %t;
    @t{ qw( up cd data down ) } = split m{\Q<!-- MP3DATASPLIT -->\E}xms,
                                        $self->_template;
    foreach (keys %t) {
        $t{$_} = $self->_trim( $t{$_} );
    }
    my $tmptime = $self->{TOTAL_TIME} ? $self->_seconds($self->{TOTAL_TIME})
                :                       undef;
    my @tmptime;

    if ($tmptime) {
        @tmptime = split m{:}xms,$tmptime;
        unshift @tmptime, 'Z' if $#tmptime <= 1;
    }

    my $average = $self->{AVERAGE_TIME}
                ? $self->_seconds( $self->{AVERAGE_TIME} )
                : '<i>Unknown</i>'
                ;

    my $HTML = {
        ENCODING    => $encoding,
        SONGS       => $self->{TOTAL_SONGS},
        TOTAL       => $self->{TOTAL_FILES},
        AVERTIME    => $average,
        FILE        => $to_scalar ? EMPTY_STRING : $self->_locate_file($file),
        TOTAL_FILES => $self->{TOTAL_FILES},
        TOTAL_TIME  => @tmptime ? [ @tmptime ]   : EMPTY_STRING,
    };

    $OUTPUT .= $self->_tcompile(template => $t{up}, params=> {HTML => $HTML});
    my($song,$cdrom, $dlen);
    foreach my $cd (@{ $self->{'_M3U_'} }) {
        next if($#{$cd->{data}} < 0);
        $cdrom .= "$cd->{drive}\\" if $drives ne 'off';
        $cdrom .= $cd->{list};
        $OUTPUT .= sprintf $t{cd}."\n", $cdrom;
        foreach my $m3u (@{ $cd->{data} }) {
            $song = $m3u->[ID3];
            if ( ! $song ) {
                my @test_path = split /\\/xms, $m3u->[PATH];
                my $tp        = pop @test_path || $m3u->[PATH];
                my @test_file = split /\./xms, $song;
                $song         = $test_file[0] || $tp;
            }
            $dlen = $m3u->[LEN] ? $self->_seconds($m3u->[LEN]) : '&nbsp;';
            $song = $song       ? $self->_escape($song)        : '&nbsp;';
            $OUTPUT .= sprintf "%s\n", $self->_tcompile(
                                            template => $t{data},
                                            params   => {
                                                data => {
                                                    len  => $dlen,
                                                    song => $song,
                                                }
                                            }
                                        );
        }
        $cdrom = EMPTY_STRING;
    }
    $OUTPUT .= $t{down};
    $self->{seconds} = $old_seconds; # restore
    return $OUTPUT;
}

sub _export_to_xml {
    my($self, $encoding) = @_;
    my $OUTPUT = EMPTY_STRING;
    $self->{TOTAL_TIME} = $self->_seconds($self->{TOTAL_TIME})
                                if $self->{TOTAL_TIME} > 0;
    $OUTPUT .= sprintf qq~<?xml version="1.0" encoding="%s" ?>\n~, $encoding;
    $OUTPUT .= sprintf qq~<m3u lists="%s" songs="%s" time="%s" average="%s">\n~,
                       $self->{TOTAL_FILES},