File Coverage

blib/lib/Music/Tag.pm

Criterion	Covered	Total	%
statement	49	51	96.0
branch			n/a
condition			n/a
subroutine	17	17	100.0
pod			n/a
total	66	68	97.0

package Music::Tag;
use strict; use warnings; use utf8;
our $VERSION = '0.4103';

# 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 Carp;
use Locale::Country;
use File::Spec;
use Encode;
use Config::Options;
use Digest::SHA1;
use Time::Local;
use IO::File;
use IO::Dir;
use File::stat;
use File::Slurp;
use Readonly;
use Music::Tag::Generic;
use DateTimeX::Easy;

use utf8;

#use vars qw(%DataMethods);
my %DataMethods;
my $DefaultOptions;
my @PLUGINS;
my $PBP_METHODS = 1;
my $TRADITIONAL_METHODS = 1;
my %METHODS = ();
my ( $SHA1_SIZE, $SLURP_SIZE, $TENPRINT_SIZE );
Readonly::Scalar $SHA1_SIZE     => 4 * 4096;
Readonly::Scalar $SLURP_SIZE    => 1024;
Readonly::Scalar $TENPRINT_SIZE => 12;
sub default_options {
    my $self = shift;
    return $DefaultOptions;
}

sub LoadOptions {
    my $self    = shift;
    my $optfile = shift;
    if ( ref $self ) {
        return $self->options->fromfile_perl($optfile);
    }
    elsif ($self) {
        return $DefaultOptions->fromfile_perl($optfile);
    }
}

sub new {
    my $class    = shift;
    my $filename = shift;
    my $options  = shift || {};
    my $plugin   = shift || 'Auto';
    my $data     = shift || {};

    my $self = {};
    $self->{data} = $data;
    if ( ref $class ) {
        my $clone = { %{$class} };
        bless $clone, ref $class;
        return $clone;
    }
    else {
        bless $self, $class;
        $self->{_plugins} = [];
        $self->options($options);
        $self->filename($filename);
        $self->{changed} = 0;
    }

    $self->_test_modules();

    $self->add_plugin( $plugin, $options );
    return $self;

}

sub _test_modules {
    my $self       = shift;
    my %module_map = (
        'ANSIColor'     => 'Term::ANSIColor',
        'LevenshteinXS' => 'Text::LevenshteinXS',
        'Levenshtein'   => 'Text::Levenshtein',
        'Unaccent'      => 'Text::Unaccent::PurePerl',
        'Inflect'       => 'Lingua::EN::Inflect',
    );
    while ( my ( $k, $v ) = each %module_map ) {
        if (   ( $self->options->{$k} )
            && ( $self->_has_module($v) ) ) {
            $self->options->{$k} = 1;
        }
        else {
            $self->options->{$k} = 0;
        }
    }
    return;
}

sub _has_module {
    my $self    = shift;
    my $module  = shift;
    my $modfile = $module . '.pm';
    $modfile =~ s/\:\:/\//g;
    if ( eval { require $modfile; 1 } ) {
        return 1;
    }
    else {
        $self->status( 1, "Not loading $module: " . $@ );
        return 0;
    }
}

sub add_plugin {
    my $self    = shift;
    my $object  = shift;
    my $opts    = shift || {};
    my $options = $self->options->clone;
    $options->merge($opts);
    my $type = shift || 0;
    my $ref;
    if ( ref $object ) {
        $ref = $object;
        $ref->info($self);
        $ref->options($options);
    }
    else {
        my ( $plugin, $popts ) = split( /:/, $object );
        if ( $self->available_plugins($plugin) ) {
            if ($popts) {
                my @opts = split( /[;]/, $popts );
                foreach (@opts) {
                    my ( $k, $v ) = split( /=/, $_ );
                    $options->options( $k, $v );
                }
            }
            if (!eval {
                    if ( not $plugin =~ /::/ ) {
                        $plugin = 'Music::Tag::' . $plugin;
                    }
                    if ( $self->_has_module($plugin) ) {
                        $ref = $plugin->new( $self, $options );
                    }
                    return 1;
                }
                ) {
                croak "Error loading plugin ${plugin}: $@" if $@;
            }
        }
        else {
            croak "Error loading plugin ${plugin}: Not Found";
        }
    }
    if ($ref) {
        push @{ $self->{_plugins} }, $ref;
    }
    return $ref;
}

