Permalink
Fetching contributors…
Cannot retrieve contributors at this time
5583 lines (5359 sloc) 206 KB
# Copyright (C) 2005-2015 Quentin Sculo <squentin@free.fr>
#
# This file is part of Gmusicbrowser.
# Gmusicbrowser is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 3, as
# published by the Free Software Foundation.
use strict;
use warnings;
use utf8;
package Songs;
#our %Songs;
our ($IDFromFile,$MissingHash); my $KeepIDFromFile;
our ($Artists_split_re,$Artists_title_re,$Articles_re);
my @MissingKeyFields;
our (%Def,%Types,%Categories,%FieldTemplates,@Fields,%HSort,%Aliases);
my %FuncCache;
INIT {
our $nan= unpack 'F', pack('F',sin(9**9**9)); # sin 9**9**9 is slighly more portable than $nan="nan", use unpack pack because the nan will be stored that way
our %timespan_menu=
( year => _("year"),
month => _("month"),
day => _("day"),
);
@MissingKeyFields=qw/size title album artist track/;
%Categories=
( file => [_"File properties",10],
audio => [_"Audio properties",30],
basic => [_"Basic fields",20],
extra => [_"Extra fields",50],
stats => [_"Statistics",40],
unknown => [_"Other",80], #fallback category
custom => [_"Custom",70],
replaygain=> [_"Replaygain",60],
);
%Types=
( generic =>
{ _ => '____[#ID#]',
get => '#_#',
set => '#get# = #VAL#',
display => '#get#',
grouptitle=> '#display#',
'editwidget:many' => sub { my $field=$_[0]; GMB::TagEdit::Combo->new(@_, Field_property($field,'edit_listall')); },
'editwidget:single' => sub { my $field=$_[0]; GMB::TagEdit::EntryString->new( @_,0,Field_property($field,'edit_listall') ); },
'editwidget:per_id' => sub { my $field=$_[0]; GMB::TagEdit::EntryString->new( @_,Field_properties($field,'editwidth','edit_listall') ); },
'filter:m' => '#display# .=~. m"#VAL#"', 'filter_prep:m' => \&Filter::QuoteRegEx,
'filter:mi' => '::superlc(#display#) .=~. m"#VAL#"i', 'filter_prep:mi'=> sub { Filter::QuoteRegEx( ::superlc($_[0]) )},
'filter:si' => 'index( ::superlc(#display#),"#VAL#") .!=. -1', 'filter_prep:si'=> sub {quotemeta ::superlc($_[0])},
'filter:s' => 'index( #display#, "#VAL#") .!=. -1', 'filter_prep:s'=> sub {quotemeta $_[0]},
'filter:fuzzy' => '.!!. Filter::_fuzzy_match(#VAL1#/100,"#VAL2#",lc(#get#))', 'filter_prep:fuzzy'=> sub {my @arg=split / /,$_[0],2; $arg[0],quotemeta lc($arg[1])},
'filterpat:fuzzy'=> [ round => "%d", unit => '%', min=>20, max=>99, default_value=>65, ],
'filterdesc:fuzzy'=> [ _"%s fuzzy match with %s",_"fuzzy match", 'fuzzy string', ],
'filterdesc:-fuzzy'=> _"no %s fuzzy match with %s",
'filterdesc:mi' => [ _"matches regexp %s",_"matches regexp",'regexp', icase=>1, ],
'filterdesc:si' => [ _"contains %s", _"contains", 'substring', icase=>1, ],
'filterdesc:e' => [ _"is equal to %s", _"is equal to", 'string', completion=>1, ],
'filterdesc:m' => [_"matches regexp %s (case sensitive)",'mi'],
'filterdesc:s' => [_"contains %s (case sensitive)", 'si'],
'filterdesc:-m' => _"doesn't match regexp %s (case sensitive)",
'filterdesc:-mi'=> _"doesn't match regexp %s",
'filterdesc:-s' => _"doesn't contain %s (case sensitive)",
'filterdesc:-si'=> _"doesn't contain %s",
'filterdesc:-e' => _"isn't equal to %s",
'smartfilter:=empty' => 'e:',
'smartfilter:=' => 'e',
'smartfilter:#' => \&Filter::smartstring_fuzzy,
'smartfilter::' => 'si s',
'smartfilter:~' => 'mi m',
default_filter => 'si',
autofill_re => '.+',
},
unknown =>
{ parent => 'generic',
},
virtual =>
{ parent => 'string',
_ => '#get#',
},
special => {},
flags =>
{ _ => '____[#ID#]',
init => '___name[0]="#none#"; ___iname[0]=::superlc(___name[0]); #sgid_to_gid(VAL=$_)# for #init_namearray#',
init_namearray => '@{ $::Options{Fields_options}{#field#}{persistent_values} ||= $Def{#field#}{default_persistent_values} || [] }',
none => quotemeta _"None",
default => '""',
check => '#VAL#= do {my $v=#VAL#; my @l; if (ref $v) {@l= @$v} else {@l= split /\x00/,$v} for (@l) { tr/\x00-\x1F//d; s/\s+$//; }; @l=sort @l; \@l }',
get_list => 'my $v=#_#; ref $v ? map(___name[$_], @$v) : $v ? ___name[$v] : ();',
get_gid => 'my $v=#_#; ref $v ? $v : [$v]',
gid_to_get => '(#GID# ? ___name[#GID#] : "")',
gid_to_display => '___name[#GID#]',
s_sort => '___sort{ sprintf("%x", #_#)}',
si_sort => '___isort{ sprintf("%x", #_#)}',
always_first_gid=> 0,
's_sort:gid' => '___name[#GID#]',
'si_sort:gid' => '___iname[#GID#]',
get => 'do {my $v=#_#; !$v ? "" : ref $v ? join "\\x00",map ___name[$_],@$v : ___name[$v];}',
newval => 'push @___iname, ::superlc(___name[-1]); ::IdleDo("newgids_#field#",1000,sub { ___new=0; ::HasChanged("newgids_#field#"); }) unless ___new++;',
sgid_to_gid => '___gid{#VAL#}||= do { my $i=push(@___name, #VAL#); #newval#; $i-1; }',
set => '{my $v=#VAL#;
my @list= sort (ref $v ? @$v : split /\\x00/,$v);
my @ids;
for my $name (@list)
{ my $id= #sgid_to_gid(VAL=$name)#;
push @ids,$id;
}
my $val= @ids<2 ? $ids[0]||0 :
(___group{join(" ",map sprintf("%x",$_),@ids)}||= \@ids);
___isort{ sprintf("%x",$val) }||= ::superlc( ___sort{ sprintf("%x",$val) }||= join ";",@list );
#_#=$val;
}',
diff => 'do {my $v=#_#; my $old=!$v ? "" : ref $v ? join "\\x00",map ___name[$_],@$v : ___name[$v]; $v=#VAL#; my $new= join "\\x00", @$v; $old ne $new; }', # #VAL# should be a sorted arrayref, as returned by #check#
display => 'do { my $v=#_#; !$v ? "" : ref $v ? join ", ",map ___name[$_],@$v : ___name[$v]; }',
check_multi => 'for my $lref (@{#VAL#}) { for (@$lref) {tr/\x00-\x1F//d; s/\s+$//;} }',
set_multi => 'do {my $c=#_#; my %h=( $c ? ref $c ? map((___name[$_]=>0), @$c) : (___name[$c]=>0) : ()); my ($toadd,$torm,$toggle)=@{#VAL#}; $h{$_}= (exists $h{$_} ? -1 : 1) for @$toggle; $h{$_}++ for @$toadd; $h{$_}-- for @$torm; (scalar grep $h{$_}!=0, keys %h) ? [grep $h{$_}>=0, keys %h] : undef; }',
makefilter => '#GID# ? "#field#:~:".___name[#GID#] : "#field#:ecount:0"',
'filter:~' => '.!!. do {my $v=#_#; $v ? ref $v ? grep(#VAL#==$_, @$v) : ($v == #VAL#) : 0}',
#smartmatch version: 'filter:~' => '.!!. do {my $v=#_#; $v ? #VAL# ~~ $v : 0}', # is flag set
'filter_prep:~' => '___gid{#PAT#} ||= #sgid_to_gid(VAL=#PAT#)#;',
'filter_prephash:~' => 'return { map { #sgid_to_gid(VAL=$_)#, undef } keys %{#HREF#} }',
'filter:h~' => '.!!. do {my $v=#_#; $v ? ref $v ? grep(exists $hash#VAL#->{$_+0}, @$v) : (exists $hash#VAL#->{#_#+0}) : 0}',
'filter:ecount' => '#VAL# .==. do {my $v=#_#; $v ? ref $v ? scalar(@$v) : 1 : 0}',
#FIXME for filters s,m,mi,h~, using a list of matching names in ___inames/___names could be better (using a bitstring)
'filter:s' => 'do { my $v=#_#; !$v ? .0. : ref $v ? (.!!. grep index(___name[$_], "#VAL#") != -1 ,@$v) : (index(___name[$v], "#VAL#") .!=. -1); }',
'filter:si' => 'do { my $v=#_#; !$v ? .0. : ref $v ? (.!!. grep index(___iname[$_], "#VAL#") != -1 ,@$v) : (index(___iname[$v], "#VAL#") .!=. -1); }',
'filter:fuzzy' => 'do { my $v=#_#; !$v ? .0. : ref $v ? (.!!. ::first {Filter::_fuzzy_match(#VAL1#/100,"#VAL2#",___iname[$_])} @$v) : .!!. Filter::_fuzzy_match(#VAL1#/100,"#VAL2#",___iname[$v]); }',
'filter:m' => 'do { my $v=#_#; !$v ? .0. : ref $v ? (.!!. grep ___name[$_] =~ m"#VAL#" ,@$v) : ___name[$v] .=~. m"#VAL#"; }',
'filter:mi' => 'do { my $v=#_#; !$v ? .0. : ref $v ? (.!!. grep ___iname[$_] =~ m"#VAL#"i ,@$v) : ___iname[$v] .=~. m"#VAL#"i; }',
'filter_prep:m' => \&Filter::QuoteRegEx,
'filter_prep:mi'=> sub { Filter::QuoteRegEx( ::superlc($_[0]) )},
'filter_prep:si'=> sub {quotemeta ::superlc($_[0])},
'filter_prep:s' => sub {quotemeta $_[0]},
'filter_prep:fuzzy'=>sub {my @arg=split / /,$_[0],2; $arg[0],quotemeta ::superlc($arg[1])},
stats => 'do {my $v=#_#; #HVAL#{$_+0}=undef for ref $v ? @$v : $v;} ---- AFTER: #HVAL#=[map ___name[$_], keys %{#HVAL#}];',
'stats:gid' => 'do {my $v=#_#; #HVAL#{$_+0}=undef for ref $v ? @$v : $v;}',
hashm => 'do {my $v=#_#; ref $v ? @$v : $v }',
'hashm:name' => 'do {my $v=#_#; ref $v ? map(___name[$_], @$v) : $v ? ___name[$v] : () }',
is_set => 'my $gid=___gid{#VAL#}; my $v=#_#; $gid ? ref $v ? (grep $_==$gid, @$v) : $v==$gid : 0;',
#smartmatch version : is_set => 'my $gid=___gid{#VAL#}; my $v=#_#; $gid ? $gid ~~ $v : 0;',
listall => '1..$#___name',
'editwidget:many' => sub { GMB::TagEdit::EntryMassList->new(@_) },
'editwidget:single' => sub { GMB::TagEdit::FlagList->new(@_) },
'editwidget:per_id' => sub { GMB::TagEdit::FlagList->new(@_) },
autofill_re => '.+',
'filterdesc:~' => [ _"includes %s", _"includes", 'combostring', ],
'filterdesc:-~' => _"doesn't include %s",
'filterdesc:ecount:0' => _"has none",
'filterdesc:-ecount:0'=> _"has at least one",
'filterdesc:mi' => [ _"matches regexp %s",_"matches regexp",'regexp', icase=>1, ],
'filterdesc:si' => [ _"contains %s", _"contains", 'substring', icase=>1, ],
'filterdesc:m' => [_"matches regexp %s (case sensitive)",'mi'],
'filterdesc:s' => [_"contains %s (case sensitive)", 'si'],
'filterdesc:-m' => _"doesn't match regexp %s (case sensitive)",
'filterdesc:-mi'=> _"doesn't match regexp %s",
'filterdesc:-s' => _"doesn't contain %s (case sensitive)",
'filterdesc:-si'=> _"doesn't contain %s",
'filterdesc:fuzzy'=> [ _"%s fuzzy match with %s",_"fuzzy match", 'fuzzy string', ],
'filterdesc:-fuzzy'=> _"no %s fuzzy match with %s",
'smartfilter:=empty' => 'ecount:0',
'smartfilter:=' => '~',
'smartfilter::' => 'si s',
'smartfilter:~' => 'mi m',
'smartfilter:#' => \&Filter::smartstring_fuzzy,
'filterpat:fuzzy'=> [ round => "%d", unit => '%', min=>20, max=>99, default_value=>65, ],
default_filter => 'si',
load_extra => '___gid{#SGID#} || return;',
save_extra => 'my %h; while ( my ($sgid,$gid)=each %___gid ) { $h{$sgid}= [#SUBFIELDS#] } delete $h{""}; return \%h;',
},
artists =>
{ _ => '____[#ID#]',
mainfield => 'artist',
#plugin => 'picture',
# _name => '__#mainfield#_name[#_#]',
# _iname => '__#mainfield#_iname[#_#]',
get => 'do {my $v=#_#; ref $v ? join "\\x00",map __#mainfield#_name[$_],@$v : __#mainfield#_name[$v];}',
display => 'do {my $v=#_#; ref $v ? join ", ", map __#mainfield#_name[$_],@$v : __#mainfield#_name[$v];}',
get_gid => 'my $v=#_#; ref $v ? $v : [$v]',
's_sort:gid' => '__#mainfield#_name[#GID#]',
'si_sort:gid' => '__#mainfield#_iname[#GID#]',
#display => '##mainfield#->display#',
get_list => 'my @l=( ##mainfield#->get#, grep(defined, #title->get# =~ m/$Artists_title_re/g) ); my %h; grep !$h{$_}++, map split(/$Artists_split_re/), @l;',
gid_to_get => '(#GID#!=1 ? __#mainfield#_name[#GID#] : "")', # or just '__#mainfield#_name[#GID#]' ?
gid_to_display => '__#mainfield#_name[#GID#]',
update => 'my @ids;
for my $name (do{ #get_list# })
{ my $id= ##mainfield#->sgid_to_gid(VAL=$name)#;
push @ids,$id;
}
#_# = @ids==1 ? $ids[0] :
@ids==0 ? 1 :
(___group{join(" ",map sprintf("%x",$_),@ids)}||= \@ids);', # 1 for @ids==0 is the special gid for unknown artists defined in artist's init
'filter:m' => '(ref #_# ? (.!!. grep __#mainfield#_name[$_] =~ m"#VAL#", @{#_#}) : (__#mainfield#_name[#_#] .=~. m"#VAL#"))',
'filter:mi' => '(ref #_# ? (.!!. grep __#mainfield#_iname[$_] =~ m"#VAL#"i, @{#_#}) : (__#mainfield#_iname[#_#] .=~. m"#VAL#"i))',
'filter:s' => '(ref #_# ? (.!!. grep index( __#mainfield#_name[$_],"#VAL#") != -1, @{#_#}) : (index(__#mainfield#_name[#_#],"#VAL#") .!=. -1))',
'filter:si' => '(ref #_# ? (.!!. grep index( __#mainfield#_iname[$_], "#VAL#") != -1, @{#_#}) : (index(__#mainfield#_iname[#_#], "#VAL#") .!=. -1))',
'filter:fuzzy' => 'do { my $v=#_#; ref $v ? (.!!. ::first {Filter::_fuzzy_match(#VAL1#/100,"#VAL2#",__#mainfield#_iname[$_])} @$v) : .!!. Filter::_fuzzy_match(#VAL1#/100,"#VAL2#",__#mainfield#_iname[$v]); }',
'filter_prep:m' => \&Filter::QuoteRegEx,
'filter_prep:mi'=> sub { Filter::QuoteRegEx( ::superlc($_[0]) )},
'filter_prep:si'=> sub { quotemeta ::superlc($_[0])},
'filter_prep:s' => sub {quotemeta $_[0]},
'filter_prep:fuzzy'=>sub {my @arg=split / /,$_[0],2; $arg[0],quotemeta ::superlc($arg[1])},
'filter:~' => '(ref #_# ? (.!!. grep $_ == #VAL#, @{#_#}) : (#_# .==. #VAL#))',#FIXME use simpler/faster version if perl5.10 (with ~~)
'filter_prep:~' => '##mainfield#->filter_prep:~#',
'filter_prephash:~' => '##mainfield#->filter_prephash:~#',
'filter_simplify:~' => sub { length($_[0]) ? split /$Artists_split_re/,$_[0] : $_[0]; },
'filter:h~' => '(ref #_# ? (grep .!!. exists $hash#VAL#->{$_+0}, @{#_#}) : (.!!. exists $hash#VAL#->{#_#+0}))',
makefilter => '"#field#:~:".##mainfield#->gid_to_sgid#',
#group => '#_# !=',
stats => 'do {my $v=#_#; #HVAL#{__#mainfield#_name[$_]}=undef for ref $v ? @$v : $v;} ---- AFTER: #HVAL#=[keys %{#HVAL#}];',
'stats:gid' => 'do {my $v=#_#; #HVAL#{$_}=undef for ref $v ? @$v : $v;} ---- AFTER: #HVAL#=[keys %{#HVAL#}];',
hashm => 'do {my $v=#_#; ref $v ? @$v : $v}',
listall => '##mainfield#->listall#',
'filterdesc:~' => [ _"includes artist %s", _"includes artist", 'menustring', ],
'filterdesc:-~' => _"doesn't include artist %s",
'filterdesc:mi' => [ _"matches regexp %s",_"matches regexp",'regexp', icase=>1, ],
'filterdesc:si' => [ _"contains %s", _"contains", 'substring', icase=>1, ],
'filterdesc:m' => [_"matches regexp %s (case sensitive)",'mi'],
'filterdesc:s' => [_"contains %s (case sensitive)", 'si'],
'filterdesc:-m' => _"doesn't match regexp %s (case sensitive)",
'filterdesc:-mi'=> _"doesn't match regexp %s",
'filterdesc:-s' => _"doesn't contain %s (case sensitive)",
'filterdesc:-si'=> _"doesn't contain %s",
'filterdesc:fuzzy'=> [ _"%s fuzzy match with %s",_"fuzzy match", 'fuzzy string', ],
'filterdesc:-fuzzy'=> _"no %s fuzzy match with %s",
'smartfilter:=' => '~',
'smartfilter::' => 'si s',
'smartfilter:~' => 'mi m',
'smartfilter:#' => \&Filter::smartstring_fuzzy,
'filterpat:fuzzy'=> [ round => "%d", unit => '%', min=>20, max=>99, default_value=>65, ],
default_filter => 'si',
},
artist_first =>
{ parent => 'artist', #FIXME
_ => 'do {my $v=__artists__[#ID#]; ref $v ? $v->[0] : $v}',
#update => ';',
init => ';', #FIXME
},
artist =>
{ #set => '#_#= (#VAL# eq "" ? 0 : (__#mainfield#_gid{#VAL#}||= (push @__#mainfield#_name, #VAL#)-1));',
parent => 'fewstring',
mainfield => 'artist',
init => '____=""; __#mainfield#_gid{""}=1; #_iname#[1]=::superlc( #_name#[1]=_("<Unknown>") );',
get => 'do {my $v=#_#; $v!=1 ? #_name#[$v] : "";}',
gid_to_get => '(#GID#!=1 ? #_name#[#GID#] : "")',
gid_to_sgid => '(#GID#!=1 ? #_name#[#GID#] : "")',
search_gid => 'my $gid=__#mainfield#_gid{#VAL#}||0; $gid>1 ? $gid : undef;',
makefilter => '"#field#:~:" . #gid_to_sgid#',
diff => 'do {my $old=#_#; ($old!=1 ? #_name#[$old] : "") ne #VAL# }',
#save_extra => 'my %h; for my $gid (2..$##_name#) { my $v=__#mainfield#_picture[$gid]; next unless defined $v; ::_utf8_on($v); $h{ #_name#[$gid] }=$v; } return artist_pictures',
listall => '2..@#_name#-1',
load_extra => '__#mainfield#_gid{#SGID#} || return;',
save_extra => 'my %h; while ( my ($sgid,$gid)=each %__#mainfield#_gid ) { $h{$sgid}= [#SUBFIELDS#] } delete $h{""}; return \%h;',
#plugin => 'picture',
'filter:pic' => '.!!. __#mainfield#_picture[#_#]',
'filterdesc:pic:1'=> _"has a picture",
'filterdesc:-pic:1'=> _"doesn't have a picture",
},
album =>
{ parent => 'fewstring',
mainfield => 'album',
_empty => 'vec(__#mainfield#_empty,#_#,1)',
unknown => '_("<Unknown>")." "',
init => '____=""; __#mainfield#_gid{"\\x00"}=1; __#mainfield#_empty=""; vec(__#mainfield#_empty,1,1)=1; __#mainfield#_sgid[1]="\\x00"; #_iname#[1]=::superlc( #_name#[1]=_("<Unknown>") );',
findgid => 'do{ my $name=#VAL#; my $sgid= $name ."\\x00". ($name eq "" ? "artist=".#artist->get# : do {my $a=#album_artist_raw->get#; $a ne "" ? "album_artist=$a" : #compilation->get# ? "compilation=1" : ""} );
__#mainfield#_gid{$sgid}||= do {my $n=@#_name#; if ($name eq "") {vec(__#mainfield#_empty,$n,1)=1; $name=#unknown#.#artist->get#; } push @#_name#,$name; push @__#mainfield#_sgid,$sgid; #newval#; $n; };
};',
#possible sgid : album."\x00". "" if no album name and no artist
# "artist=".artist if no album name
# "album_artist"=album_artist if non-empty album_artist
# "compilation=1" if empty album_artist, compilation flag set
# ""
load => '#_#= #findgid#;',
set => 'my $oldgid=#_#; my $newgid= #_#= #findgid#; if ($newgid+1==@#_name# && $newgid!=$oldgid) { ___picture[$newgid]= ___picture[$oldgid]; }', #same as load, but if gid changed and is new, use picture from old gid
#newval => 'push @#_iname#, ::superlc( #_name#[-1] );',
get => '(#_empty# ? "" : #_name#[#_#])',
gid_to_get => '(vec(__#mainfield#_empty,#GID#,1) ? "" : #_name#[#GID#])',
sgid_to_gid => 'do {my $s=#VAL#; __#mainfield#_gid{$s}||= do { my $n=@#_name#; if ($s=~s/\x00(\w+)=(.*)$// && $s eq "" && $1 eq "artist") { $s= #unknown#.$2; vec(__#mainfield#_empty,$n,1)=1;} push @#_name#,$s; push @__#mainfield#_sgid,#VAL#; #newval#; $n }}',
gid_to_sgid => '$__#mainfield#_sgid[#GID#]',
makefilter => '"#field#:~:" . #gid_to_sgid#',
update => 'my $albumname=#get#; #set(VAL=$albumname)#;',
listall => 'grep !vec(__#mainfield#_empty,$_,1), 2..@#_name#-1',
'stats:artistsort' => '#HVAL#->{ #album_artist->get_gid# }=undef; ---- AFTER: #HVAL#=do { my @ar= keys %{#HVAL#}; @ar>1 ? ::superlc(_"Various artists") : __artist_iname[$ar[0]]; }',
#plugin => 'picture',
load_extra => ' __#mainfield#_gid{#SGID#} || return;',
save_extra => 'my %h; while ( my ($sgid,$gid)=each %__#mainfield#_gid ) { $h{$sgid}= [#SUBFIELDS#] } delete $h{""}; return \%h;',
'filter:pic' => '.!!. __#mainfield#_picture[#_#]',
'filterdesc:pic:1'=> _"has a picture",
'filterdesc:-pic:1'=> _"doesn't have a picture",
'filterpat:menustring'=> [ display=> sub { my $s=shift; $s=~s/\x00.*//; $s; } ], # could display $album by $album_artist instead
#load_extra => '___pix[ #sgid_to_gid(VAL=$_[0])# ]=$_[1];',
#save_extra => 'my @res; for my $gid (1..$##_name#) { my $v=___pix[$gid]; next unless length $v; push @res, [#*:gid_to_sgid(GID=$gid)#,$val]; } return \@res;',
},
string =>
{ parent => 'generic',
default => '""',
check => '#VAL#=~tr/\x1D\x00//d; #VAL#=~s/\s+$//;', #remove trailing spaces and \x1D\x00
diff => '#_# ne #VAL#',
s_sort => '#_#',
'filter:e' => '#_# .eq. "#VAL#"',
hash => '#_#',
group => '#_# ne',
stats => '#HVAL#{#_#}=undef; ---- AFTER: #HVAL#=[keys %{#HVAL#}];',
},
istring => # _much_ faster with case/accent insensitive operations, at the price of double memory
{ parent => 'string',
_iname => '___iname[#ID#]',
set => '#_# = #VAL#; #_iname#= ::superlc(#VAL#);',
si_sort => '#_iname#',
'filter:si' => 'index( #_iname#,"#VAL#") .!=. -1', 'filter_prep:si'=> sub { quotemeta ::superlc($_[0])},
'filter:mi' => '#_iname# .=~. m"#VAL#"i', 'filter_prep:mi'=> sub { Filter::QuoteRegEx( ::superlc($_[0]) )},
'filter:fuzzy' => ' .!!. Filter::_fuzzy_match(#VAL1#/100,"#VAL2#",#_iname#)', 'filter_prep:fuzzy'=> sub {my @arg=split / /,$_[0],2; $arg[0],quotemeta ::superlc($arg[1])},
},
text => #multi-lines string
{ parent => 'string',
check => '#VAL#=~tr/\x00-\x09\x0B\x0C\x0E-\x1F//d; #VAL#=~s/\s+$//;',
'editwidget:single' => sub { GMB::TagEdit::EntryText->new(@_); },
'editwidget:many' => sub { GMB::TagEdit::EntryText->new(@_); },
},
filename=>
{ parent => 'string',
check => ';', #override string's check because not needed and filename may not be utf8
get => '#_#',
set => '#_#=#VAL#; ::_utf8_off(#_#);',
display => '::filename_to_utf8displayname(#get#)',
hash_to_display => '::filename_to_utf8displayname(#VAL#)', #only used by FolderList:: and MassTag::
load => '#_#=::decode_url(#VAL#)',
save => 'filename_escape(#_#)',
#'filterpat:string' => [ display => \&::filename_to_utf8displayname, ],
},
# picture =>
# { get_picture => '__#mainfield#_picture[#GID#] || $::Options{Default_picture_#mainfield#};',
# get_pixbuf => 'my $file= #get_picture#; GMB::Picture::pixbuf($file);',
# set_picture => '::_utf8_off(#VAL#); __#mainfield#_picture[#GID#]= #VAL# eq "" ? undef : #VAL#; ::HasChanged("Picture_#mainfield#",#GID#);',
# 'load_extra:picture' => 'if (#VAL# ne "") { __#mainfield#_picture[#GID#]= ::decode_url(#VAL#); }',
# 'save_extra:picture' => 'do { my $v=__#mainfield#_picture[#GID#]; defined $v ? ::url_escape($v) : ""; }',
# },
_picture =>
{ _ => '__#mainfield#_picture[#GID#]',
init => '@__#mainfield#_picture=(); push @GMB::Picture::ArraysOfFiles, \@__#mainfield#_picture;',
default => '$::Options{Default_picture}{#mainfield#}',
get_for_gid => '#_# || #default#;',
pixbuf_for_gid => 'my $file= #get_for_gid#; GMB::Picture::pixbuf($file);',
set_for_gid => '::_utf8_off(#VAL#); #_#= #VAL# eq "" ? undef : #VAL#; ::HasChanged("Picture_#mainfield#",#GID#);',
load_extra => 'if (#VAL# ne "") { #_#= ::decode_url(#VAL#); }',
save_extra => 'do { my $v=#_#; defined $v ? filename_escape($v) : ""; }',
get => '__#mainfield#_picture[ ##mainfield#->get_gid# ]',
},
fewstring=> #for strings likely to be repeated
{ _ => 'vec(____,#ID#,#bits#)',
bits => 32, #32 bits by default (16 bits ?)
mainfield => '#field#',
_name => '__#mainfield#_name',
_iname => '__#mainfield#_iname',
sgid_to_gid => '__#mainfield#_gid{#VAL#}||= do { my $i=push(@#_name#, #VAL#); #newval#; $i-1; }',
newval => 'push @#_iname#, ::superlc( #_name#[-1] );',
#newval => 'push @#_iname#, ::superlc(#VAL#);',
set => '#_# = #sgid_to_gid#;',
init => '____=""; __#mainfield#_gid{""}=1; #_name#[1]=#_iname#[1]="";',
check => '#VAL#=~tr/\x00-\x1F//d; #VAL#=~s/\s+$//;',
default => '""',
get_gid => '#_#',
get => '#_name#[#_#]',
diff => '#get# ne #VAL#',
display => '#_name#[#_#]',
s_sort => '#_name#[#_#]',
si_sort => '#_iname#[#_#]',
gid_to_get => '#_name#[#GID#]',
's_sort:gid' => '#_name#[#GID#]',
'si_sort:gid' => '#_iname#[#GID#]',
always_first_gid=> 0,
gid_to_display => '#_name#[#GID#]',
'filter:m' => '#_name#[#_#] .=~. m"#VAL#"',
'filter:mi' => '#_iname#[#_#] .=~. m"#VAL#"i',
'filter:fuzzy' => '.!!. Filter::_fuzzy_match(#VAL1#/100,"#VAL2#",#_iname#[#_#])', 'filter_prep:fuzzy'=> sub {my @arg=split / /,$_[0],2; $arg[0],quotemeta ::superlc($arg[1])},
'filter:si' => 'index( #_iname#[#_#],"#VAL#") .!=. -1', 'filter_prep:si' => sub {quotemeta ::superlc($_[0])},
'filter:s' => 'index( #_name#[#_#], "#VAL#") .!=. -1',
'filter:e' => '#_name#[#_#] .eq. "#VAL#"',
'filter:~' => '#_# .==. #VAL#', 'filter_prep:~' => '#sgid_to_gid(VAL=#PAT#)#',
'filter_prephash:~' => 'return {map { #sgid_to_gid(VAL=$_)#,undef} keys %{#HREF#}}',
'filter:h~' => '.!!. exists $hash#VAL#->{#_#}',
# hash => '#_name#[#_#]',
hash => '#_#',
#"hash:gid" => '#_#',
makefilter => '"#field#:~:".#_name#[#GID#]',
group => '#_# !=',
stats => '#HVAL#{#_name#[#_#]}=undef; ---- AFTER: #HVAL#=[keys %{#HVAL#}];',
'stats:gid' => '#HVAL#{#_#}=undef; ---- AFTER: #HVAL#=[keys %{#HVAL#}];',
listall => '2..@#_name#-1',
edit_listall => 1,
parent => 'generic',
maxgid => '@#_name#-1',
'filterdesc:~' => [ _"is %s", _"is", 'menustring', ],
'filterdesc:-~' => _"isn't %s",
#gsummary => 'my $gids=Songs::UniqList(#field#,#IDs#); @$gids==1 ? #gid_to_display(GID=$gids->[0])# : #names(count=scalar @$gids)#;',
},
number =>
{ parent => 'generic',
set => '#_# = #VAL#||0',
########save => '(#_# || "")',
n_sort => '#_#',
'n_sort:gid' => '#GID#',
diff => '#_# != #VAL#',
'filter:e' => '#_# .==. #VAL#',
'filter:>' => '#_# .>. #VAL#',
'filter:<' => '#_# .<. #VAL#',
'filter:b' => '#_# .>=. #VAL1# .&&. #_# .<=. #VAL2#',
'filter_prep:b' => \&filter_prep_numbers_between,
'filter_prep:>' => \&filter_prep_numbers,
'filter_prep:<' => \&filter_prep_numbers,
'filter_prep:e' => \&filter_prep_numbers,
'group' => '#_# !=',
'stats:range' => 'push @{#HVAL#},#_#; ---- AFTER: #HVAL#=do {my ($m0,$m1)=(sort {$a <=> $b} @{#HVAL#})[0,-1]; $m0==$m1 ? $m0 : "$m0 - $m1"}',
'stats:average' => 'push @{#HVAL#},#_#; ---- AFTER: #HVAL#=do { my $s=0; $s+=$_ for @{#HVAL#}; $s/@{#HVAL#}; }',
'stats:sum' => '#HVAL# += #_#;',
stats => '#HVAL#{#_#+0}=undef;',
hash => '#_#+0',
display => '(#_# ? sprintf("#displayformat#", #_# ) : "")', #replace 0 with ""
gid_to_display => '#GID#',
get_gid => '#_#+0',
makefilter => '"#field#:e:#GID#"',
default => '0+0', #not 0 because it needs to be true :(
autofill_re => '\\d+',
default_filter => '>',
'filterdesc:e' => [ "= %s", "=", 'value', ],
'filterdesc:>' => [ "> %s", ">", 'value', noinv=>1 ],
'filterdesc:<' => [ "< %s", "<", 'value', noinv=>1 ],
'filterdesc:-<' => [ "%s", "", 'value', noinv=>1 ],
'filterdesc:->' => [ "%s", "", 'value', noinv=>1 ],
'filterdesc:b' => [ _"between %s and %s", _"between", 'value value'],
'filterdesc:-b' => _"not between %s and %s",
'filterdesc:-e' => "%s",
'filterdesc:h' => [ _"in the top %s", _"in the top", 'number',], # "the %s most" "the most", ?
'filterdesc:t' => [ _"in the bottom %s",_"in the bottom", 'number',], # "the %s least" "the least", ?
'filterdesc:-h' => _"not in the top %s",
'filterdesc:-t' => _"not in the bottom %s",
'filterpat:substring' => [icase => 0],
'filterpat:regexp' => [icase => 0],
'smartfilter:>' => \&Filter::_smartstring_number_moreless,
'smartfilter:<' => \&Filter::_smartstring_number_moreless,
'smartfilter:<='=> \&Filter::_smartstring_number_moreless,
'smartfilter:>='=> \&Filter::_smartstring_number_moreless,
'smartfilter:=' => \&Filter::_smartstring_number,
'smartfilter::' => \&Filter::_smartstring_number,
'smartfilter:~' => 'm',
'smartfilter:=empty' => 'e:0',
'smartfilter:#' => undef,
filter_exclude => 'fuzzy', # do not show these filters
rightalign=>1, #right-align in SongTree and SongList
},
'number.div' =>
{ group => 'int(#_#/#ARG0#) !=',
hash => 'int(#_#/#ARG0#)', #hash:minute => '60*int(#_#/60)',
#makefilter => '"#field#:".(!#GID# ? "e:0" : "b:".(#GID# * #ARG0#)." ".((#GID#+1) * #ARG0#))',
makefilter => 'Filter->newadd(1, "#field#:-<:".(#GID# * #ARG0#), "#field#:<:".((#GID#+1) * #ARG0#) )', #FIXME decimal separator must be always "."
gid_to_display => '#GID# * #ARG0#',
get_gid => 'int(#_#/#ARG0#)',
},
fewnumber =>
{ _ => '___value[vec(____,#ID#,#bits#)]',
parent => 'number',
bits => 16,
init => '____=""; ___value[0]=undef;',
set => 'vec(____,#ID#,#bits#) = ___gid{#VAL#}||= do { push(@___value, #VAL#+0)-1; }',
check => '#VAL#= #VAL# =~m/^(-?\d*\.?\d+)$/ ? $1 : 0;',
displayformat => '%d',
},
integer =>
{ _ => 'vec(____,#ID#,#bits#)',
displayformat => '%d',
bits => 32, #use 32 bits by default
#check => '#VAL#= #VAL# =~m/^(\d+)$/ ? $1 : 0;',
check => '#VAL#= #VAL# =~m/^(\d+)/ && $1<2**#bits# ? $1 : 0;', # set to 0 if overflow
init => '____="";',
parent => 'number',
'editwidget:all'=> sub { my $field=$_[0]; GMB::TagEdit::EntryNumber->new(@_,min=>$Def{$field}{edit_min},max=>$Def{$field}{edit_max},digits=>0,mode=>$Def{$field}{edit_mode}); },
step => 1, #minimum difference between 2 values, used to simplify filters
},
'integer.div' =>
{ makefilter => '"#field#:b:".(#GID# * #ARG0#)." ".(((#GID#+1) * #ARG0#)-1)',
},
float => #make sure the string doesn't have the utf8 flag, else substr won't work
{ _ => 'unpack("F",substr(____,#ID#<<3,8))',
display => 'do {my $v=#_#; (#v_is_nan# ? "" : ::format_number($v,"#displayformat#"))}', # replace novalue (NaN) with ""
get => 'do {my $v=#_#; (#v_is_nan# ? "" : $v ); }', #
diff => ($nan==$nan ? 'do {my $new=#VAL#; $new=#nan# unless length $new; $new!=#_# }' :
'do {my $new=#VAL#; $new=#nan# unless length $new; my $v=#_#; $new!=$v && ($new==$new || ! #v_is_nan#) }'),
displayformat => '%.2f',
init => '____=" "x8;', #needs init for ID==0
parent => 'number',
nan => '$Songs::nan',
v_is_nan => ($nan==$nan ? '($v==#nan#)' : '($v!=$v)'), #on some system $nan!=$nan, on some not. In case nan==0, 0 will be treated as novalue, could treat novalue as 0 instead
novalue => '#nan#', #use NaN as novalue
default => '#novalue#',
set => 'substr(____,#ID#<<3,8)=pack("F",(length(#VAL#) ? #VAL# : #novalue#))',
check => '#VAL#= #VAL# =~m/^(-?\d*\.?\d+(?:e[-+]\d+)?)$/i ? $1 : #novalue#;',
# FIXME make sure that locale is set to C (=> '.' as decimal separator) when needed
'editwidget:all'=> sub { my $field=$_[0]; GMB::TagEdit::EntryNumber->new(@_,min=>$Def{$field}{edit_min},max=>$Def{$field}{edit_max},signed=>1,digits=>2,mode=>'allow_empty'); },
autofill_re => '-?\\d*\\.?\\d+',
'filterpat:value' => [ digits => 2, signed=>1, round => "%.2f", ],
n_sort => 'do {my $v=#_#; #v_is_nan# ? "-inf" : $v}',
'filter:defined' => 'do {my $v=#_#; .!. (#v_is_nan#)}',
'filterdesc:defined:1' => _"is defined",
'filterdesc:-defined:1' => _"is not defined",
'smartfilter:=empty' => '-defined:1',
'stats:same'=> 'do {my $v1=#HVAL#; my $v2=#_#; if (defined $v1) { #HVAL#=#nan# if $v1!=$v2; } else { #HVAL#= $v2 } }', #hval=nan if $v1!=$v2 works both if nan==nan or nan!=nan : set hval to nan if either one of them is nan or if they are not equal. That way no need to use #v_is_nan#, which would be complicated as it uses $v
},
'float.range'=>
{ get_gid => 'do {my $v=#_#; #v_is_nan# ? #nan_gid# : int($v/#range_step#) ;}',
nan_gid => '-2**31+1', #gid in FilterList are Long, 2**31-1 is GID_ALL
always_first_gid=> -2**31+1,
range_step => '1', #default step
gid_to_display => '( #GID#==#nan_gid# ? _"not defined" : do {my $v= #GID# * #range_step#; "$v .. ".($v+#range_step#)})',
gid_to_get => '( #GID#==#nan_gid# ? #nan# : #GID# * #range_step#)',
hash => '#get_gid#',
makefilter => '#GID#==#nan_gid# ? "#field#:-defined:1" : do { my $v= #GID# * #range_step#; Filter->newadd(1, "#field#:-<:".$v, "#field#:<:".($v + #range_step#)); }', #FIXME decimal separator must be always "."
'n_sort:gid' => '( do{my $n=#GID#==#nan_gid# ? "-inf" : #GID# * #range_step#;warn "#GID# => $n";$n })',
'n_sort:gid' => '( #GID#==#nan_gid# ? "-inf" : #GID# * #range_step# )',
'n_sort:gid' => '#GID#', # #nan_gid# is already the most negative number, no need to replace it with -inf
},
'length' =>
{ display => 'sprintf("%d:%02d", #_#/60, #_#%60)',
parent => 'integer',
'filter_prep:e' => \&::ConvertTimeLength,
'filter_prep:>' => \&::ConvertTimeLength,
'filter_prep:<' => \&::ConvertTimeLength,
'filter_prep:b' => sub {sort {$a <=> $b} map ::ConvertTimeLength($_), split / /,$_[0],2},
},
'length.div' => { gid_to_display => 'my $v=#GID# * #ARG0#; sprintf("%d:%02d", $v/60, $v%60);', },
size =>
{ display => '( ::format_number( #_#/'. ::MB() .',"%.1f").q( '. _"MB" .') )',
'filter_prep:e' => \&::ConvertSize,
'filter_prep:>' => \&::ConvertSize,
'filter_prep:<' => \&::ConvertSize,
'filter_prep:b' => sub {sort {$a <=> $b} map ::ConvertSize($_), split / /,$_[0],2},
parent => 'integer',
'filterpat:value' => [ unit=> \%::SIZEUNITS, default_unit=> 'm', default_value=>1, ],
},
'size.div' => { gid_to_display => '( ::format_number( #GID# * #ARG0#/'. ::MB() .',"%d").q( '. _"MB" .') )', },
rating =>
{ parent => 'integer',
bits => 8,
_ => 'vec(____,#ID#,#bits#)',
_default=> 'vec(___default_,#ID#,#bits#)',
init => '____ = ___default_ = "";',
default => '""',
diff => '(#VAL# eq "" ? 255 : #VAL#)!=#_#',
get => '(#_#==255 ? "" : #_#)',
display => '(#_#==255 ? "" : #_#)',
'stats:range' => 'push @{#HVAL#},#_default#; ---- AFTER: #HVAL#=do {my ($m0,$m1)=(sort {$a <=> $b} @{#HVAL#})[0,-1]; $m0==$m1 ? $m0 : "$m0 - $m1"}',
'stats:average' => 'push @{#HVAL#},#_default#; ---- AFTER: #HVAL#=do { my $s=0; $s+=$_ for @{#HVAL#}; $s/@{#HVAL#}; }',
check => '#VAL#= #VAL# =~m/^\d+$/ ? (#VAL#>100 ? 100 : #VAL#) : "";',
set => '{ my $v=#VAL#; #_default#= ($v eq "" ? $::Options{DefaultRating} : $v); #_# = ($v eq "" ? 255 : $v); }',
makefilter => '"#field#:~:#GID#"',
'filter:~' => '#_# .==. #VAL#',
'filter:e' => '#_default# .==. #VAL#',
'filter:>' => '#_default# .>. #VAL#',
'filter:<' => '#_default# .<. #VAL#',
'filter:b' => '#_default# .>=. #VAL1# .&&. #_default# .<=. #VAL2#',
'filterdesc:~' => [_"set to %s", _"set to", 'value'],
'filterdesc:-~' => _"not set to %s",,
'filterdesc:~:255'=> 'set to default',
'filterdesc:-~:255'=>'not set to default',
'smartfilter:=empty' => '~:255',
n_sort => '#_default#',
#array => '#_default#',
gid_to_display => '#GID#==255 ? _"Default" : #GID#',
percent => '#_default#', #for random mode
update => '___default_=____; my $d=pack "C",$::Options{DefaultRating}; ___default_=~s/\xff/$d/g;', #\xff==255 # called when $::Options{DefaultRating} has changed
#"hash:gid" => '#_#',
hash => '#_#',
'editwidget:all' => sub {GMB::TagEdit::EntryRating->new(@_) },
},
date =>
{ parent => 'integer',
display => 'Songs::DateString(#_#)',
daycount=> 'do { my $t=(time-( #_# ) )/86400; ($t<0)? 0 : $t}', #for random mode
'filter_prep:>ago' => \&::ConvertTime,
'filter_prep:<ago' => \&::ConvertTime,
'filter_prep:bago' => sub {sort {$a <=> $b} map ::ConvertTime($_), split / /,$_[0],2},
'filter:>ago' => '#_# .<. #VAL#',
'filter:<ago' => '#_# .>. #VAL#',
'filter:bago' => '#_# .>=. #VAL1# .&&. #_# .<=. #VAL2#',
#'filterdesc:e' => [_"is equal to %s", _"is equal to", 'date' ],
filter_exclude => 'e', # do not show these filters
'filterdesc:>ago' => [_"more than %s ago", _"more than", 'ago', ],
'filterdesc:<ago' => [_"less than %s ago", _"less than", 'ago', ],
'filterdesc:>' => [_"after %s", _"after", 'date', ],
'filterdesc:<' => [_"before %s", _"before", 'date', ],
'filterdesc:b' => [_"between %s and %s", _"between (absolute dates)", 'date date'],
'filterdesc:bago' => [_"between %s ago and %s ago", _"between (relative dates)", 'ago ago'],
'filterdesc:->ago' => _"less than %s ago",
'filterdesc:-<ago' => _"more than %s ago",
'filterdesc:->' => _"before %s",
'filterdesc:-<' => _"after %s",
'filterdesc:-b' => _"not between %s and %s",
'filterdesc:-bago' => _"not between %s ago and %s ago",
'filterdesc:h' => [ _"the %s most recent", _"the most recent", 'number'], #"the %s latest" "the latest" ?
'filterdesc:t' => [ _"the %s least recent", _"the least recent", 'number'], #"the %s earliest" "the earliest" ?
'filterdesc:-h' => _"not the %s most recent",
'filterdesc:-t' => _"not the %s least recent",
'filterpat:ago' => [ unit=> \%::DATEUNITS, default_unit=> 'd', ],
'filterpat:date' => [ display=> sub { my $var=shift; $var= ::strftime_utf8('%c',localtime $var) if $var=~m/^\d+$/; $var; }, ],
default_filter => '<ago',
'smartfilter:>' => \&Filter::_smartstring_date_moreless,
'smartfilter:<' => \&Filter::_smartstring_date_moreless,
'smartfilter:<='=> \&Filter::_smartstring_date_moreless,
'smartfilter:>='=> \&Filter::_smartstring_date_moreless,
'smartfilter:=' => \&Filter::_smartstring_date,
'smartfilter::' => \&Filter::_smartstring_date,
'smartfilter:~' => 'm',
'smartfilter:=empty' => 'e:0',
#for date.year, date.month, date.day :
always_first_gid=> 0,
group => '#mktime# !=',
get_gid => '#_# ? #mktime# : 0',
hash => '(#_# ? #mktime# : 0)', #or use post-hash modification for 0 case
subtypes_menu=> \%timespan_menu,
grouptitle=> 'my $gid=#get_gid#; #gid_to_display(GID=$gid)#;',
rightalign=>0,
},
'date.year' =>
{ mktime => '::mktime(0,0,0,1,0,(localtime(#_#))[5])',
gid_to_display => '(#GID# ? ::strftime_utf8("%Y",localtime(#GID#)) : _"never")',
makefilter => '"#field#:".(!#GID# ? "e:0" : "b:".#GID#." ".(::mktime(0,0,0,1,0,(localtime(#GID#))[5]+1)-1))',
},
'date.month' =>
{ mktime => '::mktime(0,0,0,1,(localtime(#_#))[4,5])',
gid_to_display => '(#GID# ? ::strftime_utf8("%b %Y",localtime(#GID#)) : _"never")',
makefilter => '"#field#:".(!#GID# ? "e:0" : "b:".#GID#." ".do{my ($m,$y)= (localtime(#GID#))[4,5]; ::mktime(0,0,0,1,$m+1,$y)-1})',
},
'date.day' =>
{ mktime => '::mktime(0,0,0,(localtime(#_#))[3,4,5])',
gid_to_display => '(#GID# ? ::strftime_utf8("%x",localtime(#GID#)) : _"never")',
makefilter => '"#field#:".(!#GID# ? "e:0" : "b:".#GID#." ".do{my ($d,$m,$y)= (localtime(#GID#))[3,4,5]; ::mktime(0,0,0,$d+1,$m,$y)-1})',
},
dates_compact => # ___index_ : binary string containing position (in unit of 1 date => 4 bytes) of the first date in ___values_ for each song
# ___nb_ : binary string containing number of dates for each song
# ___values_ : binary string containing the actual dates
# ___free_ : array containing free positions in ___values_ for each size
{ parent => 'dates',
_ => 'substr(___values_, #index# * #bytes#, #nb# * #bytes#)',
index => 'vec(___index_,#ID#,32)', # => max 2**32 songs that share the same number of dates, could maybe use 16 bits instead
nb => 'vec(___nb_,#ID#,16)', # => max 2**16 dates per song, could maybe use 8 bits instead
get_list => 'unpack("#packformat#*", #_#)',
init => '___index_= ___values_= ___nb_ = "";',
set => '{ my $v=#VAL#;
my @list= !$v ? () : sort { $a <=> $b } (ref $v ? @$v : split /\D+/,$v);
if (my $nb=#nb#) { ___free_[$nb].= pack "N",#index#; } # add previous space to list of free spaces
if (@list)
{ my $string= pack "#packformat#*", @list;
my $nb= #nb#= scalar @list;
if (___free_[$nb]) # re-use old space
{ #index#= unpack "N", substr(___free_[$nb],-4,4,"");
#_#= $string;
}
else # use new space
{ #index#= length(___values_)/#bytes#;
___values_ .= $string;
}
}
else { #index#=0; #nb#=0 }
}',
'filter:ecount' => '#VAL# .==. #nb#',
'stats:count' => '#HVAL# += #nb#;',
},
dates =>
{ parent => 'generic', # for m mi s si filters
_ => '____[#ID#]',
default => 'undef',
bits => 32, packformat=> 'L', # replace with 64 and Q for 64bits dates
bytes => '(#bits#/8)',
check => ';',
get_list => 'unpack("#packformat#*",#_#||"")',
display => 'join("\n",map Songs::DateString($_), reverse #get_list#)',
gid_to_get => '#GID#',
gid_to_display => 'Songs::DateString(#GID#)',
#n_sort => 'unpack("#packformat#*",substr(#_#||"",-#bytes#))', #sort by last date, not used
'n_sort:gid' => '#GID#',
get => 'join(" ",#get_list#)',
set => '{ my $v=#VAL#;
my @list= !$v ? () : sort { $a <=> $b } (ref $v ? @$v : split /\D+/,$v);
#_#= !@list ? undef : pack("#packformat#*", @list);
}', #use undef instead of '' if no dates to save some memory
diff => 'do {my $old=#_#||""; my $new=#VAL#; $new= pack "#packformat#*",sort { $a <=> $b } (ref $new ? @$new : split /\D+/,$new); $old ne $new; }',
check_multi => 'for my $lref (@{#VAL#}) {@$lref=grep m/^\d+$/, @$lref}',
set_multi => 'do {my %h; $h{$_}=0 for #get_list#; my ($toadd,$torm,$toggle)=@{#VAL#}; $h{$_}= (exists $h{$_} ? -1 : 1) for @$toggle; $h{$_}++ for @$toadd; $h{$_}-- for @$torm; (scalar grep $h{$_}!=0, keys %h) ? [grep $h{$_}>=0, keys %h] : undef; }',
'filter:ecount' => '#VAL# .==. length(#_#)/#bytes#',
'stats:count' => '#HVAL# += length(#_#)/#bytes#;',
#example of use : Songs::BuildHash('artist',$::Library,undef,'playhistory:countrange:DATE1-DATE2')); where DATE1 and DATE2 are secongs since epoch and DATE1<DATE2
'stats:countrange' => 'INIT: my ($$date1,$$date2)= #ARG#=~m/(\d+)/g; ---- #HVAL# ++ for grep $$date1<$_ && $$date2>$_, #get_list#;', #count plays between 2 dates (in seconds since epoch)
'stats:countafter' => '#HVAL# ++ for grep #ARG#<$_, #get_list#;', #count plays after date (in seconds since epoch)
'stats:countbefore' => '#HVAL# ++ for grep #ARG#>$_, #get_list#;', #count plays before date (in seconds since epoch)
stats => 'do {#HVAL#{$_}=undef for #get_list#;};',
'filter:e' => '.!!. do{ grep($_ == #VAL#, #get_list#) }',
'filter:>' => '.!!. do{ grep($_ > #VAL#, #get_list#) }',
'filter:<' => '.!!. do{ grep($_ < #VAL#, #get_list#) }',
'filter:b' => '.!!. do{ grep($_ >= #VAL1# && $_ <= #VAL2#, #get_list#) }',
'filter_prep:>' => \&filter_prep_numbers,
'filter_prep:<' => \&filter_prep_numbers,
'filter_prep:e' => \&filter_prep_numbers,
'filter_prep:b' => \&filter_prep_numbers_between,
'filter_prep:>ago' => \&::ConvertTime,
'filter_prep:<ago' => \&::ConvertTime,
'filter_prep:bago' => sub {sort {$a <=> $b} map ::ConvertTime($_), split / /,$_[0],2},
'filter:>ago' => '.!!. do{ grep($_ < #VAL#, #get_list#) }',
'filter:<ago' => '.!!. do{ grep($_ > #VAL#, #get_list#) }',
'filter:bago' => '.!!. do{ grep($_ >= #VAL1# && $_ <= #VAL2#, #get_list#) }',
#copy of filterdesc:* smartfilter:* from date type
'filterdesc:>ago' => [_"more than %s ago", _"more than", 'ago', ],
'filterdesc:<ago' => [_"less than %s ago", _"less than", 'ago', ],
'filterdesc:>' => [_"after %s", _"after", 'date', ],
'filterdesc:<' => [_"before %s", _"before", 'date', ],
'filterdesc:b' => [_"between %s and %s", _"between (absolute dates)", 'date date'],
'filterdesc:bago' => [_"between %s ago and %s ago", _"between (relative dates)", 'ago ago'],
'filterdesc:->ago' => _"not more than %s ago",
'filterdesc:-<ago' => _"not less than %s ago",
'filterdesc:->' => _"not after %s",
'filterdesc:-<' => _"not before %s",
'filterdesc:-b' => _"not between %s and %s",
'filterdesc:-bago' => _"not between %s ago and %s ago",
'filterdesc:h' => [ _"the %s most recent", _"the most recent", 'number'], #"the %s latest" "the latest" ?
'filterdesc:t' => [ _"the %s least recent", _"the least recent", 'number'], #"the %s earliest" "the earliest" ?
'filterdesc:-h' => _"not the %s most recent",
'filterdesc:-t' => _"not the %s least recent",
'filterpat:ago' => [ unit=> \%::DATEUNITS, default_unit=> 'd', ],
'filterpat:date' => [ display=> sub { my $var=shift; $var= ::strftime_utf8('%c',localtime $var) if $var=~m/^\d+$/; $var; }, ],
default_filter => '<ago',
'smartfilter:>' => \&Filter::_smartstring_date_moreless,
'smartfilter:<' => \&Filter::_smartstring_date_moreless,
'smartfilter:<='=> \&Filter::_smartstring_date_moreless,
'smartfilter:>='=> \&Filter::_smartstring_date_moreless,
'smartfilter:=' => \&Filter::_smartstring_date,
'smartfilter::' => \&Filter::_smartstring_date,
'smartfilter:=empty' => 'ecount:0',
'smartfilter:#' => undef,
filter_exclude => 'fuzzy', # do not show these filters
#get_gid => '[#get_list#]',
#hashm => '#get_list#',
#mktime => '$_',
#for dates.year, dates.month, dates.day :
always_first_gid=> 0,
get_gid => '[#_# ? (map #mktime#,#get_list#) : 0]',
hashm => '(#_# ? (map #mktime#,#get_list#) : 0)', #or use post-hash modification for 0 case
subtypes_menu=> \%timespan_menu,
},
#identical to date.*, except #_# is replaced by $_ in mktime, and "e" filter by "ecount"
'dates.year' =>
{ mktime => '::mktime(0,0,0,1,0,(localtime($_))[5])',
gid_to_display => '(#GID# ? ::strftime_utf8("%Y",localtime(#GID#)) : _"never")',
makefilter => '"#field#:".(!#GID# ? "ecount:0" : "b:".#GID#." ".(::mktime(0,0,0,1,0,(localtime(#GID#))[5]+1)-1))',
},
'dates.month' =>
{ mktime => '::mktime(0,0,0,1,(localtime($_))[4,5])',
gid_to_display => '(#GID# ? ::strftime_utf8("%b %Y",localtime(#GID#)) : _"never")',
makefilter => '"#field#:".(!#GID# ? "ecount:0" : "b:".#GID#." ".do{my ($m,$y)= (localtime(#GID#))[4,5]; ::mktime(0,0,0,1,$m+1,$y)-1})',
},
'dates.day' =>
{ mktime => '::mktime(0,0,0,(localtime($_))[3,4,5])',
gid_to_display => '(#GID# ? ::strftime_utf8("%x",localtime(#GID#)) : _"never")',
makefilter => '"#field#:".(!#GID# ? "ecount:0" : "b:".#GID#." ".do{my ($d,$m,$y)= (localtime(#GID#))[3,4,5]; ::mktime(0,0,0,$d+1,$m,$y)-1})',
},
boolean =>
{ parent => 'integer', bits => 1,
check => '#VAL#= #VAL# ? 1 : 0;',
display => "(#_# ? #yes# : #no#)", yes => '_("Yes")', no => 'q()',
'editwidget:all'=> sub { my $field=$_[0]; GMB::TagEdit::EntryBoolean->new(@_); },
'filterdesc:e:0' => [_"is false",_"is false",'',noinv=>1],
'filterdesc:e:1' => [_"is true", _"is true", '',noinv=>1],
'filterdesc:-e:0' => _"is true",
'filterdesc:-e:1' => _"is false",
filter_exclude => 'ALL', #do not show filters inherited from parents
default_filter => 'e:1',
'smartfilter:=empty' => 'e:0',
rightalign=>0,
},
shuffle=>
{ n_sort => 'Songs::update_shuffle($Songs::LastID) ---- vec($Songs::SHUFFLE,#ID#,32)',
},
gidshuffle=>
{ n_sort => 'Songs::update_shuffle(##mainfield#->maxgid#) ---- vec($Songs::SHUFFLE,##mainfield#->get_gid#,32)',
},
writeonly=>
{ diff=>'1',
set => '',
check=>'',
},
);
%Def= #flags : Read Write Editable Sortable Column caseInsensitive sAve List Gettable Properties
(file =>
{ name => _"Filename", width => 400, flags => 'fgascp_', type => 'filename',
'stats:filetoid' => '#HVAL#{ #file->get# }=#ID#',
category=>'file',
alias => 'filename',
},
id =>
{ type=> 'integer',
_ => '#ID#',
'stats:list' => 'push @{#HVAL#}, #ID#',
'stats:uniq' => '#HVAL#=undef', #doesn't really belong here, but simpler this way
'stats:count' => '#HVAL#++',
},
path =>
{ name => _"Folder", width => 200, flags => 'fgascp_', type => 'filename',
'filter:i' => '#_# .=~. m/^#VAL#(?:$::QSLASH|$)/o',
'filter_prep:i' => sub { quotemeta ::decode_url($_[0]); },
'filterdesc:i' => [_"is in %s", _"is in", 'filename'],
'filterdesc:-i' => _"isn't in %s",
'filterpat:filename' => [ display => sub { ::filename_to_utf8displayname(::decode_url($_[0])); }, ],
can_group=>1,
category=>'file',
alias => 'folder',
},
modif =>
{ name => _"Modification", width => 160, flags => 'fgarscp_', type => 'date',
FilterList => {type=>'year',},
can_group=>1,
category=>'file',
alias => 'modified',
},
size =>
{ name => _"Size", width => 80, flags => 'fgarscp_', #32bits => 4G max
type => 'size',
FilterList => {type=>'div.'.::MB(),},
category=>'file',
},
title =>
{ name => _"Title", width => 270, flags => 'fgarwescpi', type => 'istring',
id3v1 => 0, id3v2 => 'TIT2', vorbis => 'title', ape => 'Title', lyrics3v2=> 'ETT', ilst => "\xA9nam",
'filter:~' => '#_iname# .=~. m"(?:^|/) *#VAL# *(?:[/\(\[]|$)"', 'filter_prep:~'=> \&Filter::SmartTitleRegEx,
'filter_simplify:~' => \&Filter::SmartTitleSimplify,
'filterdesc:~' => [_"is smart equal to %s", _"is smart equal", 'substring'],
'filterdesc:-~' => _"Isn't smart equal to %s",
makefilter_fromID => '"title:~:" . #get#',
edit_order=> 10, letter => 't',
category=>'basic',
alias_trans=> ::_p('Field_aliases',"title"), #TRANSLATION: comma-separated list of field aliases for title, these are in addition to english aliases
articles=>1,
},
artist =>
{ name => _"Artist", width => 200, flags => 'fgarwescpi',
type => 'artist',
id3v1 => 1, id3v2 => 'TPE1', vorbis => 'artist', ape => 'Artist', lyrics3v2=> 'EAR', ilst => "\xA9ART",
FilterList => {search=>1,drag=>::DRAG_ARTIST},
all_count=> _"All artists",
apic_id => 8,
picture_field => 'artist_picture',
edit_order=> 20, edit_many=>1, letter => 'a',
can_group=>1,
#names => '::__("%d artist","%d artists",#count#);'
category=>'basic',
alias=> 'by',
alias_trans=> ::_p('Field_aliases',"artist,by"), #TRANSLATION: comma-separated list of field aliases for artist, these are in addition to english aliases
articles=>1,
},
first_artist =>
{ flags => 'fig',
type => 'artist_first', depend => 'artists', name => _"Main artist",
FilterList => {search=>1,drag=>::DRAG_ARTIST},
picture_field => 'artist_picture',
sortgroup=>'artist',
can_group=>1,
articles=>1,
},
artists =>
{ flags => 'gfil', type => 'artists', depend => 'artist title', name => _"Artists",
all_count=> _"All artists",
FilterList => {search=>1,drag=>::DRAG_ARTIST},
picture_field => 'artist_picture',
articles=>1,
},
album =>
{ name => _"Album", width => 200, flags => 'fgarwescpi', type => 'album',
id3v1 => 2, id3v2 => 'TALB', vorbis => 'album', ape => 'Album', lyrics3v2=> 'EAL', ilst => "\xA9alb",
depend => 'artist album_artist_raw compilation', #because albums with no names get the name : <Unknown> (artist)
all_count=> _"All albums",
FilterList => {search=>1,drag=>::DRAG_ALBUM},
apic_id => 3,
picture_field => 'album_picture',
names => '::__("%d album","%d albums",#count#);',
edit_order=> 30, edit_many=>1, letter => 'l',
can_group=>1,
category=>'basic',
alias=> 'on',
alias_trans=> ::_p('Field_aliases',"album,on"), #TRANSLATION: comma-separated list of field aliases for album, these are in addition to english aliases
articles=>1,
},
# genre_picture =>
# { name => "Genre picture",
# flags => 'g',
# depend => 'genre',
# property_of => 'genre',
# mainfield => 'genre',
# type => '_picture',
# },
album_picture =>
{ name => _"Album picture",
flags => 'g',
depend => 'album',
property_of => 'album',
mainfield => 'album',
type => '_picture',
letter => 'c',
},
artist_picture =>
{ name => _"Artist picture",
flags => 'g',
depend => 'artist',
property_of => 'artist',
mainfield => 'artist',
type => '_picture',
},
album_artist_raw =>
{ name => _"Album artist",width => 200, flags => 'fgarwescpi', type => 'artist',
id3v2 => 'TPE2', vorbis => 'albumartist|album_artist', ape => 'Album Artist|Album_artist', ilst => "aART",
#FilterList => {search=>1,drag=>::DRAG_ARTIST},
picture_field => 'artist_picture',
edit_order=> 35, edit_many=>1,
#can_group=>1,
category=>'basic',
},
album_artist =>
{ name => _"Album artist or artist",width => 200, flags => 'fgcsi', type => 'artist',
FilterList => {search=>1,drag=>::DRAG_ARTIST},
picture_field => 'artist_picture',
_ => 'do {my $n=vec(__album_artist_raw__,#ID#,#bits#); $n==1 ? vec(__artist__,#ID#,#bits#) : $n}',
can_group=>1,
letter => 'A',
depend => 'album_artist_raw artist album',
category=>'basic',
articles=>1,
},
album_has_picture=>
{ name => _"Album has picture", width => 20, flags => 'fgcs', type => 'boolean',
_ => '!!(__#mainfield#_picture[ ##mainfield#->get_gid# ])', mainfield=> 'album',
},
artist_has_picture=>
{ name => _"Artist has picture", width => 20, flags => 'fgcs', type => 'boolean',
_ => '!!(__#mainfield#_picture[ ##mainfield#->get_gid# ])', mainfield=> 'artist',
},
has_picture =>
{ name => _"Embedded picture", width => 20, flags => 'fgarscp', type => 'boolean',
id3v2 => 'APIC', vorbis => 'METADATA_BLOCK_PICTURE', 'ilst' => 'covr',
category=>'extra',
disable=>1, options => 'disable',
},
has_lyrics =>
{ name => _"Embedded lyrics", width => 20, flags => 'fgarscp', type => 'boolean',
id3v2 => 'TXXX;FMPS_Lyrics;%v | USLT;;;%v', vorbis => 'FMPS_LYRICS|lyrics', ape => 'FMPS_LYRICS|Lyrics',
'ilst' => "----FMPS_Lyrics|\xA9lyr", lyrics3v2 => 'LYR',
category=>'extra',
disable=>1, options => 'disable',
},
compilation =>
{ name => _"Compilation", width => 20, flags => 'fgarwescp', type => 'boolean',
id3v2 => 'TCMP', vorbis => 'compilation', ape => 'Compilation', ilst => 'cpil',
edit_many=>1,
category=>'basic',
},
grouping =>
{ name => _"Grouping", width => 100, flags => 'fgarwescpi', type => 'fewstring',
FilterList => {search=>1},
can_group=>1,
edit_order=> 55, edit_many=>1,
id3v2 => 'TIT1', vorbis => 'grouping', ape => 'Grouping', ilst => "\xA9grp",
category=>'extra',
articles=>1,
},
year =>
{ name => _"Year", width => 40, flags => 'fgarwescp', type => 'integer', bits => 16,
edit_max=>3000, edit_mode=> 'year',
check => '#VAL#= #VAL# =~m/(\d\d\d\d)/ ? $1 : 0;',
id3v1 => 3, id3v2 => 'TDRC|TYER', 'id3v2.3'=> 'TYER|TDRC', 'id3v2.4'=> 'TDRC|TYER', vorbis => 'date|year', ape => 'Record Date|Year', ilst => "\xA9day",
prewrite=> sub { $_[0] ? $_[0] : undef }, #remove tag if 0
gid_to_display => '#GID# ? #GID# : _"None"',
'stats:range' => '#HVAL#{#_#}=undef; ---- AFTER: delete #HVAL#{0}; #HVAL#=do {my ($m0,$m1)=(sort {$a <=> $b} keys %{#HVAL#})[0,-1]; !defined $m0 ? "" : $m0==$m1 ? $m0 : "$m0 - $m1"}',
editwidth => 6,
edit_order=> 50, edit_many=>1, letter => 'y',
can_group=>1,
FilterList => {},
autofill_re => '[12]\\d{3}',
category=>'basic',
},
track =>
{ name => _"Track", width => 40, flags => 'fgarwescp',
id3v1 => 5, id3v2 => 'TRCK', vorbis => 'tracknumber', ape => 'Track', ilst => "trkn",
prewrite=> sub { $_[0] ? $_[0] : undef }, #remove tag if 0
type => 'integer', displayformat => '%02d', bits => 16,
edit_max => 65535, edit_mode=> 'nozero',
edit_order=> 20, editwidth => 4, letter => 'n',
category=>'basic',
},
disc =>
{ name => _"Disc", width => 40, flags => 'fgarwescp', type => 'integer', bits => 8,
edit_max => 255, edit_mode=> 'nozero',
id3v2 => 'TPOS', vorbis => 'discnumber', ape => 'discnumber', ilst => "disk|disc",
prewrite=> sub { $_[0] ? $_[0] : undef }, #remove tag if 0
editwidth => 4,
edit_order=> 40, edit_many=>1, letter => 'd',
can_group=>1,
category=>'basic',
alias => 'disk',
},
discname =>
{ name => _"Disc name", width => 100, flags => 'fgarwescpi', type => 'fewstring',
id3v2 => 'TSST', vorbis => 'discsubtitle', ape => 'DiscSubtitle', ilst=> '----DISCSUBTITLE',
edit_many=>1,
disable=>1, options => 'disable',
category=>'extra',
alias => 'diskname',
},
genre =>
{ name => _"Genres", width => 180, flags => 'fgarwescpil',
#is_set => '(__GENRE__=~m/(?:^|\x00)__QVAL__(?:$|\x00)/)? 1 : 0', #for random mode
id3v1 => 6, id3v2 => 'TCON', vorbis => 'genre', ape => 'Genre', ilst => "\xA9gen & ----genre",
read_split => qr/\s*;\s*/,
type => 'flags', #default_persistent_values => \@Tag::MP3::Genres,
none => quotemeta _"No genre",
all_count => _"All genres",
FilterList => {search=>1},
edit_order=> 70, edit_many=>1, letter => 'g',
category=>'basic',
editsubmenu=>0,
options => 'editsubmenu',
# picture_field => 'genre_picture',
},
label =>
{ name => _"Labels", width => 180, flags => 'fgaescpil',
#is_set => '(__LABEL__=~m/(?:^|\x00)__QVAL__(?:$|\x00)/)? 1 : 0', #for random mode
type => 'flags',
iconprefix => 'label-',
icon => sub { $Def{label}{iconprefix}.$_[0]; }, #FIXME use icon_for_gid
icon_for_gid => '"#iconprefix#".#gid_to_get#',
all_count => _"All labels",
edit_string => _"Edit labels",
none => quotemeta _"No label",
FilterList => {search=>1,icon=>1},
icon_edit_string=> _"Choose icon for label {name}",
edit_order=> 80, edit_many=>1, letter => 'L',
category=>'extra',
editsubmenu=>1,
options => 'persistent_values editsubmenu',
default_persistent_values => [_("favorite"),_("bootleg"),_("broken"),_("bonus tracks"),_("interview"),],
},
mood =>
{ name => _"Moods", width => 180, flags => 'fgarwescpil',
id3v2 => 'TMOO', vorbis => 'MOOD', ape => 'Mood', ilst => "----MOOD",
read_split => qr/\s*;\s*/,
type => 'flags',
none => quotemeta _"No moods",
all_count => _"All moods",
FilterList => {search=>1},
edit_order=> 71, edit_many=>1,
disable=>1, options => 'disable editsubmenu',
editsubmenu=>0,
category=>'extra',
},
style =>
{ name => _"Styles", width => 180, flags => 'fgaescpil',
type => 'flags',
all_count => _"All styles",
none => quotemeta _"No styles",
FilterList => {search=>1,},
edit_order=> 72, edit_many=>1,
disable=>1, options => 'disable editsubmenu',
editsubmenu=>0,
category=>'extra',
},
theme =>
{ name => _"Themes", width => 180, flags => 'fgaescpil',
type => 'flags',
all_count => _"All themes",
none => quotemeta _"No themes",
FilterList => {search=>1,},
edit_order=> 73, edit_many=>1,
disable=>1, options => 'disable editsubmenu',
editsubmenu=>0,
category=>'extra',
},
comment=>
{ name => _"Comment", width => 200, flags => 'fgarwescpi', type => 'text',
id3v1 => 4, id3v2 => 'COMM;;;%v', vorbis => 'description|comment|comments', ape => 'Comment', lyrics3v2=> 'INF', ilst => "\xA9cmt", join_with => "\n",
edit_order=> 60, edit_many=>1, letter => 'C',
category=>'basic',
},
rating =>
{ name => _"Rating", width => 80, flags => 'fgaescp', type => 'rating',
id3v2 => 'TXXX;FMPS_Rating_User;%v::%i & TXXX;FMPS_Rating;%v | percent( TXXX;gmbrating;%v ) | five( TXXX;rating;%v )',
vorbis => 'FMPS_RATING_USER::%i & FMPS_RATING | percent( gmbrating ) | five( rating )',
ape => 'FMPS_RATING_USER::%i & FMPS_RATING | percent( gmbrating ) | five( rating )',
ilst => '----FMPS_Rating_User::%i & ----FMPS_Rating | percent( ----gmbrating ) | five( ----rating )',
postread=> \&FMPS_rating_postread,
prewrite=> \&FMPS_rating_prewrite,
'postread:five'=> sub { my $v=shift; length $v && $v=~m/^\d+$/ && $v<=5 ? sprintf('%d',$v*20) : undef }, # for reading foobar2000 rating 0..5 ?
'postread:percent'=> sub { $_[0] }, # for anyone who used gmbrating
FilterList => {},
starprefix => 'stars',
edit_order=> 90, edit_many=>1,
edit_string=> _"Edit rating",
editsubmenu=>1,
options => 'rw_ userid editsubmenu stars',
'filterpat:value' => [ round => "%d", unit => '%', max=>100, default_value=>50, ],
category=>'basic',
alias => 'stars',
},
ratingnumber => #same as rating but returns DefaultRating if rating set to default, will be replaced by rating.number or something in the future
{ type => 'virtual',
flags => 'g',
depend => 'rating',
get => '#rating->_default#',
},
added =>
{ name => _"Added", width => 100, flags => 'fgascp_', type => 'date',
FilterList => {type=>'month', },
can_group=>1,
category=>'stats',
},
lastplay =>
{ name => _"Last played", width => 100, flags => 'fgascp', type => 'date',
FilterList => {type=>'month',},
can_group=>1, letter => 'P',
'filterdesc:e:0' => _"never",
'filterdesc:-e:0' => _"has been played", #FIXME better description
category=>'stats',
#alias => 'played',
},
playhistory =>
{ name => _"Play history", flags => 'fgalp', type=> 'dates_compact',
FilterList => {type=>'month',},
'filterdesc:ecount:0' => _"never",
'filterdesc:-ecount:0' => _"has been played", #FIXME better description
alias => 'played',
category=>'stats',
disable=>0, options => 'disable',
},
lastskip =>
{ name => _"Last skipped", width => 100, flags => 'fgascp', type => 'date',
FilterList => {type=>'month',},
can_group=>1, letter => 'K',
'filterdesc:e:0' => _"never",
'filterdesc:-e:0' => _"has been skipped", #FIXME better description
category=>'stats',
alias => 'skipped',
},
skiphistory =>
{ name => _"Skip history", flags => 'fgalp', type=> 'dates_compact',
FilterList => {type=>'month',},
'filterdesc:ecount:0' => _"never",
'filterdesc:-ecount:0' => _"has been skipped", #FIXME better description
#alias => 'skipped',
category=>'stats',
disable=>1, options => 'disable',
},
playcount =>
{ name => _"Play count", width => 50, flags => 'fgaescp', type => 'integer', letter => 'p',
options => 'rw_ userid',
id3v2 => 'TXXX;FMPS_Playcount;%v&TXXX;FMPS_Playcount_User;%v::%i',
vorbis => 'FMPS_PLAYCOUNT&FMPS_PLAYCOUNT_USER::%i',
ape => 'FMPS_PLAYCOUNT&FMPS_PLAYCOUNT_USER::%i',
ilst => '----FMPS_Playcount&----FMPS_Playcount_User::%i',
postread=> sub { my $v=shift; length $v ? sprintf('%d',$v) : undef },
prewrite=> sub { sprintf('%.1f', $_[0]); },
category=>'stats',
alias => 'plays',
edit_order=> 90,
options => 'editable',
},
skipcount =>
{ name => _"Skip count", width => 50, flags => 'fgaescp', type => 'integer', letter => 'k',
category=>'stats',
alias => 'skips',
edit_order=> 91,
options => 'editable',
},
composer =>
{ name => _"Composer", width => 100, flags => 'fgarwescpi', type => 'artist',
id3v2 => 'TCOM', vorbis => 'composer', ape => 'Composer', ilst => "\xA9wrt",
apic_id => 11,
picture_field => 'artist_picture',
FilterList => {search=>1},
edit_many=>1,
disable=>1, options => 'disable',
category=>'extra',
articles=>1,
},
lyricist =>
{ name => _"Lyricist", width => 100, flags => 'fgarwescpi', type => 'artist',
id3v2 => 'TEXT', vorbis => 'LYRICIST', ape => 'Lyricist', ilst => '---LYRICIST',
apic_id => 12,
picture_field => 'artist_picture',
FilterList => {search=>1},
edit_many=>1,
disable=>1, options => 'disable',
category=>'extra',
articles=>1,
},
conductor =>
{ name => _"Conductor", width => 100, flags => 'fgarwescpi', type => 'artist',
id3v2 => 'TPE3', vorbis => 'CONDUCTOR', ape => 'Conductor', ilst => '---CONDUCTOR',
apic_id => 9,
picture_field => 'artist_picture',
FilterList => {search=>1},
edit_many=>1,
disable=>1, options => 'disable',
category=>'extra',
articles=>1,
},
remixer =>
{ name => _"Remixer", width => 100, flags => 'fgarwescpi', type => 'artist',
id3v2 => 'TPE4', vorbis => 'REMIXER', ape => 'MixArtist', ilst => '---REMIXER',
picture_field => 'artist_picture',
FilterList => {search=>1},
edit_many=>1,
disable=>1, options => 'disable',
category=>'extra',
articles=>1,
},
version=> #subtitle ?
{ name => _"Version", width => 150, flags => 'fgarwescpi', type => 'fewstring',
id3v2 => 'TIT3', vorbis => 'version|subtitle', ape => 'Subtitle', ilst=> '----SUBTITLE',
category=>'extra',
},
bpm =>
{ name => _"BPM", width => 60, flags => 'fgarwescp', type => 'integer',
id3v2 => 'TBPM', vorbis => 'BPM', ape => 'BPM', ilst=> 'tmpo',
FilterList => {type=>'div.10',},
disable=>1, options => 'disable',
category=>'extra',
},
channel=>
{ name => _"Channels", width => 50, flags => 'fgarscp', type => 'integer', bits => 4, audioinfo => 'channels',
default_filter => 'e:2',
'filterdesc:e:1' => _"is mono",
'filterdesc:-e:1'=> _"isn't mono",
'filterdesc:e:2' => _"is stereo",
'filterdesc:-e:2'=> _"isn't stereo",
category=>'audio',
},
bitrate=>
{ name => _"Bitrate", width => 90, flags => 'fgarscp_', type => 'integer', bits => 16, audioinfo => 'bitrate|bitrate_nominal', check => '#VAL#= sprintf "%.0f",#VAL#/1000;',
display => '::replace_fnumber("%d kbps",#_#)',
FilterList => {type=>'div.32',},
'filterpat:value' => [ round => "%d", unit => 'kbps', default_value=>192 ],
category=>'audio',
},
samprate=>
{ name => _"Sampling Rate", width => 90, flags => 'fgarscp', type => 'fewnumber', bits => 8, audioinfo => 'rate',
display => '::replace_fnumber("%d Hz",#_#)',
FilterList => {},
'filterdesc:e:44100' => _"is 44.1kHz",
'filterpat:value' => [ round => "%d", unit => 'Hz', step=> 100, default_value=>44100 ],
category=>'audio',
},
filetype=>
{ name => _"File type", width => 80, flags => 'fgarscp', type => 'fewstring', bits => 8, #could probably fit in 4bit
FilterList => {},
'filterdesc:m:^mp3' => _"is a mp3 file",
'filterdesc:m:^mp4 mp4a'=> _"is an aac file",
'filterdesc:m:^mp4 alac'=> _"is an alac file",
'filterdesc:m:^mp4' => _"is an mp4/m4a file",
'filterdesc:m:^vorbis' => _"is a vorbis file",
'filterdesc:m:^flac' => _"is a flac file",
'filterdesc:m:^mpc' => _"is a musepack file",
'filterdesc:m:^wv' => _"is a wavepack file",
'filterdesc:m:^ape' => _"is an ape file",
'filterdesc:m:^ape|^flac|^mp4 alac|^wv' => _"is a lossless file",
'filterdesc:-m:^ape|^flac|^mp4 alac|^wv'=> _"is a lossy file",
category=>'audio',
alias => 'type',
},
'length'=>
{ name => _"Length", width => 50, flags => 'fgarscp_', type => 'length', bits => 16, # 16 bits limit length to ~18.2 hours
audioinfo => 'seconds', check => '#VAL#= sprintf "%.0f",#VAL#;',
FilterList => {type=>'div.60',},
'filterpat:value' => [ unit => \%::TIMEUNITS, default_unit=> 's', default_value=>1 ],
letter => 'm',
category=>'audio',
},
replaygain_track_gain=>
{ name => _"Track gain", width => 70, flags => 'fgrwscpa',
type => 'float', check => '#VAL#= do{ #VAL# =~m/^([-+]?\d*\.?\d+)\s*(?:dB)?$/i ? $1 : #novalue#};',
displayformat => '%.2f dB',
id3v2 => 'TXXX;replaygain_track_gain;%v', vorbis => 'replaygain_track_gain', ape => 'replaygain_track_gain', ilst => '----replaygain_track_gain',
prewrite=> sub { length($_[0]) && $_[0]==$_[0] ? sprintf("%.2f dB",$_[0]) : undef }, #remove tag if empty string or NaN
options => 'disable editable',
category=>'replaygain',
alias => 'track_gain trackgain',
edit_max=> 120,
edit_order=> 95,
FilterList => {type=>'range',},
},
replaygain_track_peak=>
{ name => _"Track peak", width => 60, flags => 'fgrwscpa',
id3v2 => 'TXXX;replaygain_track_peak;%v', vorbis => 'replaygain_track_peak', ape => 'replaygain_track_peak', ilst => '----replaygain_track_peak',
prewrite=> sub { length($_[0]) && $_[0]==$_[0] ? sprintf("%.6f",$_[0]) : undef }, #remove tag if empty string or NaN
type => 'float',
options => 'disable',
category=>'replaygain',
alias => 'track_peak trackpeak',
range_step=> '.1',
FilterList => {type=>'range',},
},
replaygain_album_gain=>
{ name => _"Album gain", width => 70, flags => 'fgrwscpa',
type => 'float', check => '#VAL#= do{ #VAL# =~m/^([-+]?\d*\.?\d+)\s*(?:dB)?$/i ? $1 : #novalue#};',
displayformat => '%.2f dB',
id3v2 => 'TXXX;replaygain_album_gain;%v', vorbis => 'replaygain_album_gain', ape => 'replaygain_album_gain', ilst => '----replaygain_album_gain',
prewrite=> sub { length($_[0]) && $_[0]==$_[0] ? sprintf("%.2f dB",$_[0]) : undef }, #remove tag if empty string or NaN
options => 'disable editable',
category=>'replaygain',
alias => 'album_gain albumgain',
edit_max=> 120,
edit_order=> 96,
edit_many=>1,
FilterList => {type=>'range',},
},
replaygain_album_peak=>
{ name => _"Album peak", width => 60, flags => 'fgrwscpa',
id3v2 => 'TXXX;replaygain_album_peak;%v', vorbis => 'replaygain_album_peak', ape => 'replaygain_album_peak', ilst => '----replaygain_album_peak',
prewrite=> sub { length($_[0]) && $_[0]==$_[0] ? sprintf("%.6f",$_[0]) : undef }, #remove tag if empty string or NaN
type => 'float',
options => 'disable',
category=>'replaygain',
alias => 'album_peak albumpeak',
range_step=> '.1',
FilterList => {type=>'range',},
},
replaygain_reference_level=>
{ flags => 'w', type => 'writeonly', #only used for writing
id3v2 => 'TXXX;replaygain_reference_level;%v',vorbis => 'replaygain_reference_level', ape => 'replaygain_reference_level', ilst => '----replaygain_reference_level',
category=>'replaygain',
},
playedlength => { name=> "Played length", type=>'length', flags=> 'g',
get => '#playcount->get# * #length->get#', _=>'#get#',
depend=> 'playcount length',
},
version_or_empty => { get => 'do {my $v=#version->get#; $v eq "" ? "" : " ($v)"}', type=> 'virtual', depend => 'version', flags => 'g', letter => 'V', },
album_years => { name => _"Album year(s)", get => 'AA::Get("year:range","album",#album->get_gid#)', type=> 'virtual', depend => 'album year', flags => 'g', letter => 'Y', }, #depends on years from other songs too
uri => { get => '"file://".::url_escape(#path->get# .::SLASH. #file->get#)', type=> 'virtual', depend => 'file path', flags => 'g', },
fullfilename_raw =>{ name => _"Raw filename with path", flags => 'g', letter => 'f',
get => '#fullfilename->get#', type=> 'virtual', depend => 'file path',
},
fullfilename => { get => '#path->get# .::SLASH. #file->get#',
display => '#path->display# .::SLASH. #file->display#',
makefilter_fromID => '"fullfilename:e:" . #get#',
type => 'virtual', flags => 'g', depend => 'file path', letter => 'u',
'filter:e' => '#ID# == #VAL#', 'filter_prep:e'=> sub { FindID($_[0]); },
},
barefilename => { name => _"Filename without extension", type=> 'filename', flags => 'g', letter => 'o',
get => 'do {my $s=#file->get#; $s=~s/\.[^.]+$//; $s;}', depend => 'file',
},
extension => { name => _"Filename extension", type=> 'filename', flags => 'g',
get => 'do {my $s=#file->get#; $s=~s#^.*\.##; $s;}', depend => 'file',
},
title_or_file => { get => '(#title->get# eq "" ? (#show_ext# ? #file->display# : #barefilename->display#) : #title->get#)',
type=> 'virtual', flags => 'gcs', width => 270,
name=> _"Title or filename",
depend => 'file title', letter => 'S', #why letter S ? :)
options => 'show_ext', show_ext=>0,
articles=>1,
},
missing => { flags => 'gan', type => 'integer', bits => 32, }, #FIXME store it using a 8-bit relative number to $::DAYNB
missingkey => { get => 'join "\\x1D",'.join(',',map("#$_->get#",@MissingKeyFields)), depend => "@MissingKeyFields", type=> 'virtual', }, #used to check if same song
shuffle => { name => _"Shuffle", type => 'shuffle', flags => 's', },
album_shuffle => { name => _"Album shuffle", type => 'gidshuffle', flags => 's', mainfield=>'album' },
embedded_pictures=>
{ flags => 'wl', type=>'writeonly',
id3v2 => 'APIC', vorbis => 'METADATA_BLOCK_PICTURE', 'ilst' => 'covr',
},
embedded_lyrics=>
{ flags => '', type => 'virtual',
id3v2 => 'TXXX;FMPS_Lyrics;%v | USLT;;;%v', vorbis => 'FMPS_LYRICS|lyrics', ape => 'FMPS_LYRICS|Lyrics',
'ilst' => "----FMPS_Lyrics|\xA9lyr", lyrics3v2 => 'LYR',
},
filetags => # debug field : list of the id3v2 frames / vorbis comments
{ name => "filetags", width => 180, flags => 'grascil', type => 'flags',
"id3v2:read" => sub { my $tag=shift; my %res; for my $key ($tag->get_keys) { my @v=$tag->get_values($key); if ($key=~m/^TXXX$|^COMM$|^WXXX$/) { my $i= $key eq 'COMM' ? 1 : 0; $res{"$key;$_->[$i]"}=undef for @v; } else { $res{$key}=undef; } } ; return [map "id3v2_$_", keys %res]; },
'vorbis:read' => sub { [map "vorbis_$_",$_[0]->get_keys] },
'ape:read' => sub { [map "ape_$_", $_[0]->get_keys] },
'ilst:read' => sub { [map "ilst_$_", $_[0]->get_keys] },
FilterList => {search=>1,none=>1},
none => quotemeta "No tags", #not translated because made for debugging
disable=>1,
},
list =>
{ type=> 'special',
flags => 'f',
name => _"Lists",
'filterdesc:~' => [ _"present in %s", _"present in list", 'listname',],
'filterdesc:-~' => _"not present in %s",
'filter:~' => '.!!. do {my $l=$::Options{SavedLists}{"#VAL#"}; $l ? $l->IsIn(#ID#) : undef}',
default_filter => '~',
},
length_estimated =>
{ type => 'boolean',
audioinfo=> 'estimated',
flags => 'gar',
},
);
our %FieldTemplates=
( string => { type=>'string', editname=>_"string", flags=>'fgaescp', width=> 200, edit_many =>1, options=> 'customfield', articles=>1, },
text => { type=>'text', editname=>_"multi-lines string",flags=>'fgaescp', width=> 200, edit_many =>1, options=> 'customfield', },
float => { type=>'float', editname=>_"float", flags=>'fgaescp', width=> 100, edit_many =>1, options=> 'customfield', desc => _"For decimal numbers", },
boolean => { type=>'boolean', editname=>_"boolean", flags=>'fgaescp', width=> 20, edit_many =>1, options=> 'customfield', },
flags => { type=>'flags', editname=>_"flags", flags=>'fgaescpil', width=> 180, edit_many =>1, can_group=>1, options=> 'customfield persistent_values editsubmenu', FilterList=> {search=>1}, desc=>_"Same type as labels", editsubmenu => 1, },
artist => { type=>'artist', editname=>_"artist", flags=>'fgaescpi', width=> 200, edit_many =>1, can_group=>1, options=> 'customfield', FilterList=> {search=>1,drag=>::DRAG_ARTIST}, picture_field => 'artist_picture', articles=>1, },
fewstring=>{ type=>'fewstring', editname=>_"common string", flags=>'fgaescpi',width=> 200, edit_many =>1, can_group=>1, options=> 'customfield', FilterList=> {search=>1}, desc=>_"For when values are likely to be repeated", articles=>1, },
fewnumber=>{ type=>'fewnumber', editname=>_"common number", flags=>'fgaescp', width=> 100, edit_many =>1, can_group=>1, options=> 'customfield', FilterList=> {}, desc=>_"For when values are likely to be repeated" },
integer => { type=>'integer', editname=>_"integer", flags=>'fgaescp', width=> 100, edit_many =>1, can_group=>1, options=> 'customfield', FilterList=> {}, desc => _"For integer numbers", },
rating => { type=>'rating', editname=>_"rating", flags=>'fgaescp_', width=> 80, edit_many =>1, can_group=>1, options=> 'customfield rw_ useridwarn userid editsubmenu stars', FilterList=> {},
postread => \&FMPS_rating_postread, prewrite => \&FMPS_rating_prewrite,
id3v2 => 'TXXX;FMPS_Rating_User;%v::%i', vorbis => 'FMPS_RATING_USER::%i', ape => 'FMPS_RATING_USER::%i', ilst => '----FMPS_Rating_User::%i',
starprefix => 'stars',
editsubmenu => 1,
desc => _"For alternate ratings",
},
);
$FieldTemplates{$_}{category}||='custom' for keys %FieldTemplates;
our %HSort=
( string => '$h->{$a} cmp $h->{$b} ||',
number => '$h->{$a} <=> $h->{$b} ||',
year2 => 'substr($h->{$a},-4,4) cmp substr($h->{$b},-4,4) ||',
);
# discname
# version '' : " ($v)"
#
} #end of INIT block
our $OLD_FIELDS='file path modif length size bitrate filetype channel samprate title artist album disc track year version genre comment author added lastplay playcount rating label missing lastskip skipcount';
sub FieldUpgrade #for versions <1.1
{ (split / /,$OLD_FIELDS)[$_[0]];
}
my (%Get,%Display,$DIFFsub,$NEWsub,$LENGTHsub,%UPDATEsub,$SETsub); my (%Get_gid,%Gid_to_display,%Gid_to_get);
use constant FIRSTID => 1;
our $LastID=FIRSTID-1;
sub filename_escape #same as ::url_escape but escape different characters
{ my $s=$_[0];
::_utf8_off($s);
$s=~s#([^/_.+'(),A-Za-z0-9- ])#sprintf('%%%02X',ord($1))#seg;
return $s;
}
sub Macro
{ local $_=shift;
my %h=@_;
s/#(\w+)#/exists $h{$1} ? $h{$1} : "#$1#"/eg;
return $_;
}
#sub Find_Properties
#{ my ($field,$start)=@_;
# ($field,my $subtype)=split /\./,$field;
# my @hashlist= ($Def{$field});
# my $type=$Def{$field}{type};
# warn "no type defined for field $field\n" unless $type;
# while ($type)
# { push @hashlist,$Types{"$type.$subtype"} if $subtype;
# push @hashlist,$Types{$type};
# my $plugin=$Types{$type}{plugin};
# push @hashlist,map $Types{$_}, split / /,$plugin if $plugin;
# $type= $Types{$type}{parent};
# }
# my @found;
# for my $h (grep defined, @hashlist)
# { push @found, grep index($_,$start)==0, keys %$h;
# }
# return sort @found;
#}
sub LookupCode
{ my ($field_opt,@actions)=@_;
my ($field,@opt)=split /\./,$field_opt;
my %vars;
%vars=@{pop @actions} if ref $actions[-1];
my @hashlist= ($Def{$field}, {field => $field});
my $type=$Def{$field}{type};
my $subtype=shift @opt;
#$vars{field}=$field;
if (@opt) { $vars{"ARG$_"}=$opt[$_] for 0..$#opt; }
warn "no type defined for field $field\n" unless $type;
while ($type)
{ #warn " +type $type\n";
push @hashlist,$Types{"$type.$subtype"} if $subtype;
push @hashlist,$Types{$type};
#my $plugin=$Types{$type}{plugin};
#push @hashlist,map $Types{$_}, split / /,$plugin if $plugin;
$type= $Types{$type}{parent};
}
@hashlist=grep defined, @hashlist;
my @code;
for my $action (@actions)
{ my @or=split /\|/,$action;
my $c;
while (!$c && @or)
{ my $key=shift @or;
($c)=grep defined,map $_->{$key}, @hashlist;
#if ($c) {warn " found $key for field $field\n"}
}
if ($c && !ref $c)
{ 1 while $c=~s/#([_0-9a-z:~.]+)#/(grep defined,map $_->{$1}, @hashlist)[0]/ge;
# $c=~s/#(\w+)->([_0-9a-z:~.]+)(?:\((\w+)=([^)]+)\))?#/LookupCode($1,$2,($3 ? [$3 => $4] : ()))/ge;
$c=~s/#(?:(\w+)->)?([_0-9a-z:~.]+)(?:\((\w+)=([^)]+)\))?#/LookupCode($1||$field_opt,$2,($3 ? [$3 => $4] : ()))/ge;
$c=~s#___#__${field}_#g;
$c=~s#([@%\$\#])__(\w+)#($1||'\$').'Songs::Songs_'.$2#ge;
$c=~s#__(\w+)#\$Songs::Songs_$1#g;
$c=~s/#(\w+)#/exists $vars{$1} ? $vars{$1} : "#$1#"/ge; #variable names must be in UPPERCASE
}
push @code,$c;
}
return wantarray ? @code : $code[0];
}
sub Code
{ my ($field,$action,@h)=@_;
my $code=LookupCode($field,$action,\@h);
return $code;
}
sub MakeCode #keep ?
{ my ($field,$code,@h)=@_;
my @actions= $code=~m/#([\w\|.]+)#/g; #warn "field=$field : @actions";
my (@codes)=LookupCode($field,@actions,\@h); #warn join(' ',map {defined $_ ? 1 : 0} @codes);
$code=~s/#[\w\|.]+#/shift @codes/ge;
return $code;
}
sub Field_property
{ my ($field_opt,$key)=@_;
my ($field,$subtype)=split /\./,$field_opt;
my $h= $Def{$field};
return undef unless $h;
while ($h)
{ return $h->{$key} if exists $h->{$key};
my $type= $h->{parent} || $h->{type};
return undef unless $type;
$h= $Types{$type};
return $Types{"$type.$subtype"}{$key} if $subtype && $Types{"$type.$subtype"} && exists $Types{"$type.$subtype"}{$key};
}
}
sub Field_properties
{ my ($field,@keys)=@_;
return map Field_property($field,$_), @keys;
}
sub Fields_with_filter
{ return grep $Def{$_}{flags}=~/f/, @Fields;
}
sub filter_properties
{ my ($field,$cmd0)=@_;
my ($inv,$cmd,$pat)= $cmd0=~m/^(-?)([^-:]+)(?::(.*))?$/;
my @totry= ("$inv$cmd", $cmd);
unshift @totry, "$inv$cmd:$pat", "$cmd:$pat" if defined $pat && length $pat;
my $prop;
for my $c (@totry)
{ $prop= Songs::Field_property($field,"filterdesc:$c");
next unless $prop;
if (!ref $prop && $c=~m/:/ && $c!~m/^-/) { $prop= [$prop,$prop,'']; }
next if !ref $prop || @$prop<2;
if (@$prop==2) { $c= $prop->[1]; $prop= Songs::Field_property($field,"filterdesc:$c"); }
$cmd=$c;
last;
}
return $cmd,$prop;
}
sub Field_filter_choices
{ my $field=shift;
my %filters;
my $h= $Def{$field};
my %exclude;
while ($h)
{ for my $key (keys %$h)
{ next unless $key=~m/^filterdesc:(.+)/ && !$exclude{$1} && !$filters{$1};
my $value= $h->{$key};
my $f=$1;
if (ref $value) { if (@$value<3) { $exclude{$f}=1; next } else { $value=$value->[1]; } }
else { unless ($f=~m/:/ && $f!~m/^-/) { $exclude{$f}=1; next} } # for constant filters eg: filterdesc:e:44100
$filters{$f}= $value;
}
my $type= $h->{parent} || $h->{type};
last unless $type;
if (my $e= $h->{filter_exclude}) #list of filters from parent to ignore, 'ALL' for all
{ last if $e eq 'ALL';
$exclude{$_}=1 for split / +/, $e;
}
$h= $Types{$type};
}
return \%filters;
}
sub filter_prep_numbers { $_[0]=~m/(-?\d*\.?\d+)/; return $1 || 0 }
sub filter_prep_numbers_between { sort {$a <=> $b} map filter_prep_numbers($_), split / /,$_[0],2 }
sub FilterCode
{ my ($field,$cmd,$pat,$inv)=@_;
my ($code,$convert)=LookupCode($field, "filter:$cmd", "filter_prep:$cmd");
unless ($code) { warn "error can't find code for filter $field,$cmd,$pat,$inv\n"; return 1}
$convert||=sub {quotemeta $_[0]};
unless (ref $convert) { $convert=~s/#PAT#/\$_[0]/g; $convert=eval "sub {$convert}"; }
$code=~s/#ID#/\$_/g;
if ($inv) {$code=~s#$Filter::OpRe#$Filter::InvOp{$1}#go}
else {$code=~s#$Filter::OpRe#$1 eq '!!' ? '' : $1#ego}
if ($code=~m/#VAL1#/) { my @p= $convert->($pat); $code=~s/#VAL(\d)#/$p[$1-1]/g; }
else { my $p=$convert->($pat,$field); $code=~s/#VAL#/$p/g; }
return $code;
}
sub SortCode
{ my ($field,$inv,$insensitive,$for_gid)=@_; #warn "SortCode : @_\n";
my ($code,$scode,$sicode)= LookupCode($field, ($for_gid ? qw/n_sort:gid s_sort:gid si_sort:gid/ : qw/n_sort s_sort si_sort/));
my $op="<=>";
if ($scode)
{ $op='cmp';
if (!$insensitive) { $code=$scode}
else { $code= $sicode || "::superlc($scode)"; }
if ($::Options{Remove_articles} && CanRemoveArticles($field)) { $code="remove_articles($code)"; }
}
my $init='';
$init=$1 if $code=~s/^(.+) +---- +//;
my $code2=$code;
$code =~s/#(?:GID|ID)#/\$a/g;
$code2=~s/#(?:GID|ID)#/\$b/g;
$code= $inv ? "$code2 $op $code" : "$code $op $code2";
return $init,$code;
}
sub CompileArticleRE
{ my @art= split /\s+/, $::Options{Articles};
s/_/ /g for @art; #replace _ by spaces to allow multi-word "articles", not sure if it could be useful
@art= map quotemeta($_).(m/'$/ ? "" : "\\s+"), @art;
my $re= '^(?:' .join('|',@art). ')';
$Articles_re= qr/$re/i;
}
sub UpdateArticleRE
{ delete $::Delayed{'UpdateArticleRE'};
Songs::CompileArticleRE();
%FuncCache=();#FIXME find a better way
Songs::Changed(undef,FieldList(true=>'articles'));
}
sub CanRemoveArticles { $Def{$_[0]}{articles}; }
sub remove_articles
{ my $s=$_[0]; $s=~s/$Articles_re//; $s;
}
sub Compile #currently return value of the code must be a scalar
{ my ($name,$code)=@_;
if ($::debug) { $::DebugEvaledCode{$name}=$code; $code=~s/^sub \{/sub { local *__ANON__ = 'evaled $name';/; }
my $res=eval $code;
if ($@) { warn "** Compilation error in $name\n Code:-------\n$code\n *Error:-------\n$@**\n";}
return $res;
}
sub UpdateFuncs
{ undef %FuncCache;
delete $Def{$_}{_depended_on_by}, delete $Def{$_}{_properties} for keys %Def;
@Fields=();
%Get=%Display=(); #FIXME probably more need reset
my %done;
my %_depended_on_by; my %_properties;
Field_Apply_options();
CompileArtistsRE();
CompileArticleRE();
my @todo=grep !$Def{$_}{disable}, sort keys %Def;
while (@todo)
{ my $count=@todo;
for my $f (@todo)
{ if (my $d=$Def{$f}{depend})
{ next if grep !exists $done{$_}, split / /,$d;
$_depended_on_by{$_}{$f}=undef for split / /,$d;
}
if (my $p=$Def{$f}{property_of}) {$_properties{$p}{$f}=undef}
push @Fields,$f;
$done{$f}=undef;
}
@todo=grep !exists $done{$_}, @todo;
if ($count==@todo) { warn "Circular field dependencies, can't order these fields : @todo !\n"; push @Fields,@todo; last; }
}
$Def{$_}{_depended_on_by}= join ' ',keys %{$_depended_on_by{$_}} for keys %_depended_on_by;
$Def{$_}{_properties}= join ' ',keys %{$_properties{$_}} for keys %_properties;
warn "\@Fields=@Fields\n" if $::debug;
$Def{$_}{flags}||='' for @Fields; #DELME
{ my $code;
for my $f (@Fields)
{ $Def{$f}{flags}||='';
$code.= (Code($f,'init')||'').";\n";
}
Compile(init=>$code);
}
for my $f (@Fields)
{ if (my $code=Code($f, 'update', ID => '$ID'))
{ $UPDATEsub{$f}= Compile("Update_$f"=> 'sub { for my $ID (@{$_[0]}) {'.$code.'} }');
}
}
# create DIFF sub
{ my $code='my $ID=$_[0]; my $values=$_[1]; my $val; my @changed;'."\n";
for my $f (grep $Def{$_}{flags}=~m/r/, @Fields)
{ my $c= $Def{$f}{flags}=~m/_/ ?
"if (exists \$values->{$f}) { \$val=\$values->{$f}; #check#;\n".
" if (#diff#) { #set#; push \@changed,'$f'; } }\n"
:
"\$val= (exists \$values->{$f} ? \$values->{$f} : #default#);\n".
" #check#; if (#diff#) { #set#; push \@changed,'$f'; }\n";
$code.=MakeCode($f,$c,ID => '$ID', VAL => "\$val");
}
$code.=' return @changed;';
$DIFFsub= Compile(Diff =>"sub {$code}");
}
# create SET sub
{ my $code=join "\n",
'my $IDs=$_[0]; my $values=$_[1]; my %onefieldchanged; my @towrite; my %changedfields; my @changedIDs; my $i=0; my $val;',
'for my $ID (@$IDs)',
'{ my $changed;';
for my $f (grep $Def{$_}{flags}=~m/[aw]/, @Fields)
{ my $set= ($Def{$f}{flags}=~m/w/ && !$::Options{TAG_nowrite_mode}) ?
"push \@{\$towrite[\$i]}, '$f',\$val;" :
"#set#; \$changedfields{$f}=undef; \$changed=1;";
my $c= " \$val= exists \$values->{$f} ? \$values->{$f} :\n".
" exists \$values->{'\@$f'} ? shift \@{\$values->{'\@$f'}} :\n".
" undef;\n".
" if (defined \$val)\n".
" { #check#;\n".
" if (#diff#) { $set }\n".
" }\n";
if ($Def{$f}{flags}=~m/l/ && !($Def{$f}{flags}!~m/r/ && $Def{$f}{flags}=~m/w/)) # edit mode for multi-value fields, exclude write-only or read-on-demand fields (w without r) as this requires knowing the current values
{ $c.= " elsif (\$val=\$values->{'+$f'})\n". # $v must contain [[toset],[torm],[toggle]]
" { #check_multi#\n".
" if (\$val= #set_multi#) { $set }\n". # set_multi return the new arrayref if modified, undef if not changed
" }\n";
}
$code.= MakeCode($f,$c,ID => '$ID', VAL => "\$val");
}
$code.= join "\n",
' push @changedIDs,$ID if $changed;',
' $i++;',
'}',
#'::SongsChanged(\@changedIDs, [keys %changedfields]) if @changedIDs;',
'return \%changedfields, \@towrite;';
$SETsub= Compile(Set =>"sub {$code}");
}
# create NEW sub
{ my $code='$LastID++; my $values=$_[0]; my $val;'."\n";
my %done;
for my $f (grep $Def{$_}{flags}=~m/a/, @Fields)
{ #$c||= '____[] = #VAL#';
$done{$f}=undef;
my $c= " \$val= exists \$values->{$f} ? \$values->{$f} : #default#;\n".
" #check#;\n".
" #set#;\n";
#unless ($c) { warn "'set' code not found for field $f\n"; next }
$code.=MakeCode($f,$c,ID => '$LastID', VAL => "\$val");
#$code.= qq(;warn "\nsetting field $f :\n";);
}
for my $f (grep $Def{$_}{depend}, @Fields)
{ next if exists $done{$f};
next unless grep exists $done{$_}, split / /,$Def{$f}{depend};
my $c=Code($f, 'update' , ID => '$LastID');
$code.=$c.";\n" if $c;
}
$code.= ';return $LastID;';
$NEWsub= Compile(New =>"sub {$code}");
}
{ my $code='my $size=0; my $sec=0; for my $ID (@{$_[0]}) {'
. '$size+='. Code('size', 'get', ID => '$ID').';'
. '$sec+='. Code('length', 'get', ID => '$ID').';'
. '} return ($size,$sec)';
$LENGTHsub= Compile(Length =>"sub {$code}");
}
%::ReplaceFields= map { '%'.$Def{$_}{letter} => $_ } grep $Def{$_}{letter}, @Fields;
my @getfields= grep $Def{$_}{flags}=~m/g/, @Fields;
%Aliases= map {$_=>$_} @getfields;
for my $field (@getfields)
{ $Aliases{$_}=$field for split / +/, ($Def{$field}{alias}||'');
}
#for my $field (@getfields) # user-defined aliases
#{ for my $alias (split / +/, ($::Options{Fields_options}{$field}{aliases}||''))
# { $Aliases{ ::superlc($alias) } ||= $field;
# }
#}
for my $field (@getfields) #translated aliases
{ for my $alias (split /\s*,\s*/, ($Def{$field}{alias_trans}||''))
{ $alias=~s/ /_/g;
$Aliases{ ::superlc($alias) } ||= $field;
}
}
$::ReplaceFields{'$'.$_}= $::ReplaceFields{'${'.$_.'}'}= $Aliases{$_} for keys %Aliases;
::HasChanged('fields_reset');
#FIXME connect them to 'fields_reset' event :
SongList::init_textcolumns();
SongTree::init_textcolumns();
}
sub MakeLoadSub
{ my ($extradata,@loaded_slots)=@_;
my %extra_sub;
my %loadedfields;
$loadedfields{$loaded_slots[$_]}=$_ for 0..$#loaded_slots;
# begin with a line that checks if a given path-file has already been loaded into the library
my $pathfile_code= '$_['.$loadedfields{path}.'] ."/". $_['.$loadedfields{file}.']';
my $code= '$uniq_check{ '.$pathfile_code.' }++ && do { warn "warning: file ".'.$pathfile_code.'." already in library, skipping.\\n"; return };'."\n";
# new file, increment $LastID
$code.='$LastID++;'."\n";
for my $field (@Fields)
{ my $i=$loadedfields{$field};
my $c;
if (defined $i)
{ $Def{$field} ||= { type => 'unknown', flags => 'a', };
$c= Code($field, 'load|set', ID => '$LastID', VAL => "\$_[$i]");
}
elsif ($Def{$field}{flags}=~m/a/)
{ $loadedfields{$field}=undef;
$c= Code($field, 'load|set', ID => '$LastID', VAL => Code($field,'default'));
}
elsif (my $dep=$Def{$field}{depend})
{ next if grep !exists $loadedfields{$_}, split / /,$dep;
$c=Code($field, 'update', ID => '$LastID'); #FIXME maybe add {} around it, to avoid multiple my at the same level
warn "adding update code for $field\n" if $::debug && $c;
}
$code.=$c.";\n" if $c;
my ($mainfield,$load_extra)=LookupCode($field,'mainfield','load_extra',[SGID=>'$_[0]']);
$mainfield||=$field;
if ($load_extra && $extradata->{$mainfield} && !$extra_sub{$mainfield})
{ my $code= 'my $gid='.$load_extra.";\n";
my $i=1;
for my $subfield (split /\t/,$extradata->{$mainfield}[0])
{ my $c=LookupCode($subfield,'load_extra',[GID=>'$gid',VAL=>"\$_[$i]"]);
$code.= "\t$c;\n" if $c;
$i++;
}
$extra_sub{$mainfield}= Compile("LoadSub_$mainfield" => "sub {$code}") || sub {};
}
}
$code.= '; return $LastID;';
my $loadsub= Compile(LoadSub => "my %uniq_check; sub {$code}");
return $loadsub,\%extra_sub;
}
sub MakeSaveSub
{ my @saved_fields;
my @code;
my %extra_sub; my %extra_subfields;
for my $field (sort grep $Def{$_}{flags}=~m/a/, @Fields)
{ next if $::Options{Fields_options}{$field}{remove}; #deleted custom field
my $save_as= $Def{$field}{_renamed_to} || $field;
push @saved_fields,$save_as;
push @code, Code($field, 'save|get', ID => '$_[0]');
my ($mainfield,$save_extra)=LookupCode($field,'mainfield','save_extra');
if ($save_extra && $Def{$field}{_properties} && ( !$mainfield || $mainfield eq $field ))
{ my @subfields= split / /, $Def{$field}{_properties};
if (@subfields)
{ my @extra_code;
for my $subfield (@subfields)
{ my $c=LookupCode($subfield,'save_extra',[GID => '$gid']);
push @extra_code, $c;
}
$extra_subfields{$save_as}= join ' ', map $Def{$_}{_renamed_to}||$_, @subfields;
my $code= $save_extra;
my $extra_code=join ',', @extra_code;
$code=~s/#SUBFIELDS#/$extra_code/g;
$extra_sub{$save_as}= Compile("SaveSub_$field" => "sub { $code }") || sub {};
}
}
}
my $code= "sub { return (\n\t".join(",\n\t",@code)."\n); }";
my $savesub= Compile(SaveSub => $code);
return $savesub,\@saved_fields,\%extra_sub,\%extra_subfields;
}
sub New
{ my $file=$_[0];
#check already in @Songs#FIXME
warn "Reading Tag for $file\n" if $::Verbose;
my ($size,$modif)=(stat $file)[7,9];
my $values= FileTag::Read($file,1);
return unless $values;
(my $path,$file)=::splitpath($file);
%$values=( %$values,
file => $file, path=> $path,
modif=> $modif, size=> $size,
added=> time,
);
my ($ID,$wasmissing)= CheckMissing($values);
if (defined $ID)
{ ReReadFile($ID);
::CheckLength($ID) if $::Options{LengthCheckMode} eq 'add' && Get($ID,'length_estimated');
return $wasmissing ? $ID : undef;
}
#warn "\nNewSub(LastID=$LastID)\n";warn join("\n",map("$_=>$values->{$_}",sort keys %$values))."\n";
$ID=$NEWsub->($values); #warn $Songs::Songs_title__[-1]." NewSub end\n";
if ($values->{length_estimated} && $::Options{LengthCheckMode} eq 'add') { ::CheckLength($ID); }
$IDFromFile->{$path}{$file}=$ID if $IDFromFile;
return $ID;
}
sub ReReadFile #force values :
# 0=>read if file changed (size or date),
# 1=>force read tags
# 2=> same as 3 if estimated, else same as 0
# 3=>force check length (and tags)
{ my ($ID,$force,$noremove)=@_;
my $file= GetFullFilename($ID);
if (-e $file)
{ my ($size1,$modif1,$estimated)=Songs::Get($ID,qw/size modif length_estimated/);
my ($size2,$modif2)=(stat $file)[7,9];
$force||=0;
$force= $estimated ? 3 : 0 if $force==2;
my $checklength= ($size1!=$size2 || $force==3) ? 2 : 0;
return 1 unless $checklength || $force || $modif1!=$modif2;
my $values=FileTag::Read($file,$checklength);
return unless $values;
$values->{size}=$size2;
$values->{modif}=$modif2;
$values->{length_estimated}||=0 if $estimated;
my @changed=$DIFFsub->($ID,$values);
Changed([$ID],@changed) if @changed;
}
elsif (!$noremove) #file not found
{ warn "Can't find file '$file'\n";
::SongsRemove([$ID]);
}
}
#FIXME check if fields are enabled and add a way (option?) to silently ignore disabled fields
sub Set #can be called either with (ID,[field=>newval,...],option=>val) or (ID,field=>newval,...); ID can be an arrayref
{ warn "Songs::Set(@_) called from : ".join(':',caller)."\n" if $::debug;
my ($IDs,$modif,%opt);
if (ref $_[1]) { ($IDs,$modif,%opt)=@_ }
else { ($IDs,@$modif)=@_ }
$IDs=[$IDs] unless ref $IDs;
my %values;
while (@$modif)
{ my $f=shift @$modif;
my $val=shift @$modif;
my $multi;
if ($f=~s/^([-+^])//) { $multi=$1 }
my $def= $f=~m/^@(.*)$/ ? $Def{$1} : $Def{$f};
if (!$def) { warn "Songs::Set : Invalid field $f\n";next }
my $flags=$def->{flags};
#unless ($flags=~m/e/) { warn "Songs::Set : Field $f cannot be edited\n"; next }
#if (my $sub=$Def{$f}{check}))
# { my $res=$sub->($val); unless ($res) {warn "Songs::Set : Invalid value '$v' for field $f\n"; next} }
if ($multi) #multi eq + or - or ^ => add or remove or toggle values (for labels and genres)
{ if ($flags!~m/l/) { warn "Songs::Set : Field $f doesn't support multiple values\n"; next }
elsif ($flags!~m/r/ && $flags=~m/w/) { warn "Songs::Set : Can't add/remove/toggle values of multi-value field $f because it is a write-only or read-on-demand field\n"; next }
my $array=$values{"+$f"}||=[[],[],[]]; #$array contains [[toset],[torm],[toggle]]
my $i= $multi eq '+' ? 0 : $multi eq '^' ? 2 : 1;
$val=[$val] unless ref $val;
$array->[$i]=$val;
}
else { $values{$f}=$val }
}
::setlocale(::LC_NUMERIC, 'C');
my ($changed,$towrite)= $SETsub->($IDs,\%values);
::setlocale(::LC_NUMERIC, '');
Changed($IDs,$changed) if %$changed;
Write($IDs,towrite=>$towrite,%opt);
}
sub UpdateTags
{ my ($IDs,$fields,%opt)=@_;
Write($IDs,update=>$fields,%opt);
}
sub Write
{ my ($IDs,%opt)=@_; #%opt must have either update OR towrite
my $update=$opt{update}; # [list_of_fields_to_update]
my $towrite=$opt{towrite}; # [[modifs_for_first_ID],[...],...]
if (!@$IDs || ($towrite && !@$towrite)) #nothing to do
{ $opt{callback_finish}() if $opt{callback_finish};
return
}
my $i=0; my $abort; my $skip_all;
my $pid= ::Progress( undef, end=>scalar(@$IDs), abortcb=>sub {$abort=1}, widget =>$opt{progress}, title=>_"Writing tags");
my $errorsub=sub
{ my ($syserr,$details)= FileTag::Error_Message(@_);
my $abortmsg=$opt{abortmsg};
$abortmsg||=_"Abort mass-tagging" if @$IDs>1;
my $errormsg= $opt{errormsg} || _"Error while writing tag";
$errormsg.= ' ('.($i+1).'/'.@$IDs.')' if @$IDs>1;
my $res= $skip_all;
$res ||= ::Retry_Dialog($syserr,$errormsg, ID=>$IDs->[$i], details=>$details, window=>$opt{window}, abortmsg=>$abortmsg, many=>(@$IDs-$i)>1);
$skip_all=$res if $res eq 'skip_all';
if ($res eq 'abort')
{ $opt{abortcb}() if $opt{abortcb};
$abort=1;
}
return $res;
};
my $write_next= sub
{ my $ID= $IDs->[$i];
if (defined $ID)
{ my $modif;
if ($update)
{ for my $field (@$update)
{ my $v= $Def{$field}{flags}=~m/l/ ? [Get_list($ID,$field)] : Get($ID,$field);
push @$modif, $field,$v;
}
}
elsif ($towrite)
{ $modif=$towrite->[$i];
}
if ($modif)
{ my $file= Songs::GetFullFilename($ID);
FileTag::Write($file, $modif, $errorsub);
warn "ID=$ID towrite : ".join(' ',@$modif)."\n" if $::debug;
::IdleCheck($ID) unless $update; # not done in update mode
}
}
$i++;
if ($abort || $i>=@$IDs)
{ ::Progress($pid, abort=>1);
$opt{callback_finish}() if $opt{callback_finish};
return 0;
}
::Progress( $pid, current=>$i );
return 1;
};
if ($opt{noidle}) { my $c=1; $c=$write_next->() until $c==0; } else { Glib::Idle->add($write_next); }
}
sub Changed # 2nd arg contains list of changed fields as a list or a hash ref
{ my $IDs=shift || $::Library;
my $changed= ref $_[0] ? $_[0] : {map( ($_=>undef), @_ )};
warn "Songs::Changed : IDs=@$IDs fields=".join(' ',keys %$changed)."\n" if $::debug;
$IDFromFile=undef if $IDFromFile && !$KeepIDFromFile && (exists $changed->{file} || exists $changed->{path});
$MissingHash=undef if $MissingHash && grep(exists $changed->{$_}, @MissingKeyFields);
my @needupdate;
for my $f (keys %$changed)
{ if (my $l=$Def{$f}{_depended_on_by}) { push @needupdate, split / /,$l; }
}
for my $f (sort @needupdate)
{ next if exists $changed->{$f};
$changed->{$f}=undef;
if (my $update=$UPDATEsub{$f}) { warn "Updating field : $f\n" if $::debug; $update->($IDs); }
}
AA::Fields_Changed($changed);
::SongsChanged($IDs,[keys %$changed]);
}
sub CheckMissing
{ my $song=$_[0];
#my $key=Get($song,'missingkey');
return unless defined $song->{title} && length $song->{title} && (defined $song->{album} || defined $song->{artist});
for (qw/title album artist track/) { $song->{$_}="" unless defined $song->{$_} }
return unless length ($song->{album} . $song->{artist});
#ugly fix, clean-up the fields so they can be compared to those in library, depends on @MissingKeyFields #FIXME should generate a function using #check# and VAL=>'$song->{$field})'
$song->{$_}=~s/\s+$// for qw/title album artist/;
$song->{track}= $song->{track}=~m/^(\d+)/ ? $1+0 : 0;
my $key=join "\x1D", @$song{@MissingKeyFields};
$MissingHash||= BuildHash('missingkey',undef,undef,'id:list');
my $IDs=$MissingHash->{$key};
return unless $IDs;
if (@$IDs>1) #too many candidates, try to find the best one
{ my @score;
for my $oldID (@$IDs)
{ my $m=0;
$m+=2 if $song->{file} eq Get($oldID,'file');
$m++ if $song->{path} eq Get($oldID,'path');
#could do more checks
push @score,$m;
}
my $max= ::max(@score);
@$IDs= map $IDs->[$_], grep $score[$_]==$max, 0..$#$IDs;
if (@$IDs>1) #still more than 1, abort, maybe could continue anyway, the files must be nearly identical anyway
{ warn "CheckMissing: more than 1 (".@$IDs.") possible matches for $song-->{path}/$song->{file}, assume identification is unreliable, considering it a new song.\n";
return
}
}
for my $oldID (@$IDs)
{ my $wasmissing= Get($oldID,'missing');
my $fullfilename= GetFullFilename($oldID);
next if !$wasmissing && -e $fullfilename; #if candidate still exists
warn "Found missing song, formerly '$fullfilename'\n";
my $gid=Songs::Get_gid($oldID,'album');
if (my $pic= Picture($gid,'album','get'))
{ my $suffix= $pic=~s/(:\w+)$// ? $1 : '';
unless (-e $pic)
{ my $new;
if ($pic eq $fullfilename) # check if cover is embedded picture in this file
{ $new= ::catfile( $song->{path}, $song->{file} ).$suffix;
warn "setting new picture $new\n";
}
else
{ # if cover was in same folder or a sub-folder, check if there based on new folder
$new=$pic;
my $oldpath= ::pathslash(::dirname($fullfilename));
my $newpath= ::pathslash($song->{path});
$new=undef unless $new=~s#^\Q$oldpath\E#$newpath# && -e $new;
}
Picture($gid,'album','set',$new) if $new;
}
}
#remove from MissingHash, not really needed
#if (@$IDs>1) { $MissingHash->{$key}= [grep $_!=$oldID, @$IDs]; }
#else { delete $MissingHash->{$key}; }
#update $IDFromFile, and prevent its destruction in Changed(), not very nice #FIXME make hashes that update themselves when possible
$KeepIDFromFile=1;
$IDFromFile->{$song->{path}}{$song->{file}}= delete $IDFromFile->{Get($oldID,'path')}{Get($oldID,'file')} if $IDFromFile;
Songs::Set($oldID,file=>$song->{file},path=>$song->{path}, missing=>0);
$KeepIDFromFile=0;
return $oldID,$wasmissing;
}
return
}
sub Makesub
{ my $c=&Code; warn "Songs::Makesub(@_) called from : ".join(':',caller)."\n" unless $c;
$c="local *__ANON__ ='Maksub(@_)'; $c" if $::debug;
my $sub=eval "sub {$c}";
if ($@) { warn "Compilation error :\n code : $c\n error : $@";}
return $sub;
}
sub Stars
{ my ($gid,$field)=@_;
return undef if !defined $gid || $gid eq '' || $gid==255;
my $pb= $Def{$field}{pixbuf} || $Def{'rating'}{pixbuf};
return $pb->[ sprintf("%d",$gid/100*$#$pb) ];
}
sub Picture
{ my ($gid,$field,$action,$extra)=@_;
$action.='_for_gid';
my $func= $FuncCache{$action.' '.$field};
unless ($func)
{ my $pfield= $Def{$field}{picture_field} || $field;
my $mainfield= $Def{$field}{property_of} || $field;
$func=$FuncCache{$action.' '.$mainfield}||=$FuncCache{$action.' '.$pfield}=
Makesub($pfield, $action, GID => '$_[0]', VAL=>'$_[1]');
return unless $func;
}
$func->($gid,$extra);
# if ($action eq 'set') { ($FuncCache{'set_for_gid '.$field}||= Makesub($field, 'set_for_gid', GID => '$_[0]', VAL=>'$_[1]') ) ->($gid,$extra); }
# elsif ($action eq 'get') { ($FuncCache{'get_for_gid '.$field}||= Makesub($field, 'get_for_gid', GID => '$_[0]') ) ->($gid); }
# elsif ($action eq 'pixbuf') { ($FuncCache{'pixbuf_for_gid '.$field}||= Makesub($field, 'pixbuf_for_gid', GID => '$_[0]') ) ->($gid); }
# elsif ($action eq 'icon') { ($FuncCache{'icon_for_gid '.$field}||= Makesub($field, 'icon_for_gid', GID => '$_[0]') ) ->($gid); }
}
sub ListAll
{ my $field=$_[0];
my $func= $FuncCache{'listall '.$field} ||=
do { if ( my $c=Code($field, 'listall') )
{ my ($initsort,$sort)=SortCode($field,0,1,1);
my $gid2get=Code($field, 'gid_to_get', GID => '$_');
eval "sub { $initsort; [map( $gid2get, sort {$sort} $c)]}";
}
else {1}
};
return ref $func ? $func->() : [];
}
sub Get_grouptitle
{ my ($field,$IDs)=@_;
($FuncCache{'grouptitle '.$field}||= Makesub($field, 'grouptitle', ID => '$_[0][0]', IDs=>'$_[0]') ) ->($IDs);
}
sub Search_artistid #return artist id or undef if not found
{ my $artistname=shift;
my $field='artist';
($FuncCache{'search_gid '.$field}||= Makesub($field, 'search_gid', VAL=>'$_[0]') ) ->($artistname);
}
sub Get_gid
{ my ($ID,$field)=@_;
($Get_gid{$field}||= Makesub($field, 'get_gid', ID => '$_[0]') ) ->($ID);
# $Get_gid{$field}->($ID);
}
sub Get_list #rarely used, keep ?
{ my ($ID,$field)=@_;
#FIXME check field can have multiple values
my $func= $FuncCache{'getlist '.$field} ||= Makesub($field, 'get_list', ID => '$_[0]');
$func->($ID);
}
sub Get_icon_list
{ my ($field,$ID)=@_;
my $func= $FuncCache{"icon_list $field"} ||= Compile("icon_list $field", MakeCode($field,'sub {grep Gtk2::IconFactory->lookup_default($_), map #icon_for_gid#, @{#get_gid#}; }',ID=>'$_[0]', GID=>'$_')); #FIXME simplify the code-making process
return $func->($ID);
}
sub Gid_to_Display #convert a gid from a Get_gid to a displayable value
{ my ($field,$gid)=@_; #warn "Gid_to_Display(@_)\n";
my $sub= $Gid_to_display{$field} || DisplayFromGID_sub($field);
if (ref $gid) { return [map $sub->($_), @$gid] }
return $sub->($gid);
}
sub DisplayFromGID_sub
{ my $field=$_[0];
return $Gid_to_display{$field}||= Makesub($field, 'gid_to_display', GID => '$_[0]');
}
sub DisplayFromHash_sub #not a good name, very specific, only used for $field=path currently
{ my $field=$_[0];
return $FuncCache{"DisplayFromHash_sub $field"}||= Makesub($field, 'hash_to_display', VAL => '$_[0]');
}
sub MakeFilterFromGID
{ my ($field,$gid)=@_; #warn "MakeFilterFromGID:@_\n";#warn Code($field, 'makefilter', GID => '$_[0]');
my $sub=$FuncCache{'makefilter '.$field}||= Makesub($field, 'makefilter', GID => '$_[0]');
warn "MakeFilterFromGID => ".($sub->($gid)) if $::debug;
return Filter->new( $sub->($gid) );
}
sub MakeFilterFromID #should support most fields, FIXME check if works for year/artists/labels/genres/...
{ my ($field,$ID)=@_;
return Filter->null unless $ID; # null filter if no ID
if (my $code=Code($field, 'makefilter_fromID', ID => '$_[0]')) #FIXME optimize : don't call this every time, for example check for a flag that would indicate that this field has a gid
{ my $sub=$FuncCache{'makefilter_fromID '.$field} ||= Compile('makefilter_fromID '.$field, "sub {$code}"); #FIXME if method doesn't exist
return Filter->new( $sub->($ID) );
}
else
{ my $gid=Get_gid($ID,$field);
if (ref $gid) { return Filter->newadd(::FALSE,map MakeFilterFromGID($field,$_), @$gid) }
return MakeFilterFromGID($field,$gid);
}
}
sub Gid_to_Get #convert a gid from a Get_gid to a what Get would return
{ my ($field,$gid)=@_;
my $sub= $Gid_to_get{$field}||= Makesub($field, 'gid_to_get', GID => '$_[0]');
if (ref $gid) { return [map $sub->($_), @$gid] }
return $sub->($gid);
}
#sub Gid_to_string_sub #used to get string gid that stays valid between session #not used anymore
#{ my ($field)=@_;
# my $sub= $FuncCache{'g_to_s:'.$field}||= Makesub($field, 'gid_to_sgid', GID => '$_[0]');
# return $sub;
#}
#sub String_to_gid_sub #not used anymore
#{ my ($field)=@_;
# my $sub= $FuncCache{'s_to_g:'.$field}||= Makesub($field, 'sgid_to_gid', VAL => '$_[0]');
# return $sub;
#}
sub sort_gid_by_name
{ my ($field,$gids,$h,$pre,$mode)=@_;
$mode||='';
my $func= $FuncCache{"sortgid $field $mode"} ||= do
{ my ($initsort,$sort)= SortCode($field,undef,1,1);
$pre= $pre ? $HSort{$pre} : '';
eval 'sub {my $l=$_[0]; my $h=$_[1]; '.$initsort.'; @$l=sort { '."$pre $sort".' } @$l}';
};
$func->($gids,$h);
}
sub Get_all_gids #FIXME add option to filter out values eq ''
{ my $field=$_[0];
return UniqList($field,$::Library,1); #FIXME use ___name directly
}
sub Get # ($ID,@fields)
{ #warn "Songs::Get(@_) called from : ".join(':',caller)."\n";
my $ID=shift;
return wantarray ? map (($Get{$_}||CompileGet($_))->($ID), @_) : ($Get{$_[0]}||CompileGet($_[0]))->($ID);
}
sub Display # ($ID,@fields)
{ #warn "Songs::Display(@_) called from : ".join(':',caller)."\n";
my $ID=shift;
return wantarray ? map ( ($Display{$_}||CompileDisp($_))->($ID), @_) : ($Display{$_[0]}||CompileDisp($_[0]))->($ID);
}
sub DisplayEsc # ($ID,$field)
{ return ::PangoEsc( ($Display{$_[1]}||CompileDisp($_[1]))->($_[0]) );
}
sub CompileGet
{ my ($field,$disp)=@_;
unless ($Def{$field}{flags}=~m/g/)
{ return $Display{$field}=$Get{$field}=sub { warn "Songs::Get or Songs::Display : Invalid field '$field'\n" };
}
my $get= Code($field, 'get', ID => '$_[0]');
$get="local *__ANON__ ='getsub for $field'; $get" if $::debug;
$Get{$field}= Compile("Get_$field"=>"sub {$get}");
my $display= Code($field, 'display', ID => '$_[0]');
if ($display && $display ne $get)
{ $Display{$field}= Compile("Display_$field"=>"sub {$display}");
}
else { $Display{$field}=$Get{$field}; }
return $Get{$field};
}
sub CompileDisp
{ my $field=shift;
CompileGet($field);
return $Display{$field};
}
sub Map
{ my ($field,$IDs)=@_; #warn "Songs::Map(@_) called from : ".join(':',caller)."\n";
my $f= $Get{$field}||CompileGet($field);
return map $f->($_), @$IDs;
}
sub Map_to_gid
{ my ($field,$IDs)=@_;
return map Get_gid($_,$field), @$IDs;
}
sub GetFullFilename { Get($_[0],'fullfilename') }
#sub GetURI
#{ return map 'file://'.::url_escape($_), GetFullFilename(@_);
#}
sub IsSet # used only once
{ my ($ID,$field,$value)=@_;
my $sub= $FuncCache{'is_set '.$field}||= Makesub($field, 'is_set', ID=>'$_[0]', VAL=>'$_[1]' );
return $sub->($ID,$value);
}
#sub GetArtists #not used, remove ?
#{ Get_list($_[0],'artists');
#}
sub ListLength
{ &$LENGTHsub;
}
#FIXME cache the BuildHash sub
sub UniqList #FIXME same as UniqList2. use "string" (for artist) in this one and not in UniqList2 ?
{ my ($field,$IDs,$sorted)=@_; #warn "Songs::UniqList(@_)\n";
my $h=BuildHash($field,$IDs,undef,':uniq'); #my $h=BuildHash($field,$IDs,'string',':uniq'); ??????
return [keys %$h] unless $sorted;
return [sort keys %$h]; #FIXME more sort modes ?
}
sub UniqList2 #FIXME MUST handle special cases, merge with UniqList ?
{ &UniqList;
}
sub Build_IDFromFile
{ $IDFromFile||=BuildHash('path',undef,undef,'file:filetoid');
}
sub FindID
{ my $f=$_[0];
if ($f=~m/\D/)
{ my ($dir,$file)= ::splitpath(::simplify_path($f));
if (defined $file)
{ $IDFromFile||=Build_IDFromFile();
return $IDFromFile->{$dir}{$file};
#return $IDFromFile->{$dir}{$file} if $IDFromFile;
#my $m=Filter->newadd(1,'file:e:'.$file, 'path:e:'.$dir)->filter_all;
#if (@$m)
#{ warn "Error, more than one ID match $dir/$file" if @$m>1;
# return $m->[0];
#}
}
return undef;
}
$f=undef if $f>$LastID;
return $f;
}
sub UpdateDefaultRating
{ my $l=AllFilter('rating:~:255');
Changed($l,'rating') if @$l;
}
sub UpdateArtistsRE
{ CompileArtistsRE();
Songs::Changed([FIRSTID..$LastID],'artist');
}
sub CompileArtistsRE
{ my $ref1= $::Options{Artists_split_re} ||= ['\s*&\s*', '\s*;\s*', '\s*,\s+', '\s*/\s*'];
$Artists_split_re= join '|', @$ref1;
$Artists_split_re||='$';
$Artists_split_re=qr/$Artists_split_re/;
my $ref2= $::Options{Artists_title_re} ||= ['\(with\s+([^)]+)\)', '\(feat\.\s+([^)]+)\)'];
$Artists_title_re= join '|', @$ref2;
$Artists_title_re||='^\x00$';
$Artists_title_re=qr/$Artists_title_re/;
}
sub DateString
{ my $time=shift;
my ($fmt,@formats)= split /(\d+) +/, $::Options{DateFormat}||"%c";
unless ($time)
{ return _"never";
}
my $diff=time-$time;
while (@formats)
{ my $max=shift @formats;
last if $diff>$max;
$fmt=shift @formats;
}
::strftime_utf8($fmt,localtime $time);
}
#sub Album_Artist #guess album artist
#{ my $alb= Get($_[0],'album');
# my %h; $h{ Get($_[0],'artist') }=undef for @{AA::GetIDs('album',$alb)};
# my $nb=keys %h;
# return Get($_[0],'artist') if $nb==1;
# my @l=map split(/$Artists_split_re/), keys %h;
# my %h2; $h2{$_}++ for @l;
# my @common;
# for (@l) { if ($h2{$_}>=$nb) { push @common,$_; delete $h2{$_}; } }
# return @common ? join(' & ',@common) : _"Various artists";
#}
sub ChooseIcon #FIXME add a way to create a colored square/circle/... icon
{ my ($field,$gid)=@_;
my $string= ::__x( $Def{$field}{icon_edit_string}, name=> Gid_to_Get($field,$gid) );
my $file=::ChoosePix($::CurrentDir.::SLASH, $string, undef,'LastFolder_Icon');
return unless defined $file;
my $dir=$::HomeDir.'icons';
return if ::CreateDir($dir,undef,_"Error saving icon") ne 'ok';
my $destfile= $dir. ::SLASH. ::url_escape( Picture($gid,$field,'icon') );
unlink $destfile.'.svg',$destfile.'.png';
if ($file eq '0') {} #unset icon
elsif ($file=~m/\.svg/i)
{ $destfile.='.svg';
::copy($file,$destfile.'.svg');
}
else
{ $destfile.='.png';
my $pixbuf= GMB::Picture::load($file,size=>-48); # -48 means it will be resized to 48x48 if wifth or height bigger than 48
return unless $pixbuf;
$pixbuf->save($destfile,'png');
}
::LoadIcons();
}
sub FilterListFields
{ grep $Def{$_}{FilterList}, @Fields;
}
sub FilterListProp
{ my ($field,$key)=@_;
if ($key eq 'picture') {return $Def{$field}{picture_field}}
if ($key eq 'multi') {return $Def{$field}{flags}=~m/l/ }
$Def{$field}{FilterList}{$key};
}
sub ColumnsKeys
{ grep $Def{$_}{flags}=~m/c/, @Fields;
}
sub ColumnAlign
{ Field_property($_[0],'rightalign') || 0;
}
sub PropertyFields
{ grep $Def{$_}{flags}=~m/p/, @Fields;
}
sub InfoFields
{ my %tree;
for my $f (grep $Def{$_}{flags}=~m/p/, @Fields)
{ my $cat= $Def{$f}{category}||'unknown';
push @{ $tree{$cat} }, $f;
}
my @list;
for my $cat ( sort { $Categories{$a}[1] <=> $Categories{$b}[1] } keys %tree )
{ my $fields= $tree{$cat};
push @list, $cat, $Categories{$cat}[0], [::superlc_sort(@$fields)];
}
return \@list;
#FIXME sort according to a number like $Def{$_}{order}
#was : (qw/title artist album year track disc version genre rating label playcount lastplay skipcount lastskip added modif comment file path length size bitrate filetype channel samprate/)
}
sub SortKeys
{ grep $Def{$_}{flags}=~m/s/, @Fields;
}
sub Field_All_string
{ my $f=$_[0];
return $Def{$f} && exists $Def{$f}{all_count} ? $Def{$f}{all_count} : _"All";
}
sub Field_Edit_string
{ my $f=$_[0];
return $Def{$f} && exists $Def{$f}{edit_string} ? $Def{$f}{edit_string} : ucfirst(::__x( _"Edit {field}",field=>Songs::FieldName($f)));
}
sub FieldName
{ my $f=$_[0];
return $Def{$f} && exists $Def{$f}{name} ? $Def{$f}{name} : ::__x(_"Unknown field ({field})",field=>$f);
}
sub MainField
{ my $f=$_[0];
return Songs::Code($f,'mainfield') || $f;
}
sub FieldWidth
{ my $f=$_[0];
return $Def{$f} && $Def{$f}{width} ? $Def{$f}{width} : 100;
}
sub FieldEnabled #check if a field is enabled
{ !! grep $_[0] eq $_, @Fields;
}
sub FieldList #return list of fields, may be filtered by type and/or a key
{ my %args=@_; # args may be type=> 'flags' or 'rating' true=> key_that_must_be_true
my @l= @Fields;
if (my $type=$args{type})
{ @l= grep { ($Def{$_}{fieldtype} || $Def{$_}{type}) eq $type} @l; # currently type flags all have a type=>'flags' in %Def, but might change, so fieldtype can overide it
}
if (my $true=$args{true})
{ @l= grep $Def{$_}{$true}, @l;
}
return @l;
}
sub FieldType #currently used to check "flags" or "rating" types
{ my $field=shift;
return '' unless grep $field eq $_, @Fields;
return $Def{$field}{fieldtype} || $Def{$field}{type}; # currently fieldtype is not used but might be useful as $Def{$field}{type} is an implementation detail and not a field property
}
sub ListGroupTypes
{ my @list= grep $Def{$_}{can_group}, @Fields;
my @ret;
for my $field (@list)
{ my $val=$field;
my $name=FieldName($field);
my $types=LookupCode($field,'subtypes_menu');
if ($types)
{ $val=[map( (qq($field.$_) => "$name ($types->{$_})"), keys %$types)];
}
push @ret, $val,$name;
}
return \@ret;
}
sub WriteableFields
{ grep $Def{$_}{flags}=~m/a/ && $Def{$_}{flags}=~m/w/, @Fields;
}
sub EditFields #type is one of qw/single many per_id/
{ my $type=$_[0];
my @fields= grep $Def{$_}{flags}=~m/e/, @Fields;
@fields= grep $Def{$_}{edit_many}, @fields if $type eq 'many';
@fields= sort { ($Def{$a}{edit_order}||1000) <=> ($Def{$b}{edit_order}||1000)
|| $Def{$a}{name} cmp $Def{$b}{name}
} @fields;
return @fields;
}
sub EditWidget
{ my ($field,$type,$IDs)=@_; #type is one of qw/single many per_id/
my ($sub)= LookupCode($field, "editwidget:all|editwidget:$type|editwidget");
unless ($sub) {warn "Can't find editwidget for field $field\n"; return undef;}
return $sub->($field,$IDs);
}
sub ReplaceFields_to_re
{ my $string=shift;
my $field= $::ReplaceFields{$string};
if ($field && $Def{$field}{flags}=~m/e/)
{ return $Def{$field}{_autofill_re} ||= '('. LookupCode($field, 'autofill_re') .')';
}
$string=~s#(\$\{\})#\\$1#; # escape $ and {}
return $string;
}
sub StringFields #list of fields that are strings, used for selecting fields for interactive search
{ grep SortICase($_), @Fields; #currently use SortICase #FIXME ?
}
sub SortGroup
{ my $f=$_[0];
$f=~s#\..*##; #FIXME should be able to sort on "modif.year" and others, but for now, simplfy it into "modif"
return $Def{$f}{sortgroup} || SortField($f);
}
sub SortICase
{ my $f=$_[0];
return $Def{$f} && $Def{$f}{flags}=~m/i/;
}
sub SortField
{ my $f=$_[0];
return $Def{$f} && $Def{$f}{flags}=~m/i/ ? $f.=':i' : $f; #case-insensitive by default
}
sub MakeSortCode
{ my $sort=shift;
my @code;
my $init='';
for my $s (split / /,$sort)
{ my ($inv,$field,$i)= $s=~m/^(-)?(\w+)(:i)?$/;
next unless $field;
unless ($Def{$field}) { warn "Songs::SortList : Invalid field $field\n"; next }
unless ($Def{$field}{flags}=~m/s/) { warn "Don't know how to sort $field\n"; next }
my ($sortinit,$sortcode)= SortCode($field,$inv,$i);
push @code, $sortcode;
$init.= $sortinit."; " if $sortinit;
}
@code=('0') unless @code;
return $init, join(' || ',@code);
}
sub FindNext # find the song in listref that would be right after ID if ID was in the list #could be optimized by not re-evaluating left-side for every comparison
{ my ($listref,$sort,$ID)=@_; # list must be sorted by $sort
my $func= $FuncCache{"FindNext $sort"} ||=
do { my ($init,$code)= MakeSortCode($sort);
$code= 'sub {my $l=$_[0];$a=$_[1]; '.$init.'for $b (@$l) { return $b if (' . $c