File Coverage

blib/lib/Music/Tag/Generic.pm

Criterion	Covered	Total	%
statement	21	159	13.2
branch	0	42	0.0
condition	0	16	0.0
subroutine	7	26	26.9
pod	18	18	100.0
total	46	261	17.6

package Music::Tag::Generic;
use strict; use warnings; use utf8;
our $VERSION = '.4101';

# Copyright © 2007,2008,2009,2010 Edward Allen III. Some rights reserved.

#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
#

use Encode;
use vars qw($AUTOLOAD);
use Scalar::Util qw(weaken);
use Carp;

sub new {
    my $class   = shift;
    my $parent  = shift;
    my $options = shift || {};
    my $self    = {};
    bless $self, $class;
    $self->info($parent);
    $self->options($options);
    return $self;
}

sub info {
    my $self = shift;
    my $val  = shift;
    if ( defined $val && ref $val ) {
        $self->{info} = $val;
        weaken $self->{info};
    }
    return $self->{info};
}

sub required_values {
}

sub set_values {
}

sub saved_values {
}

sub get_tag {
}

sub set_tag {
}

sub strip_tag {
}

sub close {
}

sub tagchange {
    my $self = shift;
    my $tag  = lc(shift);
    my $to   = shift || $self->info->get_data($tag) || "";
    $self->status( $self->info->_tenprint( $tag, 'bold blue', 15 ) . '"' . $to . '"' );
    return $self->info->changed(1);
}

sub simplify {
    my $self = shift;
    my $text = shift;
    chomp $text;
    return $text unless $text;

    if ( $self->options->{Unaccent} ) {
        $text = Text::Unaccent::PurePerl::unac_string($text);
    }

    $text = lc($text);

    $text =~ s/\[[^\]]+\]//g;
    $text =~ s/[\s_]/ /g;

    if ( length($text) > 5 ) {
        $text =~ s/\bthe\s//g;
        $text =~ s/\ba\s//g;
        $text =~ s/\ban\s//g;
        $text =~ s/\band\s//g;
        $text =~ s/\ble\s//g;
        $text =~ s/\bles\s//g;
        $text =~ s/\bla\s//g;
        $text =~ s/\bde\s//g;
    }
    if ( $self->options->{Inflect} ) {
        $text =~ s/(\.?\d+\,?\d*\.?\d*)/Lingua::EN::Inflect::NUMWORDS($1)/egxms;
    }
    else {
        $text =~ s/\b10\s/ten /g;
        $text =~ s/\b9\s/nine /g;
        $text =~ s/\b8\s/eight /g;
        $text =~ s/\b7\s/seven /g;
        $text =~ s/\b6\s/six /g;
        $text =~ s/\b5\s/five /g;
        $text =~ s/\b4\s/four /g;
        $text =~ s/\b3\s/three /g;
        $text =~ s/\b2\s/two /g;
        $text =~ s/\b1\s/one /g;
    }

    $text =~ s/\sii\b/two/g;
    $text =~ s/\siii\b/three/g;
    $text =~ s/\siv\b/four/g;
    $text =~ s/\sv\b/five/g;
    $text =~ s/\svi\b/six/g;
    $text =~ s/\svii\b/seven/g;
    $text =~ s/\sviii\b/eight/g;

    # Don't translate IX because of a soft spot in my heart for the technologically rich planet.

    $text =~ s/[^a-z0-9]//g;
    return $text;
}

sub simple_compare {
    my $self            = shift;
    my $a               = shift;
    my $b               = shift;
    my $similar_percent = shift;
    my $crop_percent    = shift;

    my $sa = $self->simplify($a);
    my $sb = $self->simplify($b);
    if ( $sa eq $sb ) {
        return 1;
    }

    return unless ( $similar_percent || $crop_percent );

    my $la  = length($sa);
    my $lb  = length($sb);
    my $max = ( $la < $lb ) ? $lb : $la;
    my $min = ( $la < $lb ) ? $la : $lb;

    return unless ( $min and $max );

    my $dist = undef;
    if ( $self->options->{LevenshteinXS} ) {
        $dist = Text::LevenshteinXS::distance( $sa, $sb );
    }
    elsif ( $self->options->{Levenshtein} ) {
        $dist = Text::Levenshtein::distance( $sa, $sb );
    }
    unless ($crop_percent) {
        $crop_percent = $similar_percent * ( 2 / 3 );
    }

    if ( ( defined $dist ) && ( ( ( $min - $dist ) / $min ) >= $similar_percent ) ) {
        return -1;
    }

    if ( $min < 10 ) {
        return 0;
    }
    if ( ( ( ( 2 * $min ) - $max ) / $min ) <= $crop_percent ) {
        return 0;
    }
    if ( substr( $sa, 0, $min ) eq substr( $sb, 0, $min ) ) {
        return -1;
    }
    return 0;
}

sub status {
    my $self = shift;
    $self->info->status( ref($self), @_ );
	return;
}

sub error {
    my $self = shift;
    carp( ref($self), " ", @_ );
	return;
}

sub changed {
    my $self = shift;
    return $self->info->changed(@_);
}

sub wav_out {
    my $self = shift;
    my $fh   = shift;
    if ( $self->options->{wav_out_system} ) {
        my @sys = ();
        foreach ( @{ $self->options->{wav_out_system} } ) {
            my $a = $_;
            $a =~ s/\[FILENAME\]/$self->info->get_data('filename')/ge;
            push @sys, $a;
        }
        $self->status( 0, "Executing ", join( " ", @sys ) );
		my $in;
        if ( open( $in, '-|', @sys ) ) {
            binmode $in;
            binmode $fh;
            my $buffer = "";
            while ( my $count = sysread( $in, $buffer, 1024 ) ) {
                my $wrote = 0;
                while ( $wrote < $count ) {
                    $wrote += syswrite( $fh, $buffer, ( $count - $wrote ), $wrote );
                }
                $buffer = "";
            }
            return 1;
        }
		CORE::close($in);
        return 0;
    }
    return;
}

sub options {
    my $self = shift;
    unless ( exists $self->{_options} ) {
        $self->{_options} = Config::Options->new( $self->default_options );
    }
    return $self->{_options}->options(@_);
}

sub default_options { return {} }

sub DESTROY {
    my $self = shift;
    if ( exists $self->{info} ) {
		delete $self->{info};
    }
	return;
}

1;

__END__