sub plugin {
    my $self   = shift;
    my $plugin = shift;
    if ( defined $plugin ) {
        foreach ( @{ $self->{_plugins} } ) {
            if ( ref($_) =~ /$plugin$/ ) {
                return $_;
            }
        }
    }
    return;
}

sub get_tag {
    my $self = shift;
    $self->_foreach_plugin( sub { $_[0]->get_tag } );
    return $self;
}

sub _foreach_plugin {
    my $self     = shift;
    my $callback = shift;
    foreach my $plugin ( @{ $self->{_plugins} } ) {
        if ( ref $plugin ) {
            &{$callback}($plugin);
        }
        elsif ($plugin) {
            $self->error("Invalid Plugin in list: '$plugin'");
        }
    }
    return $self;
}

sub set_tag {
    my $self = shift;
    $self->_foreach_plugin( sub { $_[0]->set_tag } );
    return $self;
}

sub strip_tag {
    my $self = shift;
    $self->_foreach_plugin( sub { $_[0]->strip_tag } );
    return $self;
}


# In retrospect, this was misnamed.  Too late now!
sub close {    ## no critic (ProhibitBuiltinHomonyms, ProhibitAmbiguousNames)
    my $self = shift;
    return $self->_foreach_plugin(
        sub {
            $_[0]->close();

            #$_->{info} = undef;
            #$_ = undef;
        }
    );
}

sub changed {
    my $self = shift;
    my $new  = shift;
    if ( defined $new ) {
        $self->{changed}++;
    }
    return $self->{changed};
}

sub data {
    my $self = shift;
    my $new  = shift;
    if ( defined $new ) {
        $self->{data} = $new;
    }
    return $self->{data};
}

sub options {    ## no critic (Subroutines::RequireArgUnpacking)
    my $self = shift;
    if ( not exists $self->{_options} ) {
        $self->{_options} = Config::Options->new( $self->default_options );
    }
    return $self->{_options}->options(@_);
}

sub setfileinfo {
    my $self = shift;
    if ( $self->filename ) {
        my $st = stat $self->filename;
        $self->mepoch( $st->mtime );
        $self->bytes( $st->size );
        return $st;
    }
    return;
}

sub sha1 {
    my $self = shift;
    if ( not( ( $self->filename ) && ( -e $self->filename ) ) ) {
        return undef;  ## no critic (Subroutines::ProhibitExplicitReturnUndef)
    }
    my $maxsize = $SHA1_SIZE;
    my $in      = IO::File->new();
    $in->open( $self->filename, '<' ) or die "Bad file: $self->filename\n";
    my $st   = stat $self->filename;
    my $sha1 = Digest::SHA1->new();
    $sha1->add( pack( 'V', $st->size ) );
    my $d;

    if ( $in->read( $d, $maxsize ) ) {
        $sha1->add($d);
    }
    $in->close();
    return $sha1->hexdigest;
}

sub picture {
    my $self = shift;
    unless ( exists $self->{data}->{PICTURE} ) {
        $self->{data}->{PICTURE} = {};
    }
    $self->{data}->{PICTURE} = shift if @_;

    if (   ( exists $self->{data}->{PICTURE}->{filename} )
        && ( $self->{data}->{PICTURE}->{filename} ) ) {
        my $root = File::Spec->rootdir();
        if ( $self->filename ) {
            $root = $self->filedir;
        }
        my $picfile =
            File::Spec->rel2abs( $self->{data}->{PICTURE}->{filename},
            $root );
        if ( -f $picfile ) {
            if ( $self->{data}->{PICTURE}->{_Data} ) {
                delete $self->{data}->{PICTURE}->{_Data};
            }
            my %ret = %{ $self->{data}->{PICTURE} };    # Copy ref
            $ret{_Data} = read_file( $picfile, 'binmode' => ':raw' );
            return \%ret;
        }
    }
    elsif (( exists $self->{data}->{PICTURE}->{_Data} )
        && ( length $self->{data}->{PICTURE}->{_Data} ) ) {
        return $self->{data}->{PICTURE};
    }
    return {};
}

sub get_picture {
    my $self = shift;
    return $self->picture;
}

sub set_picture {
    my $self  = shift;
    my $value = shift;
    return $self->picture($value);
}

sub picture_filename {
    my $self = shift;
    my $new  = shift;
    if ($new) {
        if ( not exists $self->{data}->{PICTURE} ) {
            $self->{data}->{PICTURE} = {};
        }
        $self->{data}->{PICTURE}->{filename} = $new;
    }
    if (   ( exists $self->{data}->{PICTURE} )
        && ( $self->{data}->{PICTURE}->{filename} ) ) {
        return $self->{data}->{PICTURE}->{filename};
    }
    elsif (( exists $self->{data}->{PICTURE} )
        && ( $self->{data}->{PICTURE}->{_Data} )
        && ( length( $self->{data}->{PICTURE}->{_Data} ) ) ) {
        return 0;
    }

    # Value is undefined, so return undef.
    return undef;    ## no critic (Subroutines::ProhibitExplicitReturnUndef)
}

sub picture_exists { goto &has_picture; }
sub has_picture {
    my $self = shift;
    if (   ( exists $self->{data}->{PICTURE}->{filename} )
        && ( $self->{data}->{PICTURE}->{filename} ) ) {
        my $root = File::Spec->rootdir();
        if ( $self->filename ) {
            $root = $self->filedir;
        }
        my $picfile =
            File::Spec->rel2abs( $self->{data}->{PICTURE}->{filename},
            $root );
        if ( -f $picfile ) {
            return 1;
        }
        else {
            $self->status( 0, 'Picture: ', $picfile, ' does not exists' );
        }
    }
    elsif (( exists $self->{data}->{PICTURE}->{_Data} )
        && ( length $self->{data}->{PICTURE}->{_Data} ) ) {
        return 1;
    }
    return 0;
}

sub available_plugins {
    my $self  = shift;
    my $check = shift;
    if ($check) {
        foreach (@PLUGINS) {
            if ( $check eq $_ ) {
                return 1;
            }
        }
        return 0;
    }
    return @PLUGINS;
}


sub datamethods {
    my $package = shift;
    if (ref $package) { $package = ref $package; }
    my $add  = shift;
    if ($add) {
        my $new = lc($add);
        $DataMethods{$new} = 1;
        if ( !defined &{ 'get_' . $new } ) {
            $package->_make_accessor( $new => {} );
        }
    }
    return [ keys %DataMethods ];
}

sub used_datamethods {
    my $self = shift;
    my @ret  = ();
    foreach my $m ( @{ $self->datamethods } ) {
        if ($self->has_data($m)) {
            push @ret, $m;
        }
    }
    return \@ret;
}

sub wav_out {
    my $self = shift;
    my $fh   = shift;
    my $out;
    $self->_foreach_plugin(
        sub {
            $out = $_->wav_out($fh);
            return $out if ( defined $out );
        }
    );
    return $out;
}

# This method is far from perfect.  It can't be perfect.
# It won't mangle valid UTF-8, however.
# Just be sure to always return perl utf8 in plugins when possible.

sub _isutf8 {
    my $self = shift;
    my $in   = shift;

    # If it is a proper utf8, with tag, just return it.
    if ( Encode::is_utf8( $in, 1 ) ) {
        return $in;
    }

    my $has7f = 0;
    foreach ( split( //, $in ) ) {
        if ( ord($_) >= 0x7f ) {    ## no critic (ProhibitMagicNumbers)
            $has7f++;
        }
    }

    # No char >7F it is prob. valid ASCII, just return it.
    if ( !$has7f ) {
        utf8::upgrade($in);
        return $in;
    }

    # See if it is a valid UTF-16 encoding.
    #my $out;
    #eval {
    #    $out = decode('UTF-16', $in, 1);
    #};
    #return $out unless $@;

    # See if it is a valid UTF-16LE encoding.
    #my $out;
    #eval {
    #    $out = decode('UTF-16LE', $in, 1);
    #};
    #return $out unless $@;

    # See if it is a valid UTF-8 encoding.
    my $out;
    if ( eval { $out = decode( 'UTF-8', $in, 1 ); return 1 } ) {
        utf8::upgrade($out);
        return $out;
    }

    # Finally just give up and return it.

    utf8::upgrade($in);
    return $in;
}

sub _add_to_namespace {
    my ( $package, $attrname, $reader, $writer, $predicate ) = @_;
    $METHODS{$attrname} = {reader => $reader};
    if ($predicate) {
        $METHODS{$attrname}->{predicate} = $predicate;
    }
    {
        ## no critic (ProhibitProlongedStrictureOverride,ProhibitNoStrict)
        no strict 'refs';

        if ($TRADITIONAL_METHODS) {
            my $readwriter;
            if ($writer) {
                $readwriter = _generate_readwriter( $package, $reader, $writer );
                $METHODS{$attrname}->{writer} = $writer;
            } elsif ($reader) {
                $readwriter = $reader;
            }
            $METHODS{$attrname}->{readwriter} = $readwriter;
            if ($readwriter) { *{ $package . '::' . $attrname } = $readwriter; }
        }
        if ($PBP_METHODS) {
            if ($writer)    { *{ $package . '::set_' . $attrname } = $writer; }
            if ($reader)    { *{ $package . '::get_' . $attrname } = $reader; }
        }
        if ($TRADITIONAL_METHODS || $PBP_METHODS) {
            if ($predicate) { *{ $package . '::has_' . $attrname } = $predicate; }
        }
        ## use critic
    }
}

sub _get_method {
    my $self = shift;
    my $method = shift;
    my $attr = shift;
    if ((exists $METHODS{$attr}) && (ref $METHODS{$attr})) {
        return $METHODS{$attr}->{$method};
    }
    else {
        return sub {};
    }
}

sub _get_reader {
    my $self = shift;
    my $attr = shift;
    $self->_get_method('reader',$attr);
}

sub _get_writer {
    my $self = shift;
    my $attr = shift;
    $self->_get_method('writer',$attr);
}

sub _get_predicate {
    my $self = shift;
    my $attr = shift;
    $self->_get_method('predicate',$attr);
}

sub _do_method {
    my $self = shift;
    my $method = shift;
    my $attr = shift;
    my @p = @_;
    &{$self->_get_method($method,$attr)}($self,@p);
}

sub get_data {
    my $self = shift;
    my @opts = @_;
    $self->_do_method('reader',@opts);
}

sub set_data {
    my $self = shift;
    my @opts = @_;
    $self->_do_method('writer',@opts);
}

sub has_data {
    my $self = shift;
    my @opts = @_;
    $self->_do_method('predicate',@opts);
}

sub _generate_reader {
    my ( $package, $attr, $options ) = @_;
    my $default   = $options->{default}     || undef;
    my $trigger   = $options->{readtrigger} || undef;
    my $outfilter = $options->{outfilter}   || undef;
    my $builder   = $options->{builder}     || undef;
    return sub {
        my $self = shift;
        if (   ( not exists $self->{data}->{$attr} )
            or ( not defined $self->{data}->{$attr} ) ) {
            if ($builder) {
                $self->{data}->{$attr} = &{$builder}($self);
            }
            else {
                return $default;
            }
        }
        if ($trigger) { &{$trigger}( $self, $self->{data}->{$attr} ); }
        return $outfilter
            ? &{$outfilter}( $self, $self->{data}->{$attr} )
            : $self->{data}->{$attr};
        }
}

sub _generate_writer {
    my ( $package, $attr, $options ) = @_;
    my $trigger   = $options->{trigger}   || undef;
    my $filter    = $options->{filter}    || undef;
    my $validator = $options->{validator} || undef;

    return sub {
        my ( $self, $value ) = @_;
        my $setvalue = $filter ? &{$filter}( $self, $value ) : $value;
        if ( ($validator) && ( !&{$validator}( $self, $value ) ) ) {
            $self->status(
                0,
                "Invalid value for $attr: ",
                ( defined $setvalue ) ? $setvalue : 'UNDEFINED'
            );
            return;
        }
        if ( $self->options('verbose') ) {
            $self->status(
                1,
                "Setting $attr to ",
                ( defined $setvalue ) ? $setvalue : 'UNDEFINED'
           );
        }
        $self->{data}->{$attr} = $setvalue;
        if ($trigger) { &{$trigger}( $self, $setvalue ); }
        return $self->{data}->{$attr};
        }
}

sub _generate_readwriter {
    my ( $package, $reader, $writer ) = @_;
    return sub {
        my ( $self, $value ) = @_;
        if ( defined $value ) {
            return &{$writer}( $self, $value );
        }
        else {
            return &{$reader}($self);
        }
    };
}

sub _generate_predicate {
    my ( $package, $attr, $options ) = @_;
    return sub {
        my $self = shift;
        return (   ( exists $self->{data}->{$attr} )
                && ( defined $self->{data}->{$attr} ) );
    };
}

sub _make_accessor {
    my ( $package, $attrname, $options ) = @_;
    my $attr = $options->{attr} || uc($attrname);
    my $reader = _generate_reader( $package, $attr, $options );
    my $writer;
    if ( !( ( exists $options->{readonly} ) && ( $options->{readonly} ) ) ) {
        $writer = _generate_writer( $package, $attr, $options );
    }
    my $predicate = _generate_predicate( $package, $attr, $options );
    _add_to_namespace( $package, $attrname, $reader, $writer, $predicate );
    return;
}

sub _make_datetime_accessor {
    my ( $package, $attrname, $options ) = @_;
    my $attr = $options->{attr} || uc($attrname);
    my $filter = sub {
        my ( $self, $value ) = @_;
        if ( defined $value ) {
            if ( $value =~ /^\-?\d+$/ ) {
                return DateTime->from_epoch( epoch => $value );
            }
            else {
                return DateTimeX::Easy->new($value);
            }
            $self->status( 0, "Invalid date set for ${attr}: ${value}" );
        }
        return;
    };
    $options->{filter}  = $filter;

    my $predicate = _generate_predicate( $package, $attr, $options );
    my $writer = _generate_writer( $package, $attr, $options );
    my $dt_reader = _generate_reader( $package, $attr, $options );
    _add_to_namespace( $package,
        ( $options->{dtname} ? $options->{dtname} : $attrname . 'dt' ),
        $dt_reader, $writer, $predicate );

    $options->{outfilter} = sub { my ( $self, $val ) = @_; return $val->ymd };
    my $date_reader = _generate_reader( $package, $attr, $options );
    _add_to_namespace(
        $package,
        ( $options->{datename} ? $options->{datename} : $attrname . 'date' ),
        $date_reader,
        $writer,
        $predicate
    );

    $options->{outfilter} =
        sub { my ( $self, $val ) = @_; return $val->ymd . ' ' . $val->hms };
    my $time_reader = _generate_reader( $package, $attr, $options );
    _add_to_namespace(
        $package,
        ( $options->{timename} ? $options->{timename} : $attrname . 'time' ),
        $time_reader,
        $writer,
        $predicate
    );

    $options->{outfilter} =
        sub { my ( $self, $val ) = @_; return $val->epoch };
    my $epoch_reader = _generate_reader( $package, $attr, $options );
    _add_to_namespace(
        $package,
        (     $options->{epochname}
            ? $options->{epochname}
            : $attrname . 'epoch'
        ),
        $epoch_reader,
        $writer,
        $predicate
    );
    return;
}

sub _make_ordinal_accessor {
    my ( $package, $attrname, $options ) = @_;
    my $attr = uc($attrname);
    my $pos  = $options->{pos_attr};
    if ( !$pos ) { croak("pos_attr required\n"); return }
    my $total = $options->{total_attr};
    if ( !$total ) { croak("total_attr required\n"); return }
    my $writer = sub {
        my ( $self, $new ) = @_;
        my ( $t, $tt ) = split( m{/}, $new );
        if ($t) {
            &{$self->_get_writer($pos)}($self,$t);
        }
        if ($tt) {
            &{$self->_get_writer($total)}($self,$tt);
        }
        return $new;
    };
    my $reader = sub {
        my $self = shift;
        my $m    = '_get_' . $pos;
        my $t    = &{$self->_get_reader($pos)}($self);
        my $tt    = &{$self->_get_reader($total)}($self);
        my $r  = '';
        if ($t) {
            $r .= $t;
        }
        if ($tt) {
            $r .= '/' . $tt;
        }
        return $r;
    };
    my $predicate = sub {
        my $self = shift;
        my ( $pp, $pt ) = ( 'has_' . $pos, 'has_' . $total );
        if ( $self->$pp || $self->$pt ) {
            return 1;
        }
        return;
    };
    _add_to_namespace( $package, $attrname, $reader, $writer, $predicate );
    return;
}

sub _make_list_accessor {
    my ( $package, $attrname, $options ) = @_;
    $options->{filter} = sub {
        my ( $self, $value ) = @_;
        my @ret = ();
        if ( ref $value ) {
            push @ret, @{$value};
        }
        else {
            push @ret, split( /\s*,\s*/, $value );
        }
        return \@ret;
    };
    _make_accessor( $package, $attrname, $options );
}

sub status {    ## no critic (Subroutines::RequireArgUnpacking)
    my $self = shift;
    if ( not $self->options('quiet') ) {
        my $name = ref($self);
        if ( $_[0] =~ /\:\:/ ) {
            $name = shift;
        }
        my $level = 0;
        if ( $_[0] =~ /^\d+$/ ) {
            $level = shift;
        }
        my $verbose = $self->options('verbose') || 0;
        if ( $level <= $verbose ) {
            $name =~ s/^Music::Tag:://g;
            print $self->_tenprint( $name, 'bold white', $TENPRINT_SIZE ), @_,
                "\n";
        }
    }
    return;
}

sub _tenprint {
    my $self   = shift;
    my $text   = shift;
    my $_color = shift || 'bold yellow';
    my $size   = shift || $TENPRINT_SIZE;
    return
          $self->_color($_color)
        . sprintf( '%' . $size . 's: ', substr( $text, 0, $size ) )
        . $self->_color('reset');
}

sub _color {    ## no critic (Subroutines::RequireArgUnpacking)
    my $self = shift;
    if ( $self->options->{ANSIColor} ) {
        return Term::ANSIColor::color(@_);
    }
    else {
        return '';
    }
}

sub error {     ## no critic (Subroutines::RequireArgUnpacking)
    my $self = shift;

    # unless ( $self->options('quiet') ) {
    carp( ref($self), ' ', @_ );

    # }
    return;
}

sub _create_attributes {
    my $package = shift;
    my $params = shift;

    if ($params->{pbp}) {
        $PBP_METHODS = 1;
        $TRADITIONAL_METHODS = 0;
    }
    if ($params->{traditional}) {
        $TRADITIONAL_METHODS = 1;
    }

    if (ref $package) { $package = ref $package; }
    my @datamethods = qw(
        album album_type albumartist albumartist_sortname albumid appleid
        artist artist_end artist_start artist_start_time artist_start_epoch
        artist_end_time artist_end_epoch artist_type artistid asin bitrate
        booklet bytes codec comment compilation composer copyright country
        countrycode disc discnum disctitle duration encoded_by encoder filename
        frames framesize frequency gaplessdata genre ipod ipod_dbid
        ipod_location ipod_trackid label lastplayedtime lastplayeddate
        lastplayedepoch lyrics mb_albumid mb_artistid mb_trackid mip_puid
        mtime mdate mepoch originalartist performer path picture playcount
        postgap pregap rating albumrating recorddate recordtime releasedate
        releasetime recordepoch releaseepoch samplecount secs songid sortname
        stereo tempo title totaldiscs totaltracks track tracknum url user vbr
        year upc ean jan filetype mip_fingerprint artisttags albumtags
        tracktags);

    %DataMethods = map { $_ => { readwrite => 1 } } @datamethods;

    ## no critic (ProtectPrivateSubs)

    $package->_make_accessor(
        'albumartist' => {
            builder => sub { my $self = shift; return $self->artist() }
        }
    );
    $package->_make_accessor(
        'albumartist_sortname' => {
            builder => sub { my $self = shift; return $self->sortname() }
        }
    );
    $package->_make_list_accessor( 'albumtags'  => {} );
    $package->_make_list_accessor( 'artisttags' => {} );
    $package->_make_accessor(
        'country' => {
            attr   => 'COUNTRYCODE',
            filter => sub {
                my ( $self, $new ) = @_;
                return country2code($new);
            },
            outfilter => sub {
                my ( $self, $value ) = @_;
                return code2country($value);
                }
        }
    );
    $package->_make_ordinal_accessor(
        'discnum',
        {   pos_attr   => 'disc',
            total_attr => 'totaldiscs',
        }
    );
    $package->_make_accessor(
        'secs',
        {   attr   => 'DURATION',
            filter => sub {
                my ( $self, $new ) = @_;
                return $new * 1000;
            },
            outfilter => sub {
                my ( $self, $value ) = @_;
                return int( $value / 1000 );
                }
        }
    );
    $package->_make_accessor(
        'ean',
        {   validator => sub {
                my ( $self, $value ) = @_;
                return $value =~ /^\d{13}$/;
            },
            alias => [qw(jan)],
        }
    );
    $package->_make_accessor(
        'filename',
        {   filter => sub {
                my ( $self, $new ) = @_;
                return File::Spec->rel2abs($new);
                }
        }
    );
    $package->_make_accessor(
        'filedir',
        {   attr      => 'FILENAME',
            outfilter => sub {
                my ( $self, $value ) = @_;
                my ( $vol, $path, $file ) = File::Spec->splitpath($value);
                return File::Spec->catpath( $vol, $path, '' );
            },
            readonly => 1,
        }
    );
    $package->_make_accessor( 'artist', { alias => [qw(performer)] } );

    $package->_make_list_accessor( 'tracktags' => {} );

    $package->_make_ordinal_accessor(
        'tracknum',
        {   pos_attr   => 'track',
            total_attr => 'totaltracks',
        }
    );

    $package->_make_accessor(
        'upc',
        {   attr      => 'EAN',
            validator => sub {
                my ( $self, $value ) = @_;
                return $value =~ /^\d{13}$/;
            },
            filter => sub {
                my ( $self, $value ) = @_;
                return ( '0' . $value );
            },
            outfilter => sub {
                my ( $self, $value ) = @_;
                $value =~ s/^0//;
                return $value;
                }
        }
    );

    $package->_make_datetime_accessor(
        'record' => {
            trigger => sub {
                my ( $self, $value ) = @_;
                if ( $value->isa('DateTime') ) {
                    $self->set_year( $value->year );
                }
                }
        }
    );
    $package->_make_datetime_accessor( 'release' => {} );
    $package->_make_datetime_accessor( 'm'       => {} );
    $package->_make_datetime_accessor('lastplayed');
    $package->_make_datetime_accessor(
        'artist_start' => {
            timename  => 'artist_start_time',
            datename  => 'artist_start',
            epochname => 'artist_start_epoch',
            dtname    => 'artist_start_dt',
        }
    );
    $package->_make_datetime_accessor(
        'artist_end' => {
            timename  => 'artist_end_time',
            datename  => 'artist_end',
            epochname => 'artist_end_epoch',
            dtname    => 'artist_end_dt',
        }
    );

    $package->_make_accessor(
        'year' => {
            builder => sub {
                my $self = shift;
                if ( $self->has_releasedt ) {
                    return $self->releasedt->year;
                }
                }
        }
    );

    $METHODS{'picture'} = {
        reader => \&get_picture,
        writer => \&set_picture,
        predicate => \&has_picture,
    };


    foreach my $m (@datamethods) {
        if ( ! exists $METHODS{$m}) {
            $package->_make_accessor( $m => {} );
        }
    }
    ## use critic
}

sub _find_plugins {
    my $package = shift;
    if (ref $package) { $package = ref $package; }
    my $me = $package;
    $me =~ s{::}{/}g;
    @PLUGINS = ();
    foreach my $d (@INC) {
        chomp $d;
        if ( -d "$d/$me/" ) {
            my $fdir = IO::Dir->new("$d/$me");
            if ( defined $fdir ) {
                while ( my $m = $fdir->read() ) {
                    next if $m eq 'Test.pm';
                    if ( $m =~ /^(.*)\.pm$/ ) {
                        my $mod = $1;
                        push @PLUGINS, $mod;
                    }
                }
            }
            $fdir->close();
        }
    }

}

sub import {
    my $package = shift;
    my $params = {};
    if    ( ref $_[0] )      { $params = $_[0]; }
    elsif ( !scalar @_ % 2 ) { $params = {@_}; }
    $package->_create_attributes($params);
    $package->_find_plugins($params);
    return 1;
}

BEGIN {
    $DefaultOptions = Config::Options->new(
        {   verbose       => 0,
            quiet         => 0,
            ANSIColor     => 0,
            LevenshteinXS => 1,
            Levenshtein   => 1,
            Unaccent      => 1,
            Inflect       => 0,
            optionfile =>
                [ '/etc/musictag.conf', $ENV{HOME} . '/.musictag.conf' ],
        }
    );
}

sub DESTROY {
    my $self = shift;
    $self->_foreach_plugin( sub { $_[0]->{info} = undef } );
    return;
}

1;
__END__