1# Copyright (C) 2005-2015 Quentin Sculo <squentin@free.fr> 2# 3# This file is part of Gmusicbrowser. 4# Gmusicbrowser is free software; you can redistribute it and/or modify 5# it under the terms of the GNU General Public License version 3, as 6# published by the Free Software Foundation. 7 8use strict; 9use warnings; 10use utf8; 11 12package Songs; 13 14#our %Songs; 15our ($IDFromFile,$MissingHash); my $KeepIDFromFile; 16our ($Artists_split_re,$Artists_title_re); 17my @MissingKeyFields; 18our (%Def,%Types,%Categories,%FieldTemplates,@Fields,%HSort,%Aliases); 19my %FuncCache; 20INIT { 21our $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 22our %timespan_menu= 23( year => _("year"), 24 month => _("month"), 25 day => _("day"), 26); 27@MissingKeyFields=qw/size title album artist track/; 28%Categories= 29( file => [_"File properties",10], 30 audio => [_"Audio properties",30], 31 basic => [_"Basic fields",20], 32 extra => [_"Extra fields",50], 33 stats => [_"Statistics",40], 34 unknown => [_"Other",80], #fallback category 35 custom => [_"Custom",70], 36 replaygain=> [_"Replaygain",60], 37); 38%Types= 39( generic => 40 { _ => '____[#ID#]', 41 get => '#_#', 42 set => '#get# = #VAL#', 43 display => '#get#', 44 grouptitle=> '#display#', 45 'editwidget:many' => sub { my $field=$_[0]; GMB::TagEdit::Combo->new(@_, Field_property($field,'edit_listall')); }, 46 'editwidget:single' => sub { my $field=$_[0]; GMB::TagEdit::EntryString->new( @_,0,Field_property($field,'edit_listall') ); }, 47 'editwidget:per_id' => sub { my $field=$_[0]; GMB::TagEdit::EntryString->new( @_,Field_properties($field,'editwidth','edit_listall') ); }, 48 'filter:m' => '#display# .=~. m"#VAL#"', 'filter_prep:m' => \&Filter::QuoteRegEx, 49 'filter:mi' => '::superlc(#display#) .=~. m"#VAL#"i', 'filter_prep:mi'=> sub { Filter::QuoteRegEx( ::superlc($_[0]) )}, 50 'filter:si' => 'index( ::superlc(#display#),"#VAL#") .!=. -1', 'filter_prep:si'=> sub {quotemeta ::superlc($_[0])}, 51 'filter:s' => 'index( #display#, "#VAL#") .!=. -1', 'filter_prep:s'=> sub {quotemeta $_[0]}, 52 '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])}, 53 'filterpat:fuzzy'=> [ round => "%d", unit => '%', min=>20, max=>99, default_value=>65, ], 54 'filterdesc:fuzzy'=> [ _"%s fuzzy match with %s",_"fuzzy match", 'fuzzy string', ], 55 'filterdesc:-fuzzy'=> _"no %s fuzzy match with %s", 56 'filterdesc:mi' => [ _"matches regexp %s",_"matches regexp",'regexp', icase=>1, ], 57 'filterdesc:si' => [ _"contains %s", _"contains", 'substring', icase=>1, ], 58 'filterdesc:e' => [ _"is equal to %s", _"is equal to", 'string', completion=>1, ], 59 'filterdesc:m' => [_"matches regexp %s (case sensitive)",'mi'], 60 'filterdesc:s' => [_"contains %s (case sensitive)", 'si'], 61 'filterdesc:-m' => _"doesn't match regexp %s (case sensitive)", 62 'filterdesc:-mi'=> _"doesn't match regexp %s", 63 'filterdesc:-s' => _"doesn't contain %s (case sensitive)", 64 'filterdesc:-si'=> _"doesn't contain %s", 65 'filterdesc:-e' => _"isn't equal to %s", 66 'smartfilter:=empty' => 'e:', 67 'smartfilter:=' => 'e', 68 'smartfilter:#' => \&Filter::smartstring_fuzzy, 69 'smartfilter::' => 'si s', 70 'smartfilter:~' => 'mi m', 71 default_filter => 'si', 72 autofill_re => '.+', 73 }, 74 unknown => 75 { parent => 'generic', 76 }, 77 virtual => 78 { parent => 'string', 79 _ => '#get#', 80 }, 81 special => {}, 82 flags => 83 { _ => '____[#ID#]', 84 init => '___name[0]="#none#"; ___iname[0]=::superlc(___name[0]); #sgid_to_gid(VAL=$_)# for #init_namearray#', 85 init_namearray => '@{ $::Options{Fields_options}{#field#}{persistent_values} ||= $Def{#field#}{default_persistent_values} || [] }', 86 none => quotemeta _"None", 87 default => '""', 88 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 }', 89 get_list => 'my $v=#_#; ref $v ? map(___name[$_], @$v) : $v ? ___name[$v] : ();', 90 get_gid => 'my $v=#_#; ref $v ? $v : [$v]', 91 gid_to_get => '(#GID# ? ___name[#GID#] : "")', 92 gid_to_display => '___name[#GID#]', 93 s_sort => '___sort{ sprintf("%x", #_#)}', 94 si_sort => '___isort{ sprintf("%x", #_#)}', 95 always_first_gid=> 0, 96 's_sort:gid' => '___name[#GID#]', 97 'si_sort:gid' => '___iname[#GID#]', 98 get => 'do {my $v=#_#; !$v ? "" : ref $v ? join "\\x00",map ___name[$_],@$v : ___name[$v];}', 99 newval => 'push @___iname, ::superlc(___name[-1]); ::IdleDo("newgids_#field#",1000,sub { ___new=0; ::HasChanged("newgids_#field#"); }) unless ___new++;', 100 sgid_to_gid => '___gid{#VAL#}||= do { my $i=push(@___name, #VAL#); #newval#; $i-1; }', 101 set => '{my $v=#VAL#; 102 my @list= sort (ref $v ? @$v : split /\\x00/,$v); 103 my @ids; 104 for my $name (@list) 105 { my $id= #sgid_to_gid(VAL=$name)#; 106 push @ids,$id; 107 } 108 my $val= @ids<2 ? $ids[0]||0 : 109 (___group{join(" ",map sprintf("%x",$_),@ids)}||= \@ids); 110 ___isort{ sprintf("%x",$val) }||= ::superlc( ___sort{ sprintf("%x",$val) }||= join ";",@list ); 111 #_#=$val; 112 }', 113 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# 114 display => 'do { my $v=#_#; !$v ? "" : ref $v ? join ", ",map ___name[$_],@$v : ___name[$v]; }', 115 check_multi => 'for my $lref (@{#VAL#}) { for (@$lref) {tr/\x00-\x1F//d; s/\s+$//;} }', 116 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; }', 117 makefilter => '#GID# ? "#field#:~:".___name[#GID#] : "#field#:ecount:0"', 118 'filter:~' => '.!!. do {my $v=#_#; $v ? ref $v ? grep(#VAL#==$_, @$v) : ($v == #VAL#) : 0}', 119 #smartmatch version: 'filter:~' => '.!!. do {my $v=#_#; $v ? #VAL# ~~ $v : 0}', # is flag set 120 'filter_prep:~' => '___gid{#PAT#} ||= #sgid_to_gid(VAL=#PAT#)#;', 121 'filter_prephash:~' => 'return { map { #sgid_to_gid(VAL=$_)#, undef } keys %{#HREF#} }', 122 'filter:h~' => '.!!. do {my $v=#_#; $v ? ref $v ? grep(exists $hash#VAL#->{$_+0}, @$v) : (exists $hash#VAL#->{#_#+0}) : 0}', 123 'filter:ecount' => '#VAL# .==. do {my $v=#_#; $v ? ref $v ? scalar(@$v) : 1 : 0}', 124 #FIXME for filters s,m,mi,h~, using a list of matching names in ___inames/___names could be better (using a bitstring) 125 'filter:s' => 'do { my $v=#_#; !$v ? .0. : ref $v ? (.!!. grep index(___name[$_], "#VAL#") != -1 ,@$v) : (index(___name[$v], "#VAL#") .!=. -1); }', 126 'filter:si' => 'do { my $v=#_#; !$v ? .0. : ref $v ? (.!!. grep index(___iname[$_], "#VAL#") != -1 ,@$v) : (index(___iname[$v], "#VAL#") .!=. -1); }', 127 '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]); }', 128 'filter:m' => 'do { my $v=#_#; !$v ? .0. : ref $v ? (.!!. grep ___name[$_] =~ m"#VAL#" ,@$v) : ___name[$v] .=~. m"#VAL#"; }', 129 'filter:mi' => 'do { my $v=#_#; !$v ? .0. : ref $v ? (.!!. grep ___iname[$_] =~ m"#VAL#"i ,@$v) : ___iname[$v] .=~. m"#VAL#"i; }', 130 'filter_prep:m' => \&Filter::QuoteRegEx, 131 'filter_prep:mi'=> sub { Filter::QuoteRegEx( ::superlc($_[0]) )}, 132 'filter_prep:si'=> sub {quotemeta ::superlc($_[0])}, 133 'filter_prep:s' => sub {quotemeta $_[0]}, 134 'filter_prep:fuzzy'=>sub {my @arg=split / /,$_[0],2; $arg[0],quotemeta ::superlc($arg[1])}, 135 stats => 'do {my $v=#_#; #HVAL#{$_+0}=undef for ref $v ? @$v : $v;} ---- AFTER: #HVAL#=[map ___name[$_], keys %{#HVAL#}];', 136 'stats:gid' => 'do {my $v=#_#; #HVAL#{$_+0}=undef for ref $v ? @$v : $v;}', 137 hashm => 'do {my $v=#_#; ref $v ? @$v : $v }', 138 'hashm:name' => 'do {my $v=#_#; ref $v ? map(___name[$_], @$v) : $v ? ___name[$v] : () }', 139 is_set => 'my $gid=___gid{#VAL#}; my $v=#_#; $gid ? ref $v ? (grep $_==$gid, @$v) : $v==$gid : 0;', 140 #smartmatch version : is_set => 'my $gid=___gid{#VAL#}; my $v=#_#; $gid ? $gid ~~ $v : 0;', 141 listall => '1..$#___name', 142 'editwidget:many' => sub { GMB::TagEdit::EntryMassList->new(@_) }, 143 'editwidget:single' => sub { GMB::TagEdit::FlagList->new(@_) }, 144 'editwidget:per_id' => sub { GMB::TagEdit::FlagList->new(@_) }, 145 autofill_re => '.+', 146 'filterdesc:~' => [ _"includes %s", _"includes", 'combostring', ], 147 'filterdesc:-~' => _"doesn't include %s", 148 'filterdesc:ecount:0' => _"has none", 149 'filterdesc:-ecount:0'=> _"has at least one", 150 'filterdesc:mi' => [ _"matches regexp %s",_"matches regexp",'regexp', icase=>1, ], 151 'filterdesc:si' => [ _"contains %s", _"contains", 'substring', icase=>1, ], 152 'filterdesc:m' => [_"matches regexp %s (case sensitive)",'mi'], 153 'filterdesc:s' => [_"contains %s (case sensitive)", 'si'], 154 'filterdesc:-m' => _"doesn't match regexp %s (case sensitive)", 155 'filterdesc:-mi'=> _"doesn't match regexp %s", 156 'filterdesc:-s' => _"doesn't contain %s (case sensitive)", 157 'filterdesc:-si'=> _"doesn't contain %s", 158 'filterdesc:fuzzy'=> [ _"%s fuzzy match with %s",_"fuzzy match", 'fuzzy string', ], 159 'filterdesc:-fuzzy'=> _"no %s fuzzy match with %s", 160 'smartfilter:=empty' => 'ecount:0', 161 'smartfilter:=' => '~', 162 'smartfilter::' => 'si s', 163 'smartfilter:~' => 'mi m', 164 'smartfilter:#' => \&Filter::smartstring_fuzzy, 165 'filterpat:fuzzy'=> [ round => "%d", unit => '%', min=>20, max=>99, default_value=>65, ], 166 default_filter => 'si', 167 168 load_extra => '___gid{#SGID#} || return;', 169 save_extra => 'my %h; while ( my ($sgid,$gid)=each %___gid ) { $h{$sgid}= [#SUBFIELDS#] } delete $h{""}; return \%h;', 170 171 }, 172 artists => 173 { _ => '____[#ID#]', 174 mainfield => 'artist', 175 #plugin => 'picture', 176# _name => '__#mainfield#_name[#_#]', 177# _iname => '__#mainfield#_iname[#_#]', 178 get => 'do {my $v=#_#; ref $v ? join "\\x00",map __#mainfield#_name[$_],@$v : __#mainfield#_name[$v];}', 179 display => 'do {my $v=#_#; ref $v ? join ", ", map __#mainfield#_name[$_],@$v : __#mainfield#_name[$v];}', 180 get_gid => 'my $v=#_#; ref $v ? $v : [$v]', 181 's_sort:gid' => '__#mainfield#_name[#GID#]', 182 'si_sort:gid' => '__#mainfield#_iname[#GID#]', 183 #display => '##mainfield#->display#', 184 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;', 185 gid_to_get => '(#GID#!=1 ? __#mainfield#_name[#GID#] : "")', # or just '__#mainfield#_name[#GID#]' ? 186 gid_to_display => '__#mainfield#_name[#GID#]', 187 update => 'my @ids; 188 for my $name (do{ #get_list# }) 189 { my $id= ##mainfield#->sgid_to_gid(VAL=$name)#; 190 push @ids,$id; 191 } 192 #_# = @ids==1 ? $ids[0] : 193 @ids==0 ? 1 : 194 (___group{join(" ",map sprintf("%x",$_),@ids)}||= \@ids);', # 1 for @ids==0 is the special gid for unknown artists defined in artist's init 195 'filter:m' => '(ref #_# ? (.!!. grep __#mainfield#_name[$_] =~ m"#VAL#", @{#_#}) : (__#mainfield#_name[#_#] .=~. m"#VAL#"))', 196 'filter:mi' => '(ref #_# ? (.!!. grep __#mainfield#_iname[$_] =~ m"#VAL#"i, @{#_#}) : (__#mainfield#_iname[#_#] .=~. m"#VAL#"i))', 197 'filter:s' => '(ref #_# ? (.!!. grep index( __#mainfield#_name[$_],"#VAL#") != -1, @{#_#}) : (index(__#mainfield#_name[#_#],"#VAL#") .!=. -1))', 198 'filter:si' => '(ref #_# ? (.!!. grep index( __#mainfield#_iname[$_], "#VAL#") != -1, @{#_#}) : (index(__#mainfield#_iname[#_#], "#VAL#") .!=. -1))', 199 '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]); }', 200 'filter_prep:m' => \&Filter::QuoteRegEx, 201 'filter_prep:mi'=> sub { Filter::QuoteRegEx( ::superlc($_[0]) )}, 202 'filter_prep:si'=> sub { quotemeta ::superlc($_[0])}, 203 'filter_prep:s' => sub {quotemeta $_[0]}, 204 'filter_prep:fuzzy'=>sub {my @arg=split / /,$_[0],2; $arg[0],quotemeta ::superlc($arg[1])}, 205 'filter:~' => '(ref #_# ? (.!!. grep $_ == #VAL#, @{#_#}) : (#_# .==. #VAL#))',#FIXME use simpler/faster version if perl5.10 (with ~~) 206 'filter_prep:~' => '##mainfield#->filter_prep:~#', 207 'filter_prephash:~' => '##mainfield#->filter_prephash:~#', 208 'filter_simplify:~' => sub { split /$Artists_split_re/,$_[0] }, 209 'filter:h~' => '(ref #_# ? (grep .!!. exists $hash#VAL#->{$_+0}, @{#_#}) : (.!!. exists $hash#VAL#->{#_#+0}))', 210 makefilter => '"#field#:~:".##mainfield#->gid_to_sgid#', 211 #group => '#_# !=', 212 stats => 'do {my $v=#_#; #HVAL#{__#mainfield#_name[$_]}=undef for ref $v ? @$v : $v;} ---- AFTER: #HVAL#=[keys %{#HVAL#}];', 213 'stats:gid' => 'do {my $v=#_#; #HVAL#{$_}=undef for ref $v ? @$v : $v;} ---- AFTER: #HVAL#=[keys %{#HVAL#}];', 214 hashm => 'do {my $v=#_#; ref $v ? @$v : $v}', 215 listall => '##mainfield#->listall#', 216 'filterdesc:~' => [ _"includes artist %s", _"includes artist", 'menustring', ], 217 'filterdesc:-~' => _"doesn't include artist %s", 218 'filterdesc:mi' => [ _"matches regexp %s",_"matches regexp",'regexp', icase=>1, ], 219 'filterdesc:si' => [ _"contains %s", _"contains", 'substring', icase=>1, ], 220 'filterdesc:m' => [_"matches regexp %s (case sensitive)",'mi'], 221 'filterdesc:s' => [_"contains %s (case sensitive)", 'si'], 222 'filterdesc:-m' => _"doesn't match regexp %s (case sensitive)", 223 'filterdesc:-mi'=> _"doesn't match regexp %s", 224 'filterdesc:-s' => _"doesn't contain %s (case sensitive)", 225 'filterdesc:-si'=> _"doesn't contain %s", 226 'filterdesc:fuzzy'=> [ _"%s fuzzy match with %s",_"fuzzy match", 'fuzzy string', ], 227 'filterdesc:-fuzzy'=> _"no %s fuzzy match with %s", 228 'smartfilter:=' => '~', 229 'smartfilter::' => 'si s', 230 'smartfilter:~' => 'mi m', 231 'smartfilter:#' => \&Filter::smartstring_fuzzy, 232 'filterpat:fuzzy'=> [ round => "%d", unit => '%', min=>20, max=>99, default_value=>65, ], 233 default_filter => 'si', 234 }, 235 artist_first => 236 { parent => 'artist', #FIXME 237 _ => 'do {my $v=__artists__[#ID#]; ref $v ? $v->[0] : $v}', 238 #update => ';', 239 init => ';', #FIXME 240 }, 241 artist => 242 { #set => '#_#= (#VAL# eq "" ? 0 : (__#mainfield#_gid{#VAL#}||= (push @__#mainfield#_name, #VAL#)-1));', 243 parent => 'fewstring', 244 mainfield => 'artist', 245 init => '____=""; __#mainfield#_gid{""}=1; #_iname#[1]=::superlc( #_name#[1]=_("<Unknown>") );', 246 get => 'do {my $v=#_#; $v!=1 ? #_name#[$v] : "";}', 247 gid_to_get => '(#GID#!=1 ? #_name#[#GID#] : "")', 248 gid_to_sgid => '(#GID#!=1 ? #_name#[#GID#] : "")', 249 search_gid => 'my $gid=__#mainfield#_gid{#VAL#}||0; $gid>1 ? $gid : undef;', 250 makefilter => '"#field#:~:" . #gid_to_sgid#', 251 diff => 'do {my $old=#_#; ($old!=1 ? #_name#[$old] : "") ne #VAL# }', 252 #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', 253 listall => '2..@#_name#-1', 254 load_extra => '__#mainfield#_gid{#SGID#} || return;', 255 save_extra => 'my %h; while ( my ($sgid,$gid)=each %__#mainfield#_gid ) { $h{$sgid}= [#SUBFIELDS#] } delete $h{""}; return \%h;', 256 #plugin => 'picture', 257 'filter:pic' => '.!!. __#mainfield#_picture[#_#]', 258 'filterdesc:pic:1'=> _"has a picture", 259 'filterdesc:-pic:1'=> _"doesn't have a picture", 260 }, 261 album => 262 { parent => 'fewstring', 263 mainfield => 'album', 264 _empty => 'vec(__#mainfield#_empty,#_#,1)', 265 unknown => '_("<Unknown>")." "', 266 init => '____=""; __#mainfield#_gid{"\\x00"}=1; __#mainfield#_empty=""; vec(__#mainfield#_empty,1,1)=1; __#mainfield#_sgid[1]="\\x00"; #_iname#[1]=::superlc( #_name#[1]=_("<Unknown>") );', 267 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" : ""} ); 268 __#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; }; 269 };', 270 #possible sgid : album."\x00". "" if no album name and no artist 271 # "artist=".artist if no album name 272 # "album_artist"=album_artist if non-empty album_artist 273 # "compilation=1" if empty album_artist, compilation flag set 274 # "" 275 load => '#_#= #findgid#;', 276 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 277 #newval => 'push @#_iname#, ::superlc( #_name#[-1] );', 278 get => '(#_empty# ? "" : #_name#[#_#])', 279 gid_to_get => '(vec(__#mainfield#_empty,#GID#,1) ? "" : #_name#[#GID#])', 280 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 }}', 281 gid_to_sgid => '$__#mainfield#_sgid[#GID#]', 282 makefilter => '"#field#:~:" . #gid_to_sgid#', 283 update => 'my $albumname=#get#; #set(VAL=$albumname)#;', 284 listall => 'grep !vec(__#mainfield#_empty,$_,1), 2..@#_name#-1', 285 'stats:artistsort' => '#HVAL#->{ #album_artist->get_gid# }=undef; ---- AFTER: #HVAL#=do { my @ar= keys %{#HVAL#}; @ar>1 ? ::superlc(_"Various artists") : __artist_iname[$ar[0]]; }', 286 #plugin => 'picture', 287 load_extra => ' __#mainfield#_gid{#SGID#} || return;', 288 save_extra => 'my %h; while ( my ($sgid,$gid)=each %__#mainfield#_gid ) { $h{$sgid}= [#SUBFIELDS#] } delete $h{""}; return \%h;', 289 'filter:pic' => '.!!. __#mainfield#_picture[#_#]', 290 'filterdesc:pic:1'=> _"has a picture", 291 'filterdesc:-pic:1'=> _"doesn't have a picture", 292 'filterpat:menustring'=> [ display=> sub { my $s=shift; $s=~s/\x00.*//; $s; } ], # could display $album by $album_artist instead 293 294 #load_extra => '___pix[ #sgid_to_gid(VAL=$_[0])# ]=$_[1];', 295 #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;', 296 }, 297 string => 298 { parent => 'generic', 299 default => '""', 300 check => '#VAL#=~tr/\x1D\x00//d; #VAL#=~s/\s+$//;', #remove trailing spaces and \x1D\x00 301 diff => '#_# ne #VAL#', 302 s_sort => '#_#', 303 'filter:e' => '#_# .eq. "#VAL#"', 304 hash => '#_#', 305 group => '#_# ne', 306 stats => '#HVAL#{#_#}=undef; ---- AFTER: #HVAL#=[keys %{#HVAL#}];', 307 }, 308 istring => # _much_ faster with case/accent insensitive operations, at the price of double memory 309 { parent => 'string', 310 _iname => '___iname[#ID#]', 311 set => '#_# = #VAL#; #_iname#= ::superlc(#VAL#);', 312 si_sort => '#_iname#', 313 'filter:si' => 'index( #_iname#,"#VAL#") .!=. -1', 'filter_prep:si'=> sub { quotemeta ::superlc($_[0])}, 314 'filter:mi' => '#_iname# .=~. m"#VAL#"i', 'filter_prep:mi'=> sub { Filter::QuoteRegEx( ::superlc($_[0]) )}, 315 'filter:fuzzy' => ' .!!. Filter::_fuzzy_match(#VAL1#/100,"#VAL2#",#_iname#)', 'filter_prep:fuzzy'=> sub {my @arg=split / /,$_[0],2; $arg[0],quotemeta ::superlc($arg[1])}, 316 }, 317 text => #multi-lines string 318 { parent => 'string', 319 check => '#VAL#=~tr/\x00-\x09\x0B\x0C\x0E-\x1F//d; #VAL#=~s/\s+$//;', 320 'editwidget:single' => sub { GMB::TagEdit::EntryText->new(@_); }, 321 'editwidget:many' => sub { GMB::TagEdit::EntryText->new(@_); }, 322 }, 323 filename=> 324 { parent => 'string', 325 check => ';', #override string's check because not needed and filename may not be utf8 326 get => '#_#', 327 set => '#_#=#VAL#; ::_utf8_off(#_#);', 328 display => '::filename_to_utf8displayname(#get#)', 329 hash_to_display => '::filename_to_utf8displayname(#VAL#)', #only used by FolderList:: and MassTag:: 330 load => '#_#=::decode_url(#VAL#)', 331 save => 'filename_escape(#_#)', 332 #'filterpat:string' => [ display => \&::filename_to_utf8displayname, ], 333 }, 334# picture => 335# { get_picture => '__#mainfield#_picture[#GID#] || $::Options{Default_picture_#mainfield#};', 336# get_pixbuf => 'my $file= #get_picture#; GMB::Picture::pixbuf($file);', 337# set_picture => '::_utf8_off(#VAL#); __#mainfield#_picture[#GID#]= #VAL# eq "" ? undef : #VAL#; ::HasChanged("Picture_#mainfield#",#GID#);', 338# 'load_extra:picture' => 'if (#VAL# ne "") { __#mainfield#_picture[#GID#]= ::decode_url(#VAL#); }', 339# 'save_extra:picture' => 'do { my $v=__#mainfield#_picture[#GID#]; defined $v ? ::url_escape($v) : ""; }', 340# }, 341 _picture => 342 { _ => '__#mainfield#_picture[#GID#]', 343 init => '@__#mainfield#_picture=(); push @GMB::Picture::ArraysOfFiles, \@__#mainfield#_picture;', 344 default => '$::Options{Default_picture}{#mainfield#}', 345 get_for_gid => '#_# || #default#;', 346 pixbuf_for_gid => 'my $file= #get_for_gid#; GMB::Picture::pixbuf($file);', 347 set_for_gid => '::_utf8_off(#VAL#); #_#= #VAL# eq "" ? undef : #VAL#; ::HasChanged("Picture_#mainfield#",#GID#);', 348 load_extra => 'if (#VAL# ne "") { #_#= ::decode_url(#VAL#); }', 349 save_extra => 'do { my $v=#_#; defined $v ? filename_escape($v) : ""; }', 350 get => '__#mainfield#_picture[ ##mainfield#->get_gid# ]', 351 }, 352 fewstring=> #for strings likely to be repeated 353 { _ => 'vec(____,#ID#,#bits#)', 354 bits => 32, #32 bits by default (16 bits ?) 355 mainfield => '#field#', 356 _name => '__#mainfield#_name', 357 _iname => '__#mainfield#_iname', 358 sgid_to_gid => '__#mainfield#_gid{#VAL#}||= do { my $i=push(@#_name#, #VAL#); #newval#; $i-1; }', 359 newval => 'push @#_iname#, ::superlc( #_name#[-1] );', 360 #newval => 'push @#_iname#, ::superlc(#VAL#);', 361 set => '#_# = #sgid_to_gid#;', 362 init => '____=""; __#mainfield#_gid{""}=1; #_name#[1]=#_iname#[1]="";', 363 check => '#VAL#=~tr/\x00-\x1F//d; #VAL#=~s/\s+$//;', 364 default => '""', 365 get_gid => '#_#', 366 get => '#_name#[#_#]', 367 diff => '#get# ne #VAL#', 368 display => '#_name#[#_#]', 369 s_sort => '#_name#[#_#]', 370 si_sort => '#_iname#[#_#]', 371 gid_to_get => '#_name#[#GID#]', 372 's_sort:gid' => '#_name#[#GID#]', 373 'si_sort:gid' => '#_iname#[#GID#]', 374 always_first_gid=> 0, 375 gid_to_display => '#_name#[#GID#]', 376 'filter:m' => '#_name#[#_#] .=~. m"#VAL#"', 377 'filter:mi' => '#_iname#[#_#] .=~. m"#VAL#"i', 378 'filter:fuzzy' => '.!!. Filter::_fuzzy_match(#VAL1#/100,"#VAL2#",#_iname#[#_#])', 'filter_prep:fuzzy'=> sub {my @arg=split / /,$_[0],2; $arg[0],quotemeta ::superlc($arg[1])}, 379 'filter:si' => 'index( #_iname#[#_#],"#VAL#") .!=. -1', 'filter_prep:si' => sub {quotemeta ::superlc($_[0])}, 380 'filter:s' => 'index( #_name#[#_#], "#VAL#") .!=. -1', 381 'filter:e' => '#_name#[#_#] .eq. "#VAL#"', 382 'filter:~' => '#_# .==. #VAL#', 'filter_prep:~' => '#sgid_to_gid(VAL=#PAT#)#', 383 'filter_prephash:~' => 'return {map { #sgid_to_gid(VAL=$_)#,undef} keys %{#HREF#}}', 384 'filter:h~' => '.!!. exists $hash#VAL#->{#_#}', 385# hash => '#_name#[#_#]', 386 hash => '#_#', 387 #"hash:gid" => '#_#', 388 makefilter => '"#field#:~:".#_name#[#GID#]', 389 group => '#_# !=', 390 stats => '#HVAL#{#_name#[#_#]}=undef; ---- AFTER: #HVAL#=[keys %{#HVAL#}];', 391 'stats:gid' => '#HVAL#{#_#}=undef; ---- AFTER: #HVAL#=[keys %{#HVAL#}];', 392 listall => '2..@#_name#-1', 393 edit_listall => 1, 394 parent => 'generic', 395 maxgid => '@#_name#-1', 396 'filterdesc:~' => [ _"is %s", _"is", 'menustring', ], 397 'filterdesc:-~' => _"isn't %s", 398 #gsummary => 'my $gids=Songs::UniqList(#field#,#IDs#); @$gids==1 ? #gid_to_display(GID=$gids->[0])# : #names(count=scalar @$gids)#;', 399 }, 400 number => 401 { parent => 'generic', 402 set => '#_# = #VAL#||0', 403 ########save => '(#_# || "")', 404 n_sort => '#_#', 405 'n_sort:gid' => '#GID#', 406 diff => '#_# != #VAL#', 407 'filter:e' => '#_# .==. #VAL#', 408 'filter:>' => '#_# .>. #VAL#', 409 'filter:<' => '#_# .<. #VAL#', 410 'filter:b' => '#_# .>=. #VAL1# .&&. #_# .<=. #VAL2#', 411 'filter_prep:b' => \&filter_prep_numbers_between, 412 'filter_prep:>' => \&filter_prep_numbers, 413 'filter_prep:<' => \&filter_prep_numbers, 414 'filter_prep:e' => \&filter_prep_numbers, 415 'group' => '#_# !=', 416 'stats:range' => 'push @{#HVAL#},#_#; ---- AFTER: #HVAL#=do {my ($m0,$m1)=(sort {$a <=> $b} @{#HVAL#})[0,-1]; $m0==$m1 ? $m0 : "$m0 - $m1"}', 417 'stats:average' => 'push @{#HVAL#},#_#; ---- AFTER: #HVAL#=do { my $s=0; $s+=$_ for @{#HVAL#}; $s/@{#HVAL#}; }', 418 'stats:sum' => '#HVAL# += #_#;', 419 stats => '#HVAL#{#_#+0}=undef;', 420 hash => '#_#+0', 421 display => '(#_# ? sprintf("#displayformat#", #_# ) : "")', #replace 0 with "" 422 gid_to_display => '#GID#', 423 get_gid => '#_#+0', 424 makefilter => '"#field#:e:#GID#"', 425 default => '0+0', #not 0 because it needs to be true :( 426 autofill_re => '\\d+', 427 default_filter => '>', 428 'filterdesc:e' => [ "= %s", "=", 'value', ], 429 'filterdesc:>' => [ "> %s", ">", 'value', noinv=>1 ], 430 'filterdesc:<' => [ "< %s", "<", 'value', noinv=>1 ], 431 'filterdesc:-<' => [ "≥ %s", "≥", 'value', noinv=>1 ], 432 'filterdesc:->' => [ "≤ %s", "≤", 'value', noinv=>1 ], 433 'filterdesc:b' => [ _"between %s and %s", _"between", 'value value'], 434 'filterdesc:-b' => _"not between %s and %s", 435 'filterdesc:-e' => "≠ %s", 436 'filterdesc:h' => [ _"in the top %s", _"in the top", 'number',], # "the %s most" "the most", ? 437 'filterdesc:t' => [ _"in the bottom %s",_"in the bottom", 'number',], # "the %s least" "the least", ? 438 'filterdesc:-h' => _"not in the top %s", 439 'filterdesc:-t' => _"not in the bottom %s", 440 'filterpat:substring' => [icase => 0], 441 'filterpat:regexp' => [icase => 0], 442 'smartfilter:>' => \&Filter::_smartstring_number_moreless, 443 'smartfilter:<' => \&Filter::_smartstring_number_moreless, 444 'smartfilter:<='=> \&Filter::_smartstring_number_moreless, 445 'smartfilter:>='=> \&Filter::_smartstring_number_moreless, 446 'smartfilter:=' => \&Filter::_smartstring_number, 447 'smartfilter::' => \&Filter::_smartstring_number, 448 'smartfilter:~' => 'm', 449 'smartfilter:=empty' => 'e:0', 450 'smartfilter:#' => undef, 451 filter_exclude => 'fuzzy', # do not show these filters 452 rightalign=>1, #right-align in SongTree and SongList 453 }, 454 'number.div' => 455 { group => 'int(#_#/#ARG0#) !=', 456 hash => 'int(#_#/#ARG0#)', #hash:minute => '60*int(#_#/60)', 457 #makefilter => '"#field#:".(!#GID# ? "e:0" : "b:".(#GID# * #ARG0#)." ".((#GID#+1) * #ARG0#))', 458 makefilter => 'Filter->newadd(1, "#field#:-<:".(#GID# * #ARG0#), "#field#:<:".((#GID#+1) * #ARG0#) )', #FIXME decimal separator must be always "." 459 gid_to_display => '#GID# * #ARG0#', 460 get_gid => 'int(#_#/#ARG0#)', 461 }, 462 fewnumber => 463 { _ => '___value[vec(____,#ID#,#bits#)]', 464 parent => 'number', 465 bits => 16, 466 init => '____=""; ___value[0]=undef;', 467 set => 'vec(____,#ID#,#bits#) = ___gid{#VAL#}||= do { push(@___value, #VAL#+0)-1; }', 468 check => '#VAL#= #VAL# =~m/^(-?\d*\.?\d+)$/ ? $1 : 0;', 469 displayformat => '%d', 470 }, 471 integer => 472 { _ => 'vec(____,#ID#,#bits#)', 473 displayformat => '%d', 474 bits => 32, #use 32 bits by default 475 #check => '#VAL#= #VAL# =~m/^(\d+)$/ ? $1 : 0;', 476 check => '#VAL#= #VAL# =~m/^(\d+)/ && $1<2**#bits# ? $1 : 0;', # set to 0 if overflow 477 init => '____="";', 478 parent => 'number', 479 '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}); }, 480 step => 1, #minimum difference between 2 values, used to simplify filters 481 }, 482 'integer.div' => 483 { makefilter => '"#field#:b:".(#GID# * #ARG0#)." ".(((#GID#+1) * #ARG0#)-1)', 484 }, 485 float => #make sure the string doesn't have the utf8 flag, else substr won't work 486 { _ => 'unpack("F",substr(____,#ID#<<3,8))', 487 display => 'do {my $v=#_#; (#v_is_nan# ? "" : ::format_number($v,"#displayformat#"))}', # replace novalue (NaN) with "" 488 get => 'do {my $v=#_#; (#v_is_nan# ? "" : $v ); }', # 489 diff => ($nan==$nan ? 'do {my $new=#VAL#; $new=#nan# unless length $new; $new!=#_# }' : 490 'do {my $new=#VAL#; $new=#nan# unless length $new; my $v=#_#; $new!=$v && ($new==$new || ! #v_is_nan#) }'), 491 displayformat => '%.2f', 492 init => '____=" "x8;', #needs init for ID==0 493 parent => 'number', 494 nan => '$Songs::nan', 495 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 496 novalue => '#nan#', #use NaN as novalue 497 default => '#novalue#', 498 set => 'substr(____,#ID#<<3,8)=pack("F",(length(#VAL#) ? #VAL# : #novalue#))', 499 check => '#VAL#= #VAL# =~m/^(-?\d*\.?\d+(?:e[-+]\d+)?)$/i ? $1 : #novalue#;', 500 # FIXME make sure that locale is set to C (=> '.' as decimal separator) when needed 501 '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'); }, 502 autofill_re => '-?\\d*\\.?\\d+', 503 'filterpat:value' => [ digits => 2, signed=>1, round => "%.2f", ], 504 n_sort => 'do {my $v=#_#; #v_is_nan# ? "-inf" : $v}', 505 'filter:defined' => 'do {my $v=#_#; .!. (#v_is_nan#)}', 506 'filterdesc:defined:1' => _"is defined", 507 'filterdesc:-defined:1' => _"is not defined", 508 'smartfilter:=empty' => '-defined:1', 509 '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 510 }, 511 'float.range'=> 512 { get_gid => 'do {my $v=#_#; #v_is_nan# ? #nan_gid# : int($v/#range_step#) ;}', 513 nan_gid => '-2**31+1', #gid in FilterList are Long, 2**31-1 is GID_ALL 514 always_first_gid=> -2**31+1, 515 range_step => '1', #default step 516 gid_to_display => '( #GID#==#nan_gid# ? _"not defined" : do {my $v= #GID# * #range_step#; "$v .. ".($v+#range_step#)})', 517 gid_to_get => '( #GID#==#nan_gid# ? #nan# : #GID# * #range_step#)', 518 hash => '#get_gid#', 519 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 "." 520 'n_sort:gid' => '( do{my $n=#GID#==#nan_gid# ? "-inf" : #GID# * #range_step#;warn "#GID# => $n";$n })', 521 'n_sort:gid' => '( #GID#==#nan_gid# ? "-inf" : #GID# * #range_step# )', 522 'n_sort:gid' => '#GID#', # #nan_gid# is already the most negative number, no need to replace it with -inf 523 }, 524 'length' => 525 { display => 'sprintf("%d:%02d", #_#/60, #_#%60)', 526 parent => 'integer', 527 'filter_prep:e' => \&::ConvertTimeLength, 528 'filter_prep:>' => \&::ConvertTimeLength, 529 'filter_prep:<' => \&::ConvertTimeLength, 530 'filter_prep:b' => sub {sort {$a <=> $b} map ::ConvertTimeLength($_), split / /,$_[0],2}, 531 }, 532 'length.div' => { gid_to_display => 'my $v=#GID# * #ARG0#; sprintf("%d:%02d", $v/60, $v%60);', }, 533 size => 534 { display => '( ::format_number( #_#/'. ::MB() .',"%.1f").q( '. _"MB" .') )', 535 'filter_prep:e' => \&::ConvertSize, 536 'filter_prep:>' => \&::ConvertSize, 537 'filter_prep:<' => \&::ConvertSize, 538 'filter_prep:b' => sub {sort {$a <=> $b} map ::ConvertSize($_), split / /,$_[0],2}, 539 parent => 'integer', 540 'filterpat:value' => [ unit=> \%::SIZEUNITS, default_unit=> 'm', default_value=>1, ], 541 }, 542 'size.div' => { gid_to_display => '( ::format_number( #GID# * #ARG0#/'. ::MB() .',"%d").q( '. _"MB" .') )', }, 543 rating => 544 { parent => 'integer', 545 bits => 8, 546 _ => 'vec(____,#ID#,#bits#)', 547 _default=> 'vec(___default_,#ID#,#bits#)', 548 init => '____ = ___default_ = "";', 549 default => '""', 550 diff => '(#VAL# eq "" ? 255 : #VAL#)!=#_#', 551 get => '(#_#==255 ? "" : #_#)', 552 display => '(#_#==255 ? "" : #_#)', 553 'stats:range' => 'push @{#HVAL#},#_default#; ---- AFTER: #HVAL#=do {my ($m0,$m1)=(sort {$a <=> $b} @{#HVAL#})[0,-1]; $m0==$m1 ? $m0 : "$m0 - $m1"}', 554 'stats:average' => 'push @{#HVAL#},#_default#; ---- AFTER: #HVAL#=do { my $s=0; $s+=$_ for @{#HVAL#}; $s/@{#HVAL#}; }', 555 check => '#VAL#= #VAL# =~m/^\d+$/ ? (#VAL#>100 ? 100 : #VAL#) : "";', 556 set => '{ my $v=#VAL#; #_default#= ($v eq "" ? $::Options{DefaultRating} : $v); #_# = ($v eq "" ? 255 : $v); }', 557 makefilter => '"#field#:~:#GID#"', 558 'filter:~' => '#_# .==. #VAL#', 559 'filter:e' => '#_default# .==. #VAL#', 560 'filter:>' => '#_default# .>. #VAL#', 561 'filter:<' => '#_default# .<. #VAL#', 562 'filter:b' => '#_default# .>=. #VAL1# .&&. #_default# .<=. #VAL2#', 563 'filterdesc:~' => [_"set to %s", _"set to", 'value'], 564 'filterdesc:-~' => _"not set to %s",, 565 'filterdesc:~:255'=> 'set to default', 566 'filterdesc:-~:255'=>'not set to default', 567 'smartfilter:=empty' => '~:255', 568 n_sort => '#_default#', 569 #array => '#_default#', 570 gid_to_display => '#GID#==255 ? _"Default" : #GID#', 571 percent => '#_default#', #for random mode 572 update => '___default_=____; my $d=pack "C",$::Options{DefaultRating}; ___default_=~s/\xff/$d/g;', #\xff==255 # called when $::Options{DefaultRating} has changed 573 #"hash:gid" => '#_#', 574 hash => '#_#', 575 'editwidget:all' => sub {GMB::TagEdit::EntryRating->new(@_) }, 576 }, 577 date => 578 { parent => 'integer', 579 display => 'Songs::DateString(#_#)', 580 daycount=> 'do { my $t=(time-( #_# ) )/86400; ($t<0)? 0 : $t}', #for random mode 581 'filter_prep:>ago' => \&::ConvertTime, 582 'filter_prep:<ago' => \&::ConvertTime, 583 'filter_prep:bago' => sub {sort {$a <=> $b} map ::ConvertTime($_), split / /,$_[0],2}, 584 'filter:>ago' => '#_# .<. #VAL#', 585 'filter:<ago' => '#_# .>. #VAL#', 586 'filter:bago' => '#_# .>=. #VAL1# .&&. #_# .<=. #VAL2#', 587 #'filterdesc:e' => [_"is equal to %s", _"is equal to", 'date' ], 588 filter_exclude => 'e', # do not show these filters 589 'filterdesc:>ago' => [_"more than %s ago", _"more than", 'ago', ], 590 'filterdesc:<ago' => [_"less than %s ago", _"less than", 'ago', ], 591 'filterdesc:>' => [_"after %s", _"after", 'date', ], 592 'filterdesc:<' => [_"before %s", _"before", 'date', ], 593 'filterdesc:b' => [_"between %s and %s", _"between (absolute dates)", 'date date'], 594 'filterdesc:bago' => [_"between %s ago and %s ago", _"between (relative dates)", 'ago ago'], 595 'filterdesc:->ago' => _"less than %s ago", 596 'filterdesc:-<ago' => _"more than %s ago", 597 'filterdesc:->' => _"before %s", 598 'filterdesc:-<' => _"after %s", 599 'filterdesc:-b' => _"not between %s and %s", 600 'filterdesc:-bago' => _"not between %s ago and %s ago", 601 'filterdesc:h' => [ _"the %s most recent", _"the most recent", 'number'], #"the %s latest" "the latest" ? 602 'filterdesc:t' => [ _"the %s least recent", _"the least recent", 'number'], #"the %s earliest" "the earliest" ? 603 'filterdesc:-h' => _"not the %s most recent", 604 'filterdesc:-t' => _"not the %s least recent", 605 'filterpat:ago' => [ unit=> \%::DATEUNITS, default_unit=> 'd', ], 606 'filterpat:date' => [ display=> sub { my $var=shift; $var= ::strftime_utf8('%c',localtime $var) if $var=~m/^\d+$/; $var; }, ], 607 default_filter => '<ago', 608 'smartfilter:>' => \&Filter::_smartstring_date_moreless, 609 'smartfilter:<' => \&Filter::_smartstring_date_moreless, 610 'smartfilter:<='=> \&Filter::_smartstring_date_moreless, 611 'smartfilter:>='=> \&Filter::_smartstring_date_moreless, 612 'smartfilter:=' => \&Filter::_smartstring_date, 613 'smartfilter::' => \&Filter::_smartstring_date, 614 'smartfilter:~' => 'm', 615 'smartfilter:=empty' => 'e:0', 616 617 #for date.year, date.month, date.day : 618 always_first_gid=> 0, 619 group => '#mktime# !=', 620 get_gid => '#_# ? #mktime# : 0', 621 hash => '(#_# ? #mktime# : 0)', #or use post-hash modification for 0 case 622 subtypes_menu=> \%timespan_menu, 623 grouptitle=> 'my $gid=#get_gid#; #gid_to_display(GID=$gid)#;', 624 rightalign=>0, 625 }, 626 'date.year' => 627 { mktime => '::mktime(0,0,0,1,0,(localtime(#_#))[5])', 628 gid_to_display => '(#GID# ? ::strftime_utf8("%Y",localtime(#GID#)) : _"never")', 629 makefilter => '"#field#:".(!#GID# ? "e:0" : "b:".#GID#." ".(::mktime(0,0,0,1,0,(localtime(#GID#))[5]+1)-1))', 630 }, 631 'date.month' => 632 { mktime => '::mktime(0,0,0,1,(localtime(#_#))[4,5])', 633 gid_to_display => '(#GID# ? ::strftime_utf8("%b %Y",localtime(#GID#)) : _"never")', 634 makefilter => '"#field#:".(!#GID# ? "e:0" : "b:".#GID#." ".do{my ($m,$y)= (localtime(#GID#))[4,5]; ::mktime(0,0,0,1,$m+1,$y)-1})', 635 }, 636 'date.day' => 637 { mktime => '::mktime(0,0,0,(localtime(#_#))[3,4,5])', 638 gid_to_display => '(#GID# ? ::strftime_utf8("%x",localtime(#GID#)) : _"never")', 639 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})', 640 }, 641 dates_compact => # ___index_ : binary string containing position (in unit of 1 date => 4 bytes) of the first date in ___values_ for each song 642 # ___nb_ : binary string containing number of dates for each song 643 # ___values_ : binary string containing the actual dates 644 # ___free_ : array containing free positions in ___values_ for each size 645 { parent => 'dates', 646 _ => 'substr(___values_, #index# * #bytes#, #nb# * #bytes#)', 647 index => 'vec(___index_,#ID#,32)', # => max 2**32 songs that share the same number of dates, could maybe use 16 bits instead 648 nb => 'vec(___nb_,#ID#,16)', # => max 2**16 dates per song, could maybe use 8 bits instead 649 get_list => 'unpack("#packformat#*", #_#)', 650 init => '___index_= ___values_= ___nb_ = "";', 651 set => '{ my $v=#VAL#; 652 my @list= !$v ? () : sort { $a <=> $b } (ref $v ? @$v : split /\D+/,$v); 653 if (my $nb=#nb#) { ___free_[$nb].= pack "N",#index#; } # add previous space to list of free spaces 654 if (@list) 655 { my $string= pack "#packformat#*", @list; 656 my $nb= #nb#= scalar @list; 657 if (___free_[$nb]) # re-use old space 658 { #index#= unpack "N", substr(___free_[$nb],-4,4,""); 659 #_#= $string; 660 } 661 else # use new space 662 { #index#= length(___values_)/#bytes#; 663 ___values_ .= $string; 664 } 665 } 666 else { #index#=0; #nb#=0 } 667 }', 668 'filter:ecount' => '#VAL# .==. #nb#', 669 'stats:count' => '#HVAL# += #nb#;', 670 }, 671 dates => 672 { parent => 'generic', # for m mi s si filters 673 _ => '____[#ID#]', 674 default => 'undef', 675 bits => 32, packformat=> 'L', # replace with 64 and Q for 64bits dates 676 bytes => '(#bits#/8)', 677 check => ';', 678 get_list => 'unpack("#packformat#*",#_#||"")', 679 display => 'join("\n",map Songs::DateString($_), reverse #get_list#)', 680 gid_to_get => '#GID#', 681 gid_to_display => 'Songs::DateString(#GID#)', 682 #n_sort => 'unpack("#packformat#*",substr(#_#||"",-#bytes#))', #sort by last date, not used 683 'n_sort:gid' => '#GID#', 684 get => 'join(" ",#get_list#)', 685 set => '{ my $v=#VAL#; 686 my @list= !$v ? () : sort { $a <=> $b } (ref $v ? @$v : split /\D+/,$v); 687 #_#= !@list ? undef : pack("#packformat#*", @list); 688 }', #use undef instead of '' if no dates to save some memory 689 diff => 'do {my $old=#_#||""; my $new=#VAL#; $new= pack "#packformat#*",sort { $a <=> $b } (ref $new ? @$new : split /\D+/,$new); $old ne $new; }', 690 check_multi => 'for my $lref (@{#VAL#}) {@$lref=grep m/^\d+$/, @$lref}', 691 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; }', 692 'filter:ecount' => '#VAL# .==. length(#_#)/#bytes#', 693 'stats:count' => '#HVAL# += length(#_#)/#bytes#;', 694 #example of use : Songs::BuildHash('artist',$::Library,undef,'playhistory:countrange:DATE1-DATE2')); where DATE1 and DATE2 are secongs since epoch and DATE1<DATE2 695 '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) 696 'stats:countafter' => '#HVAL# ++ for grep #ARG#<$_, #get_list#;', #count plays after date (in seconds since epoch) 697 'stats:countbefore' => '#HVAL# ++ for grep #ARG#>$_, #get_list#;', #count plays before date (in seconds since epoch) 698 stats => 'do {#HVAL#{$_}=undef for #get_list#;};', 699 'filter:e' => '.!!. do{ grep($_ == #VAL#, #get_list#) }', 700 'filter:>' => '.!!. do{ grep($_ > #VAL#, #get_list#) }', 701 'filter:<' => '.!!. do{ grep($_ < #VAL#, #get_list#) }', 702 'filter:b' => '.!!. do{ grep($_ >= #VAL1# && $_ <= #VAL2#, #get_list#) }', 703 'filter_prep:>' => \&filter_prep_numbers, 704 'filter_prep:<' => \&filter_prep_numbers, 705 'filter_prep:e' => \&filter_prep_numbers, 706 'filter_prep:b' => \&filter_prep_numbers_between, 707 'filter_prep:>ago' => \&::ConvertTime, 708 'filter_prep:<ago' => \&::ConvertTime, 709 'filter_prep:bago' => sub {sort {$a <=> $b} map ::ConvertTime($_), split / /,$_[0],2}, 710 'filter:>ago' => '.!!. do{ grep($_ < #VAL#, #get_list#) }', 711 'filter:<ago' => '.!!. do{ grep($_ > #VAL#, #get_list#) }', 712 'filter:bago' => '.!!. do{ grep($_ >= #VAL1# && $_ <= #VAL2#, #get_list#) }', 713 #copy of filterdesc:* smartfilter:* from date type 714 'filterdesc:>ago' => [_"more than %s ago", _"more than", 'ago', ], 715 'filterdesc:<ago' => [_"less than %s ago", _"less than", 'ago', ], 716 'filterdesc:>' => [_"after %s", _"after", 'date', ], 717 'filterdesc:<' => [_"before %s", _"before", 'date', ], 718 'filterdesc:b' => [_"between %s and %s", _"between (absolute dates)", 'date date'], 719 'filterdesc:bago' => [_"between %s ago and %s ago", _"between (relative dates)", 'ago ago'], 720 'filterdesc:->ago' => _"not more than %s ago", 721 'filterdesc:-<ago' => _"not less than %s ago", 722 'filterdesc:->' => _"not after %s", 723 'filterdesc:-<' => _"not before %s", 724 'filterdesc:-b' => _"not between %s and %s", 725 'filterdesc:-bago' => _"not between %s ago and %s ago", 726 'filterdesc:h' => [ _"the %s most recent", _"the most recent", 'number'], #"the %s latest" "the latest" ? 727 'filterdesc:t' => [ _"the %s least recent", _"the least recent", 'number'], #"the %s earliest" "the earliest" ? 728 'filterdesc:-h' => _"not the %s most recent", 729 'filterdesc:-t' => _"not the %s least recent", 730 'filterpat:ago' => [ unit=> \%::DATEUNITS, default_unit=> 'd', ], 731 'filterpat:date' => [ display=> sub { my $var=shift; $var= ::strftime_utf8('%c',localtime $var) if $var=~m/^\d+$/; $var; }, ], 732 default_filter => '<ago', 733 'smartfilter:>' => \&Filter::_smartstring_date_moreless, 734 'smartfilter:<' => \&Filter::_smartstring_date_moreless, 735 'smartfilter:<='=> \&Filter::_smartstring_date_moreless, 736 'smartfilter:>='=> \&Filter::_smartstring_date_moreless, 737 'smartfilter:=' => \&Filter::_smartstring_date, 738 'smartfilter::' => \&Filter::_smartstring_date, 739 'smartfilter:=empty' => 'ecount:0', 740 'smartfilter:#' => undef, 741 filter_exclude => 'fuzzy', # do not show these filters 742 743 #get_gid => '[#get_list#]', 744 #hashm => '#get_list#', 745 #mktime => '$_', 746 #for dates.year, dates.month, dates.day : 747 always_first_gid=> 0, 748 get_gid => '[#_# ? (map #mktime#,#get_list#) : 0]', 749 hashm => '(#_# ? (map #mktime#,#get_list#) : 0)', #or use post-hash modification for 0 case 750 subtypes_menu=> \%timespan_menu, 751 752 }, 753 #identical to date.*, except #_# is replaced by $_ in mktime, and "e" filter by "ecount" 754 'dates.year' => 755 { mktime => '::mktime(0,0,0,1,0,(localtime($_))[5])', 756 gid_to_display => '(#GID# ? ::strftime_utf8("%Y",localtime(#GID#)) : _"never")', 757 makefilter => '"#field#:".(!#GID# ? "ecount:0" : "b:".#GID#." ".(::mktime(0,0,0,1,0,(localtime(#GID#))[5]+1)-1))', 758 }, 759 'dates.month' => 760 { mktime => '::mktime(0,0,0,1,(localtime($_))[4,5])', 761 gid_to_display => '(#GID# ? ::strftime_utf8("%b %Y",localtime(#GID#)) : _"never")', 762 makefilter => '"#field#:".(!#GID# ? "ecount:0" : "b:".#GID#." ".do{my ($m,$y)= (localtime(#GID#))[4,5]; ::mktime(0,0,0,1,$m+1,$y)-1})', 763 }, 764 'dates.day' => 765 { mktime => '::mktime(0,0,0,(localtime($_))[3,4,5])', 766 gid_to_display => '(#GID# ? ::strftime_utf8("%x",localtime(#GID#)) : _"never")', 767 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})', 768 }, 769 boolean => 770 { parent => 'integer', bits => 1, 771 check => '#VAL#= #VAL# ? 1 : 0;', 772 display => "(#_# ? #yes# : #no#)", yes => '_("Yes")', no => 'q()', 773 'editwidget:all'=> sub { my $field=$_[0]; GMB::TagEdit::EntryBoolean->new(@_); }, 774 'filterdesc:e:0' => [_"is false",_"is false",'',noinv=>1], 775 'filterdesc:e:1' => [_"is true", _"is true", '',noinv=>1], 776 'filterdesc:-e:0' => _"is true", 777 'filterdesc:-e:1' => _"is false", 778 filter_exclude => 'ALL', #do not show filters inherited from parents 779 default_filter => 'e:1', 780 'smartfilter:=empty' => 'e:0', 781 rightalign=>0, 782 }, 783 shuffle=> 784 { n_sort => 'Songs::update_shuffle($Songs::LastID) ---- vec($Songs::SHUFFLE,#ID#,32)', 785 }, 786 gidshuffle=> 787 { n_sort => 'Songs::update_shuffle(##mainfield#->maxgid#) ---- vec($Songs::SHUFFLE,##mainfield#->get_gid#,32)', 788 }, 789 writeonly=> 790 { diff=>'1', 791 set => '', 792 check=>'', 793 }, 794); 795%Def= #flags : Read Write Editable Sortable Column caseInsensitive sAve List Gettable Properties 796(file => 797 { name => _"Filename", width => 400, flags => 'fgascp_', type => 'filename', 798 'stats:filetoid' => '#HVAL#{ #file->get# }=#ID#', 799 category=>'file', 800 alias => 'filename', 801 }, 802 id => 803 { type=> 'integer', 804 _ => '#ID#', 805 'stats:list' => 'push @{#HVAL#}, #ID#', 806 'stats:uniq' => '#HVAL#=undef', #doesn't really belong here, but simpler this way 807 'stats:count' => '#HVAL#++', 808 }, 809 path => 810 { name => _"Folder", width => 200, flags => 'fgascp_', type => 'filename', 811 'filter:i' => '#_# .=~. m/^#VAL#(?:$::QSLASH|$)/o', 812 'filter_prep:i' => sub { quotemeta ::decode_url($_[0]); }, 813 'filterdesc:i' => [_"is in %s", _"is in", 'filename'], 814 'filterdesc:-i' => _"isn't in %s", 815 'filterpat:filename' => [ display => sub { ::filename_to_utf8displayname(::decode_url($_[0])); }, ], 816 can_group=>1, 817 category=>'file', 818 alias => 'folder', 819 }, 820 modif => 821 { name => _"Modification", width => 160, flags => 'fgarscp_', type => 'date', 822 FilterList => {type=>'year',}, 823 can_group=>1, 824 category=>'file', 825 alias => 'modified', 826 }, 827 size => 828 { name => _"Size", width => 80, flags => 'fgarscp_', #32bits => 4G max 829 type => 'size', 830 FilterList => {type=>'div.'.::MB(),}, 831 category=>'file', 832 }, 833 title => 834 { name => _"Title", width => 270, flags => 'fgarwescpi', type => 'istring', 835 id3v1 => 0, id3v2 => 'TIT2', vorbis => 'title', ape => 'Title', lyrics3v2=> 'ETT', ilst => "\xA9nam", 836 'filter:~' => '#_iname# .=~. m"(?:^|/) *#VAL# *(?:[/\(\[]|$)"', 'filter_prep:~'=> \&Filter::SmartTitleRegEx, 837 'filter_simplify:~' => \&Filter::SmartTitleSimplify, 838 'filterdesc:~' => [_"is smart equal to %s", _"is smart equal", 'substring'], 839 'filterdesc:-~' => _"Isn't smart equal to %s", 840 makefilter_fromID => '"title:~:" . #get#', 841 edit_order=> 10, letter => 't', 842 category=>'basic', 843 alias_trans=> ::_p('Field_aliases',"title"), #TRANSLATION: comma-separated list of field aliases for title, these are in addition to english aliases 844 }, 845 artist => 846 { name => _"Artist", width => 200, flags => 'fgarwescpi', 847 type => 'artist', 848 id3v1 => 1, id3v2 => 'TPE1', vorbis => 'artist', ape => 'Artist', lyrics3v2=> 'EAR', ilst => "\xA9ART", 849 FilterList => {search=>1,drag=>::DRAG_ARTIST}, 850 all_count=> _"All artists", 851 apic_id => 8, 852 picture_field => 'artist_picture', 853 edit_order=> 20, edit_many=>1, letter => 'a', 854 can_group=>1, 855 #names => '::__("%d artist","%d artists",#count#);' 856 category=>'basic', 857 alias=> 'by', 858 alias_trans=> ::_p('Field_aliases',"artist,by"), #TRANSLATION: comma-separated list of field aliases for artist, these are in addition to english aliases 859 }, 860 first_artist => 861 { flags => 'fig', 862 type => 'artist_first', depend => 'artists', name => _"Main artist", 863 FilterList => {search=>1,drag=>::DRAG_ARTIST}, 864 picture_field => 'artist_picture', 865 sortgroup=>'artist', 866 can_group=>1, 867 }, 868 artists => 869 { flags => 'gfil', type => 'artists', depend => 'artist title', name => _"Artists", 870 all_count=> _"All artists", 871 FilterList => {search=>1,drag=>::DRAG_ARTIST}, 872 picture_field => 'artist_picture', 873 }, 874 album => 875 { name => _"Album", width => 200, flags => 'fgarwescpi', type => 'album', 876 id3v1 => 2, id3v2 => 'TALB', vorbis => 'album', ape => 'Album', lyrics3v2=> 'EAL', ilst => "\xA9alb", 877 depend => 'artist album_artist_raw compilation', #because albums with no names get the name : <Unknown> (artist) 878 all_count=> _"All albums", 879 FilterList => {search=>1,drag=>::DRAG_ALBUM}, 880 apic_id => 3, 881 picture_field => 'album_picture', 882 names => '::__("%d album","%d albums",#count#);', 883 edit_order=> 30, edit_many=>1, letter => 'l', 884 can_group=>1, 885 category=>'basic', 886 alias=> 'on', 887 alias_trans=> ::_p('Field_aliases',"album,on"), #TRANSLATION: comma-separated list of field aliases for album, these are in addition to english aliases 888 }, 889# genre_picture => 890# { name => "Genre picture", 891# flags => 'g', 892# depend => 'genre', 893# property_of => 'genre', 894# mainfield => 'genre', 895# type => '_picture', 896# }, 897 album_picture => 898 { name => _"Album picture", 899 flags => 'g', 900 depend => 'album', 901 property_of => 'album', 902 mainfield => 'album', 903 type => '_picture', 904 letter => 'c', 905 }, 906 artist_picture => 907 { name => _"Artist picture", 908 flags => 'g', 909 depend => 'artist', 910 property_of => 'artist', 911 mainfield => 'artist', 912 type => '_picture', 913 }, 914 album_artist_raw => 915 { name => _"Album artist",width => 200, flags => 'fgarwescpi', type => 'artist', 916 id3v2 => 'TPE2', vorbis => 'albumartist|album_artist', ape => 'Album Artist|Album_artist', ilst => "aART", 917 #FilterList => {search=>1,drag=>::DRAG_ARTIST}, 918 picture_field => 'artist_picture', 919 edit_order=> 35, edit_many=>1, 920 #can_group=>1, 921 category=>'basic', 922 }, 923 album_artist => 924 { name => _"Album artist or artist",width => 200, flags => 'fgcsi', type => 'artist', 925 FilterList => {search=>1,drag=>::DRAG_ARTIST}, 926 picture_field => 'artist_picture', 927 _ => 'do {my $n=vec(__album_artist_raw__,#ID#,#bits#); $n==1 ? vec(__artist__,#ID#,#bits#) : $n}', 928 can_group=>1, 929 letter => 'A', 930 depend => 'album_artist_raw artist album', 931 category=>'basic', 932 }, 933 haspicture => 934 { name => _"Embedded picture", width => 20, flags => 'fgarwscp', type => 'boolean', 935 id3v2 => 'APIC;;;;%v', ilst => 'covr', #or just id3v2 => 'APIC', ? 936 disable=>1, 937 }, 938 haslyrics => 939 { name => _"Embedded lyrics", width => 20, flags => 'fgarwscp', type => 'boolean', 940 id3v2 => 'USLT;;;%v', vorbis => 'lyrics', ape => 'Lyrics', #TESTME 941 disable=>1, 942 }, 943 compilation => 944 { name => _"Compilation", width => 20, flags => 'fgarwescp', type => 'boolean', 945 id3v2 => 'TCMP', vorbis => 'compilation', ape => 'Compilation', ilst => 'cpil', 946 edit_many=>1, 947 category=>'basic', 948 }, 949 grouping => 950 { name => _"Grouping", width => 100, flags => 'fgarwescpi', type => 'fewstring', 951 FilterList => {search=>1}, 952 can_group=>1, 953 edit_order=> 55, edit_many=>1, 954 id3v2 => 'TIT1', vorbis => 'grouping', ape => 'Grouping', ilst => "\xA9grp", 955 category=>'extra', 956 }, 957 year => 958 { name => _"Year", width => 40, flags => 'fgarwescp', type => 'integer', bits => 16, 959 edit_max=>3000, edit_mode=> 'year', 960 check => '#VAL#= #VAL# =~m/(\d\d\d\d)/ ? $1 : 0;', 961 id3v1 => 3, id3v2 => 'TDRC|TYER', 'id3v2.3'=> 'TYER|TDRC', 'id3v2.4'=> 'TDRC|TYER', vorbis => 'date|year', ape => 'Record Date|Year', ilst => "\xA9day", 962 prewrite=> sub { $_[0] ? $_[0] : undef }, #remove tag if 0 963 gid_to_display => '#GID# ? #GID# : _"None"', 964 '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"}', 965 editwidth => 6, 966 edit_order=> 50, edit_many=>1, letter => 'y', 967 can_group=>1, 968 FilterList => {}, 969 autofill_re => '[12]\\d{3}', 970 category=>'basic', 971 }, 972 track => 973 { name => _"Track", width => 40, flags => 'fgarwescp', 974 id3v1 => 5, id3v2 => 'TRCK', vorbis => 'tracknumber', ape => 'Track', ilst => "trkn", 975 prewrite=> sub { $_[0] ? $_[0] : undef }, #remove tag if 0 976 type => 'integer', displayformat => '%02d', bits => 16, 977 edit_max => 65535, edit_mode=> 'nozero', 978 edit_order=> 20, editwidth => 4, letter => 'n', 979 category=>'basic', 980 }, 981 disc => 982 { name => _"Disc", width => 40, flags => 'fgarwescp', type => 'integer', bits => 8, 983 edit_max => 255, edit_mode=> 'nozero', 984 id3v2 => 'TPOS', vorbis => 'discnumber', ape => 'discnumber', ilst => "disk|disc", 985 prewrite=> sub { $_[0] ? $_[0] : undef }, #remove tag if 0 986 editwidth => 4, 987 edit_order=> 40, edit_many=>1, letter => 'd', 988 can_group=>1, 989 category=>'basic', 990 alias => 'disk', 991 }, 992 discname => 993 { name => _"Disc name", width => 100, flags => 'fgarwescpi', type => 'fewstring', 994 id3v2 => 'TSST', vorbis => 'discsubtitle', ape => 'DiscSubtitle', ilst=> '----DISCSUBTITLE', 995 edit_many=>1, 996 disable=>1, options => 'disable', 997 category=>'extra', 998 alias => 'diskname', 999 }, 1000 genre => 1001 { name => _"Genres", width => 180, flags => 'fgarwescpil', 1002 #is_set => '(__GENRE__=~m/(?:^|\x00)__QVAL__(?:$|\x00)/)? 1 : 0', #for random mode 1003 id3v1 => 6, id3v2 => 'TCON', vorbis => 'genre', ape => 'Genre', ilst => "\xA9gen & ----genre", 1004 read_split => qr/\s*;\s*/, 1005 type => 'flags', #default_persistent_values => \@Tag::MP3::Genres, 1006 none => quotemeta _"No genre", 1007 all_count => _"All genres", 1008 FilterList => {search=>1}, 1009 edit_order=> 70, edit_many=>1, letter => 'g', 1010 category=>'basic', 1011 editsubmenu=>0, 1012 options => 'editsubmenu', 1013# picture_field => 'genre_picture', 1014 }, 1015 label => 1016 { name => _"Labels", width => 180, flags => 'fgaescpil', 1017 #is_set => '(__LABEL__=~m/(?:^|\x00)__QVAL__(?:$|\x00)/)? 1 : 0', #for random mode 1018 type => 'flags', 1019 iconprefix => 'label-', 1020 icon => sub { $Def{label}{iconprefix}.$_[0]; }, #FIXME use icon_for_gid 1021 icon_for_gid => '"#iconprefix#".#gid_to_get#', 1022 all_count => _"All labels", 1023 edit_string => _"Edit labels", 1024 none => quotemeta _"No label", 1025 FilterList => {search=>1,icon=>1}, 1026 icon_edit_string=> _"Choose icon for label {name}", 1027 edit_order=> 80, edit_many=>1, letter => 'L', 1028 category=>'extra', 1029 editsubmenu=>1, 1030 options => 'persistent_values editsubmenu', 1031 default_persistent_values => [_("favorite"),_("bootleg"),_("broken"),_("bonus tracks"),_("interview"),], 1032 }, 1033 mood => 1034 { name => _"Moods", width => 180, flags => 'fgarwescpil', 1035 id3v2 => 'TMOO', vorbis => 'MOOD', ape => 'Mood', ilst => "----MOOD", 1036 read_split => qr/\s*;\s*/, 1037 type => 'flags', 1038 none => quotemeta _"No moods", 1039 all_count => _"All moods", 1040 FilterList => {search=>1}, 1041 edit_order=> 71, edit_many=>1, 1042 disable=>1, options => 'disable editsubmenu', 1043 editsubmenu=>0, 1044 category=>'extra', 1045 }, 1046 style => 1047 { name => _"Styles", width => 180, flags => 'fgaescpil', 1048 type => 'flags', 1049 all_count => _"All styles", 1050 none => quotemeta _"No styles", 1051 FilterList => {search=>1,}, 1052 edit_order=> 72, edit_many=>1, 1053 disable=>1, options => 'disable editsubmenu', 1054 editsubmenu=>0, 1055 category=>'extra', 1056 }, 1057 theme => 1058 { name => _"Themes", width => 180, flags => 'fgaescpil', 1059 type => 'flags', 1060 all_count => _"All themes", 1061 none => quotemeta _"No themes", 1062 FilterList => {search=>1,}, 1063 edit_order=> 73, edit_many=>1, 1064 disable=>1, options => 'disable editsubmenu', 1065 editsubmenu=>0, 1066 category=>'extra', 1067 }, 1068 comment=> 1069 { name => _"Comment", width => 200, flags => 'fgarwescpi', type => 'text', 1070 id3v1 => 4, id3v2 => 'COMM;;;%v', vorbis => 'description|comment|comments', ape => 'Comment', lyrics3v2=> 'INF', ilst => "\xA9cmt", join_with => "\n", 1071 edit_order=> 60, edit_many=>1, letter => 'C', 1072 category=>'basic', 1073 }, 1074 rating => 1075 { name => _"Rating", width => 80, flags => 'fgaescp', type => 'rating', 1076 id3v2 => 'TXXX;FMPS_Rating_User;%v::%i & TXXX;FMPS_Rating;%v | percent( TXXX;gmbrating;%v ) | five( TXXX;rating;%v )', 1077 vorbis => 'FMPS_RATING_USER::%i & FMPS_RATING | percent( gmbrating ) | five( rating )', 1078 ape => 'FMPS_RATING_USER::%i & FMPS_RATING | percent( gmbrating ) | five( rating )', 1079 ilst => '----FMPS_Rating_User::%i & ----FMPS_Rating | percent( ----gmbrating ) | five( ----rating )', 1080 postread=> \&FMPS_rating_postread, 1081 prewrite=> \&FMPS_rating_prewrite, 1082 'postread:five'=> sub { my $v=shift; length $v && $v=~m/^\d+$/ && $v<=5 ? sprintf('%d',$v*20) : undef }, # for reading foobar2000 rating 0..5 ? 1083 'postread:percent'=> sub { $_[0] }, # for anyone who used gmbrating 1084 FilterList => {}, 1085 starprefix => 'stars', 1086 edit_order=> 90, edit_many=>1, 1087 edit_string=> _"Edit rating", 1088 editsubmenu=>1, 1089 options => 'rw_ userid editsubmenu stars', 1090 'filterpat:value' => [ round => "%d", unit => '%', max=>100, default_value=>50, ], 1091 category=>'basic', 1092 alias => 'stars', 1093 }, 1094 ratingnumber => #same as rating but returns DefaultRating if rating set to default, will be replaced by rating.number or something in the future 1095 { type => 'virtual', 1096 flags => 'g', 1097 depend => 'rating', 1098 get => '#rating->_default#', 1099 }, 1100 added => 1101 { name => _"Added", width => 100, flags => 'fgascp_', type => 'date', 1102 FilterList => {type=>'month', }, 1103 can_group=>1, 1104 category=>'stats', 1105 }, 1106 lastplay => 1107 { name => _"Last played", width => 100, flags => 'fgascp', type => 'date', 1108 FilterList => {type=>'month',}, 1109 can_group=>1, letter => 'P', 1110 'filterdesc:e:0' => _"never", 1111 'filterdesc:-e:0' => _"has been played", #FIXME better description 1112 category=>'stats', 1113 #alias => 'played', 1114 }, 1115 playhistory => 1116 { name => _"Play history", flags => 'fgalp', type=> 'dates_compact', 1117 FilterList => {type=>'month',}, 1118 'filterdesc:ecount:0' => _"never", 1119 'filterdesc:-ecount:0' => _"has been played", #FIXME better description 1120 alias => 'played', 1121 category=>'stats', 1122 disable=>0, options => 'disable', 1123 }, 1124 lastskip => 1125 { name => _"Last skipped", width => 100, flags => 'fgascp', type => 'date', 1126 FilterList => {type=>'month',}, 1127 can_group=>1, letter => 'K', 1128 'filterdesc:e:0' => _"never", 1129 'filterdesc:-e:0' => _"has been skipped", #FIXME better description 1130 category=>'stats', 1131 alias => 'skipped', 1132 }, 1133 skiphistory => 1134 { name => _"Skip history", flags => 'fgalp', type=> 'dates_compact', 1135 FilterList => {type=>'month',}, 1136 'filterdesc:ecount:0' => _"never", 1137 'filterdesc:-ecount:0' => _"has been skipped", #FIXME better description 1138 #alias => 'skipped', 1139 category=>'stats', 1140 disable=>1, options => 'disable', 1141 }, 1142 playcount => 1143 { name => _"Play count", width => 50, flags => 'fgaescp', type => 'integer', letter => 'p', 1144 options => 'rw_ userid', 1145 id3v2 => 'TXXX;FMPS_Playcount;%v&TXXX;FMPS_Playcount_User;%v::%i', 1146 vorbis => 'FMPS_PLAYCOUNT&FMPS_PLAYCOUNT_USER::%i', 1147 ape => 'FMPS_PLAYCOUNT&FMPS_PLAYCOUNT_USER::%i', 1148 ilst => '----FMPS_Playcount&----FMPS_Playcount_User::%i', 1149 postread=> sub { my $v=shift; length $v ? sprintf('%d',$v) : undef }, 1150 prewrite=> sub { sprintf('%.1f', $_[0]); }, 1151 category=>'stats', 1152 alias => 'plays', 1153 edit_order=> 90, 1154 options => 'editable', 1155 }, 1156 skipcount => 1157 { name => _"Skip count", width => 50, flags => 'fgaescp', type => 'integer', letter => 'k', 1158 category=>'stats', 1159 alias => 'skips', 1160 edit_order=> 91, 1161 options => 'editable', 1162 }, 1163 composer => 1164 { name => _"Composer", width => 100, flags => 'fgarwescpi', type => 'artist', 1165 id3v2 => 'TCOM', vorbis => 'composer', ape => 'Composer', ilst => "\xA9wrt", 1166 apic_id => 11, 1167 picture_field => 'artist_picture', 1168 FilterList => {search=>1}, 1169 edit_many=>1, 1170 disable=>1, options => 'disable', 1171 category=>'extra', 1172 }, 1173 lyricist => 1174 { name => _"Lyricist", width => 100, flags => 'fgarwescpi', type => 'artist', 1175 id3v2 => 'TEXT', vorbis => 'LYRICIST', ape => 'Lyricist', ilst => '---LYRICIST', 1176 apic_id => 12, 1177 picture_field => 'artist_picture', 1178 FilterList => {search=>1}, 1179 edit_many=>1, 1180 disable=>1, options => 'disable', 1181 category=>'extra', 1182 }, 1183 conductor => 1184 { name => _"Conductor", width => 100, flags => 'fgarwescpi', type => 'artist', 1185 id3v2 => 'TPE3', vorbis => 'CONDUCTOR', ape => 'Conductor', ilst => '---CONDUCTOR', 1186 apic_id => 9, 1187 picture_field => 'artist_picture', 1188 FilterList => {search=>1}, 1189 edit_many=>1, 1190 disable=>1, options => 'disable', 1191 category=>'extra', 1192 }, 1193 remixer => 1194 { name => _"Remixer", width => 100, flags => 'fgarwescpi', type => 'artist', 1195 id3v2 => 'TPE4', vorbis => 'REMIXER', ape => 'MixArtist', ilst => '---REMIXER', 1196 picture_field => 'artist_picture', 1197 FilterList => {search=>1}, 1198 edit_many=>1, 1199 disable=>1, options => 'disable', 1200 category=>'extra', 1201 }, 1202 version=> #subtitle ? 1203 { name => _"Version", width => 150, flags => 'fgarwescpi', type => 'fewstring', 1204 id3v2 => 'TIT3', vorbis => 'version|subtitle', ape => 'Subtitle', ilst=> '----SUBTITLE', 1205 category=>'extra', 1206 }, 1207 bpm => 1208 { name => _"BPM", width => 60, flags => 'fgarwescp', type => 'integer', 1209 id3v2 => 'TBPM', vorbis => 'BPM', ape => 'BPM', ilst=> 'tmpo', 1210 FilterList => {type=>'div.10',}, 1211 disable=>1, options => 'disable', 1212 category=>'extra', 1213 }, 1214 channel=> 1215 { name => _"Channels", width => 50, flags => 'fgarscp', type => 'integer', bits => 4, audioinfo => 'channels', 1216 default_filter => 'e:2', 1217 'filterdesc:e:1' => _"is mono", 1218 'filterdesc:-e:1'=> _"isn't mono", 1219 'filterdesc:e:2' => _"is stereo", 1220 'filterdesc:-e:2'=> _"isn't stereo", 1221 category=>'audio', 1222 }, 1223 bitrate=> 1224 { name => _"Bitrate", width => 90, flags => 'fgarscp_', type => 'integer', bits => 16, audioinfo => 'bitrate|bitrate_nominal', check => '#VAL#= sprintf "%.0f",#VAL#/1000;', 1225 display => '::replace_fnumber("%d kbps",#_#)', 1226 FilterList => {type=>'div.32',}, 1227 'filterpat:value' => [ round => "%d", unit => 'kbps', default_value=>192 ], 1228 category=>'audio', 1229 }, 1230 samprate=> 1231 { name => _"Sampling Rate", width => 90, flags => 'fgarscp', type => 'fewnumber', bits => 8, audioinfo => 'rate', 1232 display => '::replace_fnumber("%d Hz",#_#)', 1233 FilterList => {}, 1234 'filterdesc:e:44100' => _"is 44.1kHz", 1235 'filterpat:value' => [ round => "%d", unit => 'Hz', step=> 100, default_value=>44100 ], 1236 category=>'audio', 1237 }, 1238 filetype=> 1239 { name => _"File type", width => 80, flags => 'fgarscp', type => 'fewstring', bits => 8, #could probably fit in 4bit 1240 FilterList => {}, 1241 'filterdesc:m:^mp3' => _"is a mp3 file", 1242 'filterdesc:m:^mp4 mp4a'=> _"is an aac file", 1243 'filterdesc:m:^mp4 alac'=> _"is an alac file", 1244 'filterdesc:m:^mp4' => _"is an mp4/m4a file", 1245 'filterdesc:m:^vorbis' => _"is a vorbis file", 1246 'filterdesc:m:^flac' => _"is a flac file", 1247 'filterdesc:m:^mpc' => _"is a musepack file", 1248 'filterdesc:m:^wv' => _"is a wavepack file", 1249 'filterdesc:m:^ape' => _"is an ape file", 1250 'filterdesc:m:^ape|^flac|^mp4 alac|^wv' => _"is a lossless file", 1251 'filterdesc:-m:^ape|^flac|^mp4 alac|^wv'=> _"is a lossy file", 1252 category=>'audio', 1253 alias => 'type', 1254 }, 1255 'length'=> 1256 { name => _"Length", width => 50, flags => 'fgarscp_', type => 'length', bits => 16, # 16 bits limit length to ~18.2 hours 1257 audioinfo => 'seconds', check => '#VAL#= sprintf "%.0f",#VAL#;', 1258 FilterList => {type=>'div.60',}, 1259 'filterpat:value' => [ unit => \%::TIMEUNITS, default_unit=> 's', default_value=>1 ], 1260 letter => 'm', 1261 category=>'audio', 1262 }, 1263 1264 replaygain_track_gain=> 1265 { name => _"Track gain", width => 70, flags => 'fgrwscpa', 1266 type => 'float', check => '#VAL#= do{ #VAL# =~m/^([-+]?\d*\.?\d+)\s*(?:dB)?$/i ? $1 : #novalue#};', 1267 displayformat => '%.2f dB', 1268 id3v2 => 'TXXX;replaygain_track_gain;%v', vorbis => 'replaygain_track_gain', ape => 'replaygain_track_gain', ilst => '----replaygain_track_gain', 1269 prewrite=> sub { length($_[0]) && $_[0]==$_[0] ? sprintf("%.2f dB",$_[0]) : undef }, #remove tag if empty string or NaN 1270 options => 'disable editable', 1271 category=>'replaygain', 1272 alias => 'track_gain trackgain', 1273 edit_max=> 120, 1274 edit_order=> 95, 1275 FilterList => {type=>'range',}, 1276 }, 1277 replaygain_track_peak=> 1278 { name => _"Track peak", width => 60, flags => 'fgrwscpa', 1279 id3v2 => 'TXXX;replaygain_track_peak;%v', vorbis => 'replaygain_track_peak', ape => 'replaygain_track_peak', ilst => '----replaygain_track_peak', 1280 prewrite=> sub { length($_[0]) && $_[0]==$_[0] ? sprintf("%.6f",$_[0]) : undef }, #remove tag if empty string or NaN 1281 type => 'float', 1282 options => 'disable', 1283 category=>'replaygain', 1284 alias => 'track_peak trackpeak', 1285 range_step=> '.1', 1286 FilterList => {type=>'range',}, 1287 }, 1288 replaygain_album_gain=> 1289 { name => _"Album gain", width => 70, flags => 'fgrwscpa', 1290 type => 'float', check => '#VAL#= do{ #VAL# =~m/^([-+]?\d*\.?\d+)\s*(?:dB)?$/i ? $1 : #novalue#};', 1291 displayformat => '%.2f dB', 1292 id3v2 => 'TXXX;replaygain_album_gain;%v', vorbis => 'replaygain_album_gain', ape => 'replaygain_album_gain', ilst => '----replaygain_album_gain', 1293 prewrite=> sub { length($_[0]) && $_[0]==$_[0] ? sprintf("%.2f dB",$_[0]) : undef }, #remove tag if empty string or NaN 1294 options => 'disable editable', 1295 category=>'replaygain', 1296 alias => 'album_gain albumgain', 1297 edit_max=> 120, 1298 edit_order=> 96, 1299 edit_many=>1, 1300 FilterList => {type=>'range',}, 1301 }, 1302 replaygain_album_peak=> 1303 { name => _"Album peak", width => 60, flags => 'fgrwscpa', 1304 id3v2 => 'TXXX;replaygain_album_peak;%v', vorbis => 'replaygain_album_peak', ape => 'replaygain_album_peak', ilst => '----replaygain_album_peak', 1305 prewrite=> sub { length($_[0]) && $_[0]==$_[0] ? sprintf("%.6f",$_[0]) : undef }, #remove tag if empty string or NaN 1306 type => 'float', 1307 options => 'disable', 1308 category=>'replaygain', 1309 alias => 'album_peak albumpeak', 1310 range_step=> '.1', 1311 FilterList => {type=>'range',}, 1312 }, 1313 replaygain_reference_level=> 1314 { flags => 'w', type => 'writeonly', #only used for writing 1315 id3v2 => 'TXXX;replaygain_reference_level;%v',vorbis => 'replaygain_reference_level', ape => 'replaygain_reference_level', ilst => '----replaygain_reference_level', 1316 category=>'replaygain', 1317 }, 1318 1319 playedlength => { name=> "Played length", type=>'length', flags=> 'g', 1320 get => '#playcount->get# * #length->get#', _=>'#get#', 1321 depend=> 'playcount length', 1322 }, 1323 version_or_empty => { get => 'do {my $v=#version->get#; $v eq "" ? "" : " ($v)"}', type=> 'virtual', depend => 'version', flags => 'g', letter => 'V', }, 1324 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 1325 uri => { get => '"file://".::url_escape(#path->get# .::SLASH. #file->get#)', type=> 'virtual', depend => 'file path', flags => 'g', }, 1326 fullfilename_raw =>{ name => _"Raw filename with path", flags => 'g', letter => 'f', 1327 get => '#fullfilename->get#', type=> 'virtual', depend => 'file path', 1328 }, 1329 fullfilename => { get => '#path->get# .::SLASH. #file->get#', 1330 display => '#path->display# .::SLASH. #file->display#', 1331 makefilter_fromID => '"fullfilename:e:" . #get#', 1332 type => 'virtual', flags => 'g', depend => 'file path', letter => 'u', 1333 'filter:e' => '#ID# == #VAL#', 'filter_prep:e'=> sub { FindID($_[0]); }, 1334 }, 1335 barefilename => { name => _"Filename without extension", type=> 'filename', flags => 'g', letter => 'o', 1336 get => 'do {my $s=#file->get#; $s=~s/\.[^.]+$//; $s;}', depend => 'file', 1337 }, 1338 extension => { name => _"Filename extension", type=> 'filename', flags => 'g', 1339 get => 'do {my $s=#file->get#; $s=~s#^.*\.##; $s;}', depend => 'file', 1340 }, 1341 title_or_file => { get => '(#title->get# eq "" ? (#show_ext# ? #file->display# : #barefilename->display#) : #title->get#)', 1342 type=> 'virtual', flags => 'gcs', width => 270, 1343 name=> _"Title or filename", 1344 depend => 'file title', letter => 'S', #why letter S ? :) 1345 options => 'show_ext', show_ext=>0, 1346 }, 1347 1348 missing => { flags => 'gan', type => 'integer', bits => 32, }, #FIXME store it using a 8-bit relative number to $::DAYNB 1349 missingkey => { get => 'join "\\x1D",'.join(',',map("#$_->get#",@MissingKeyFields)), depend => "@MissingKeyFields", type=> 'virtual', }, #used to check if same song 1350 1351 shuffle => { name => _"Shuffle", type => 'shuffle', flags => 's', }, 1352 album_shuffle => { name => _"Album shuffle", type => 'gidshuffle', flags => 's', mainfield=>'album' }, 1353 embedded_pictures=> 1354 { flags => 'wl', type=>'writeonly', 1355 id3v2 => 'APIC', vorbis => 'METADATA_BLOCK_PICTURE', 'ilst' => 'covr', 1356 }, 1357 embedded_lyrics=> 1358 { flags => '', type => 'virtual', 1359 id3v2 => 'TXXX;FMPS_Lyrics;%v | USLT;;;%v', vorbis => 'FMPS_LYRICS|lyrics', ape => 'FMPS_LYRICS|Lyrics', 1360 'ilst' => "----FMPS_Lyrics|\xA9lyr", lyrics3v2 => 'LYR', 1361 }, 1362 filetags => # debug field : list of the id3v2 frames / vorbis comments 1363 { name => "filetags", width => 180, flags => 'grascil', type => 'flags', 1364 "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]; }, 1365 'vorbis:read' => sub { [map "vorbis_$_",$_[0]->get_keys] }, 1366 'ape:read' => sub { [map "ape_$_", $_[0]->get_keys] }, 1367 'ilst:read' => sub { [map "ilst_$_", $_[0]->get_keys] }, 1368 FilterList => {search=>1,none=>1}, 1369 none => quotemeta "No tags", #not translated because made for debugging 1370 disable=>1, 1371 }, 1372 list => 1373 { type=> 'special', 1374 flags => 'f', 1375 name => _"Lists", 1376 'filterdesc:~' => [ _"present in %s", _"present in list", 'listname',], 1377 'filterdesc:-~' => _"not present in %s", 1378 'filter:~' => '.!!. do {my $l=$::Options{SavedLists}{"#VAL#"}; $l ? $l->IsIn(#ID#) : undef}', 1379 default_filter => '~', 1380 }, 1381 length_estimated => 1382 { type => 'boolean', 1383 audioinfo=> 'estimated', 1384 flags => 'gar', 1385 }, 1386); 1387 1388our %FieldTemplates= 1389( string => { type=>'string', editname=>_"string", flags=>'fgaescp', width=> 200, edit_many =>1, options=> 'customfield', }, 1390 text => { type=>'text', editname=>_"multi-lines string",flags=>'fgaescp', width=> 200, edit_many =>1, options=> 'customfield', }, 1391 float => { type=>'float', editname=>_"float", flags=>'fgaescp', width=> 100, edit_many =>1, options=> 'customfield', desc => _"For decimal numbers", }, 1392 boolean => { type=>'boolean', editname=>_"boolean", flags=>'fgaescp', width=> 20, edit_many =>1, options=> 'customfield', }, 1393 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, }, 1394 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', }, 1395 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" }, 1396 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" }, 1397 integer => { type=>'integer', editname=>_"integer", flags=>'fgaescp', width=> 100, edit_many =>1, can_group=>1, options=> 'customfield', FilterList=> {}, desc => _"For integer numbers", }, 1398 rating => { type=>'rating', editname=>_"rating", flags=>'fgaescp_', width=> 80, edit_many =>1, can_group=>1, options=> 'customfield rw_ useridwarn userid editsubmenu stars', FilterList=> {}, 1399 postread => \&FMPS_rating_postread, prewrite => \&FMPS_rating_prewrite, 1400 id3v2 => 'TXXX;FMPS_Rating_User;%v::%i', vorbis => 'FMPS_RATING_USER::%i', ape => 'FMPS_RATING_USER::%i', ilst => '----FMPS_Rating_User::%i', 1401 starprefix => 'stars', 1402 editsubmenu => 1, 1403 desc => _"For alternate ratings", 1404 }, 1405); 1406$FieldTemplates{$_}{category}||='custom' for keys %FieldTemplates; 1407 1408our %HSort= 1409( string => '$h->{$a} cmp $h->{$b} ||', 1410 number => '$h->{$a} <=> $h->{$b} ||', 1411 year2 => 'substr($h->{$a},-4,4) cmp substr($h->{$b},-4,4) ||', 1412); 1413 1414# discname 1415# version '' : " ($v)" 1416# 1417 1418 1419} #end of INIT block 1420 1421our $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'; 1422sub FieldUpgrade #for versions <1.1 1423{ (split / /,$OLD_FIELDS)[$_[0]]; 1424} 1425 1426my (%Get,%Display,$DIFFsub,$NEWsub,$LENGTHsub,%UPDATEsub,$SETsub); my (%Get_gid,%Gid_to_display,%Gid_to_get); 1427use constant FIRSTID => 1; 1428our $LastID=FIRSTID-1; 1429 1430sub filename_escape #same as ::url_escape but escape different characters 1431{ my $s=$_[0]; 1432 ::_utf8_off($s); 1433 $s=~s#([^/_.+'(),A-Za-z0-9- ])#sprintf('%%%02X',ord($1))#seg; 1434 return $s; 1435} 1436 1437sub Macro 1438{ local $_=shift; 1439 my %h=@_; 1440 s/#(\w+)#/exists $h{$1} ? $h{$1} : "#$1#"/eg; 1441 return $_; 1442} 1443 1444#sub Find_Properties 1445#{ my ($field,$start)=@_; 1446# ($field,my $subtype)=split /\./,$field; 1447# my @hashlist= ($Def{$field}); 1448# my $type=$Def{$field}{type}; 1449# warn "no type defined for field $field\n" unless $type; 1450# while ($type) 1451# { push @hashlist,$Types{"$type.$subtype"} if $subtype; 1452# push @hashlist,$Types{$type}; 1453# my $plugin=$Types{$type}{plugin}; 1454# push @hashlist,map $Types{$_}, split / /,$plugin if $plugin; 1455# $type= $Types{$type}{parent}; 1456# } 1457# my @found; 1458# for my $h (grep defined, @hashlist) 1459# { push @found, grep index($_,$start)==0, keys %$h; 1460# } 1461# return sort @found; 1462#} 1463sub LookupCode 1464{ my ($field_opt,@actions)=@_; 1465 my ($field,@opt)=split /\./,$field_opt; 1466 my %vars; 1467 %vars=@{pop @actions} if ref $actions[-1]; 1468 my @hashlist= ($Def{$field}, {field => $field}); 1469 my $type=$Def{$field}{type}; 1470 my $subtype=shift @opt; 1471 #$vars{field}=$field; 1472 if (@opt) { $vars{"ARG$_"}=$opt[$_] for 0..$#opt; } 1473 warn "no type defined for field $field\n" unless $type; 1474 while ($type) 1475 { #warn " +type $type\n"; 1476 push @hashlist,$Types{"$type.$subtype"} if $subtype; 1477 push @hashlist,$Types{$type}; 1478 #my $plugin=$Types{$type}{plugin}; 1479 #push @hashlist,map $Types{$_}, split / /,$plugin if $plugin; 1480 $type= $Types{$type}{parent}; 1481 } 1482 @hashlist=grep defined, @hashlist; 1483 my @code; 1484 for my $action (@actions) 1485 { my @or=split /\|/,$action; 1486 my $c; 1487 while (!$c && @or) 1488 { my $key=shift @or; 1489 ($c)=grep defined,map $_->{$key}, @hashlist; 1490 #if ($c) {warn " found $key for field $field\n"} 1491 } 1492 if ($c && !ref $c) 1493 { 1 while $c=~s/#([_0-9a-z:~.]+)#/(grep defined,map $_->{$1}, @hashlist)[0]/ge; 1494# $c=~s/#(\w+)->([_0-9a-z:~.]+)(?:\((\w+)=([^)]+)\))?#/LookupCode($1,$2,($3 ? [$3 => $4] : ()))/ge; 1495 $c=~s/#(?:(\w+)->)?([_0-9a-z:~.]+)(?:\((\w+)=([^)]+)\))?#/LookupCode($1||$field_opt,$2,($3 ? [$3 => $4] : ()))/ge; 1496 $c=~s#___#__${field}_#g; 1497 $c=~s#([@%\$\#])__(\w+)#($1||'\$').'Songs::Songs_'.$2#ge; 1498 $c=~s#__(\w+)#\$Songs::Songs_$1#g; 1499 $c=~s/#(\w+)#/exists $vars{$1} ? $vars{$1} : "#$1#"/ge; #variable names must be in UPPERCASE 1500 } 1501 push @code,$c; 1502 } 1503 return wantarray ? @code : $code[0]; 1504} 1505sub Code 1506{ my ($field,$action,@h)=@_; 1507 my $code=LookupCode($field,$action,\@h); 1508 return $code; 1509} 1510sub MakeCode #keep ? 1511{ my ($field,$code,@h)=@_; 1512 my @actions= $code=~m/#([\w\|.]+)#/g; #warn "field=$field : @actions"; 1513 my (@codes)=LookupCode($field,@actions,\@h); #warn join(' ',map {defined $_ ? 1 : 0} @codes); 1514 $code=~s/#[\w\|.]+#/shift @codes/ge; 1515 return $code; 1516} 1517sub Field_property 1518{ my ($field_opt,$key)=@_; 1519 my ($field,$subtype)=split /\./,$field_opt; 1520 my $h= $Def{$field}; 1521 return undef unless $h; 1522 while ($h) 1523 { return $h->{$key} if exists $h->{$key}; 1524 my $type= $h->{parent} || $h->{type}; 1525 return undef unless $type; 1526 $h= $Types{$type}; 1527 return $Types{"$type.$subtype"}{$key} if $subtype && $Types{"$type.$subtype"} && exists $Types{"$type.$subtype"}{$key}; 1528 } 1529} 1530sub Field_properties 1531{ my ($field,@keys)=@_; 1532 return map Field_property($field,$_), @keys; 1533} 1534 1535sub Fields_with_filter 1536{ return grep $Def{$_}{flags}=~/f/, @Fields; 1537} 1538sub filter_properties 1539{ my ($field,$cmd0)=@_; 1540 my ($inv,$cmd,$pat)= $cmd0=~m/^(-?)([^-:]+)(?::(.*))?$/; 1541 my @totry= ("$inv$cmd", $cmd); 1542 unshift @totry, "$inv$cmd:$pat", "$cmd:$pat" if defined $pat && length $pat; 1543 my $prop; 1544 for my $c (@totry) 1545 { $prop= Songs::Field_property($field,"filterdesc:$c"); 1546 next unless $prop; 1547 if (!ref $prop && $c=~m/:/ && $c!~m/^-/) { $prop= [$prop,$prop,'']; } 1548 next if !ref $prop || @$prop<2; 1549 if (@$prop==2) { $c= $prop->[1]; $prop= Songs::Field_property($field,"filterdesc:$c"); } 1550 $cmd=$c; 1551 last; 1552 } 1553 return $cmd,$prop; 1554} 1555sub Field_filter_choices 1556{ my $field=shift; 1557 my %filters; 1558 my $h= $Def{$field}; 1559 my %exclude; 1560 while ($h) 1561 { for my $key (keys %$h) 1562 { next unless $key=~m/^filterdesc:(.+)/ && !$exclude{$1} && !$filters{$1}; 1563 my $value= $h->{$key}; 1564 my $f=$1; 1565 if (ref $value) { if (@$value<3) { $exclude{$f}=1; next } else { $value=$value->[1]; } } 1566 else { unless ($f=~m/:/ && $f!~m/^-/) { $exclude{$f}=1; next} } # for constant filters eg: filterdesc:e:44100 1567 $filters{$f}= $value; 1568 } 1569 my $type= $h->{parent} || $h->{type}; 1570 last unless $type; 1571 if (my $e= $h->{filter_exclude}) #list of filters from parent to ignore, 'ALL' for all 1572 { last if $e eq 'ALL'; 1573 $exclude{$_}=1 for split / +/, $e; 1574 } 1575 $h= $Types{$type}; 1576 } 1577 return \%filters; 1578} 1579sub filter_prep_numbers { $_[0]=~m/(-?\d*\.?\d+)/; return $1 || 0 } 1580sub filter_prep_numbers_between { sort {$a <=> $b} map filter_prep_numbers($_), split / /,$_[0],2 } 1581sub FilterCode 1582{ my ($field,$cmd,$pat,$inv)=@_; 1583 my ($code,$convert)=LookupCode($field, "filter:$cmd", "filter_prep:$cmd"); 1584 unless ($code) { warn "error can't find code for filter $field,$cmd,$pat,$inv\n"; return 1} 1585 $convert||=sub {quotemeta $_[0]}; 1586 unless (ref $convert) { $convert=~s/#PAT#/\$_[0]/g; $convert=eval "sub {$convert}"; } 1587 $code=~s/#ID#/\$_/g; 1588 if ($inv) {$code=~s#$Filter::OpRe#$Filter::InvOp{$1}#go} 1589 else {$code=~s#$Filter::OpRe#$1 eq '!!' ? '' : $1#ego} 1590 if ($code=~m/#VAL1#/) { my @p= $convert->($pat); $code=~s/#VAL(\d)#/$p[$1-1]/g; } 1591 else { my $p=$convert->($pat,$field); $code=~s/#VAL#/$p/g; } 1592 return $code; 1593} 1594sub SortCode 1595{ my ($field,$inv,$insensitive,$for_gid)=@_; #warn "SortCode : @_\n"; 1596 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/)); 1597 my $op="<=>"; 1598 if ($scode) 1599 { $op='cmp'; 1600 if (!$insensitive) { $code=$scode} 1601 else { $code= $sicode || "::superlc($scode)"; } 1602 } 1603 my $init=''; 1604 $init=$1 if $code=~s/^(.+) +---- +//; 1605 my $code2=$code; 1606 $code =~s/#(?:GID|ID)#/\$a/g; 1607 $code2=~s/#(?:GID|ID)#/\$b/g; 1608 $code= $inv ? "$code2 $op $code" : "$code $op $code2"; 1609 return $init,$code; 1610} 1611 1612sub Compile #currently return value of the code must be a scalar 1613{ my ($name,$code)=@_; 1614 if ($::debug) { $::DebugEvaledCode{$name}=$code; $code=~s/^sub \{/sub { local *__ANON__ = 'evaled $name';/; } 1615 my $res=eval $code; 1616 if ($@) { warn "** Compilation error in $name\n Code:-------\n$code\n *Error:-------\n$@**\n";} 1617 return $res; 1618} 1619 1620sub UpdateFuncs 1621{ undef %FuncCache; 1622 delete $Def{$_}{_depended_on_by}, delete $Def{$_}{_properties} for keys %Def; 1623 @Fields=(); 1624 %Get=%Display=(); #FIXME probably more need reset 1625 1626 my %done; 1627 my %_depended_on_by; my %_properties; 1628 1629 Field_Apply_options(); 1630 CompileArtistsRE(); 1631 1632 my @todo=grep !$Def{$_}{disable}, sort keys %Def; 1633 while (@todo) 1634 { my $count=@todo; 1635 for my $f (@todo) 1636 { if (my $d=$Def{$f}{depend}) 1637 { next if grep !exists $done{$_}, split / /,$d; 1638 $_depended_on_by{$_}{$f}=undef for split / /,$d; 1639 } 1640 if (my $p=$Def{$f}{property_of}) {$_properties{$p}{$f}=undef} 1641 push @Fields,$f; 1642 $done{$f}=undef; 1643 } 1644 @todo=grep !exists $done{$_}, @todo; 1645 if ($count==@todo) { warn "Circular field dependencies, can't order these fields : @todo !\n"; push @Fields,@todo; last; } 1646 } 1647 $Def{$_}{_depended_on_by}= join ' ',keys %{$_depended_on_by{$_}} for keys %_depended_on_by; 1648 $Def{$_}{_properties}= join ' ',keys %{$_properties{$_}} for keys %_properties; 1649 warn "\@Fields=@Fields\n" if $::debug; 1650 $Def{$_}{flags}||='' for @Fields; #DELME 1651 { my $code; 1652 for my $f (@Fields) 1653 { $Def{$f}{flags}||=''; 1654 $code.= (Code($f,'init')||'').";\n"; 1655 } 1656 Compile(init=>$code); 1657 } 1658 for my $f (@Fields) 1659 { if (my $code=Code($f, 'update', ID => '$ID')) 1660 { $UPDATEsub{$f}= Compile("Update_$f"=> 'sub { for my $ID (@{$_[0]}) {'.$code.'} }'); 1661 } 1662 } 1663 1664 # create DIFF sub 1665 { my $code='my $ID=$_[0]; my $values=$_[1]; my $val; my @changed;'."\n"; 1666 for my $f (grep $Def{$_}{flags}=~m/r/, @Fields) 1667 { my $c= $Def{$f}{flags}=~m/_/ ? 1668 "if (exists \$values->{$f}) { \$val=\$values->{$f}; #check#;\n". 1669 " if (#diff#) { #set#; push \@changed,'$f'; } }\n" 1670 : 1671 "\$val= (exists \$values->{$f} ? \$values->{$f} : #default#);\n". 1672 " #check#; if (#diff#) { #set#; push \@changed,'$f'; }\n"; 1673 $code.=MakeCode($f,$c,ID => '$ID', VAL => "\$val"); 1674 } 1675 $code.=' return @changed;'; 1676 $DIFFsub= Compile(Diff =>"sub {$code}"); 1677 } 1678 1679 # create SET sub 1680 { my $code=join "\n", 1681 'my $IDs=$_[0]; my $values=$_[1]; my %onefieldchanged; my @towrite; my %changedfields; my @changedIDs; my $i=0; my $val;', 1682 'for my $ID (@$IDs)', 1683 '{ my $changed;'; 1684 for my $f (grep $Def{$_}{flags}=~m/[aw]/, @Fields) 1685 { my $set= ($Def{$f}{flags}=~m/w/ && !$::Options{TAG_nowrite_mode}) ? 1686 "push \@{\$towrite[\$i]}, '$f',\$val;" : 1687 "#set#; \$changedfields{$f}=undef; \$changed=1;"; 1688 my $c= " \$val= exists \$values->{$f} ? \$values->{$f} :\n". 1689 " exists \$values->{'\@$f'} ? shift \@{\$values->{'\@$f'}} :\n". 1690 " undef;\n". 1691 " if (defined \$val)\n". 1692 " { #check#;\n". 1693 " if (#diff#) { $set }\n". 1694 " }\n"; 1695 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 1696 { $c.= " elsif (\$val=\$values->{'+$f'})\n". # $v must contain [[toset],[torm],[toggle]] 1697 " { #check_multi#\n". 1698 " if (\$val= #set_multi#) { $set }\n". # set_multi return the new arrayref if modified, undef if not changed 1699 " }\n"; 1700 } 1701 $code.= MakeCode($f,$c,ID => '$ID', VAL => "\$val"); 1702 } 1703 $code.= join "\n", 1704 ' push @changedIDs,$ID if $changed;', 1705 ' $i++;', 1706 '}', 1707 #'::SongsChanged(\@changedIDs, [keys %changedfields]) if @changedIDs;', 1708 'return \%changedfields, \@towrite;'; 1709 $SETsub= Compile(Set =>"sub {$code}"); 1710 } 1711 1712 # create NEW sub 1713 { my $code='$LastID++; my $values=$_[0]; my $val;'."\n"; 1714 my %done; 1715 for my $f (grep $Def{$_}{flags}=~m/a/, @Fields) 1716 { #$c||= '____[] = #VAL#'; 1717 $done{$f}=undef; 1718 my $c= " \$val= exists \$values->{$f} ? \$values->{$f} : #default#;\n". 1719 " #check#;\n". 1720 " #set#;\n"; 1721 #unless ($c) { warn "'set' code not found for field $f\n"; next } 1722 $code.=MakeCode($f,$c,ID => '$LastID', VAL => "\$val"); 1723 #$code.= qq(;warn "\nsetting field $f :\n";); 1724 } 1725 for my $f (grep $Def{$_}{depend}, @Fields) 1726 { next if exists $done{$f}; 1727 next unless grep exists $done{$_}, split / /,$Def{$f}{depend}; 1728 my $c=Code($f, 'update' , ID => '$LastID'); 1729 $code.=$c.";\n" if $c; 1730 } 1731 $code.= ';return $LastID;'; 1732 $NEWsub= Compile(New =>"sub {$code}"); 1733 } 1734 { my $code='my $size=0; my $sec=0; for my $ID (@{$_[0]}) {' 1735 . '$size+='. Code('size', 'get', ID => '$ID').';' 1736 . '$sec+='. Code('length', 'get', ID => '$ID').';' 1737 . '} return ($size,$sec)'; 1738 $LENGTHsub= Compile(Length =>"sub {$code}"); 1739 } 1740 %::ReplaceFields= map { '%'.$Def{$_}{letter} => $_ } grep $Def{$_}{letter}, @Fields; 1741 1742 1743 my @getfields= grep $Def{$_}{flags}=~m/g/, @Fields; 1744 %Aliases= map {$_=>$_} @getfields; 1745 for my $field (@getfields) 1746 { $Aliases{$_}=$field for split / +/, ($Def{$field}{alias}||''); 1747 } 1748 #for my $field (@getfields) # user-defined aliases 1749 #{ for my $alias (split / +/, ($::Options{Fields_options}{$field}{aliases}||'')) 1750 # { $Aliases{ ::superlc($alias) } ||= $field; 1751 # } 1752 #} 1753 for my $field (@getfields) #translated aliases 1754 { for my $alias (split /\s*,\s*/, ($Def{$field}{alias_trans}||'')) 1755 { $alias=~s/ /_/g; 1756 $Aliases{ ::superlc($alias) } ||= $field; 1757 } 1758 } 1759 $::ReplaceFields{'$'.$_}= $::ReplaceFields{'${'.$_.'}'}= $Aliases{$_} for keys %Aliases; 1760 1761 1762 ::HasChanged('fields_reset'); 1763 #FIXME connect them to 'fields_reset' event : 1764 SongList::init_textcolumns(); 1765 SongTree::init_textcolumns(); 1766} 1767 1768sub MakeLoadSub 1769{ my ($extradata,@loaded_slots)=@_; 1770 my %extra_sub; 1771 my %loadedfields; 1772 $loadedfields{$loaded_slots[$_]}=$_ for 0..$#loaded_slots; 1773 # begin with a line that checks if a given path-file has already been loaded into the library 1774 my $pathfile_code= '$_['.$loadedfields{path}.'] ."/". $_['.$loadedfields{file}.']'; 1775 my $code= '$uniq_check{ '.$pathfile_code.' }++ && do { warn "warning: file ".'.$pathfile_code.'." already in library, skipping.\\n"; return };'."\n"; 1776 # new file, increment $LastID 1777 $code.='$LastID++;'."\n"; 1778 for my $field (@Fields) 1779 { my $i=$loadedfields{$field}; 1780 my $c; 1781 if (defined $i) 1782 { $Def{$field} ||= { type => 'unknown', flags => 'a', }; 1783 $c= Code($field, 'load|set', ID => '$LastID', VAL => "\$_[$i]"); 1784 } 1785 elsif ($Def{$field}{flags}=~m/a/) 1786 { $loadedfields{$field}=undef; 1787 $c= Code($field, 'load|set', ID => '$LastID', VAL => Code($field,'default')); 1788 } 1789 elsif (my $dep=$Def{$field}{depend}) 1790 { next if grep !exists $loadedfields{$_}, split / /,$dep; 1791 $c=Code($field, 'update', ID => '$LastID'); #FIXME maybe add {} around it, to avoid multiple my at the same level 1792 warn "adding update code for $field\n" if $::debug && $c; 1793 } 1794 $code.=$c.";\n" if $c; 1795 1796 my ($mainfield,$load_extra)=LookupCode($field,'mainfield','load_extra',[SGID=>'$_[0]']); 1797 $mainfield||=$field; 1798 if ($load_extra && $extradata->{$mainfield} && !$extra_sub{$mainfield}) 1799 { my $code= 'my $gid='.$load_extra.";\n"; 1800 my $i=1; 1801 for my $subfield (split /\t/,$extradata->{$mainfield}[0]) 1802 { my $c=LookupCode($subfield,'load_extra',[GID=>'$gid',VAL=>"\$_[$i]"]); 1803 $code.= "\t$c;\n" if $c; 1804 $i++; 1805 } 1806 $extra_sub{$mainfield}= Compile("LoadSub_$mainfield" => "sub {$code}") || sub {}; 1807 } 1808 } 1809 $code.= '; return $LastID;'; 1810 my $loadsub= Compile(LoadSub => "my %uniq_check; sub {$code}"); 1811 return $loadsub,\%extra_sub; 1812} 1813sub MakeSaveSub 1814{ my @saved_fields; 1815 my @code; 1816 my %extra_sub; my %extra_subfields; 1817 for my $field (sort grep $Def{$_}{flags}=~m/a/, @Fields) 1818 { next if $::Options{Fields_options}{$field}{remove}; #deleted custom field 1819 my $save_as= $Def{$field}{_renamed_to} || $field; 1820 push @saved_fields,$save_as; 1821 push @code, Code($field, 'save|get', ID => '$_[0]'); 1822 my ($mainfield,$save_extra)=LookupCode($field,'mainfield','save_extra'); 1823 if ($save_extra && $Def{$field}{_properties} && ( !$mainfield || $mainfield eq $field )) 1824 { my @subfields= split / /, $Def{$field}{_properties}; 1825 if (@subfields) 1826 { my @extra_code; 1827 for my $subfield (@subfields) 1828 { my $c=LookupCode($subfield,'save_extra',[GID => '$gid']); 1829 push @extra_code, $c; 1830 } 1831 $extra_subfields{$save_as}= join ' ', map $Def{$_}{_renamed_to}||$_, @subfields; 1832 my $code= $save_extra; 1833 my $extra_code=join ',', @extra_code; 1834 $code=~s/#SUBFIELDS#/$extra_code/g; 1835 $extra_sub{$save_as}= Compile("SaveSub_$field" => "sub { $code }") || sub {}; 1836 } 1837 } 1838 } 1839 1840 my $code= "sub { return (\n\t".join(",\n\t",@code)."\n); }"; 1841 my $savesub= Compile(SaveSub => $code); 1842 return $savesub,\@saved_fields,\%extra_sub,\%extra_subfields; 1843} 1844 1845sub New 1846{ my $file=$_[0]; 1847 #check already in @Songs#FIXME 1848 warn "Reading Tag for $file\n" if $::Verbose; 1849 my ($size,$modif)=(stat $file)[7,9]; 1850 my $values= FileTag::Read($file,1); 1851 return unless $values; 1852 (my $path,$file)=::splitpath($file); 1853 %$values=( %$values, 1854 file => $file, path=> $path, 1855 modif=> $modif, size=> $size, 1856 added=> time, 1857 ); 1858 my ($ID,$wasmissing)= CheckMissing($values); 1859 if (defined $ID) 1860 { ReReadFile($ID); 1861 ::CheckLength($ID) if $::Options{LengthCheckMode} eq 'add' && Get($ID,'length_estimated'); 1862 return $wasmissing ? $ID : undef; 1863 } 1864 1865 #warn "\nNewSub(LastID=$LastID)\n";warn join("\n",map("$_=>$values->{$_}",sort keys %$values))."\n"; 1866 $ID=$NEWsub->($values); #warn $Songs::Songs_title__[-1]." NewSub end\n"; 1867 if ($values->{length_estimated} && $::Options{LengthCheckMode} eq 'add') { ::CheckLength($ID); } 1868 $IDFromFile->{$path}{$file}=$ID if $IDFromFile; 1869 return $ID; 1870} 1871 1872sub ReReadFile #force values : 1873 # 0=>read if file changed (size or date), 1874 # 1=>force read tags 1875 # 2=> same as 3 if estimated, else same as 0 1876 # 3=>force check length (and tags) 1877{ my ($ID,$force,$noremove)=@_; 1878 my $file= GetFullFilename($ID); 1879 if (-e $file) 1880 { my ($size1,$modif1,$estimated)=Songs::Get($ID,qw/size modif length_estimated/); 1881 my ($size2,$modif2)=(stat $file)[7,9]; 1882 $force||=0; 1883 $force= $estimated ? 3 : 0 if $force==2; 1884 my $checklength= ($size1!=$size2 || $force==3) ? 2 : 0; 1885 return 1 unless $checklength || $force || $modif1!=$modif2; 1886 my $values=FileTag::Read($file,$checklength); 1887 return unless $values; 1888 $values->{size}=$size2; 1889 $values->{modif}=$modif2; 1890 $values->{length_estimated}||=0 if $estimated; 1891 my @changed=$DIFFsub->($ID,$values); 1892 Changed([$ID],@changed) if @changed; 1893 } 1894 elsif (!$noremove) #file not found 1895 { warn "Can't find file '$file'\n"; 1896 ::SongsRemove([$ID]); 1897 } 1898} 1899 1900#FIXME check if fields are enabled and add a way (option?) to silently ignore disabled fields 1901sub Set #can be called either with (ID,[field=>newval,...],option=>val) or (ID,field=>newval,...); ID can be an arrayref 1902{ warn "Songs::Set(@_) called from : ".join(':',caller)."\n" if $::debug; 1903 my ($IDs,$modif,%opt); 1904 if (ref $_[1]) { ($IDs,$modif,%opt)=@_ } 1905 else { ($IDs,@$modif)=@_ } 1906 $IDs=[$IDs] unless ref $IDs; 1907 my %values; 1908 while (@$modif) 1909 { my $f=shift @$modif; 1910 my $val=shift @$modif; 1911 my $multi; 1912 if ($f=~s/^([-+^])//) { $multi=$1 } 1913 my $def= $f=~m/^@(.*)$/ ? $Def{$1} : $Def{$f}; 1914 if (!$def) { warn "Songs::Set : Invalid field $f\n";next } 1915 my $flags=$def->{flags}; 1916 #unless ($flags=~m/e/) { warn "Songs::Set : Field $f cannot be edited\n"; next } 1917 #if (my $sub=$Def{$f}{check})) 1918 # { my $res=$sub->($val); unless ($res) {warn "Songs::Set : Invalid value '$v' for field $f\n"; next} } 1919 if ($multi) #multi eq + or - or ^ => add or remove or toggle values (for labels and genres) 1920 { if ($flags!~m/l/) { warn "Songs::Set : Field $f doesn't support multiple values\n"; next } 1921 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 } 1922 my $array=$values{"+$f"}||=[[],[],[]]; #$array contains [[toset],[torm],[toggle]] 1923 my $i= $multi eq '+' ? 0 : $multi eq '^' ? 2 : 1; 1924 $val=[$val] unless ref $val; 1925 $array->[$i]=$val; 1926 } 1927 else { $values{$f}=$val } 1928 } 1929 ::setlocale(::LC_NUMERIC, 'C'); 1930 my ($changed,$towrite)= $SETsub->($IDs,\%values); 1931 ::setlocale(::LC_NUMERIC, ''); 1932 Changed($IDs,$changed) if %$changed; 1933 Write($IDs,towrite=>$towrite,%opt); 1934} 1935 1936sub UpdateTags 1937{ my ($IDs,$fields,%opt)=@_; 1938 Write($IDs,update=>$fields,%opt); 1939} 1940 1941sub Write 1942{ my ($IDs,%opt)=@_; #%opt must have either update OR towrite 1943 my $update=$opt{update}; # [list_of_fields_to_update] 1944 my $towrite=$opt{towrite}; # [[modifs_for_first_ID],[...],...] 1945 1946 if (!@$IDs || ($towrite && !@$towrite)) #nothing to do 1947 { $opt{callback_finish}() if $opt{callback_finish}; 1948 return 1949 } 1950 1951 my $i=0; my $abort; my $skip_all; 1952 my $pid= ::Progress( undef, end=>scalar(@$IDs), abortcb=>sub {$abort=1}, widget =>$opt{progress}, title=>_"Writing tags"); 1953 my $errorsub=sub 1954 { my ($syserr,$details)= FileTag::Error_Message(@_); 1955 my $abortmsg=$opt{abortmsg}; 1956 $abortmsg||=_"Abort mass-tagging" if @$IDs>1; 1957 my $errormsg= $opt{errormsg} || _"Error while writing tag"; 1958 $errormsg.= ' ('.($i+1).'/'.@$IDs.')' if @$IDs>1; 1959 my $res= $skip_all; 1960 $res ||= ::Retry_Dialog($syserr,$errormsg, ID=>$IDs->[$i], details=>$details, window=>$opt{window}, abortmsg=>$abortmsg, many=>(@$IDs-$i)>1); 1961 $skip_all=$res if $res eq 'skip_all'; 1962 if ($res eq 'abort') 1963 { $opt{abortcb}() if $opt{abortcb}; 1964 $abort=1; 1965 } 1966 return $res; 1967 }; 1968 1969 Glib::Idle->add(sub 1970 { my $ID= $IDs->[$i]; 1971 if (defined $ID) 1972 { my $modif; 1973 if ($update) 1974 { for my $field (@$update) 1975 { my $v= $Def{$field}{flags}=~m/l/ ? [Get_list($ID,$field)] : Get($ID,$field); 1976 push @$modif, $field,$v; 1977 } 1978 } 1979 elsif ($towrite) 1980 { $modif=$towrite->[$i]; 1981 } 1982 if ($modif) 1983 { my $file= Songs::GetFullFilename($ID); 1984 FileTag::Write($file, $modif, $errorsub); 1985 warn "ID=$ID towrite : ".join(' ',@$modif)."\n" if $::debug; 1986 ::IdleCheck($ID) unless $update; # not done in update mode 1987 } 1988 } 1989 $i++; 1990 if ($abort || $i>=@$IDs) 1991 { ::Progress($pid, abort=>1); 1992 $opt{callback_finish}() if $opt{callback_finish}; 1993 return 0; 1994 } 1995 ::Progress( $pid, current=>$i ); 1996 return 1; 1997 }); 1998} 1999 2000sub Changed # 2nd arg contains list of changed fields as a list or a hash ref 2001{ my $IDs=shift || $::Library; 2002 my $changed= ref $_[0] ? $_[0] : {map( ($_=>undef), @_ )}; 2003 warn "Songs::Changed : IDs=@$IDs fields=".join(' ',keys %$changed)."\n" if $::debug; 2004 $IDFromFile=undef if $IDFromFile && !$KeepIDFromFile && (exists $changed->{file} || exists $changed->{path}); 2005 $MissingHash=undef if $MissingHash && grep(exists $changed->{$_}, @MissingKeyFields); 2006 my @needupdate; 2007 for my $f (keys %$changed) 2008 { if (my $l=$Def{$f}{_depended_on_by}) { push @needupdate, split / /,$l; } 2009 } 2010 for my $f (sort @needupdate) 2011 { next if exists $changed->{$f}; 2012 $changed->{$f}=undef; 2013 if (my $update=$UPDATEsub{$f}) { warn "Updating field : $f\n" if $::debug; $update->($IDs); } 2014 } 2015 AA::Fields_Changed($changed); 2016 ::SongsChanged($IDs,[keys %$changed]); 2017} 2018 2019sub CheckMissing 2020{ my $song=$_[0]; 2021 #my $key=Get($song,'missingkey'); 2022 2023 return unless defined $song->{title} && length $song->{title} && (defined $song->{album} || defined $song->{artist}); 2024 for (qw/title album artist track/) { $song->{$_}="" unless defined $song->{$_} } 2025 return unless length ($song->{album} . $song->{artist}); 2026 #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})' 2027 $song->{$_}=~s/\s+$// for qw/title album artist/; 2028 $song->{track}= $song->{track}=~m/^(\d+)/ ? $1+0 : 0; 2029 2030 my $key=join "\x1D", @$song{@MissingKeyFields}; 2031 $MissingHash||= BuildHash('missingkey',undef,undef,'id:list'); 2032 my $IDs=$MissingHash->{$key}; 2033 return unless $IDs; 2034 if (@$IDs>1) #too many candidates, try to find the best one 2035 { my @score; 2036 for my $oldID (@$IDs) 2037 { my $m=0; 2038 $m+=2 if $song->{file} eq Get($oldID,'file'); 2039 $m++ if $song->{path} eq Get($oldID,'path'); 2040 #could do more checks 2041 push @score,$m; 2042 } 2043 my $max= ::max(@score); 2044 @$IDs= map $IDs->[$_], grep $score[$_]==$max, 0..$#$IDs; 2045 if (@$IDs>1) #still more than 1, abort, maybe could continue anyway, the files must be nearly identical anyway 2046 { warn "CheckMissing: more than 1 (".@$IDs.") possible matches for $song-->{path}/$song->{file}, assume identification is unreliable, considering it a new song.\n"; 2047 return 2048 } 2049 } 2050 for my $oldID (@$IDs) 2051 { my $wasmissing= Get($oldID,'missing'); 2052 my $fullfilename= GetFullFilename($oldID); 2053 next if !$wasmissing && -e $fullfilename; #if candidate still exists 2054 warn "Found missing song, formerly '$fullfilename'\n"; 2055 2056 my $gid=Songs::Get_gid($oldID,'album'); 2057 if (my $pic= Picture($gid,'album','get')) 2058 { my $suffix= $pic=~s/(:\w+)$// ? $1 : ''; 2059 unless (-e $pic) 2060 { my $new; 2061 if ($pic eq $fullfilename) # check if cover is embedded picture in this file 2062 { $new= ::catfile( $song->{path}, $song->{file} ).$suffix; 2063 warn "setting new picture $new\n"; 2064 } 2065 else 2066 { # if cover was in same folder or a sub-folder, check if there based on new folder 2067 $new=$pic; 2068 my $oldpath= ::pathslash(::dirname($fullfilename)); 2069 my $newpath= ::pathslash($song->{path}); 2070 $new=undef unless $new=~s#^\Q$oldpath\E#$newpath# && -e $new; 2071 } 2072 Picture($gid,'album','set',$new) if $new; 2073 } 2074 } 2075 2076 #remove from MissingHash, not really needed 2077 #if (@$IDs>1) { $MissingHash->{$key}= [grep $_!=$oldID, @$IDs]; } 2078 #else { delete $MissingHash->{$key}; } 2079 2080 #update $IDFromFile, and prevent its destruction in Changed(), not very nice #FIXME make hashes that update themselves when possible 2081 $KeepIDFromFile=1; 2082 $IDFromFile->{$song->{path}}{$song->{file}}= delete $IDFromFile->{Get($oldID,'path')}{Get($oldID,'file')} if $IDFromFile; 2083 2084 Songs::Set($oldID,file=>$song->{file},path=>$song->{path}, missing=>0); 2085 $KeepIDFromFile=0; 2086 2087 return $oldID,$wasmissing; 2088 } 2089 return 2090} 2091sub Makesub 2092{ my $c=&Code; warn "Songs::Makesub(@_) called from : ".join(':',caller)."\n" unless $c; 2093 $c="local *__ANON__ ='Maksub(@_)'; $c" if $::debug; 2094 my $sub=eval "sub {$c}"; 2095 if ($@) { warn "Compilation error :\n code : $c\n error : $@";} 2096 return $sub; 2097} 2098sub Stars 2099{ my ($gid,$field)=@_; 2100 return undef if !defined $gid || $gid eq '' || $gid==255; 2101 my $pb= $Def{$field}{pixbuf} || $Def{'rating'}{pixbuf}; 2102 return $pb->[ sprintf("%d",$gid/100*$#$pb) ]; 2103} 2104sub Picture 2105{ my ($gid,$field,$action,$extra)=@_; 2106 $action.='_for_gid'; 2107 my $func= $FuncCache{$action.' '.$field}; 2108 unless ($func) 2109 { my $pfield= $Def{$field}{picture_field} || $field; 2110 my $mainfield= $Def{$field}{property_of} || $field; 2111 $func=$FuncCache{$action.' '.$mainfield}||=$FuncCache{$action.' '.$pfield}= 2112 Makesub($pfield, $action, GID => '$_[0]', VAL=>'$_[1]'); 2113 return unless $func; 2114 } 2115 $func->($gid,$extra); 2116# if ($action eq 'set') { ($FuncCache{'set_for_gid '.$field}||= Makesub($field, 'set_for_gid', GID => '$_[0]', VAL=>'$_[1]') ) ->($gid,$extra); } 2117# elsif ($action eq 'get') { ($FuncCache{'get_for_gid '.$field}||= Makesub($field, 'get_for_gid', GID => '$_[0]') ) ->($gid); } 2118# elsif ($action eq 'pixbuf') { ($FuncCache{'pixbuf_for_gid '.$field}||= Makesub($field, 'pixbuf_for_gid', GID => '$_[0]') ) ->($gid); } 2119# elsif ($action eq 'icon') { ($FuncCache{'icon_for_gid '.$field}||= Makesub($field, 'icon_for_gid', GID => '$_[0]') ) ->($gid); } 2120} 2121sub ListAll 2122{ my $field=$_[0]; 2123 my $func= $FuncCache{'listall '.$field} ||= 2124 do { if ( my $c=Code($field, 'listall') ) 2125 { my ($initsort,$sort)=SortCode($field,0,1,1); 2126 my $gid2get=Code($field, 'gid_to_get', GID => '$_'); 2127 eval "sub { $initsort; [map( $gid2get, sort {$sort} $c)]}"; 2128 } 2129 else {1} 2130 }; 2131 return ref $func ? $func->() : []; 2132} 2133sub Get_grouptitle 2134{ my ($field,$IDs)=@_; 2135 ($FuncCache{'grouptitle '.$field}||= Makesub($field, 'grouptitle', ID => '$_[0][0]', IDs=>'$_[0]') ) ->($IDs); 2136} 2137sub Search_artistid #return artist id or undef if not found 2138{ my $artistname=shift; 2139 my $field='artist'; 2140 ($FuncCache{'search_gid '.$field}||= Makesub($field, 'search_gid', VAL=>'$_[0]') ) ->($artistname); 2141} 2142sub Get_gid 2143{ my ($ID,$field)=@_; 2144 ($Get_gid{$field}||= Makesub($field, 'get_gid', ID => '$_[0]') ) ->($ID); 2145# $Get_gid{$field}->($ID); 2146} 2147sub Get_list #rarely used, keep ? 2148{ my ($ID,$field)=@_; 2149 #FIXME check field can have multiple values 2150 my $func= $FuncCache{'getlist '.$field} ||= Makesub($field, 'get_list', ID => '$_[0]'); 2151 $func->($ID); 2152} 2153sub Get_icon_list 2154{ my ($field,$ID)=@_; 2155 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 2156 return $func->($ID); 2157} 2158sub Gid_to_Display #convert a gid from a Get_gid to a displayable value 2159{ my ($field,$gid)=@_; #warn "Gid_to_Display(@_)\n"; 2160 my $sub= $Gid_to_display{$field} || DisplayFromGID_sub($field); 2161 if (ref $gid) { return [map $sub->($_), @$gid] } 2162 return $sub->($gid); 2163} 2164sub DisplayFromGID_sub 2165{ my $field=$_[0]; 2166 return $Gid_to_display{$field}||= Makesub($field, 'gid_to_display', GID => '$_[0]'); 2167} 2168sub DisplayFromHash_sub #not a good name, very specific, only used for $field=path currently 2169{ my $field=$_[0]; 2170 return $FuncCache{"DisplayFromHash_sub $field"}||= Makesub($field, 'hash_to_display', VAL => '$_[0]'); 2171} 2172sub MakeFilterFromGID 2173{ my ($field,$gid)=@_; #warn "MakeFilterFromGID:@_\n";#warn Code($field, 'makefilter', GID => '$_[0]'); 2174 my $sub=$FuncCache{'makefilter '.$field}||= Makesub($field, 'makefilter', GID => '$_[0]'); 2175warn "MakeFilterFromGID => ".($sub->($gid)) if $::debug; 2176 return Filter->new( $sub->($gid) ); 2177} 2178sub MakeFilterFromID #should support most fields, FIXME check if works for year/artists/labels/genres/... 2179{ my ($field,$ID)=@_; 2180 return Filter->null unless $ID; # null filter if no ID 2181 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 2182 { my $sub=$FuncCache{'makefilter_fromID '.$field} ||= Compile('makefilter_fromID '.$field, "sub {$code}"); #FIXME if method doesn't exist 2183 return Filter->new( $sub->($ID) ); 2184 } 2185 else 2186 { my $gid=Get_gid($ID,$field); 2187 if (ref $gid) { return Filter->newadd(::FALSE,map MakeFilterFromGID($field,$_), @$gid) } 2188 return MakeFilterFromGID($field,$gid); 2189 } 2190} 2191 2192sub Gid_to_Get #convert a gid from a Get_gid to a what Get would return 2193{ my ($field,$gid)=@_; 2194 my $sub= $Gid_to_get{$field}||= Makesub($field, 'gid_to_get', GID => '$_[0]'); 2195 if (ref $gid) { return [map $sub->($_), @$gid] } 2196 return $sub->($gid); 2197} 2198#sub Gid_to_string_sub #used to get string gid that stays valid between session #not used anymore 2199#{ my ($field)=@_; 2200# my $sub= $FuncCache{'g_to_s:'.$field}||= Makesub($field, 'gid_to_sgid', GID => '$_[0]'); 2201# return $sub; 2202#} 2203#sub String_to_gid_sub #not used anymore 2204#{ my ($field)=@_; 2205# my $sub= $FuncCache{'s_to_g:'.$field}||= Makesub($field, 'sgid_to_gid', VAL => '$_[0]'); 2206# return $sub; 2207#} 2208sub sort_gid_by_name 2209{ my ($field,$gids,$h,$pre,$mode)=@_; 2210 $mode||=''; 2211 my $func= $FuncCache{"sortgid $field $mode"} ||= do 2212 { my ($initsort,$sort)= SortCode($field,undef,1,1); 2213 $pre= $pre ? $HSort{$pre} : ''; 2214 eval 'sub {my $l=$_[0]; my $h=$_[1]; '.$initsort.'; @$l=sort { '."$pre $sort".' } @$l}'; 2215 }; 2216 $func->($gids,$h); 2217} 2218sub Get_all_gids #FIXME add option to filter out values eq '' 2219{ my $field=$_[0]; 2220 return UniqList($field,$::Library,1); #FIXME use ___name directly 2221} 2222 2223sub Get # ($ID,@fields) 2224{ #warn "Songs::Get(@_) called from : ".join(':',caller)."\n"; 2225 my $ID=shift; 2226 return wantarray ? map (($Get{$_}||CompileGet($_))->($ID), @_) : ($Get{$_[0]}||CompileGet($_[0]))->($ID); 2227} 2228sub Display # ($ID,@fields) 2229{ #warn "Songs::Display(@_) called from : ".join(':',caller)."\n"; 2230 my $ID=shift; 2231 return wantarray ? map ( ($Display{$_}||CompileDisp($_))->($ID), @_) : ($Display{$_[0]}||CompileDisp($_[0]))->($ID); 2232} 2233sub DisplayEsc # ($ID,$field) 2234{ return ::PangoEsc( ($Display{$_[1]}||CompileDisp($_[1]))->($_[0]) ); 2235} 2236sub CompileGet 2237{ my ($field,$disp)=@_; 2238 unless ($Def{$field}{flags}=~m/g/) 2239 { return $Display{$field}=$Get{$field}=sub { warn "Songs::Get or Songs::Display : Invalid field '$field'\n" }; 2240 } 2241 my $get= Code($field, 'get', ID => '$_[0]'); 2242 $get="local *__ANON__ ='getsub for $field'; $get" if $::debug; 2243 $Get{$field}= Compile("Get_$field"=>"sub {$get}"); 2244 my $display= Code($field, 'display', ID => '$_[0]'); 2245 if ($display && $display ne $get) 2246 { $Display{$field}= Compile("Display_$field"=>"sub {$display}"); 2247 } 2248 else { $Display{$field}=$Get{$field}; } 2249 return $Get{$field}; 2250} 2251sub CompileDisp 2252{ my $field=shift; 2253 CompileGet($field); 2254 return $Display{$field}; 2255} 2256 2257sub Map 2258{ my ($field,$IDs)=@_; #warn "Songs::Map(@_) called from : ".join(':',caller)."\n"; 2259 my $f= $Get{$field}||CompileGet($field); 2260 return map $f->($_), @$IDs; 2261} 2262sub Map_to_gid 2263{ my ($field,$IDs)=@_; 2264 return map Get_gid($_,$field), @$IDs; 2265} 2266 2267sub GetFullFilename { Get($_[0],'fullfilename') } 2268#sub GetURI 2269#{ return map 'file://'.::url_escape($_), GetFullFilename(@_); 2270#} 2271sub IsSet # used only once 2272{ my ($ID,$field,$value)=@_; 2273 my $sub= $FuncCache{'is_set '.$field}||= Makesub($field, 'is_set', ID=>'$_[0]', VAL=>'$_[1]' ); 2274 return $sub->($ID,$value); 2275} 2276#sub GetArtists #not used, remove ? 2277#{ Get_list($_[0],'artists'); 2278#} 2279sub ListLength 2280{ &$LENGTHsub; 2281} 2282 2283#FIXME cache the BuildHash sub 2284sub UniqList #FIXME same as UniqList2. use "string" (for artist) in this one and not in UniqList2 ? 2285{ my ($field,$IDs,$sorted)=@_; #warn "Songs::UniqList(@_)\n"; 2286 my $h=BuildHash($field,$IDs,undef,':uniq'); #my $h=BuildHash($field,$IDs,'string',':uniq'); ?????? 2287 return [keys %$h] unless $sorted; 2288 return [sort keys %$h]; #FIXME more sort modes ? 2289} 2290sub UniqList2 #FIXME MUST handle special cases, merge with UniqList ? 2291{ &UniqList; 2292} 2293 2294 2295sub Build_IDFromFile 2296{ $IDFromFile||=BuildHash('path',undef,undef,'file:filetoid'); 2297} 2298sub FindID 2299{ my $f=$_[0]; 2300 if ($f=~m/\D/) 2301 { my ($dir,$file)= ::splitpath(::simplify_path($f)); 2302 if (defined $file) 2303 { $IDFromFile||=Build_IDFromFile(); 2304 return $IDFromFile->{$dir}{$file}; 2305 #return $IDFromFile->{$dir}{$file} if $IDFromFile; 2306 #my $m=Filter->newadd(1,'file:e:'.$file, 'path:e:'.$dir)->filter_all; 2307 #if (@$m) 2308 #{ warn "Error, more than one ID match $dir/$file" if @$m>1; 2309 # return $m->[0]; 2310 #} 2311 } 2312 return undef; 2313 } 2314 $f=undef if $f>$LastID; 2315 return $f; 2316} 2317 2318sub UpdateDefaultRating 2319{ my $l=AllFilter('rating:~:255'); 2320 Changed($l,'rating') if @$l; 2321} 2322sub UpdateArtistsRE 2323{ CompileArtistsRE(); 2324 Songs::Changed([FIRSTID..$LastID],'artist'); 2325} 2326sub CompileArtistsRE 2327{ my $ref1= $::Options{Artists_split_re} ||= ['\s*&\s*', '\s*;\s*', '\s*,\s+', '\s*/\s*']; 2328 $Artists_split_re= join '|', @$ref1; 2329 $Artists_split_re||='$'; 2330 $Artists_split_re=qr/$Artists_split_re/; 2331 2332 my $ref2= $::Options{Artists_title_re} ||= ['\(with\s+([^)]+)\)', '\(feat\.\s+([^)]+)\)']; 2333 $Artists_title_re= join '|', @$ref2; 2334 $Artists_title_re||='^\x00$'; 2335 $Artists_title_re=qr/$Artists_title_re/; 2336} 2337 2338sub DateString 2339{ my $time=shift; 2340 my ($fmt,@formats)= split /(\d+) +/, $::Options{DateFormat}||"%c"; 2341 unless ($time) 2342 { return _"never"; 2343 } 2344 my $diff=time-$time; 2345 while (@formats) 2346 { my $max=shift @formats; 2347 last if $diff>$max; 2348 $fmt=shift @formats; 2349 } 2350 ::strftime_utf8($fmt,localtime $time); 2351} 2352 2353#sub Album_Artist #guess album artist 2354#{ my $alb= Get($_[0],'album'); 2355# my %h; $h{ Get($_[0],'artist') }=undef for @{AA::GetIDs('album',$alb)}; 2356# my $nb=keys %h; 2357# return Get($_[0],'artist') if $nb==1; 2358# my @l=map split(/$Artists_split_re/), keys %h; 2359# my %h2; $h2{$_}++ for @l; 2360# my @common; 2361# for (@l) { if ($h2{$_}>=$nb) { push @common,$_; delete $h2{$_}; } } 2362# return @common ? join(' & ',@common) : _"Various artists"; 2363#} 2364 2365sub ChooseIcon #FIXME add a way to create a colored square/circle/... icon 2366{ my ($field,$gid)=@_; 2367 my $string= ::__x( $Def{$field}{icon_edit_string}, name=> Gid_to_Get($field,$gid) ); 2368 my $file=::ChoosePix($::CurrentDir.::SLASH, $string, undef,'LastFolder_Icon'); 2369 return unless defined $file; 2370 my $dir=$::HomeDir.'icons'; 2371 return if ::CreateDir($dir,undef,_"Error saving icon") ne 'ok'; 2372 my $destfile= $dir. ::SLASH. ::url_escape( Picture($gid,$field,'icon') ); 2373 unlink $destfile.'.svg',$destfile.'.png'; 2374 if ($file eq '0') {} #unset icon 2375 elsif ($file=~m/\.svg/i) 2376 { $destfile.='.svg'; 2377 ::copy($file,$destfile.'.svg'); 2378 } 2379 else 2380 { $destfile.='.png'; 2381 my $pixbuf= GMB::Picture::load($file,size=>-48); # -48 means it will be resized to 48x48 if wifth or height bigger than 48 2382 return unless $pixbuf; 2383 $pixbuf->save($destfile,'png'); 2384 } 2385 ::LoadIcons(); 2386} 2387 2388sub FilterListFields 2389{ grep $Def{$_}{FilterList}, @Fields; 2390} 2391sub FilterListProp 2392{ my ($field,$key)=@_; 2393 if ($key eq 'picture') {return $Def{$field}{picture_field}} 2394 if ($key eq 'multi') {return $Def{$field}{flags}=~m/l/ } 2395 $Def{$field}{FilterList}{$key}; 2396} 2397sub ColumnsKeys 2398{ grep $Def{$_}{flags}=~m/c/, @Fields; 2399} 2400sub ColumnAlign 2401{ Field_property($_[0],'rightalign') || 0; 2402} 2403sub PropertyFields 2404{ grep $Def{$_}{flags}=~m/p/, @Fields; 2405} 2406sub InfoFields 2407{ my %tree; 2408 for my $f (grep $Def{$_}{flags}=~m/p/, @Fields) 2409 { my $cat= $Def{$f}{category}||'unknown'; 2410 push @{ $tree{$cat} }, $f; 2411 } 2412 my @list; 2413 for my $cat ( sort { $Categories{$a}[1] <=> $Categories{$b}[1] } keys %tree ) 2414 { my $fields= $tree{$cat}; 2415 push @list, $cat, $Categories{$cat}[0], [::superlc_sort(@$fields)]; 2416 } 2417 return \@list; 2418 #FIXME sort according to a number like $Def{$_}{order} 2419 #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/) 2420} 2421sub SortKeys 2422{ grep $Def{$_}{flags}=~m/s/, @Fields; 2423} 2424sub Field_All_string 2425{ my $f=$_[0]; 2426 return $Def{$f} && exists $Def{$f}{all_count} ? $Def{$f}{all_count} : _"All"; 2427} 2428sub Field_Edit_string 2429{ my $f=$_[0]; 2430 return $Def{$f} && exists $Def{$f}{edit_string} ? $Def{$f}{edit_string} : ucfirst(::__x( _"Edit {field}",field=>Songs::FieldName($f))); 2431} 2432sub FieldName 2433{ my $f=$_[0]; 2434 return $Def{$f} && exists $Def{$f}{name} ? $Def{$f}{name} : ::__x(_"Unknown field ({field})",field=>$f); 2435} 2436sub MainField 2437{ my $f=$_[0]; 2438 return Songs::Code($f,'mainfield') || $f; 2439} 2440sub FieldWidth 2441{ my $f=$_[0]; 2442 return $Def{$f} && $Def{$f}{width} ? $Def{$f}{width} : 100; 2443} 2444sub FieldEnabled #check if a field is enabled 2445{ !! grep $_[0] eq $_, @Fields; 2446} 2447sub FieldList #return list of fields, may be filtered by type and/or a key 2448{ my %args=@_; # args may be type=> 'flags' or 'rating' true=> key_that_must_be_true 2449 my @l= @Fields; 2450 if (my $type=$args{type}) 2451 { @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 2452 } 2453 if (my $true=$args{true}) 2454 { @l= grep $Def{$_}{$true}, @l; 2455 } 2456 return @l; 2457} 2458sub FieldType #currently used to check "flags" or "rating" types 2459{ my $field=shift; 2460 return '' unless grep $field eq $_, @Fields; 2461 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 2462} 2463sub ListGroupTypes 2464{ my @list= grep $Def{$_}{can_group}, @Fields; 2465 my @ret; 2466 for my $field (@list) 2467 { my $val=$field; 2468 my $name=FieldName($field); 2469 my $types=LookupCode($field,'subtypes_menu'); 2470 if ($types) 2471 { $val=[map( (qq($field.$_) => "$name ($types->{$_})"), keys %$types)]; 2472 } 2473 push @ret, $val,$name; 2474 } 2475 return \@ret; 2476} 2477sub WriteableFields 2478{ grep $Def{$_}{flags}=~m/a/ && $Def{$_}{flags}=~m/w/, @Fields; 2479} 2480sub EditFields #type is one of qw/single many per_id/ 2481{ my $type=$_[0]; 2482 my @fields= grep $Def{$_}{flags}=~m/e/, @Fields; 2483 @fields= grep $Def{$_}{edit_many}, @fields if $type eq 'many'; 2484 @fields= sort { ($Def{$a}{edit_order}||1000) <=> ($Def{$b}{edit_order}||1000) 2485 || $Def{$a}{name} cmp $Def{$b}{name} 2486 } @fields; 2487 return @fields; 2488} 2489sub EditWidget 2490{ my ($field,$type,$IDs)=@_; #type is one of qw/single many per_id/ 2491 my ($sub)= LookupCode($field, "editwidget:all|editwidget:$type|editwidget"); 2492 unless ($sub) {warn "Can't find editwidget for field $field\n"; return undef;} 2493 return $sub->($field,$IDs); 2494} 2495sub ReplaceFields_to_re 2496{ my $string=shift; 2497 my $field= $::ReplaceFields{$string}; 2498 if ($field && $Def{$field}{flags}=~m/e/) 2499 { return $Def{$field}{_autofill_re} ||= '('. LookupCode($field, 'autofill_re') .')'; 2500 } 2501 $string=~s#(\$\{\})#\\$1#; # escape $ and {} 2502 return $string; 2503} 2504sub StringFields #list of fields that are strings, used for selecting fields for interactive search 2505{ grep SortICase($_), @Fields; #currently use SortICase #FIXME ? 2506} 2507sub SortGroup 2508{ my $f=$_[0]; 2509 $f=~s#\..*##; #FIXME should be able to sort on "modif.year" and others, but for now, simplfy it into "modif" 2510 return $Def{$f}{sortgroup} || SortField($f); 2511} 2512sub SortICase 2513{ my $f=$_[0]; 2514 return $Def{$f} && $Def{$f}{flags}=~m/i/; 2515} 2516sub SortField 2517{ my $f=$_[0]; 2518 return $Def{$f} && $Def{$f}{flags}=~m/i/ ? $f.=':i' : $f; #case-insensitive by default 2519} 2520sub MakeSortCode 2521{ my $sort=shift; 2522 my @code; 2523 my $init=''; 2524 for my $s (split / /,$sort) 2525 { my ($inv,$field,$i)= $s=~m/^(-)?(\w+)(:i)?$/; 2526 next unless $field; 2527 unless ($Def{$field}) { warn "Songs::SortList : Invalid field $field\n"; next } 2528 unless ($Def{$field}{flags}=~m/s/) { warn "Don't know how to sort $field\n"; next } 2529 my ($sortinit,$sortcode)= SortCode($field,$inv,$i); 2530 push @code, $sortcode; 2531 $init.= $sortinit."; " if $sortinit; 2532 } 2533 @code=('0') unless @code; 2534 return $init, join(' || ',@code); 2535} 2536sub 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 2537{ my ($listref,$sort,$ID)=@_; # list must be sorted by $sort 2538 my $func= $FuncCache{"FindNext $sort"} ||= 2539 do { my ($init,$code)= MakeSortCode($sort); 2540 $code= 'sub {my $l=$_[0];$a=$_[1]; '.$init.'for $b (@$l) { return $b if (' . $code . ')<1; } return undef;}'; 2541 Compile("FindNext $sort", $code); 2542 }; 2543 return $func->($listref,$ID); 2544} 2545sub FindFirst #FIXME add a few fields (like 'disc track path file') to all sort so that the sort result is constant, ie doesn't depend on the starting order 2546{ my ($listref,$sort)=@_; 2547 my $func= $FuncCache{"FindFirst $sort"} ||= 2548 do { my ($init,$code)= MakeSortCode($sort); 2549 $code= 'sub {my $l=$_[0];$a=$l->[0]; '.$init.'for $b (@$l) { $a=$b if (' . $code . ')>0; } return $a;}'; 2550 Compile("FindFirst $sort", $code); 2551 }; 2552 return $func->($listref); 2553} 2554sub SortList #FIXME add a few fields (like 'disc track path file') to all sort so that the sort result is constant, ie doesn't depend on the starting order 2555{ my $time=times; #DEBUG 2556 my $listref=$_[0]; my $sort=$_[1]; 2557 my $func= $FuncCache{"sort $sort"} ||= 2558 do { my ($init,$code)= MakeSortCode($sort); 2559 $code= 'sub { my $list=shift; ' .$init. '@$list= sort {'. $code . '} @$list; }'; 2560 Compile("sort $sort", $code); 2561 }; 2562 $func->($listref) if $func; 2563 warn "sort ($sort) : ".(times-$time)." s\n" if $::debug; #DEBUG 2564} 2565sub SortDepends 2566{ my @f=split / /,shift; 2567 s/^-//,s/:i$// for @f; 2568 return [Depends(@f)]; 2569} 2570sub ReShuffle 2571{ $Songs::SHUFFLE=''; 2572} 2573sub update_shuffle 2574{ my $max=shift; 2575 my $length= defined $Songs::SHUFFLE ? length($Songs::SHUFFLE) : 0; 2576 my $needed= $max+1 - $length/4; 2577 if ($needed>0) 2578 { my @append; 2579 $Songs::SHUFFLE.= pack 'L*', map rand(256**4), 1..$needed; 2580 } 2581} 2582 2583sub Depends 2584{ my @fields=@_; 2585 my %h; 2586 for my $f (grep $_ ne '', @fields) 2587 { $f=~s#[.:].*##; 2588 next unless $f; 2589 unless ($Def{$f}) {warn "Songs::Depends : Invalid field $f\n";next} 2590 $h{$f}=undef; 2591 if (my $d= $Def{$f}{depend}) { $h{$_}=undef for split / /,$d; } 2592 } 2593 #delete $h{none}; 2594 return keys %h; 2595} 2596 2597sub CopyFields #copy values from one song to another 2598{ my ($srcfile,$dstfile,@fields)=@_; 2599 my $IDsrc=FindID($srcfile); 2600 my $IDdst=FindID($dstfile); 2601 unless (defined $IDsrc) { warn "CopyFields : can't find $srcfile in the library\n";return 1 } 2602 unless (defined $IDdst) { warn "CopyFields : can't find $dstfile in the library\n";return 2 } 2603 #FIXME could check fields 2604 warn "Copying fields '@fields' from '$srcfile' to '$dstfile'\n" if $::debug; 2605 my @vals=Get($IDsrc,@fields); 2606 Set($IDdst, map { $fields[$_]=>$vals[$_] } 0..$#fields); 2607 return 0; 2608 2609} 2610sub GetTagValue #rename ? 2611{ my ($ID,$field)=@_; 2612 warn "GetTagValue : $ID,$field\n" if $::debug; 2613 unless ($Def{$field}{flags}=~m/g/) { warn "GetTagValue : invalid field '$field'\n"; return undef } 2614 $ID=FindID($ID); 2615 unless (defined $ID) { warn "GetTagValue : song not found\n"; return undef } 2616 return Get($ID,$field); 2617} 2618sub SetTagValue #rename ? 2619{ my ($ID,$field,$value)=@_; 2620 warn "SetTagValue : $ID,$field,$value\n" if $::debug; 2621 #unless (exists $Set{$field}) { warn "SetTagValue : invalid field\n"; return ::FALSE } 2622 $ID=FindID($ID); 2623 unless (defined $ID) { warn "SetTagValue : song not found\n"; return ::FALSE } 2624 Set($ID,$field=>$value); 2625 return ::TRUE; #FIXME could check if it has worked 2626} 2627 2628my %buildhash_deprecated= (idlist=>'id:list',count=>'id:count',uniq=>':uniq'); 2629sub BuildHash 2630{ my ($field,$IDs,$opt,@types)=@_; #warn "Songs::BuildHash(@_)\n"; 2631 $opt= $opt? ':'.$opt : ''; 2632 my ($keycode,$multi)= LookupCode($field, 'hash'.$opt.'|hash', 'hashm'.$opt.'|hashm',[ID => '$ID']); 2633 $keycode||=$multi; 2634 unless ($keycode || $multi) { warn "BuildHash error : can't find code for field $field\n"; return } #could return empty hashes ? 2635 my $init= $keycode=~s/^\s*INIT:(.*?)\s+----\s+// ? "$1;" : ''; 2636 my $keyafter= $keycode=~s/----\s+AFTER:(.*)$// ? $1 :''; 2637 @types=('id:count') unless @types; 2638 2639 my $after=''; 2640 my $code; 2641 my $i; 2642 for my $type (@types) 2643 { $i++; 2644 if ($buildhash_deprecated{$type}) { warn "BuildHash: using '$type' is deprecated, use '$buildhash_deprecated{$type}' instead\n" if ::VERSION>1.1009 || $::debug; $type=$buildhash_deprecated{$type}; } 2645 my ($f,$opt,$arg)=split /:/,$type,3; 2646 $arg=~y/-A-Z0-9:.,//cd if $arg; 2647 $opt= $opt ? 'stats:'.$opt : 'stats'; 2648 $f||= 'id'; # mostly for :uniq but also :list and :count 2649 my $c= LookupCode($f, $opt, [ID=>'$ID', ($arg ? (ARG=>"'$arg'") : () )]); 2650 $c=~s/\$\$/'$V'.$i.'_'/ge; # $$name => $V5_name if $i==5 2651 $init.=";$1;" if $c=~s/^\s*INIT:(.*?)\s+----\s+//; 2652 my $af= $c=~s/----\s+AFTER:(.*)$// ? $1 :''; 2653#warn "BuildHash $field : $f $opt => $c // $af\n"; 2654 my $hval= $multi ? '$h'.$i.'{$key}' : "\$h$i\{$keycode}"; 2655 $code.= Macro($c, HVAL=> $hval).";\n"; 2656 $after.= Macro($keyafter, H=> 'h'.$i).";\n" if $keyafter; #not used yet 2657 $after.= "for my \$key (keys \%h$i) {". Macro($af, HVAL=> '$h'.$i.'{$key}')."}\n" if $af; 2658 } 2659 $code="for my \$key ($keycode) {\n $code\n}\n" if $multi; 2660 $code="for my \$ID (@\$lref) {\n $code\n}\n$after"; 2661 my $hlist= join ',',map "\%h$_",1..$i; 2662 my $hlistref= join ',',map "\\\%h$_",1..$i; 2663 $code= "my \$lref=\$_[0]; $init; my ($hlist);\n$code;\nreturn $hlistref;"; 2664 2665#warn "BuildHash($field $opt,@types)=>\n$code\n"; 2666 my $sub= eval "sub { no warnings 'uninitialized'; $code }"; 2667 if ($@) { warn "BuildHash compilation error :\ncode: $code\nerror: $@";} 2668 $IDs||=[FIRSTID..$LastID]; 2669 $sub->( $IDs ); #returns one hash ref by @types 2670} 2671 2672sub AllFilter 2673{ my $filter=$_[0]; 2674 Filter->new($filter)->filter_all; 2675} 2676 2677#sub GroupSub_old 2678#{ my $field=$_[0]; #warn "Songs::GroupSub : @_\n"; 2679# return $FuncCache{"GroupSub $field"} ||= do 2680# { my $code= Code($field, 'group', ID => '-ID-'); 2681# $code=~s/ *(ne|!=) *$//; 2682# my $op=$1||'ne'; 2683# my $code0=$code; 2684# $code =~s/-ID-/\$list->[\$_]/g; 2685# #$code0=~s/-ID-/\$list->[\$_-1]/g; 2686# $code0=~s/-ID-/\$list->[\$_[1]]/g; 2687# my $f=eval "sub { my \$list=\$_[0]; my \$v0=$code0; [grep {$code $op \$v0 and \$v0=$code,1;} \$_[1]+1..\$_[2] ] }"; 2688# #my $f=eval "sub { my \$list=\$_[0]; [grep {$code $op $code0} \$_[1]..\$_[2] ] }"; 2689# if ($@) { warn "GroupSub compilation error :\ncode: $code $op $code0\nerror: $@"; $f=sub {warn "invalid groupsub (field=$field)";[]}} 2690# $f; 2691# }; 2692#} 2693sub GroupSub 2694{ my $field=$_[0]; #warn "Songs::GroupSub : @_\n"; 2695 return $FuncCache{"GroupSub $field"} ||= do 2696 { my $code= Code($field, 'group', ID => '-ID-'); 2697 $code=~s/ *(ne|!=) *$//; 2698 my $op=$1||'ne'; 2699 my $code0=$code; 2700 $code =~s/-ID-/\$list->[\$_]/g; 2701 $code0=~s/-ID-/\$list->[\$firstrow]/g; 2702 Compile("GroupSub $field", 2703 'sub { my ($list,$lastrows_parent)=@_; 2704 my @lastrows;my @lastchild; 2705 my $firstrow=0; 2706 for my $lastrow (@$lastrows_parent) 2707 { my $v0='.$code0.'; 2708 push @lastrows, map $_-1, grep {'."$code $op ".'$v0 and $v0='.$code.',1;} $firstrow+1..$lastrow; 2709 push @lastrows, $lastrow; 2710 push @lastchild, $#lastrows; 2711 $firstrow=$lastrow+1; 2712 } 2713 return \\@lastrows,\\@lastchild; 2714 }') 2715 #use a dummy function in case of error : 2716 || sub {warn "invalid groupsub (field=$field)"; my $lastrows=$_[1]; return [@$lastrows],[0..$#$lastrows] }; 2717 }; 2718} 2719 2720sub PrefFields #preference dialog for fields 2721{ my $store=Gtk2::TreeStore->new('Glib::String','Glib::String','Glib::Boolean','Glib::Boolean','Glib::Boolean'); 2722 my $treeview=Gtk2::TreeView->new($store); 2723 $treeview->set_headers_visible(0); 2724 my $rightbox=Gtk2::VBox->new; 2725 my $renderer=Gtk2::CellRendererText->new; 2726 $treeview->append_column( Gtk2::TreeViewColumn->new_with_attributes 2727 ( 'field name',$renderer,text => 0, editable => 2, sensitive=>3, strikethrough => 4, 2728 )); 2729 2730 my @fields= grep !$Def{$_}{template} && (!$Def{$_}{disable} || ($Def{$_}{options} && $Def{$_}{options}=~m/\bdisable\b/)), keys %Def; 2731 @fields= grep !$Def{$_}{property_of} && $Def{$_}{name} && $Def{$_}{flags}=~m/[pc]/, @fields; 2732 #add custom fields 2733 push @fields, grep $::Options{Fields_options}{$_}{template}, keys %{$::Options{Fields_options}}; 2734 2735 # create the field tree 2736 my %tree= (custom=>{}); #always show custom category, even if empty 2737 for my $field (@fields) 2738 { my $opt= $::Options{Fields_options}{$field}; 2739 my $custom= $opt->{template}; 2740 my $cat= $custom ? 'custom' : $Def{$field}{category} || 'unknown'; 2741 my $name= $custom ? $opt->{name} : $Def{$field}{name}; 2742 $tree{$cat}{$field}=$name; 2743 } 2744 2745 #fill the treestore 2746 my $custom_root; 2747 for my $cat ( sort { $Categories{$a}[1] <=> $Categories{$b}[1] } keys %tree ) 2748 { my $names= $tree{$cat}; 2749 my $editable= $cat eq 'custom'; 2750 my $parent= $store->append(undef); 2751 $store->set( $parent, 0,$Categories{$cat}[0], 1,'+'.$cat, 3,::TRUE); # category node 2752 for my $field (::sorted_keys($names)) 2753 { my $opt= $::Options{Fields_options}{$field}; 2754 my $def= $Def{$field}; 2755 my $sensitive= exists $opt->{disable} ? $opt->{disable} : $def->{disable} ? 0 : 1; 2756 $store->set( $store->append($parent), 0,$names->{$field}, 1,$field, 2,$editable, 3,$sensitive, 4,$opt->{remove} ); #child 2757 } 2758 $custom_root= $store->get_string_from_iter($parent) if $cat eq 'custom'; 2759 } 2760 $treeview->expand_all; 2761 2762 $treeview->signal_connect(cursor_changed => sub 2763 { my $treeview=shift; 2764 my $path=($treeview->get_cursor)[0]; 2765 my $store=$treeview->get_model; 2766 my ($name,$field)=$store->get( $store->get_iter($path), 0,1 ); 2767 $rightbox->remove($_) for $rightbox->get_children; 2768 if ($field=~m/^\+/) {return} #row is a category 2769 return unless $field; 2770 my $title=Gtk2::Label->new_with_format("<b>%s</b>",$name); 2771 $rightbox->pack_start($title,::FALSE,::FALSE,2); 2772 my $box=Gtk2::VBox->new; 2773 ::weaken( $box->{store}=$store ); 2774 $box->{path}=$path; 2775 Field_fill_option_box($box,$field); 2776 $rightbox->add($box); 2777 $rightbox->show_all; 2778 }); 2779 $renderer->signal_connect(edited => sub 2780 { my ($cell,$pathstr,$newname)=@_; 2781 my $iter= $store->get_iter_from_string($pathstr); 2782 my ($oldname,$field)= $store->get($iter,0,1); 2783 if ($newname eq '') 2784 { $store->remove($iter) if $oldname eq ''; 2785 $treeview->set_cursor(Gtk2::TreePath->new($custom_root)); 2786 return; 2787 } 2788 if ($field eq '') 2789 { $field= validate_custom_field_name($newname,1); 2790 $::Options{Fields_options}{$field} = { template => 'string', name => $newname, }; 2791 #$Def{$field}= { template => 'string', options => $FieldTemplates{string}{options}, category=>'custom', name=>$newname }; 2792 } 2793 $::Options{Fields_options}{$field}{name}= $newname; 2794 $store->set($iter, 0,$newname, 1,$field); 2795 $treeview->set_cursor($store->get_path($iter)); 2796 }); 2797 2798 my $newcst=::NewIconButton('gtk-add', _"New custom field", sub 2799 { my $iter=$store->append($store->get_iter_from_string($custom_root)); 2800 $store->set($iter,0,'',1,'',2,::TRUE); 2801 my $path=$store->get_path($iter); 2802 $treeview->expand_to_path($path); 2803 $treeview->set_cursor($path, $treeview->get_column(0), ::TRUE); 2804 } ); 2805 my $warning=Gtk2::Label->new; 2806 $warning->set_markup('<b>'.::PangoEsc(_"Settings on this page will only take effect after a restart").'</b>'); 2807 my $sw=Gtk2::ScrolledWindow->new; 2808 $sw->set_shadow_type('etched-in'); 2809 $sw->set_policy('never','automatic'); 2810 $sw->add($treeview); 2811 my $vbox= ::Vpack( $warning, '_',[ ['0_',$sw,$newcst], '_', $rightbox ] ); 2812 2813 $vbox->{gotofunc}=sub #go to a specific row 2814 { my $field=shift; 2815 my $parent= $store->get_iter_first; 2816 while ($parent) 2817 { my $child= $store->iter_children($parent); 2818 while ($child) 2819 { if ($store->get($child,1) eq $field) { $treeview->set_cursor($store->get_path($child)); return; } 2820 $child= $store->iter_next($child); 2821 } 2822 $parent= $store->iter_next($parent); 2823 } 2824 }; 2825 2826 return $vbox; 2827} 2828 2829sub validate_custom_field_name 2830{ my ($field,$fallback)=@_; 2831 $field=~s/[^a-zA-Z0-9_]//g; $field=~s/^\d+//; $field=~s/_+/_/g; $field=~s/_$//; # custom field id restrictions, might be relaxed in the future 2832 $field= ucfirst $field if $field=~m/^[a-z]/; 2833 my %used; 2834 $used{$_}=undef for keys %Def; 2835 $used{$Def{$_}{_renamed_to}}=undef for grep $Def{$_}{_renamed_to}, keys %Def; 2836 if (!$field || $field eq '' || exists $used{$field}) 2837 { return unless $fallback; 2838 $field= 'Custom' if $field eq ''; 2839 ::IncSuffix($field) while $used{$field}; 2840 } 2841 return $field; 2842} 2843 2844our %Field_options_aliases= 2845( customfield => 'template convwarn disable remove datawarn', 2846 rw_ => 'rw resetnotag', 2847 stars => 'starprefix starpreview', 2848); 2849our %Field_options= 2850( #bits => 2851 #{ widget => 'combo', 2852 # combo => { 32 => "32 bits", 16 => "16 bits", }, 2853 # 'default' => 32, 2854 #}, 2855 rw => 2856 { widget => 'check', 2857 label => _"Read/write in file tag", 2858 'default' => sub #extract rw (sorted) from default flags 2859 { my $default_flags= $_[0]{flags} || ''; 2860 $default_flags=~tr/rw//dc; 2861 return join '', sort split //, $default_flags; 2862 }, 2863 apply => sub 2864 { my ($def,$opt,$value)=@_; 2865 $def->{flags}=~s/[rw]//g; 2866 $def->{flags}.='rw' if $value; 2867 }, 2868 }, 2869 editable => 2870 { widget => 'check', 2871 label => _"Editable in song properties dialog", 2872 'default' => sub { my $default= $_[0]{flags} || ''; return $default=~m/e/ }, 2873 apply => sub { my ($def,$opt,$value)=@_; $def->{flags}=~s/e//g; $def->{flags}.='e' if $value; }, 2874 }, 2875 resetnotag => 2876 { widget => 'check', 2877 label => _"Reset current value if no tag found in file", 2878 'default' => sub { my $default= $_[0]{flags} || ''; return $default!~m/_/ }, 2879 apply => sub { my ($def,$opt,$value)=@_; $def->{flags}=~s/_//g; $def->{flags}.='_' if !$value; }, 2880 update => sub { $_[0]{widget}->set_sensitive( $_[0]{opt}{rw} ); }, # set insensitive when tag not read/written 2881 }, 2882 starprefix => 2883 { label => _"Star images", 2884 widget => 'combo', 2885 combo => \&::Find_all_stars, 2886 tip => ::__x(_"You can make custom stars by putting pictures in {folder}\nThey must be named 'stars', optionally followed by a '-' and a word, followed by a number from 0 to 5 or 10\nExample: stars-custom0.png",folder=>$::HomeDir.'icons'), 2887 }, 2888 starpreview => 2889 { widget => sub 2890 { my @img= map Gtk2::Image->new, 0..2; 2891 my $box= ::Hpack('-',reverse @img); 2892 $box->{img}=\@img; 2893 return $box; 2894 }, 2895 update => sub 2896 { my $arg=shift; 2897 my @files= ::Find_star_pictures($arg->{opt}{starprefix}); 2898 my $img= $arg->{widget}{img}; 2899 my @pix= map GMB::Picture::pixbuf($files[$_]), 0,int($#files/2),$#files; 2900 $img->[$_]->set_from_pixbuf($pix[$_]) for 0..2; 2901 }, 2902 }, 2903 editsubmenu => 2904 { widget => 'check', 2905 label => _"Show edition submenu in song context menu", 2906 }, 2907 disable => 2908 { widget => 'check', 2909 label => _"Disabled", 2910 }, 2911 remove => 2912 { widget => 'check', 2913 label => _"Remove this field", 2914 }, 2915 convwarn => 2916 { widget => 'label', 2917 label => _"Warning: converting existing data to this format may be lossy", 2918 update => sub # show only when field to be disabled or removed 2919 { my $arg=shift; 2920 my $show= $arg->{opt}{currentid} && ( $arg->{opt}{template} ne $Def{$arg->{opt}{currentid}}{template} ); 2921 my $w= $arg->{widget}; 2922 $w->set_visible($show); 2923 $w->set_no_show_all(1); 2924 }, 2925 }, 2926 datawarn => 2927 { widget => 'label', 2928 label => _"Warning: all existing data for this field will be lost", 2929 update => sub # show only when field to be disabled or removed 2930 { my $arg=shift; 2931 my $opt=$arg->{opt}; 2932 my $show= $opt->{currentid} && ($opt->{disable} || $opt->{remove} ); 2933 my $w= $arg->{widget}; 2934 $w->set_visible($show); 2935 $w->set_no_show_all(1); 2936 }, 2937 }, 2938 useridwarn => 2939 { widget => 'label', 2940 label => _"Warning: an identifier is needed", 2941 update => sub 2942 { my $arg=shift; 2943 my $show= $arg->{opt}{rw} && (!$arg->{opt}{userid} || $arg->{opt}{userid}=~m/^ *$/); 2944 my $w= $arg->{widget}; 2945 $w->set_visible($show); 2946 $w->set_no_show_all(1); 2947 }, 2948 }, 2949 userid => 2950 { widget => 'entry', 2951 label => _"Identifier in file tag", 2952 tip => _"Used to associate the saved value with a user or a function", 2953 update => sub { $_[0]{widget}->parent->set_sensitive( $_[0]{opt}{rw} ); }, # set insensitive when tag not read/written 2954 }, 2955 template=> 2956 { widget => \&Field_Edit_template, 2957 label => _"Field type", 2958 }, 2959 persistent_values=> 2960 { label => _("Persistent values").':', 2961 tip => _"These values will always be in the list, even if they are not used", 2962 default => sub { $_[0]{default_persistent_values} }, 2963 widget => sub 2964 { my (undef,$opt,$field)=@_; 2965 my $values= FieldType($field) eq 'flags' ? ListAll($field) : []; # check that field is live and live with correct type, else ListAll will not work 2966 my %valuesh; $valuesh{$_}=$_ for @$values; 2967 ::NewPrefMultiCombo(persistent_values=>\%valuesh,opthash=>$opt,ellipsize=>'end'); 2968 }, 2969 }, 2970 show_ext => 2971 { label => _"Show file name extension", 2972 widget => 'check', 2973 }, 2974); 2975 2976sub Field_fill_option_box 2977{ my ($vbox,$field, $keep_option, @keep_widgets)=@_; 2978 $_->parent->remove($_) for @keep_widgets; 2979 $vbox->remove($_) for $vbox->get_children; 2980 2981 my $opt= $::Options{Fields_options}{$field} ||= {}; 2982 #$vbox->{opt_orig}={%$opt}; #warning : shallow copy, sub-hash/array stay linked 2983 $vbox->{field}=$field; 2984 2985 my $template=$opt->{template}; 2986 my $def= $Def{$field}; 2987 my $option_list= ($template ? $FieldTemplates{$template}{options} : $def->{options}) ||''; 2988 my $flags= ($template ? $FieldTemplates{$template}{flags} : $def->{flags}) ||''; 2989 2990 my $sg1=Gtk2::SizeGroup->new('horizontal'); 2991 my %widgets; my @topack; 2992 $vbox->{FieldProperties}=1; #used to get back to $vbox from one of its (grand)child 2993 $vbox->{widget_hash}=\%widgets; 2994 my @options= split /\s+/, $option_list; 2995 while (my $option=shift @options) 2996 { if (my $o=$Field_options_aliases{$option}) 2997 { unshift @options,split /\s+/,$o; 2998 next; 2999 } 3000 my $ref=$Field_options{$option}; 3001 next unless $ref; 3002 my $label= $ref->{label}; 3003 my $widget= $ref->{widget}; 3004 my $key= $ref->{editkey} || $option; 3005 my $base= $template ? $FieldTemplates{$template} : $def; 3006 my $value= exists $opt->{$key} ? $opt->{$key} : Field_option_default($field,$option,$base); 3007 my @extra; 3008 if ($keep_option && $keep_option eq $option) { ($widget,@extra)= @keep_widgets; } 3009 elsif (ref $widget) 3010 { ($widget,@extra) = $widget->( $vbox, $opt, $field ); 3011 } 3012 elsif ($widget eq 'check') 3013 { $widget= Gtk2::CheckButton->new($label); 3014 undef $label; 3015 $widget->set_active($value); 3016 $widget->signal_connect(toggled => sub { $opt->{$key}= $_[0]->get_active ? 1 : 0; &Field_Edit_update }); 3017 } 3018 elsif ($widget eq 'entry') 3019 { $widget= Gtk2::Entry->new; 3020 $widget->set_text($value); 3021 $widget->signal_connect(changed => sub { my $t=$_[0]->get_text; if ($t=~m/^\s*$/) {delete $opt->{$key};} else {$opt->{$key}=$t;} &Field_Edit_update }); 3022 } 3023 elsif ($widget eq 'combo') 3024 { $widget= TextCombo->new( $ref->{combo}, $value, sub { $opt->{$key}=$_[0]->get_value; &Field_Edit_update }); 3025 } 3026 elsif ($widget eq 'label') 3027 { $widget= Gtk2::Label->new($label); 3028 undef $label; 3029 } 3030 next unless $widget; 3031 my $tip= $ref->{tip}; 3032 $widget->set_tooltip_text($tip) if defined $tip; 3033 3034 $widgets{$option}=$widget; 3035 3036 if (defined $label) 3037 { $label= Gtk2::Label->new($label); 3038 $sg1->add_widget($label); 3039 $widget= [ $label, '_',$widget ]; 3040 } 3041 push @topack, $widget,@extra; 3042 } 3043 3044 if ($flags=~m/g/) 3045 { my @idlist= sort grep $Aliases{$_} eq $field, keys %Aliases; 3046 my $varnames= join ', ',map '$'.$_, @idlist; 3047 $varnames.=', %'.$def->{letter} if $def->{letter}; 3048 my $label_var= _("Can be used as a variable with :").' '.$varnames; 3049 my $label_search= _("Can be searched with :").' '.join(', ',@idlist); 3050 $_= Gtk2::Label->new($_) for $label_var,$label_search; 3051 $_->set_selectable(1) , $_->set_alignment(0,.5) , $_->set_line_wrap(1) for $label_var,$label_search; 3052 unshift @topack, $label_var if $varnames; 3053 unshift @topack, $label_search if @idlist && $flags=~m/f/; 3054 } 3055 unshift @topack, Gtk2::Label->new( $def->{desc} ) if $def->{desc}; 3056 3057 { my $hbox= Gtk2::HBox->new; 3058 my $label1= Gtk2::Label->new(_("Field identifier").':'); 3059 my $label_id= Gtk2::Label->new($field); 3060 $hbox->pack_start($_,0,0,2) for $label1,$label_id; 3061 if ($template) #custom fields can be renamed 3062 { my $entry= Gtk2::Entry->new; 3063 my $bedit= Gtk2::Button->new(_"Edit"); 3064 my $brename= Gtk2::Button->new(_"Rename"); 3065 my $bcancel= Gtk2::Button->new(_"Cancel"); 3066 $hbox->pack_start($_,0,0,2) for $entry,$bedit,$brename,$bcancel; 3067 my @edit=($entry,$brename,$bcancel); 3068 $hbox->{edit}= \@edit; 3069 $_->set_no_show_all(1) for @edit; 3070 $hbox->{noedit}= [$label_id,$bedit]; 3071 $hbox->{entry}= $entry; 3072 $hbox->{brename}= $brename; 3073 $hbox->{label_id}= $label_id; 3074 my $toggle_edit=sub 3075 { my ($button,$on)=@_; 3076 my $hbox= $button->parent; 3077 $_->set_visible($on) for @{$hbox->{edit}}; 3078 $_->set_visible(!$on) for @{$hbox->{noedit}}; 3079 my $vbox=$button; $vbox=$vbox->parent until $vbox->{FieldProperties}; 3080 $hbox->{entry}->set_text($vbox->{field}); 3081 }; 3082 $entry->signal_connect(changed => sub { my $t= validate_custom_field_name($_[0]->get_text); $_[0]->parent->{newid}=$t; $_[0]->parent->{brename}->set_sensitive($t && $t ne $field); }); 3083 $bedit->signal_connect(clicked=> $toggle_edit,1); 3084 $bcancel->signal_connect(clicked=> $toggle_edit,0); 3085 $brename->signal_connect(clicked=> sub 3086 { my $button=shift; 3087 my $new=$button->parent->{newid}; 3088 $::Options{Fields_options}{$new}= delete($::Options{Fields_options}{$field}); 3089 if (my $id=$::Options{Fields_options}{$new}{currentid}) 3090 { $Def{$id}{_renamed_to}=$new; 3091 } 3092 my $vbox=$button; $vbox=$vbox->parent until $vbox->{FieldProperties}; 3093 $vbox->{field}= $new; 3094 $button->parent->{label_id}->set_text($new); 3095 $toggle_edit->($button,0); 3096 Field_Edit_update($vbox); 3097 }); 3098 } 3099 unshift @topack, $hbox; 3100 } 3101 3102 if (!$widgets{rw}) 3103 { my $text= $flags=~m/rw/ ? _"Value written in file tag" : 3104 $flags!~m/[rw]/ ? _"Value not written in file tag" : 3105 undef; 3106 $text=undef if $field eq 'path' || $field eq 'file'; 3107 unshift @topack, Gtk2::Label->new_with_format( '<small>%s</small>', $text ) if $text; 3108 } 3109 3110 $vbox->add( ::Vpack(@topack) ); 3111 $vbox->show_all; 3112 Field_Edit_update($vbox); 3113} 3114 3115sub Field_Edit_update 3116{ my $vbox=shift; 3117 $vbox=$vbox->parent until $vbox->{FieldProperties}; 3118 my $field= $vbox->{field}; 3119 my $opt= $::Options{Fields_options}{$field} ||= {}; 3120 my $widgets= $vbox->{widget_hash}; 3121 for my $option (sort keys %$widgets) 3122 { my $update= $Field_options{$option}{update}; 3123 next unless $update; 3124 $update->({ vbox=>$vbox, opt=>$opt, field=>$field, widget=>$widgets->{$option}, }); 3125 } 3126 my $store= $vbox->{store}; 3127 my $sensitive= (exists $opt->{disable} ? $opt->{disable} : ($Def{$field} && $Def{$field}{disable})) ? 0 : 1; 3128 my $iter= $store->get_iter($vbox->{path}); 3129 $store->set( $iter, 3, $sensitive, 4, $opt->{remove}); 3130 $store->set( $iter, 0,$opt->{name}, 1,$field) if $opt->{template}; #only for custom fields 3131} 3132 3133sub Field_Edit_template 3134{ my ($vbox,$opt,$field)=@_; 3135 my %templatelist; 3136 $templatelist{$_}= $FieldTemplates{$_}{editname} for keys %FieldTemplates; 3137 my $label= Gtk2::Label->new; 3138 my $combo= TextCombo->new(\%templatelist, $opt->{template}, sub 3139 { my $combo=shift; 3140 my $t=$opt->{template}= $combo->get_value; 3141 $Def{$field}{options}= $FieldTemplates{$t}{options}; 3142 my $focus= $combo->is_focus; #FIXME never true 3143 my $vbox=$combo; $vbox=$vbox->parent until $vbox->{FieldProperties}; 3144 Field_fill_option_box($vbox,$field, template=>$combo,$label); # will reset the option box but keep $combo and $label 3145 $combo->grab_focus if $focus; #reparenting $combo will make it lose focus, so regrab it #FIXME $focus never true 3146 my $desc= $FieldTemplates{$t}{desc}; 3147 if ($desc) {$label->set_markup_with_format("<small><i>%s</i></small>",$desc);$label->show} else {$label->hide} 3148 }); 3149 $label->set_no_show_all(1); 3150 my $desc= $FieldTemplates{$opt->{template}}{desc}; 3151 if ($desc) {$label->set_markup_with_format("<small><i>%s</i></small>",$desc);$label->show} 3152 return $combo,$label; 3153} 3154 3155sub Field_Apply_options 3156{ for my $field (keys %{ $::Options{Fields_options} }) 3157 { my $opt= $::Options{Fields_options}{$field}; 3158 if ($opt->{remove}) { delete $::Options{Fields_options}{$field}; next; } 3159 my $def= $Def{$field}; 3160 if (!$def || $def->{template}) 3161 { my $template=$opt->{template}; 3162 next unless $template; # could remove options of removed standard fields ? 3163 my $hash= $FieldTemplates{$template}; 3164 next unless $hash; 3165 $def=$Def{$field}= { %$hash, name=>$opt->{name} }; #shallow copy of the template hash 3166 $opt->{currentid}=$field; 3167 } 3168 my @options= split /\s+/, $def->{options}||''; 3169 while (my $option=shift @options) 3170 { if (my $o=$Field_options_aliases{$option}) 3171 { unshift @options,split /\s+/,$o; 3172 next; 3173 } 3174 my $ref=$Field_options{$option}; 3175 next unless $ref; 3176 3177 my $key= $ref->{editkey} || $option; 3178 my $value= exists $opt->{$key} ? $opt->{$key} : Field_option_default($field,$option,$def); 3179 if (my $apply= $ref->{apply}) { $apply->($def,$opt,$value) } 3180 else 3181 { $def->{$key}= $value; 3182 } 3183 } 3184 } 3185} 3186 3187sub Field_option_default 3188{ my ($field,$option,$def)=@_; 3189 my $ref=$Field_options{$option}; 3190 my $default= $ref->{'default'}; 3191 if (defined $default) { $default= $default->($def, $field) if ref $default; } 3192 else 3193 { my $key= $ref->{editkey} || $option; 3194 $default= $def->{$key}; 3195 $default='' unless defined $default; 3196 } 3197 return $default; 3198} 3199 3200sub FMPS_rating_postread 3201{ my $v=shift; 3202 length $v && $v=~m/^\d*\.?\d+$/ ? sprintf('%d',$v*100) : undef; 3203} 3204sub FMPS_rating_prewrite 3205{ my $v=shift; 3206 ($v eq '' || $v>100) ? '' : sprintf('%.6f', $v/100); 3207 # write a rating of '' when no rating rather than undef, so that the tag is still written (undef would remove the tag) 3208 # this allows us to distinguish "default rating" from "rating never written". 3209 # without this, it would not be possible to remove the rating (ie: set it to "default rating") when the option resetnotag is off 3210} 3211 3212 3213package AA; 3214our (%GHash,%GHash_Depend); 3215 3216our %ReplaceFields= 3217( '%' => sub {'%'}, 3218 a => sub { my $s=Songs::Gid_to_Display($_[0],$_[1]); defined $s ? $s : $_[1]; }, #FIXME PHASE1 Gid_to_Display should return something $_[1] if no gid_to_display 3219 l => sub { my $l=Get('length:sum',$_[0],$_[1]); $l=::__x( ($l>=3600 ? _"{hours}h{min}m{sec}s" : _"{min}m{sec}s"), hours => (int $l/3600), min => ($l>=3600 ? sprintf('%02d',$l/60%60) : $l/60%60), sec => sprintf('%02d',$l%60)); }, 3220 L => sub { ::CalcListLength( Get('id:list',$_[0],$_[1]),'length:sum' ); }, #FIXME is CalcListLength needed ? 3221 y => sub { Get('year:range',$_[0],$_[1])||''; }, 3222 Y => sub { my $y=Get('year:range',$_[0],$_[1]); return $y? " ($y)" : '' }, 3223 s => sub { my $l=Get('id:list',$_[0],$_[1])||[]; ::__n('%d song','%d songs',scalar @$l) }, 3224 x => sub { my $nb=@{GetXRef($_[0],$_[1])}; return $_[0] ne 'album' ? ::__("%d Album","%d Albums",$nb) : ::__("%d Artist","%d Artists",$nb); }, 3225 X => sub { my $nb=@{GetXRef($_[0],$_[1])}; return $_[0] ne 'album' ? ::__("%d Album","%d Albums",$nb) : $nb>1 ? ::__("%d Artist","%d Artists",$nb) : ''; }, 3226 b => sub { if ($_[0] ne 'album') { my $nb=@{GetXRef($_[0],$_[1])}; return ::__("%d Album","%d Albums",$nb); } 3227 else 3228 { my $l=Songs::UniqList('artist', Get('id:list',$_[0],$_[1])); 3229 return @$l==1 ? Songs::Gid_to_Display('artist',$l->[0]) : ::__("%d artist","%d artists", scalar(@$l)); 3230 } 3231 }, 3232); 3233 3234sub ReplaceFields 3235{ my ($gid,$format,$col,$esc)=@_; 3236#my $u;$u=$format; #DEBUG DELME 3237 $format=~s#(?:\\n|<br>)#\n#g; 3238 if($esc){ $format=~s/%([alLyYsxXb%r])/::PangoEsc($ReplaceFields{$1}->($col,$gid))/ge; } 3239 else { $format=~s/%([alLyYsxXb%r])/$ReplaceFields{$1}->($col,$gid)/ge; } 3240#warn "ReplaceFields $gid : $u => $format\n" if defined $u; #DEBUG DELME 3241 return $format; 3242} 3243 3244sub CreateHash 3245{ my ($type,$field)=@_; warn "AA::CreateHash(@_)\n" if $::debug; 3246 $GHash_Depend{$_}++ for Songs::Depends($type,$field); 3247 return $GHash{$field}{$type}=Songs::BuildHash($field,$::Library,undef,$type); 3248} 3249sub Fields_Changed 3250{ my $changed=shift; #hashref with changed fields as keys 3251 return unless grep $AA::GHash_Depend{$_}, keys %$changed; 3252 undef %GHash_Depend; 3253 delete $GHash{$_} for keys %$changed; 3254 for my $field (keys %GHash) 3255 { my @d0=Songs::Depends($field); 3256 if (grep exists $changed->{$_}, @d0) 3257 { delete $GHash{$field}; 3258 next; 3259 } 3260 my $subh=$GHash{$field}; 3261 for my $type (keys %$subh) 3262 { my @d= Songs::Depends($type); 3263 if (grep exists $changed->{$_}, @d) { delete $subh->{$type} } 3264 else { $GHash_Depend{$_}++ for @d0,@d; } 3265 } 3266 } 3267} 3268sub IDs_Changed #called when songs are added/removed 3269{ undef %GHash_Depend; 3270 undef %GHash; 3271 warn "IDs_Changed\n" if $::debug; 3272} 3273sub GetHash 3274{ my ($type,$field)=@_; 3275 return $GHash{$field}{$type} || CreateHash($type,$field); 3276} 3277sub Get 3278{ my ($type,$field,$key)=@_; 3279 my $h = $GHash{$field}{$type} || CreateHash($type,$field);#warn( 'DEBUG '.join('//',(keys %$h)[0..10])."...\n key=$key => $h->{$key}\n" ); 3280 return $h->{$key}; 3281} 3282sub GetAAList 3283{ my $field=$_[0]; 3284 CreateHash('id:list',$field) unless $GHash{$field}; 3285 my ($h)= values %{$GHash{$field}}; 3286 return [keys %$h]; 3287} 3288 3289sub GetXRef # get albums/artists from artist/album 3290{ my ($field,$key)=@_; 3291 my $x= $field eq 'album' ? 'artists:gid' : 'album:gid'; 3292 return Get($x,$field,$key) || []; 3293} 3294sub GetIDs 3295{ return Get('id:list',@_) || []; 3296} 3297 3298sub GrepKeys 3299{ my ($field,$string,$is_regexp,$is_casesens,$list)=@_; 3300 $list||=GetAAList($field); 3301 return [@$list] unless length $string; # m// use last regular expression used 3302 $string=quotemeta $string unless $is_regexp; 3303 my $re= $is_casesens ? qr/$string/ : qr/$string/i; 3304 my $displaysub=Songs::DisplayFromGID_sub($field); 3305 my @l=grep $displaysub->($_)=~m/$re/i, @$list; #FIXME optimize ? 3306 return \@l; 3307} 3308 3309sub SortKeys 3310{ my ($field,$list,$mode,$hsongs)=@_; 3311 my $invert= $mode=~s/^-//; 3312 my $h=my $pre=0; 3313 $mode||=''; 3314 if ($mode eq 'songs') 3315 { $h= $hsongs || GetHash('id:count',$field); 3316 $pre='number'; 3317 } 3318 elsif ($mode eq 'length') 3319 { $h= GetHash('length:sum',$field); 3320 $pre='number'; 3321 } 3322 elsif ($mode eq 'year') 3323 { $h= GetHash('year:range',$field); 3324 $pre='string'; #string because values are of the format : "1994 - 2000" 3325 } 3326 elsif ($mode eq 'year2') #use highest year 3327 { $h= GetHash('year:range',$field); 3328 $pre='year2'; #sort using the 4 last characters 3329 } 3330 elsif ($mode eq 'artist') #only for albums 3331 { $h= GetHash('album:artistsort',$field); 3332 $pre='string'; 3333 } 3334 Songs::sort_gid_by_name($field,$list,$h,$pre,$mode); 3335 @$list=reverse @$list if $invert; 3336 return $list; 3337} 3338 3339sub GuessBestCommonFolder 3340{ my ($field,$gid)=@_; 3341 my $IDs= AA::GetIDs($field,$gid); 3342 return unless @$IDs; 3343 my $h= Songs::BuildHash('path',$IDs); 3344 my $min=int(.1*::max(values %$h)); #ignore rare folders 3345 my $path= ::find_common_parent_folder( grep $h->{$_}>$min,keys %$h ); 3346 ($path)=sort { $h->{$b} <=> $h->{$a} } keys %$h if length $path<5;#take most common if too differents 3347 return $path; 3348} 3349 3350#package GMB::Filename; 3351#use overload ('""' => 'stringify'); 3352#sub new 3353#{ my ($class,$filename)=@_; 3354# ::_utf8_off($filename); 3355# return my $self= bless \$filename, $class; 3356#} 3357#sub stringify 3358#{ my $self=shift; 3359# return $$self; 3360#} 3361#sub new_from_string 3362#{ my ($class,$string)=@_; 3363# return $class->new(::decode_url($string)); 3364#} 3365#sub save_to_string 3366#{ my $self=shift; 3367# return ::url_escape($$self); 3368#} 3369 3370package SongArray; 3371my @list_of_SongArray; 3372my @need_update; 3373my $init; 3374my %Presence; 3375 3376INIT 3377{ ::Watch(undef, SongsRemoved => sub { RemoveFromArrays($_[1],\@list_of_SongArray); }); 3378} 3379 3380sub DESTROY 3381{ my $self=$_[0]; 3382 @list_of_SongArray= grep defined, @list_of_SongArray; 3383 ::weaken($_) for @list_of_SongArray; 3384 delete $Presence{$self}; 3385} 3386sub new 3387{ my ($class,$ref)=@_; 3388 $ref||=[]; 3389 push @need_update, $ref if $init; 3390 push @list_of_SongArray,$ref; 3391 ::weaken($list_of_SongArray[-1]); 3392 my $self= bless $ref, $class; 3393 return $self; 3394} 3395sub new_copy 3396{ my ($class,$ref)=@_; 3397 $ref= $ref ? [@$ref] : []; 3398 return $class->new($ref); 3399} 3400sub new_from_string 3401{ my ($class,$string)=@_; 3402 my @list= map 0+$_, split / /,$string; #0+$_ to convert to number => use less memory 3403 return $class->new(\@list); 3404} 3405sub start_init {$init=1} 3406sub updateIDs #update IDs coming from an older session 3407{ my $newIDs=shift; 3408 $init=undef; 3409 while (my $l=shift @need_update) 3410 { @$l= grep $_,map $newIDs->[$_], @$l; #IDs start at 1, removed songs get ID=undef and are then removed by the grep $_ 3411 } 3412} 3413sub build_presence 3414{ my $self=$_[0]; 3415 my $s=''; vec($s,$_,1)=1 for @$self; 3416 $Presence{$self}=$s, 3417} 3418sub IsIn 3419{ my ($self,$ID)=@_; 3420 return undef unless defined $ID; 3421 $self->build_presence unless $Presence{$self}; 3422 vec($Presence{$self},$ID,1); 3423} 3424sub AreIn 3425{ my ($self,$IDs)=@_; 3426 $self->build_presence unless $Presence{$self}; 3427 return [grep defined && vec($Presence{$self},$_,1), @$IDs]; 3428} 3429sub save_to_string 3430{ return join ' ',map $_, @{$_[0]}; #map $_ so that the numbers are not stringified => use more memory 3431} 3432 3433sub GetName {undef} 3434 3435sub RemoveFromArrays #could probably be improved 3436{ my ($IDs_toremove,$list_of_arrays)=@_; 3437 $list_of_arrays ||= \@list_of_SongArray; 3438 my $isin=''; 3439 vec($isin,$_,1)=1 for @$IDs_toremove; 3440 for my $self (grep defined, @$list_of_arrays) 3441 { my @rows=grep vec($isin,$self->[$_],1), 0..$#$self; 3442 $self->Remove(\@rows,'removeIDsfromall') if @rows; 3443 } 3444} 3445 3446sub RemoveIDs 3447{ my ($self,$IDs_toremove)=@_; 3448 my $isin=''; 3449 vec($isin,$_,1)=1 for @$IDs_toremove; 3450 my @rows=grep vec($isin,$self->[$_],1), 0..$#$self; 3451 $self->Remove(\@rows) if @rows; 3452} 3453 3454sub Sort 3455{ my ($self,$sort)=@_; 3456 my @old=@$self; 3457 Songs::SortList($self,$sort); 3458 ::HasChanged('SongArray',$self,'sort',$sort,\@old); 3459} 3460sub SetSortAndFilter 3461{ my ($self,$sort,$filter)=@_; 3462 my $list=$filter->filter; 3463 Songs::SortList($list,$sort) if $sort; 3464 $self->Replace($list); 3465} 3466sub SetFilter #KEEP ? 3467{ my ($self,$filter)=@_; 3468 $filter||=Filter->new; 3469 my $new=$filter->filter; 3470 $self->Replace($new,filter=> $filter); 3471} 3472sub Replace #DELME PHASE1 %info not used remove ? 3473{ my ($self,$new,%info)=@_; 3474 @$self= $new ? @$new : (); 3475 delete $Presence{$self}; 3476 ::HasChanged('SongArray',$self,'replace',%info); 3477} 3478sub Shuffle 3479{ my $self=shift; 3480 my @rand; 3481 push @rand,rand for 0..$#$self; 3482 $self->Replace([map $self->[$_], sort { $rand[$a] <=> $rand[$b] } 0..$#$self]); 3483} 3484sub Shift 3485{ my $self=$_[0]; 3486 my $ID=$self->[0]; 3487 $self->Remove([0]); 3488 return $ID; 3489} 3490sub Pop 3491{ my $self=$_[0]; 3492 my $ID=$self->[-1]; 3493 $self->Remove([$#$self]); 3494 return $ID; 3495} 3496sub Unshift 3497{ my ($self,$IDs)=@_; 3498 $self->Insert(0,$IDs); 3499} 3500sub Push 3501{ my ($self,$IDs)=@_; 3502 $self->Insert(scalar @$self,$IDs); 3503} 3504sub Insert 3505{ my ($self,$destrow,$IDs)=@_; 3506 splice @$self,$destrow,0,@$IDs; 3507 if ($Presence{$self}) {vec($Presence{$self}, $_, 1)=1 for @$IDs;} 3508 ::HasChanged('SongArray',$self,'insert', $destrow,$IDs); 3509} 3510sub Remove 3511{ my ($self,$rows,$IDs)=@_; #$IDs may be undef and is ignored, just there to make mirroring easier 3512 my @rows=sort { $a <=> $b } @$rows; 3513 my @IDs; 3514 push @IDs, splice @$self,$_,1 for reverse @rows; 3515 delete $Presence{$self}; 3516 ::HasChanged('SongArray',$self,'remove', \@rows,\@IDs); 3517} 3518sub Move 3519{ my ($self,$dest_row,$rows,$dest_row_final)=@_; #$dest_row_final may be undef and is ignored, just there to make mirroring easier 3520 my @rows=sort { $a <=> $b } @$rows; 3521 my @IDs; 3522 my $dest_row_orig=$dest_row; 3523 for my $row (reverse @rows) 3524 { push @IDs,splice @$self,$row,1; 3525 $dest_row-- if $row<$dest_row; 3526 } 3527 splice @$self,$dest_row,0,reverse @IDs; 3528 ::HasChanged('SongArray',$self,'move', $dest_row_orig,\@rows,$dest_row); 3529} 3530sub Top 3531{ my ($self,$rows)=@_; 3532 $self->Move(0,$rows); 3533} 3534sub Bottom 3535{ my ($self,$rows)=@_; 3536 $self->Move(scalar @$self,$rows); 3537} 3538sub Up 3539{ my ($self,$rows)=@_; 3540 my @rows=sort { $a <=> $b } @$rows; 3541 my $first=0; 3542 shift @rows while @rows && $rows[0]==$first++; #remove rows already at the top 3543 return unless @rows; 3544 @$self[$_-1,$_]= @$self[$_,$_-1] for @rows; #move rows up 3545 ::HasChanged('SongArray',$self,'up', \@rows); 3546 return \@rows; 3547} 3548sub Down 3549{ my ($self,$rows)=@_; 3550 my @rows=sort { $a <=> $b } @$rows; 3551 my $last=$#$self; 3552 pop @rows while @rows && $rows[-1]==$last--; #remove rows already at the bottom 3553 return unless @rows; 3554 @$self[$_+1,$_]= @$self[$_,$_+1] for reverse @rows; #move rows down 3555 ::HasChanged('SongArray',$self,'down', \@rows); 3556 return \@rows; 3557} 3558 3559#sub Mirror 3560#{ my ($self,$songarray,@args)=@_; 3561# @$self=@$songarray; 3562# ::HasChanged('SongArray', $self, @args); 3563#} 3564 3565package SongArray::Named; 3566use base 'SongArray'; 3567#just used to easily test if a songarray is a savedlist 3568 3569sub GetName 3570{ my $self=$_[0]; 3571 my $sl=$::Options{SavedLists}; 3572 my ($name)= grep $sl->{$_}==$self, keys %$sl; 3573 return $name; #might be undef 3574} 3575 3576package SongArray::AutoUpdate; 3577use base 'SongArray'; 3578our %Filter; 3579our %Sort; 3580our %needupdate; 3581my @list_of_AutoUpdate; 3582 3583INIT 3584{ ::Watch(undef, SongsChanged => \&SongsChanged_cb); 3585 ::Watch(undef, SongsAdded => \&SongsAdded_cb); 3586 ::Watch(undef, SongsHidden => sub { SongArray::RemoveFromArrays($_[1],\@list_of_AutoUpdate); }); 3587} 3588 3589sub new 3590{ my ($class,$auto,$sort,$filter)=@_; 3591 if (!defined $filter) {$filter=Filter->null} 3592 elsif (!ref $filter) {$filter=Filter->new($filter)} 3593 my $list= $filter->filter; 3594 Songs::SortList($list,$sort) if @$list && $sort; 3595 my $self = $class->SUPER::new([@$list]); 3596 $Sort{$self}=$sort; 3597 $Filter{$self}=$filter; 3598 if ($auto) 3599 { push @list_of_AutoUpdate,$self; 3600 ::weaken($list_of_AutoUpdate[-1]); 3601 } 3602 return $self; 3603} 3604sub DESTROY 3605{ my $self=$_[0]; 3606 delete $Filter{$self}; 3607 delete $Sort{$self}; 3608 delete $needupdate{$self}; 3609 @list_of_AutoUpdate= grep defined, @list_of_AutoUpdate; 3610 ::weaken($_) for @list_of_AutoUpdate; 3611 $self->SUPER::DESTROY; 3612} 3613sub SetAutoUpdate 3614{ my ($self,$auto)=@_; 3615 @list_of_AutoUpdate= grep $self!=$_, @list_of_AutoUpdate; 3616 push @list_of_AutoUpdate,$self if $auto; 3617 ::weaken($_) for @list_of_AutoUpdate; 3618 if ($auto) 3619 { my $list= $Filter{$self}->filter; 3620 Songs::SortList($list,$Sort{$self}); 3621 my @old=@$self; 3622 @$self=@$list; 3623 ::HasChanged('SongArray',$self,'update',\@old); 3624 } 3625 else { ::HasChanged('SongArray',$self,'mode'); } 3626} 3627sub Sort 3628{ my ($self,$sort)=@_; 3629 $Sort{$self}=$sort; 3630 $self->SUPER::Sort($sort); 3631} 3632sub SetSortAndFilter 3633{ my ($self,$sort,$filter)=@_; 3634 $Filter{$self}=$filter; 3635 $Sort{$self}=$sort; 3636 my $list=$filter->filter; 3637 Songs::SortList($list,$sort); 3638 $self->Replace($list); 3639} 3640 3641sub SongsAdded_cb 3642{ my (undef,$IDs)=@_; 3643 for my $self (grep defined, @list_of_AutoUpdate) 3644 { next if ($needupdate{$self}||0)>1; 3645 my $filter=$Filter{$self}; 3646 my ($greponly)=$filter->info; 3647 if ($greponly) 3648 { my $toadd=$filter->filter($IDs); 3649 if ($toadd) 3650 { my @old=@$self; 3651 push @$self,@$toadd; 3652 if ($Presence{$self}) {vec($Presence{$self}, $_, 1)=1 for @$IDs;} 3653 Songs::SortList($self,$Sort{$self}); 3654 ::HasChanged('SongArray',$self,'update',\@old); 3655 } 3656 } 3657 else 3658 { $needupdate{$self}=2; 3659 ::IdleDo('7_autoupdate_update'.$self,6000, \&delayed_update_cb,$self); 3660 } 3661 } 3662} 3663sub delayed_update_cb 3664{ my $self=shift; 3665 my $need= delete $needupdate{$self}; 3666 return unless $need; 3667 if ($need>1) { $self->_update_full } 3668 else 3669 { my @old=@$self; 3670 Songs::SortList($self,$Sort{$self}); 3671 if ("@old" ne "@$self") #only update if there was a change 3672 { ::HasChanged('SongArray',$self,'update',\@old); 3673 } 3674 } 3675} 3676sub _update_full 3677{ my $self=shift; 3678 delete $needupdate{$self}; 3679 my @old=@$self; 3680 my $list=$Filter{$self}->filter; 3681 Songs::SortList($list,$Sort{$self}); 3682 @$self=@$list; 3683 delete $Presence{$self}; 3684 ::HasChanged('SongArray',$self,'update',\@old); 3685} 3686sub SongsChanged_cb 3687{ my (undef,$IDs,$fields)=@_; 3688 for my $self (grep defined, @list_of_AutoUpdate) 3689 { next if ($needupdate{$self}||0)>1; 3690 my $delayed; 3691 if ($Filter{$self}->changes_may_affect($IDs,$fields,$self)) 3692 { #re-filter and re-sort 3693 $needupdate{$self}=2; 3694 $delayed=1; 3695 } 3696 elsif ($self->AreIn($IDs) && ::OneInCommon($fields,Songs::SortDepends($Sort{$self}))) 3697 { #re-sort 3698 $needupdate{$self}=1; 3699 $delayed=1; 3700 } 3701 ::IdleDo('7_autoupdate_update'.$self,6000, \&delayed_update_cb,$self) if $delayed; 3702 } 3703} 3704 3705package SongArray::PlayList; 3706use base 'SongArray'; 3707 3708sub init 3709{ $::ListPlay=SongArray::PlayList->new; 3710 3711 my $sort=$::Options{Sort}; 3712 $::RandomMode= $sort=~m/^random:/ ? Random->new($sort,$::ListPlay) : undef; 3713 $::SortFields= $::RandomMode ? $::RandomMode->fields : Songs::SortDepends($sort); 3714 3715 my $last=$::Options{LastPlayFilter} || Filter->new; 3716 if (ref $last && ref $last eq 'Filter') { $::ListPlay->SetFilter($last); } 3717 else { $::ListPlay->Replace($last); } 3718 3719 ::Watch(undef, SongsChanged => \&SongsChanged_cb); 3720 ::Watch(undef, SongsAdded => \&SongsAdded_cb); 3721 ::Watch(undef, SongsHidden => sub { SongArray::RemoveFromArrays($_[1],[$::ListPlay]) unless $::ListMode; }); 3722 ::Watch(undef, SongArray => \&SongArray_changed_cb); 3723 return $::ListPlay; 3724} 3725 3726sub Sort 3727{ my ($self,$sort)=@_; 3728 my $old=$::Options{Sort}; 3729 if ($old eq $sort && $sort=~m/shuffle/) { Songs::ReShuffle(); } 3730 if ($::RandomMode || $old=~m/shuffle/) { $::Options{Sort_LastSR}=$old; } # save sort mode for 3731 elsif ($old ne '') { $::Options{Sort_LastOrdered}=$old; } # quick toggle random/non-random 3732 $::RandomMode= $sort=~m/^random:/ ? Random->new($sort,$self) : undef; 3733 $::Options{Sort}=$sort; 3734 $::SortFields= $::RandomMode ? $::RandomMode->fields : Songs::SortDepends($sort); 3735 $self->UpdateSort; 3736 if ($::RandomMode || !@$self) { $::Position=undef } 3737 else 3738 { $::Position= defined $::SongID ? ::FindPositionSong($::SongID,$self) : undef; 3739 } 3740 ::QHasChanged('Sort'); 3741 ::QHasChanged('Pos'); 3742} 3743sub SetSortAndFilter #FIXME could be optimized #FIXME only called from a songtree/songlist for now, and as these calls are usually not about setting the level 0 filter, it doesn't actually change the filter for now, just the list, as it needs multi-level filters to work properly 3744{ my ($self,$sort,$filter)=@_; 3745 $self->Replace($filter->filter,filter=>$filter); #$self->SetFilter($filter); #FIXME use SetFilter once multi-level filters are implemented 3746 $self->Sort($sort); 3747} 3748sub Replace 3749{ my ($self,$newlist)=@_; 3750 delete $::ToDo{'7_refilter_playlist'}; 3751 delete $::ToDo{'8_resort_playlist'}; 3752 $newlist=SongArray->new unless defined $newlist; 3753 unless (ref $newlist) 3754 { ::SaveList($newlist,[]) unless $::Options{SavedLists}{$newlist}; 3755 $newlist= $::Options{SavedLists}{$newlist}; 3756 } 3757 $newlist= SongArray->new_copy($newlist); 3758 $::Position=undef; $::ChangedPos=1; 3759 my $ID=$::SongID; 3760 $ID=undef if defined $ID && $::Options{AlwaysInPlaylist} && !$newlist->IsIn($ID); 3761 if (!defined $ID) 3762 { $ID= $self->_FindFirst($newlist); 3763 } 3764 $::Options{LastPlayFilter}=$::ListMode=SongArray->new_copy($newlist); 3765 $newlist=$self->_updatelock($ID,$newlist) if $::TogLock && defined $ID; 3766 @$self=@$newlist; 3767 delete $Presence{$self}; 3768 $::SelectedFilter=$::PlayFilter=undef; 3769 if ($::RandomMode) { $::RandomMode->Invalidate; } 3770 else { $::SortFields=[]; $::Options{Sort}=''; ::QHasChanged('Sort'); } 3771 ::QHasChanged('Filter'); 3772 ::HasChanged('SongArray',$self,'replace'); 3773 _updateID($ID); 3774} 3775sub Insert 3776{ my ($self,$destrow,$IDs)=@_; 3777 $self->_staticfy; 3778 $self->SUPER::Insert($destrow,$IDs); 3779 $::Options{LastPlayFilter}=$::ListMode=SongArray->new_copy($self); 3780 if (defined $::Position && $::Position>=$destrow) 3781 { $::Position+=@$IDs; 3782 ::red("position error after insert") if $self->[$::Position] != $::SongID; #DEBUG 3783 } 3784 elsif (@$self==@$IDs && !defined $::SongID) #playlist was empty 3785 { $self->Next; 3786 } 3787 ::QHasChanged('Pos'); 3788 3789 #set Position if playlist was empty ?? 3790} 3791sub Remove 3792{ my ($self,$rows,$fromlibrary)=@_; 3793 $self->_staticfy unless $fromlibrary; #do not staticfy list for songs removed from library 3794 $self->SUPER::Remove($rows); 3795 $::Options{LastPlayFilter}=$::ListMode=SongArray->new_copy($self) unless $fromlibrary; 3796 if (@$self==0 && $::Options{AlwaysInPlaylist}) { $::Position=undef; _updateID(undef); return; } 3797 if ($::RandomMode) 3798 { $::RandomMode->RmIDs; 3799 $self->Next if defined $::SongID && $::Options{AlwaysInPlaylist} && !$self->IsIn($::SongID); #skip to next song if current not in playlist 3800 } 3801 if (defined $::Position) 3802 { my $pos=$::Position; 3803 my @rows=sort { $a <=> $b } @$rows; 3804 my $IDchanged; 3805 for my $row (reverse @rows) 3806 { $IDchanged=1 if $pos==$row; 3807 $pos-- if $pos>=$row; 3808 } 3809 $pos=0 if $pos<0; 3810 $::Position=$pos; 3811 if ($IDchanged) 3812 { if ($::Options{AlwaysInPlaylist}) 3813 { $self->Next; #skip to next song if current not in playlist 3814 } 3815 else { $::Position=undef; } 3816 } 3817 } 3818 ::QHasChanged('Pos'); 3819} 3820sub Up 3821{ my ($self,$rows)=@_; 3822 $self->_staticfy; 3823 $rows=$self->SUPER::Up($rows); 3824 $::Options{LastPlayFilter}=$::ListMode=SongArray->new_copy($self); 3825 return unless $rows; 3826 if (defined $::Position) 3827 { my $pos= $::Position; 3828 for my $row (@$rows) 3829 { if ($row==$pos) {$pos--} 3830 elsif ($row==$pos+1) {$pos++} 3831 } 3832 if ($::Position!=$pos) { $::Position=$pos; ::QHasChanged('Pos'); } 3833 } 3834} 3835sub Down 3836{ my ($self,$rows)=@_; 3837 $self->_staticfy; 3838 $rows=$self->SUPER::Down($rows); 3839 $::Options{LastPlayFilter}=$::ListMode=SongArray->new_copy($self); 3840 return unless $rows; 3841 if (defined $::Position) 3842 { my $pos= $::Position; 3843 for my $row (reverse @$rows) 3844 { if ($row==$pos) {$pos++} 3845 elsif ($row==$pos-1) {$pos--} 3846 } 3847 if ($::Position!=$pos) { $::Position=$pos; ::QHasChanged('Pos'); } 3848 } 3849} 3850sub Move 3851{ my ($self,$destrow,$rows)=@_; 3852 $self->_staticfy; 3853 $self->SUPER::Move($destrow,$rows); 3854 $::Options{LastPlayFilter}=$::ListMode=SongArray->new_copy($self); 3855 if (defined $::Position) 3856 { my $pos=$::Position; 3857 my @rows=sort { $a <=> $b } @$rows; 3858 my $delta=0; 3859 for my $row (reverse @rows) 3860 { $destrow-- if $row<$destrow; 3861 $delta++; 3862 if ($row==$::Position) { $pos=undef; $delta=0; } #selected song has moved 3863 elsif (defined $pos && $row<$pos) { $pos-- } 3864 } 3865 if (defined $pos) { $pos+=$delta if $destrow<=$pos; } 3866 else { $pos=$destrow+$delta; } 3867 3868 if ($::Position!=$pos) { $::Position=$pos; ::QHasChanged('Pos'); } 3869 } 3870} 3871 3872#watchers callbacks 3873sub SongsAdded_cb 3874{ my (undef,$IDs)=@_; 3875 return if $::ListMode; 3876 return if $::ToDo{'7_refilter_playlist'}; 3877 return unless $::PlayFilter; 3878 my $toadd=$::PlayFilter->added_are_in($IDs); 3879 return unless $toadd; 3880 if (ref $toadd) { $::ListPlay->Add($toadd); } 3881 else 3882 { ::IdleDo('7_refilter_playlist',9000, \&UpdateFilter, $::ListPlay); 3883 } 3884} 3885sub SongsChanged_cb 3886{ my (undef,$IDs,$fields)=@_; 3887 return if $::ToDo{'7_refilter_playlist'}; 3888 if ($::PlayFilter && $::PlayFilter->changes_may_affect($IDs,$fields,$::ListPlay)) 3889 { ::IdleDo('7_refilter_playlist',9000, \&UpdateFilter, $::ListPlay); 3890 } 3891 elsif (::OneInCommon($fields,$::SortFields)) 3892 { ::IdleDo('8_resort_playlist',5000, \&UpdateSort, $::ListPlay); 3893 } 3894} 3895sub SongArray_changed_cb 3896{ my (undef,$songarray,$action,@extra)=@_; 3897 #return unless $::ListMode && $songarray==$::ListMode; 3898# my $sameorder= $::Options{Sort} eq ''; 3899# if ($action eq 'sort') { $::ListPlay->Sort('') if $sameorder; } 3900# #elsif ($action eq 'insert') { $::ListPlay->Insert(@extra); } 3901# elsif ($action eq 'insert') 3902# { if ($sameorder) {$::ListPlay->Insert(@extra);} 3903# else {$::ListPlay->Add(@extra);} 3904# } 3905# #elsif ($action eq 'remove') { $::ListPlay->Remove(@extra); } 3906# elsif ($action eq 'remove') 3907# { my ($rows,$IDs)=@extra; 3908# if ($sameorder) {$::ListPlay->Remove($rows);} 3909# else 3910# { my %h; $h{$_}++ for @$IDs; 3911# my @rows=grep $h{$::ListPlay->[$_]} && $h{$::ListPlay->[$_]}--, 0..$#$::ListPlay; 3912# $::ListPlay->Remove(\@rows); 3913# } 3914# } 3915# elsif ($action eq 'move') { $::ListPlay->Move(@extra) if $sameorder; } 3916# elsif ($action eq 'up') { $::ListPlay->Up(@extra) if $sameorder; } 3917# elsif ($action eq 'down') { $::ListPlay->Down(@extra) if $sameorder; } 3918# else { $::ListPlay->Replace($::ListMode); } 3919 #@$::ListPlay= @$songarray; 3920 #FIXME sort unless $sameorder; 3921 #::HasChanged('SongArray',$::ListPlay,'update'); 3922} 3923 3924#non-SongArray methods : 3925sub Next 3926{ ::NextSong(); 3927} 3928sub SetFilter 3929{ my ($self,$filter)=@_; 3930 $::ListMode=undef; 3931 $::Options{Sort}=$::Options{Sort_LastOrdered} unless $::Options{Sort}; 3932 $::Options{LastPlayFilter}= $::SelectedFilter= $filter || Filter->new; 3933 my $newID=$self->_filter; 3934 $::Position=undef; $::ChangedPos=1; 3935 ::QHasChanged('Filter'); 3936 ::HasChanged('SongArray',$self,'replace', filter=> $::PlayFilter); 3937 _updateID($newID); 3938} 3939sub UpdateFilter 3940{ my $self=shift; 3941 my @oldlist=@$self; 3942 my $before=$::PlayFilter; 3943 my $newID=$self->_filter; 3944 if ($::PlayFilter->are_equal($before)) 3945 { ::HasChanged('SongArray',$self,'update',\@oldlist); 3946 } 3947 else #filter may change because of the lock 3948 { ::QHasChanged('Filter'); 3949 ::HasChanged('SongArray',$self,'replace', filter=> $::PlayFilter); 3950 } 3951 $::Position=undef; $::ChangedPos=1; 3952 _updateID($newID); 3953} 3954sub UpdateSort 3955{ my $self=shift; 3956 my @old; 3957 @old=@$self unless $::RandomMode; 3958 $self->_sort; 3959 ::HasChanged('SongArray',$self,'sort',$::Options{Sort},\@old) unless $::RandomMode; 3960 $::Position=undef; $::ChangedPos=1; 3961 _updateID($::SongID); 3962} 3963sub UpdateLock 3964{ my $self=shift; 3965 $::Position=undef; $::ChangedPos=1; 3966 if (defined $::ListMode) { $self->Replace($::ListMode); } 3967 else { $self->SetFilter($::SelectedFilter); } 3968} 3969 3970sub InsertAtPosition 3971{ my ($self,$IDs)=@_; 3972 my $pos=defined $::Position? $::Position+1 : 0; 3973 $self->Insert($pos,$IDs); 3974} 3975sub Add #only called in filter mode 3976{ my ($self,$IDs)=@_; 3977 $self->SUPER::Insert(scalar @$self,$IDs); # call SUPER::Insert directly instead of SUPER::Push because SUPER::Push calls $self->Insert and thus statify the list 3978 if ($::RandomMode) 3979 { $::RandomMode->AddIDs(@$IDs); 3980 } 3981 elsif (my $s=$::Options{Sort}) 3982 { $self->SUPER::Sort($s); 3983 } 3984 if (!defined $::SongID) 3985 { my $ID= $self->_FindFirst($self); 3986 $self->SetID($ID) 3987 } 3988 $::ChangedPos=1; 3989 ::UpdateCurrentSong(); 3990} 3991 3992sub SetID 3993{ my ($self,$ID)=@_; 3994 $::ChangedID=1; 3995 $::SongID=$ID; 3996 if ($self->IsIn($ID) || !$::Library->IsIn($ID)) 3997 { ::UpdateCurrentSong(); 3998 return 3999 } 4000 if ($::TogLock && defined $ID && @$self) 4001 { my $newlist=$self->_list_without_lock; 4002 if (::IDIsInList($newlist,$ID)) # is in list without lock -> reset lock 4003 { $self->UpdateLock; 4004 return; 4005 } 4006 } 4007 if ($::Options{AlwaysInPlaylist}) 4008 { $self->SetFilter; #reset filter 4009 } 4010 else 4011 { ::UpdateCurrentSong(); 4012 } 4013} 4014 4015#private functions 4016sub _updateID 4017{ my $ID=shift; 4018 ::Stop() unless defined $ID; 4019 $::ChangedID=1 if !defined $::SongID || !defined $ID || $ID!=$::SongID; 4020 $::SongID=$ID; 4021 ::UpdateCurrentSong(); 4022} 4023sub _filter 4024{ my $self=shift; 4025 delete $::ToDo{'7_refilter_playlist'}; 4026 my $filter=$::SelectedFilter; 4027 my $ID=$::SongID; 4028 $filter= Filter->newadd(1,$filter, Filter->newlock($::TogLock,$ID) ) if $::TogLock && defined $ID; 4029 $::PlayFilter=$filter; 4030 my $newlist=$filter->filter; 4031 my $need_relock; 4032 my $sorted; 4033 if (defined $ID && $::Options{AlwaysInPlaylist} && !@{ $filter->filter([$ID]) }) 4034 { if (!@$newlist && $::TogLock) 4035 { $newlist= $::SelectedFilter->filter; 4036 $need_relock=1; 4037 } 4038 if ($::RandomMode) { $ID=undef; } 4039 elsif (my $sort=$::Options{Sort}) 4040 { Songs::SortList($newlist,$sort); 4041 $sorted=1; 4042 $ID= Songs::FindNext($newlist, $sort, $ID); 4043 } 4044 } 4045 if (!defined $ID) 4046 { $ID= $self->_FindFirst($newlist); 4047 $need_relock=1 if $::TogLock; 4048 } 4049 $newlist=$self->_updatelock($ID,$newlist) if $need_relock; 4050 $self->_sort($newlist) unless $sorted; 4051 @$self=@$newlist; 4052 delete $Presence{$self}; 4053 return $ID; 4054} 4055sub _sort 4056{ my ($self,$list)=@_; 4057 $list||=$self; 4058 delete $::ToDo{'8_resort_playlist'}; 4059 if ($::RandomMode) { $::RandomMode->Invalidate; } 4060 elsif ($::Options{Sort}){ Songs::SortList($list,$::Options{Sort}); } 4061 elsif ($::ListMode) 4062 { if ($::TogLock && $::PlayFilter) 4063 { my $newlist=$::PlayFilter->filter($list); 4064 @$self=@$newlist; 4065 delete $Presence{$self}; 4066 } 4067 else 4068 { @$self=@$::ListMode; 4069 } 4070 } 4071} 4072sub _FindFirst 4073{ my ($self,$list)=@_; 4074 my $ID; 4075 if (!@$list) { $ID=undef; } 4076 elsif ($::RandomMode) 4077 { ($ID)=Random->OneTimeDraw($::RandomMode,$list,1); 4078 } 4079 else 4080 { $ID= Songs::FindFirst($list,$::Options{Sort}); 4081 } 4082 return $ID; 4083} 4084sub _list_without_lock 4085{ my $self=shift; 4086 return $::ListMode ? $::ListMode : $::SelectedFilter->filter; 4087} 4088sub _updatelock 4089{ my ($self,$ID,$newlist)=@_; 4090 if (!defined $ID) 4091 { $::TogLock=undef; 4092 ::QHasChanged('Lock'); 4093 return $newlist; 4094 } 4095 my $lockfilter=Filter->newlock($::TogLock,$ID); 4096 $::PlayFilter= $::ListMode ? $lockfilter : Filter->newadd(1,$::SelectedFilter,$lockfilter); 4097 return $lockfilter->filter($newlist); 4098} 4099sub _staticfy 4100{ my $self=shift; 4101 delete $::ToDo{'7_refilter_playlist'}; 4102 delete $::ToDo{'8_resort_playlist'}; 4103 if ($::TogLock) { $::TogLock=undef; ::QHasChanged('Lock'); } 4104 unless ($::ListMode) 4105 { ::QHasChanged('Filter'); 4106 ::HasChanged('SongArray',$self,'mode'); 4107 } 4108 $::PlayFilter=undef; 4109 if (!$::RandomMode && $::Options{Sort}) { $::SortFields=[]; $::Options{Sort_LastOrdered}=$::Options{Sort}; $::Options{Sort}=''; ::QHasChanged('Sort'); } 4110} 4111 4112#sub _updatepos 4113#{ $::PositionUpdate=0; 4114# if (!defined $::Position && !$::RandomMode && defined $::SongID) 4115# { 4116# } 4117# ::HasChanged('Pos'); 4118#} 4119 4120 4121package GMB::ListStore::Field; 4122use base 'Gtk2::ListStore'; 4123 4124our %ExistingStores; 4125 4126sub new 4127{ my ($class,$field)=@_; #warn "creating new store for $field\n"; 4128 my @cols=('Glib::String'); 4129 push @cols, 'Glib::String' if $Songs::Def{$field}{icon}; #FIXME 4130 my $self= bless Gtk2::ListStore->new(@cols), $class; 4131 $ExistingStores{$field}= $self; 4132 ::weaken $ExistingStores{$field}; 4133 ::IdleDo("9_ListStore_$field",500,\&update,$field); 4134 ::Watch($self,fields_reset=>\&changed); 4135 return $self; 4136} 4137 4138sub getstore 4139{ my $field=$_[0]; 4140 return $ExistingStores{$field} || new(__PACKAGE__,$field); 4141} 4142sub setcompletion 4143{ my ($entry,$field)=@_; 4144 my $completion=Gtk2::EntryCompletion->new; 4145 $completion->set_text_column(0); 4146 if ($Songs::Def{$field}{icon}) #FIXME 4147 { my $cell=Gtk2::CellRendererPixbuf->new; 4148 $completion->pack_start($cell,0); 4149 $completion->add_attribute($cell,'stock-id',1); 4150 } 4151 $completion->set_model( getstore($field) ); 4152 $entry->set_completion($completion); 4153} 4154 4155sub changed 4156{ @_= keys %ExistingStores unless @_; 4157 for my $field (@_) 4158 { next unless $ExistingStores{$field}; 4159 ::IdleDo("9_ListStore_$field",5000,\&update,$field); 4160 } 4161} 4162 4163sub update 4164{ my $field=$_[0]; 4165 delete $::ToDo{"9_ListStore_$field"}; 4166 my $store=$ExistingStores{$field}; 4167 return unless $store; 4168 $store->{updating}=1; 4169 $store->clear; 4170 my $list=Songs::ListAll($field); 4171 if (my $icon=$Songs::Def{$field}{icon}) { $store->set($store->append,0,$_,1, $icon->($_)) for @$list; } #FIXME 4172 else { $store->set($store->append,0,$_) for @$list; } 4173 delete $store->{updating}; 4174 ::HasChanged("ListStore_$field"); 4175} 4176 4177package GMB::ListStore::Field::Combo; 4178use base 'Gtk2::ComboBox'; 4179 4180sub new 4181{ my ($class,$field,$init,$callback)=@_; 4182 my $store= GMB::ListStore::Field::getstore($field); 4183 my $self= bless Gtk2::ComboBox->new_with_model($store), $class; 4184 4185 if ($Songs::Def{$field}{icon}) 4186 { my $cell=Gtk2::CellRendererPixbuf->new; 4187 $cell->set_fixed_size( Gtk2::IconSize->lookup('menu') ); # fixed size => icon or empty space 4188 $self->pack_start($cell,0); 4189 $self->set_attributes($cell,stock_id=>1); 4190 } 4191 my $cell=Gtk2::CellRendererText->new; 4192 #$cell->set(wrap_width=>500); 4193 #$cell->set(ellipsize=>'end'); 4194 $self->pack_start($cell,1); 4195 $self->set_attributes($cell,text=>0); 4196 $self->{value}=$init; 4197 $self->update if defined $init; 4198 $self->{callback}=$callback; 4199 $self->signal_connect( changed => \&changed_cb ); 4200 ::Watch($self,"ListStore_$field",\&update); 4201 return $self; 4202} 4203 4204sub update 4205{ my $self=$_[0]; 4206 my $value= $self->{value}; 4207 return unless defined $value; 4208 my $store=$self->get_model; 4209 $self->{busy}=1; 4210 for (my $iter=$store->get_iter_first; $iter; $iter=$store->iter_next($iter)) 4211 { $self->set_active_iter($iter),last if $store->get($iter,0) eq $value; 4212 } 4213 delete $self->{busy}; 4214} 4215 4216sub changed_cb 4217{ my $self=$_[0]; 4218 return if $self->{busy}; 4219 my $store=$self->get_model; 4220 return if $store->{updating}; 4221 my $iter= $self->get_active_iter; 4222 $self->{value}= $iter ? $store->get($iter,0) : undef; 4223 if (my $cb=$self->{callback}) 4224 { $cb->( $self,$self->{value} ); 4225 } 4226} 4227 4228sub get_value { $_[0]{value}; } 4229 4230package Filter; 4231 4232my %NGrepSubs; 4233my (%CachedTime,%CachedSize,%CachedList); my $CachedTotal=0; 4234our (%InvOp,$OpRe); 4235INIT 4236{ 4237 my @Oplist= qw( =~ !~ || && > <= < >= == != eq ne !! ! 0 1 ); #negated operators for negated filters 4238 %InvOp= (@Oplist, reverse @Oplist); 4239 $OpRe=join '|',map quotemeta, keys %InvOp; 4240 $OpRe=qr/\.($OpRe)\./; 4241 %NGrepSubs= 4242 ( t => sub 4243 { my ($field,$pat,$lref,$assign,$inv)=@_; 4244 $inv=$inv ? "$pat..(($pat>@\$tmp)? 0 : \$#\$tmp)" 4245 : "0..(($pat>@\$tmp)? \$#\$tmp : ".($pat-1).')'; 4246 return "\$tmp=$lref; Songs::SortList(\$tmp, '".Songs::SortField($field)."' ); $assign @\$tmp[$inv];"; 4247 }, 4248 h => sub 4249 { my ($field,$pat,$lref,$assign,$inv)=@_; 4250 $inv=$inv ? "$pat..(($pat>@\$tmp)? 0 : \$#\$tmp)" 4251 : "0..(($pat>@\$tmp)? \$#\$tmp : ".($pat-1).')'; 4252 return "\$tmp=$lref; Songs::SortList(\$tmp, '".'-'.Songs::SortField($field)."' ); $assign @\$tmp[$inv];"; 4253 }, 4254 ); 4255} 4256 4257#Filter object contains : 4258# - string : string notation of the filter 4259# - sub : ref to a sub which takes a ref to an array of IDs as argument and returns a ref to the filtered array 4260# - greponly : set to 1 if the sub dosn't need to filter the whole list each times -> ID can be tested individualy 4261# - fields : ref to a list of the columns used by the filter 4262 4263sub new_from_string #same as ->new, but don't try to _smart_simplify, as it shouldn't be needed, and require fields to be initialized 4264{ my ($class,$string) = @_; 4265 my $self=bless {string=>$string}, $class; 4266 return $self; 4267} 4268sub save_to_string { $_[0]->{string}; } 4269 4270sub new 4271{ my ($class,$string,$source) = @_; 4272 my $self=bless {}, $class; 4273 if (!defined $string) {$string='';} 4274 elsif (ref $string && $string->isa('Filter')) {$string=$string->{string}} 4275 elsif ($string=~m/^\w+:-?~:/) { ($string)=_smart_simplify($string); } 4276 $self->{string}=$string; 4277 $self->{source}=$source; 4278 return $self; 4279} 4280 4281sub newadd 4282{ my ($class,$and,@filters)=@_; #warn "Filter::newadd(@_) called from : ".join(':',caller)."\n"; 4283 my $self=bless {}, $class; 4284 my %sel; 4285 4286 my ($ao,$re)=$and? ( '&', qr/^\(\&\x1D(.*)\)\x1D$/) 4287 : ( '|', qr/^\(\|\x1D(.*)\)\x1D$/); 4288 my @strings; 4289 my @supersets; 4290 for my $f (@filters) 4291 { $f='' unless defined $f; 4292 if (ref $f && ref $f eq 'ARRAY') #array format : first value is true(and)/false(or) followed by filters 4293 { while (ref $f) 4294 { if (@$f<2) {$f=undef;last} 4295 if (@$f==2) { $f=$f->[1] } 4296 else { $f= Filter->newadd(@$f); last } # FIXME could avoid a recursion 4297 } 4298 next unless defined $f; 4299 } 4300 $self->{source} ||= $f->{source} if ref $f; 4301 my $string=(ref $f)? $f->{string} : $f; 4302 if (!$string) 4303 { next if $and; # all and ... = ... 4304 $self->{string}=''; # all or ... = all 4305 $self->{desc}=_"All songs"; 4306 return $self; 4307 } 4308 elsif ($string eq 'null') 4309 { next if !$and; # null or ... = ... 4310 $self->{string}='null'; # null and ... = null 4311 $self->{desc}=_"No songs"; 4312 return $self; 4313 } 4314 if ($string=~s/$re/$1/) # a & (b & c) => a & b & c 4315 { my $d=0; my $str=''; 4316 for (split /\x1D/,$string) 4317 { if (m/^\(/) {$d++} 4318 elsif (m/^\)/) {$d--} 4319 elsif (!$d) {push @strings,$_;next} 4320 $str.=$_."\x1D"; 4321 unless ($d) {push @strings,$str; $str='';} 4322 } 4323 } 4324 else 4325 { if ($string=~m/^(-)?(\d+)(\D)(.*)$/) { warn "Old filter $string FIXME\n"; $string=($1||'').Songs::FieldUpgrade($2).":$3:".$4; warn " => $string\n"} #PHASE1 4326 push @strings,( ($string=~m/^\w+:-?~:/) 4327 ? _smart_simplify($string,!$and) 4328 : $string 4329 ); 4330 } 4331 if ($and) 4332 { push @supersets, $string; 4333 push @supersets, @{$f->{superset_filters}} if ref $f && $f->{superset_filters}; 4334 } 4335 } 4336 4337 @strings=_between_simplify($and,@strings); 4338 4339 my %exist; 4340 my $sum=''; my $count=0; 4341 for my $s (@strings) 4342 { $s.="\x1D" unless $s=~m/\x1D$/; 4343 next if $exist{$s}++; #remove duplicate filters 4344 $sum.=$s; $count++; 4345 } 4346 $sum="($ao\x1D$sum)\x1D" if $count>1; 4347 4348 $self->{string}=$sum; 4349 warn "Filter->newadd=".$self->{string}."\n" if $::debug; 4350 $self->{superset_filters}= \@supersets unless $sum=~m#(?:^|\x1D)\w+:-?[th]:#; #don't use superset optimization for head/tail filters, as they are not commutative 4351 return $self; 4352} 4353 4354sub null { Filter->new('null'); } 4355 4356sub new_from_smartstring 4357{ my (undef,$string,$casesens,$regexp,$fields0)=@_; 4358 $fields0 ||= 'title'; 4359 my $and= [1]; 4360 my $or= [0,$and]; 4361 my @parents; my @not; my $notgroup; 4362 while ($string=~m/\S/) 4363 { $string=~s/^\s+//; 4364 if ($string=~s#^(?:\||OR)\s+##) { push @$or, $and=[1]; next } 4365 my $not= ($string=~s/^[-!]\s*// xor $notgroup); 4366 if ($string=~s#^\(##) #open group 4367 { push @not,$notgroup; 4368 $notgroup=$not; 4369 push @parents, $or; $and=[(1 xor $not)]; 4370 $or=[(0 xor $not), $and]; 4371 next; 4372 } 4373 if ($string=~s#^\)## && @parents) #close group 4374 { my $prev= $or; 4375 $or= pop @parents; 4376 $and= $or->[-1]; 4377 push @$and, $prev; 4378 $notgroup=pop @not; 4379 next; 4380 } 4381 $string=~s/^\\(?=[-!O|\(\)])//; #un-escape escaped negative or OR or () 4382 4383 # operator and fields 4384 my ($fields,$op); 4385 if ($string=~s&^(\w+(?:\|\w+)*)?(<=|>=|[:<>=~]|#+)&&) 4386 { $fields=$1; $op=$2; 4387 if ($fields) 4388 { my @f= grep $_, map { $Songs::Aliases{$_} || $Songs::Aliases{::superlc($_)} } split(/\|/,$fields); 4389 if (@f) { $fields= join '|',@f } 4390 else { $string= $fields.$op.$string; $fields=$op=undef; } #no recognized field => treat $fields and $op as part of the pattern 4391 } 4392 $string=~s#^\\([:<>=~\#])#$1#g unless $op; #un-escape escaped operators at start of string if no recognized operator 4393 } 4394 $fields ||= $fields0; 4395 $op||= $regexp ? '~' : ':'; 4396 4397 4398 my @patterns; 4399 { if ($string=~s#^(['"])##) #pattern begins with a quote 4400 { my $quote=$1; 4401 if ($string=~s#^(.+?)(?<!\\)$quote((?<!\\)[|)]|\s+|$)##) # closing quote followed by "|", ")", space or end of string 4402 { push @patterns,$1; 4403 $string= ")".$string if $2 eq ')'; 4404 redo if $2 eq '|'; 4405 } 4406 else { push @patterns,$string; $string=''; } # quote is never closed => pretend it is closed at the end of the string 4407 } 4408 elsif ($string=~s/^(.*?)( (?<!\\)\| | # ends with | => more than one pattern 4409 (?<!\\)(?=\)[\s|)]|\)$) | # or with closing parenthese followed by space | ) or end-of-string 4410 (?<!\\)\s+ | $ # or with spaces or end-of-string 4411 )//x) 4412 { push @patterns,$1; 4413 redo if $2 eq '|'; 4414 } 4415 } 4416 s#\\([ "'|)])#$1#g for @patterns; #un-escape escaped spaces, quotes, | and ) 4417 # convert smart operator to internal operator and create filter for this level 4418 my @filters=(0 xor $notgroup); 4419 for my $field (split /\|/, $fields) 4420 { for my $pattern (@patterns) 4421 { my $filter; 4422 my $op1= $op=~m/^#/ ? '#' : $op; #special case for ## and ### : use the same function as for # 4423 if ($pattern eq '') 4424 { $filter= Songs::Field_property($field,'smartfilter:'.$op1.'empty'); #must contain operator ':' pattern 4425 } 4426 elsif (my $found= Songs::Field_property($field,'smartfilter:'.$op1)) 4427 { if (ref $found) 4428 { $filter= $found->($pattern,$op,$casesens,$field); 4429 } 4430 else 4431 { my @found=split / /,$found; 4432 my $realop= @found>1 ? $found[$casesens ? 1 : 0] : $found; 4433 $filter= $realop.':'.$pattern; 4434 } 4435 } 4436 next unless $filter; 4437 if ($not) { $filter=~s/^-// or $filter= '-'.$filter } 4438 push @filters, $field.':'.$filter; 4439 } 4440 } 4441 next unless @filters>1; 4442 push @$and, @filters>2 ? \@filters : $filters[1]; 4443 } 4444 4445 # close opened groups 4446 while (@parents) 4447 { my $prev= $or; 4448 $or= pop @parents; 4449 $and= $or->[-1]; 4450 push @$and, $prev; 4451 } 4452 return Filter->newadd(@$or); 4453} 4454sub _smartstring_number_check_unit 4455{ my ($pat,$field)=@_; 4456 return '' unless length $pat; 4457 my $opt= { @{ Songs::Field_property($field,'filterpat:value') || [] } }; 4458 my $unit= $opt->{default_unit} || ''; 4459 my $uhash= $opt->{unit}; $uhash={} unless $uhash && ref $uhash; 4460 if ($pat=~s/([a-zA-Z]+)$//) 4461 { $unit= $uhash->{$1} ? $1 : $uhash->{lc$1} ? lc$1 : $unit; 4462 } 4463 $pat=~m/^(-?\d*\.?\d+)$/; 4464 $pat= $1||0; 4465 return 0 if $pat==0; 4466 my $unit_value= $uhash->{$unit}[0]||0; 4467 return $pat.$unit, $unit_value==1; 4468} 4469sub _smartstring_round_range # turn 5m into 4.5m..5.5m or 5.2m into 5.15m..5.25m 4470{ my ($n,$u)=@_; 4471 my $l=index $n,'.'; 4472 $l= $l>0 ? length($n)-$l-1 : 0; 4473 my $delta= .5/(10**$l); 4474 return ($n-$delta).$u, ($n+$delta).$u; 4475} 4476sub _smartstring_number_moreless 4477{ my ($pat,$op,$casesens,$field)=@_; 4478 $pat=~s/,/./g; #use dot as decimal separator 4479 return undef unless $pat=~m/^-?\d*\.?\d+[a-zA-Z]?$/; 4480 ($pat)= _smartstring_number_check_unit($pat,$field); 4481 $op= $op eq '<=' ? '->' : $op eq '>=' ? '-<' : $op; 4482 return $op.':'.$pat; 4483} 4484sub _smartstring_date_moreless 4485{ my ($pat,$op,$casesens,$field)=@_; 4486 my $suffix=''; 4487 $pat=~s/,/./g; #use dot as decimal separator 4488 if ($pat=~m/\d[smhdwMy]/) { $suffix='ago' } #relative date filter 4489 else 4490 { $pat= ::dates_to_timestamps($pat, ($op eq '>' || $op eq '<=')? 1:0); 4491 } 4492 return undef unless $pat; 4493 $op= $op eq '<=' ? '<' : $op eq '>=' ? '>' : $op; 4494 return $op.$suffix.':'.$pat; 4495} 4496sub _smartstring_number 4497{ my ($pat,$op,$casesens,$field)=@_; 4498 $pat=~s/,/./g; #use dot as decimal separator 4499 if ($pat!~m#\.\.# && ($op ne '=' || $pat!~m/^-\d*\.?\d+[a-zA-Z]?$/)) {$pat=~s/-($|-|\d*\.?\d+[a-zA-Z]?$)/..$1/} # allow ranges using - unless = with negative number (could also check if field support negative values ?) 4500 if ($pat=~m/\.\./) 4501 { my ($s1,$s2)= split /\s*\.\.\s*/,$pat,2; 4502 ($_)= _smartstring_number_check_unit($_,$field) for $s1,$s2; 4503 return (length $s1 && length $s2) ? "b:$s1 $s2": 4504 (length $s1 && !length$s2) ? "-<:".$s1 : 4505 (!length$s1 && length $s2) ? "->:".$s2 : undef; 4506 } 4507 return 's:'.$pat if $op eq ':'; 4508 return undef unless $pat=~m/^-?\d*\.?\d+[a-zA-Z]?$/; 4509 ($pat,my $is_lowest_unit)= _smartstring_number_check_unit($pat,$field); 4510 if (!$is_lowest_unit and my($n,$u)= $pat=~m#^(\d*\.?\d+)([a-zA-Z]+)$#i) # =5m turned into 4.5m..5.5m 4511 { my ($n1,$n2)= _smartstring_round_range($n,$u); 4512 return "b:$n1 $n2"; 4513 } 4514 return 'e:'.$pat; 4515} 4516sub _smartstring_date 4517{ my ($pat,$op,$casesens,$field)=@_; 4518 my $suffix=''; 4519 my $date1= my $date2=''; 4520 if ($pat=~m#\d# and ($date1,$date2)= $pat=~m#^(\d*\.?\d+[smhdwMy])?(?:\.\.|-)(\d*\.?\d+[smhdwMy])?$#i) # relative date filter 4521 { $suffix='ago'; 4522 if ($date1 && $date1!~m/[1-9]/) {$date1=''} 4523 elsif ($date1 && $date2 && $date2!~m/[1-9]/) {$date2=$date1; $date1=''} 4524 $date1||=''; 4525 $date2||=''; 4526 } 4527 elsif ($op eq '=' and my($n,$u)= $pat=~m#^(\d*\.?\d+)([smhdwMy])$#i) # =5h turned into 4.5h..5.5h 4528 { $suffix='ago'; 4529 ($date1,$date2)= $u eq 's' ? ('','') : _smartstring_round_range($n,$u); 4530 } 4531 else # absolute date filter 4532 { ($date1,$date2)= ::dates_to_timestamps($pat,2); 4533 #$pat= "$date1..$date2" if $date1.$date2 ne ''; 4534 } 4535 if ($date1.$date2 ne '') 4536 { #my ($s1,$s2)= split /\s*\.\.\s*|\s*-\s*/,$pat,2; 4537 return (length $date1 && length $date2) ? "b$suffix:$date1 $date2": 4538 (length $date1 && !length$date2) ? ">$suffix:".$date1 : 4539 (!length$date1 && length $date2) ? "<$suffix:".$date2 : undef; 4540 } 4541 $op= $op eq '=' ? 'e' : $casesens ? 's' : 'si'; 4542 return $op.':'.$pat; 4543} 4544 4545sub add_possible_superset #indicate a possible superset filter that could be used for optimization when the result of $superset_candidate is cached 4546{ my $self=shift; 4547 my $arrayself= $self->to_array; 4548 my $string1= $self->{string}; 4549 return if $string1=~m#(?:^|\x1D)\w+:-?[th]:#; # ignores filters with head/tail filters 4550 for my $superset_candidate (@_) 4551 { my $string2= $superset_candidate->{string}; 4552 next if $string2=~m#(?:^|\x1D)\w+:-?[th]:#; # ignores filters with head/tail filters 4553 next if $string2 eq $string1; 4554 push @{ $self->{superset_filters} }, $string2 if _is_subset($superset_candidate->to_array, $arrayself); 4555 } 4556 #if (my $l=$self->{superset_filters}) { my $s=$self->{string}."\n"; $s.=" superset: ".$_."\n" for @$l; $s=~s/\x1D/**/g;warn $s; } #DEBUG 4557} 4558 4559sub _is_subset # returns true if $f2 must be a subset of $f1 #$f1 and $f2 must be in array form #doesn't check for head/tail filters 4560{ my ($f1,$f2)=@_; 4561 if (!ref $f1 && !ref $f2) 4562 { return 1 if $f1 eq $f2; 4563 my ($field1,$op1,$pat1)= split /:/,$f1,3; 4564 my ($field2,$op2,$pat2)= split /:/,$f2,3; 4565 return 0 if $field1 ne $field2 || $op1 ne $op2; 4566 if ($op1 eq 's'|| $op1 eq 'si') { return index($pat2,$pat1)!=-1 } # handle case-i ? 4567 elsif ($op1 eq '-s'|| $op1 eq '-si') { return index($pat1,$pat2)!=-1 } # handle case-i ? 4568 elsif ($op1 eq '>' || $op1 eq '-<') { return ($pat1."\x00".$pat2) =~m/^(-?\d*\.?\d+)(\w*)\x00(-?\d*\.?\d+)\2$/ && $3>$1 } 4569 elsif ($op1 eq '<' || $op1 eq '->') { return ($pat1."\x00".$pat2) =~m/^(-?\d*\.?\d+)(\w*)\x00(-?\d*\.?\d+)\2$/ && $3<$1 } 4570 # FIXME check these filters : b bago >ago <ago ? 4571 return 0; 4572 } 4573 4574 # at least one is an array of filters 4575 $f1= [0,$f1] unless ref$f1; 4576 $f2= [0,$f2] unless ref$f2; 4577 if ($f1->[0] && $f2->[0]) # A & B -> C & D # each from f1 must be a superset of one from f2 4578 { for my $i (1..$#$f1) 4579 { my $in_one; 4580 $in_one ||= _is_subset($f1->[$i],$f2->[$_]) for 1..$#$f2; 4581 return 0 unless $in_one; 4582 } 4583 return 1; 4584 } 4585 elsif ($f1->[0]) # A & B -> C | D # each from f2 must be a subset of in each from f1 4586 { my $not_in_one=1; 4587 for my $i (1..$#$f2) 4588 { $not_in_one ||= ! _is_subset($f1->[$_],$f2->[$i]) for 1..$#$f1; 4589 } 4590 return !$not_in_one; 4591 } 4592 elsif ($f2->[0]) # A | B -> C & D # one from f2 must be a subset of one from f1 4593 { my $in_one; 4594 for my $i (1..$#$f2) 4595 { $in_one ||= _is_subset($f1->[$_],$f2->[$i]) for 1..$#$f1; 4596 } 4597 return $in_one; 4598 } 4599 else # A | B -> C | D # each from f2 must be a subset of one from f1 4600 { for my $i (1..$#$f2) 4601 { my $in_one; 4602 $in_one ||= _is_subset($f1->[$_],$f2->[$i]) for 1..$#$f1; 4603 return 0 unless $in_one; 4604 } 4605 return 1; 4606 } 4607} 4608 4609sub to_array #returns an array form of the filter, first value of array is false for OR, true for AND 4610{ my $filter=shift; 4611 $filter= $filter->{string} if ref $filter; 4612 my $current; 4613 $current=[0] unless $filter=~m/^\(/; 4614 my @parents; 4615 for my $part (split /\x1D/,$filter) 4616 { if ($part=~m/^\(/) # '(|' or '(&' 4617 { my $and= $part eq '(&'; 4618 push @parents, $current if $current; 4619 $current=[$and]; 4620 next; 4621 } 4622 if ($part eq ')') 4623 { last unless @parents; 4624 $part=$current; 4625 $current=pop @parents; 4626 } 4627 push @$current, $part; 4628 } 4629 return $current; 4630} 4631 4632sub _combine_ranges 4633{ my ($field,$and,@segs)=@_; 4634 my $step= Songs::Field_property($field,'step') || 0; 4635 my @out; 4636 @segs= sort { $a->[0] <=> $b->[0] } @segs; 4637 my ($s1,$s2); 4638 while (@segs) 4639 { my ($s3,$s4)= @{shift @segs}; 4640 if (defined $s1 && $s3>=$s1 && $s3<=$s2+$step) 4641 { $s2=$s4 if $s2<$s4; 4642 } 4643 else { push @out, [$s1,$s2] if defined $s1; ($s1,$s2)=($s3,$s4); } 4644 } 4645 push @out, [$s1,$s2] if defined $s1; 4646 return map { "$field:".($and ? '-' : '').'b:'.$_->[0].' '.$_->[1] } @out; 4647} 4648sub _between_simplify #combine ranges of consecutive between filters into fewer ranges if possible 4649{ my ($and,@in)=@_; 4650 my @strings; 4651 my ($field,@segs); 4652 while (@in) 4653 { my $s=shift @in; 4654 if ($s=~m/^(\w+):(-?)b:(-?\d*\.?\d+) (-?\d*\.?\d+)\x1D?$/) 4655 { if (!$2 xor $and) 4656 { $field||=$1; 4657 if ($field eq $1) 4658 { push @segs, [$3,$4]; #=> combine the range 4659 next if @in; 4660 } 4661 else { unshift @in,$s; } 4662 } 4663 } 4664 if (@segs) #change of filter or no more filters => push combined range 4665 { push @strings, _combine_ranges($field,$and,@segs); 4666 @segs=(); 4667 } 4668 else { push @strings, $s; } 4669 $field=undef; 4670 } 4671 4672 s/^(\w+):(-?)b:(-?\d*\.?\d+) \3\x1D?$/"$1:$2e:$3"/e for @strings; #replace :b:5 5 by :e:5 4673 return @strings; 4674} 4675 4676sub are_equal #FIXME could try harder 4677{ my $f1=$_[0]; my $f2=$_[1]; 4678 ($f1,my$s1)=defined $f1 ? ref $f1 ? ($f1->{string},$f1->{source}) : $f1 : ''; 4679 ($f2,my$s2)=defined $f2 ? ref $f2 ? ($f2->{string},$f2->{source}) : $f2 : ''; 4680 return ($f1 eq $f2) && ((!$s1 || !$s2) || ($s1 && $s2 && $s1 eq $s2)); 4681} 4682 4683sub _smart_simplify #only called for ~ filters 4684{ my $s=$_[0]; my $returnlist=$_[1]; 4685 my ($field,$inv,$pat)= $s=~m/^(\w+):(-?)~:(.*)$/; 4686 $inv||=''; 4687 my $sub=Songs::LookupCode($field,'filter_simplify:~'); 4688 return $s unless $sub; 4689 my @pats=$sub->($pat); 4690 if ($returnlist || @pats==1) 4691 { return map "$field:$inv~:$_" , @pats; 4692 } 4693 else 4694 { return "(|\x1D".join('',map("$field:$inv~:$_\x1D", @pats)).")\x1D"; 4695 } 4696} 4697 4698sub newlock #FIXME PHASE1 remove ? use MakeFilterFromID instead 4699{ my ($class,$field,$ID)=@_; 4700 return Songs::MakeFilterFromID($field,$ID); 4701} 4702 4703sub invert 4704{ my $self=shift; 4705 $self->{'sub'}=undef; 4706 warn 'before invert : '.$self->{string} if $::debug; 4707 my @filter=split /\x1D/,$self->{string}; 4708 for (@filter) 4709 { s/^\(\&$/(|/ && next; 4710 s/^\(\|$/(&/ && next; 4711 next if $_ eq ')'; 4712 my ($field,$cmdpat)=split ':',$_,2; 4713 $cmdpat='-'.$cmdpat unless $cmdpat=~s/^-//; 4714 $_= $field.':'.$cmdpat; 4715 } 4716 $self->{string}=join "\x1D",@filter; 4717 warn 'after invert : '.$self->{string} if $::debug; 4718 return $self; 4719} 4720 4721sub filter_all 4722{ $_[0]->filter( [Songs::FIRSTID..$Songs::LastID] ); 4723} 4724 4725sub filter 4726{ my $self=$_[0]; my $listref=$_[1]; 4727 #my $time=times; #DEBUG 4728 $listref||= $self->{source} || $::Library; 4729 my $sub=$self->{'sub'} || $self->makesub; 4730 my $on_library= ($listref == $::Library && !$self->{source}); 4731 if ($self->{nocache}) { return $listref } 4732 my $already_found; 4733 if ($on_library && !$self->{nocache} && (%CachedList || %IdleFilter::InProgress)) 4734 { my $string= $self->{string}; 4735 $CachedTime{$string}=time; # the result will be cached if it is not already => update timestamp now 4736 return [unpack 'L*',$CachedList{$string}] if defined $CachedList{$string}; 4737 #warn "no exact cache for filter\n"; 4738 if (my $idlefilter= delete $IdleFilter::InProgress{$string}) 4739 { $already_found= $idlefilter->{found}; 4740 $listref= $idlefilter->{todo}; 4741 } 4742 if ($self->{superset_filters}) 4743 { my $simplified= $self->simplify_with_superset_cache; 4744 #warn "filter: todo=".(scalar @$simplified)." avoided=".(@$::Library-@$simplified)."\n" if $simplified; 4745 $listref= $simplified if $simplified; 4746 } 4747 } 4748 my $r=$sub->($listref); 4749 $r= [ @$already_found, @$r ] if $already_found; 4750 #$time=times-$time; warn "filter $time s ( ".$self->{string}." )\n" if $debug; #DEBUG 4751 if ($on_library && !$self->{nocache}) 4752 { $self->cache_result($r); 4753 } 4754 return $r; 4755} 4756sub simplify_with_superset_cache 4757{ my $self=shift; 4758 return unless $self->{superset_filters}; 4759 my @supersets= grep defined, map $CachedList{$_}, @{$self->{superset_filters}}; 4760 if (@supersets) 4761 { #warn "found supersets : ".join(',', map length $_,@supersets)."\n"; 4762 #warn " from : ".join(',', grep $CachedList{$_}, @{$self->{superset_filters}})."\n"; 4763 return [unpack 'L*',(sort { length $a <=> length $b } @supersets)[0] ]; #take the smaller set, could find the intersection instead 4764 } 4765 # no cached result for superset, look if there is an idlefilter in progress that could be used 4766 my ($idlefilter)= sort { @{$a->{todo}} + @{$a->{found}} <=> @{$b->{todo}} + @{$b->{found}} } 4767 grep defined, map $IdleFilter::InProgress{$_}, @{$self->{superset_filters}}; 4768 return [ @{$idlefilter->{todo}}, @{$idlefilter->{found}} ] if $idlefilter; 4769 return undef; 4770} 4771sub cache_result 4772{ my $string= $_[0]{string}; 4773 my $result= $_[1]; 4774 if ($CachedTotal>100) # trim the cache 4775 { my $time=time; 4776 my @del_order= sort { ($time-$CachedTime{$b})*$CachedSize{$b} <=> ($time-$CachedTime{$a})*$CachedSize{$a} } keys %CachedSize; 4777 while ($CachedTotal>70) 4778 { my $delete=shift @del_order; 4779 #warn "removing ".do {my $f=$delete; $f=~s/\x1D+//g; $f}." last used=".localtime($CachedTime{$delete})." size=".$CachedSize{$delete}." score=".(($time-$CachedTime{$delete})*$CachedSize{$delete})."\n"; 4780 delete $CachedList{$delete}; 4781 delete $CachedTime{$delete}; 4782 $CachedTotal-= delete $CachedSize{$delete}; 4783 } 4784 4785 } 4786 $CachedTotal+= $CachedSize{$string}= 1+(39*@$result/(@$::Library||1)); 4787 $CachedTime{$string}=time; # also done in filter() 4788 $CachedList{$string}= pack 'L*',@$result; 4789} 4790sub is_cached 4791{ my $self=shift; 4792 return exists $CachedList{$self->{string}} || $self->{nocache}; 4793} 4794sub clear_cache 4795{ %CachedList=%CachedTime=%CachedSize=(); 4796 $CachedTotal=0; 4797 IdleFilter::clear(); 4798} 4799 4800sub info 4801{ my $self=shift; 4802 $self->makesub unless $self->{'sub'}; 4803 return $self->{greponly}, keys %{$self->{fields}}; 4804} 4805sub added_are_in #called with $IDs of a SongsAdded event, return true if new songs may match the filter. If greponly filter, returns a ref to a list of new IDs that match, or false if none match 4806{ my ($self,$IDs)=@_; 4807 $self->makesub unless $self->{'sub'}; 4808 if ($self->{greponly}) 4809 { my $toadd=$self->filter($IDs); 4810 $toadd=0 unless @$toadd; 4811 return $toadd; 4812 } 4813 return 1; 4814} 4815sub changes_may_affect #called with $IDs and $fields of a SongsChanged event, return true if the changes might require an update. Tries harder if a songarray is specified and a greponly filter 4816{ my ($self,$IDs,$fields,$songarray)=@_; #$songarray argument is optional, currently untested 4817 $self->makesub unless $self->{'sub'}; 4818 return 0 unless grep exists $self->{fields}{$_}, @$fields; 4819 if ($songarray && $self->{greponly}) 4820 { my $before= $songarray->AreIn($IDs); 4821 my $after= $self->filter($IDs); 4822 return 1 if @$after != @$before; 4823 for my $i (0..$#$before) { return 1 if $before->[$i]!=$after->[$i]; } 4824 return 0; 4825 } 4826 return 1; 4827} 4828 4829sub _optimize_with_hashes # optimization for some special cases 4830{ my @filter=split /\x1D/,$_[0]; 4831 return ($_[0]) if @filter<3; 4832 my $hashes=$_[1] || []; 4833 my $d=0; my (@or,@val,@ilist); 4834 for my $i (0..$#filter) 4835 { my $s=$filter[$i]; 4836 if ($s=~m/^\(/) { $d++; $or[$d]=($s eq '(|')? 1 : 0; } 4837 elsif ($s eq ')') 4838 { my $vd=delete $val[$d]; 4839 my $ilist=delete $ilist[$d]; 4840 while (my ($icc,$h)=each %$vd) 4841 { next unless (keys %$h)>2; #only optimize if more than 2 keys 4842 my ($field,$inv,$cmd)=$icc=~m/^(\w+):(-?)([^:]+):$/; 4843 my ($ok,$prephash)=Songs::LookupCode($field, 'filter:h'.$cmd, 'filter_prephash:'.$cmd, [HREF=> '$_[0]']); 4844 next unless $ok; 4845 if ($prephash) 4846 { $prephash= Songs::Compile('filter_prephash:'.$cmd,"sub {$prephash}") unless ref $prephash; 4847 $h=$prephash->($h); 4848 } 4849 my $l=$ilist->{$icc}; #index list of filters to be replaced 4850 my $first=$l->[0]; my $last=$l->[-1]; 4851 if ( $last-$first==$#$l 4852 && $filter[$first-1] && $filter[$first-1]=~m/^\(/ 4853 && $filter[$last+1] eq ')' 4854 ) 4855 {push @$l,$first-1,$last+1} #add ( && ) to the removed filters if all those inside are replaced by the hash 4856 $filter[$_]=undef for @$l; #remove filters to be replaced by the hash 4857 push @$hashes,$h; 4858 $filter[$first]="$field:".$inv."h$cmd:".$#$hashes; 4859 } 4860 $d--; 4861 } 4862 elsif ( $s=~m/^(\w+):(-?)([e~]):(.*)$/ && ($or[$d] xor $2) ) 4863 { $val[$d]{"$1:$2$3:"}{$4}=undef; #add key to the hash 4864 push @{$ilist[$d]{"$1:$2$3:"}},$i; #store filter index to remove it later if it is replaced 4865 } 4866 } 4867 my $filter=join "\x1D", grep defined,@filter; #warn "$_\n" for @filter; 4868 return $filter,$hashes; 4869} 4870 4871sub singlesong_code 4872{ my ($self,$depends,$hashes)=@_; 4873 my $filter=$self->{string}; 4874 return '1' if $filter eq ''; 4875 return undef if $filter=~m#\x1D^\w+:-?[th]:#; 4876 ($filter)=_optimize_with_hashes($filter,$hashes) if $hashes; 4877 my $code=makesub_condition($filter,$depends); 4878 return $code; 4879} 4880 4881sub makesub 4882{ my $self=$_[0]; 4883 my $filter=$self->{string}; 4884 warn "makesub filter=$filter\n" if $::debug; 4885 $self->{fields}={}; 4886 if ($filter eq '') { $self->{greponly}=$self->{nocache}=1; return $self->{'sub'}=sub {$_[0]}; } 4887 elsif ($filter eq 'null') { $self->{greponly}=$self->{nocache}=1; return $self->{'sub'}=sub { []; }; } 4888 4889 ($filter,my $hashes)=_optimize_with_hashes($filter); 4890 4891 my $func; 4892 my $depends=$self->{fields}={}; 4893 if ( $filter=~m#(?:^|\x1D)\w+:-?[th]:# ) { $func=makesub_Ngrep($filter,$depends) } 4894 else 4895 { $self->{greponly}=1; 4896 $func=makesub_condition($filter,$depends); 4897 $func='[ grep {'.$func.'} @{$_[0]} ];'; 4898 } 4899 4900 my $before=''; 4901 if ($hashes) {$before.="my \$hash$_=\$hashes->[$_];" for 0..$#$hashes;} 4902 warn "filter=$filter \$sub=eval $before; sub{ $func }\n" if $::debug; 4903 my $sub=eval "$before; sub {$func}"; 4904 if ($@) { warn "filter error :\n code:\n$before; sub {$func}\n error:\n$@"; $sub=sub {$_[0]}; }; #return empty filter if compilation error 4905 return $self->{'sub'}=$sub; 4906} 4907 4908sub makesub_condition 4909{ my $filter=$_[0]; 4910 my $depends=$_[1]||{}; 4911 my $func=''; 4912 my $op=' && '; 4913 my @ops; 4914 my $first=1; 4915 for (split /\x1D/,$filter) 4916 { if (m/^\(/) 4917 { $func.=$op unless $first; 4918 $func.='('; 4919 push @ops,$op; 4920 $op=($_ eq '(|')? ' || ' : ' && '; 4921 $first=1; 4922 } 4923 elsif ($_ eq ')') { $func.=')'; $op=pop @ops; } 4924 else 4925 { my ($field,$inv,$cmd,$pat)= m/^(\w+):(-?)([^:]+):(.*)$/; 4926 $depends->{$_}=undef for Songs::Depends($field); 4927 $func.=$op unless $first; 4928 $func.= Songs::FilterCode($field,$cmd,$pat,$inv); 4929 $first=0; 4930 } 4931 } 4932 return $func; 4933} 4934sub makesub_Ngrep ## non-grep filter 4935{ my @filter= split /\x1D/,$_[0]; 4936 my $depends=$_[1]||{}; 4937 4938 { my $d=0; my $c=0; 4939 for (@filter) 4940 { if (m/^\(/) {$d++} 4941 elsif ($_ eq ')') {$d--} 4942 elsif ($d==0) {$c++} 4943 } 4944 @filter=('(',@filter,')') if $c; 4945 } 4946 my $d=0; 4947 my $func='my @hash; my @list=($_[0]); my $tmp;'; 4948 my @out=('@{$_[0]}'); my @in; my @outref; 4949 my $listref='$_[0]'; 4950 for my $f (@filter) 4951 { if ($f=~m/^[\(\)]/) 4952 { if ($f ne ')') #$f begins with '(' 4953 { $d++; 4954 $func.='@{$list['.$d.']}=@{$list['.($d-1).']};'; 4955 if ($f eq '(|') 4956 { $func.= '$hash['.$d.']={};'; 4957 $out[$d]= 'keys %{$hash['.$d.']}'; 4958 $outref[$d]='[keys %{$hash['.$d.']}]'; 4959 $in[$d]= '$hash['.$d.']{$_}=undef for '; 4960 } 4961 else # $f eq '(&' or '(' 4962 { $outref[$d]='$list['.$d.']'; 4963 $out[$d]= '@{$list['.$d.']}'; 4964 $in[$d]= '@{$list['.$d.']}='; 4965 } 4966 $listref='$list['.$d.']'; 4967 } 4968 else # $f eq ')' 4969 { $d--; if ($d<0) { warn "invalid filter\n"; return undef; } 4970 $func.=($d==0) ? 'return '.$outref[1].';' 4971 : $in[$d].$out[$d+1].';'; 4972 } 4973 } 4974 else 4975 { my ($field,$inv,$cmd,$pat)= $f=~m/^(\w+):(-?)([^:]+):(.*)$/; 4976 $depends->{$_}=undef for Songs::Depends($field); 4977 unless ($cmd) { warn "Invalid filter : $field $cmd $pat\n"; next; } 4978 if (my $sub=$NGrepSubs{$cmd}) 4979 { $func.= $NGrepSubs{$cmd}->($field,$pat,$listref,$in[$d],$inv); 4980 } 4981 else 4982 { my $c=Songs::FilterCode($field,$cmd,$pat,$inv); 4983 $func.= $in[$d].'grep( '.$c . ',@{'.$listref.'});'; 4984 } 4985 } 4986 } 4987 return $func; 4988} 4989 4990sub is_empty 4991{ my $f=$_[0]; 4992 return 1 unless defined $f; 4993 return if $f->{source}; #FIXME 4994 $f=$f->{string} if ref $f; 4995 return ($f eq ''); 4996} 4997 4998sub name 4999{ my $self=shift; 5000 my $h= $::Options{SavedFilters}; 5001 return _"All Songs" if $self->is_empty; 5002 for my $name (sort keys %$h) 5003 { return $name if $self->are_equal($h->{$name}); 5004 } 5005 return _"Unnamed filter"; 5006} 5007 5008sub explain # return a string describing the filter 5009{ my $self=shift; 5010 return $self->{desc} if $self->{desc}; 5011 my $filter=$self->{string}; 5012 return _"All" if $filter eq ''; 5013 my $text=''; my $depth=0; 5014 for my $f (split /\x1D/,$filter) 5015 { if ($f=~m/^\(/) # '(|' or '(&' 5016 { $text.=' 'x$depth++; 5017 $text.=($f eq '(|')? _"Any of :" : _"All of :"; 5018 $text.="\n"; 5019 } 5020 elsif ($f eq ')') { $depth--; } 5021 else 5022 { next if $f eq ''; 5023 $text.= ' 'x$depth; 5024 $text.= _explain_element($f) || _("Unknown filter :")." '$f'"; 5025 $text.= "\n"; 5026 } 5027 } 5028 chomp $text; #remove last "\n" 5029 return $self->{desc}=$text; 5030} 5031 5032sub _explain_element 5033{ my $filter_element=shift; 5034 my ($field,$inv,$cmd,$pattern)= $filter_element=~m/^(\w+):(-?)([^:]+):(.*)$/; 5035 return unless $cmd; 5036 my $text= Songs::Field_property($field,"filterdesc:$inv$cmd:$pattern") || Songs::Field_property($field,"filterdesc:$inv$cmd"); 5037 (undef,my $prop)= Songs::filter_properties($field,"$inv$cmd:$pattern"); 5038 return unless $prop && $text; 5039 $text=$text->[0] if ref $text; 5040 my (undef,undef,$types,%opt)=@$prop; 5041 my (@patterns,@types); 5042 if ($types) 5043 { @types=split / /,$types; 5044 @patterns= split / /,$pattern, scalar @types; 5045 push @patterns,('')x(@types-@patterns); 5046 } 5047 5048 for my $pat (@patterns) 5049 { my $type= shift @types; 5050 my $opt2= Songs::Field_property($field,'filterpat:'.$type) || []; 5051 my %opt2= (%opt, @$opt2); 5052 my $unit=$opt2{unit}; 5053 my $round=$opt2{round}; 5054 if (my $display= $opt2{display}) { $pat= $display->($pat); } 5055 elsif (($unit || $round) && $pat=~m/^(-?\d*\.?\d+)([a-zA-Z]*)$/) #numbers 5056 { my $number=$1; 5057 my $letter=$2; 5058 if (ref $unit) # \%::SIZEUNITS, \%::DATEUNITS or %::TIMEUNITS 5059 { if ($letter && $unit->{$letter}) { $unit= $unit->{$letter}[1] } 5060 else {$unit=undef} 5061 } 5062 $pat= ::format_number($number,$round); 5063 $pat.= " ".$unit if $unit; 5064 } 5065 } 5066 $text= sprintf $text, @patterns; 5067 return Songs::FieldName($field). ' '. $text; 5068} 5069 5070sub SmartTitleSimplify 5071{ my $s=$_[0]; 5072 $s=~s#(?<=.) *[\(\[].*##; #remove '(...' unless '(' is at the begining of the string 5073 my @pats=grep m/\S/, split / *\/+ */,$s; 5074 return @pats; 5075} 5076sub SmartTitleRegEx 5077{ local $_=quotemeta ::superlc($_[0]); 5078 s#\\'# ?. ?#g; #for 's == is ... 5079 s#\Bing\b#in[g']#g; 5080 s#\\ is\b#(?:'s|\\ is)#ig; 5081 s#\\ (?:and|\\&|et)\\ #\\ (?:and|\\&|et)\\ #ig; 5082 s#\\[-,.]#.?#g; 5083 s# ?\\\?# ?\\?#g; 5084 return $_; 5085} 5086sub QuoteRegEx 5087{ local $_=$_[0]; 5088 s#((?:\G|[^\\])(?:\\\\)*)([\$@](?:::?)?[0-9a-z])#$1\\$2#gi; #quote variable names if not already quoted 5089 s#^((?:.*[^\\])?(?:\\\\)*\\)$#$1\\#g; ##escape trailing '\' in impair number 5090 s!((?:\G|[^\\])(?:\\\\)*)\\?"!$1\\"!g; #make sure " are escaped (and only once, so that \\\" doesn't become \\\\") 5091 if (!eval {qr/$_/;}) { warn "invalid regular expression \"$_[0]\" : $@\n" if $::debug; return quotemeta $_[0]; } #check if re valid, else quote everything 5092 return $_; 5093} 5094 5095sub smartstring_fuzzy 5096{ my ($pat,$op,$casesens,$field)=@_; 5097 my $threshold= $pat=~s/([<>])(\d?\d)$// ? ($1 eq '>' ? $2 : int(100-100*$2/length($pat))-1) : 5098 $op eq '#' ? 80 : $op eq '##' ? 70 : 60; 5099 $threshold=20 if $threshold<20; 5100 $threshold=99 if $threshold>99; 5101 return 'fuzzy:'.$threshold.' '.$pat; 5102} 5103 5104sub _fuzzy_match 5105{ my ($min,$string1,$string2)=@_; 5106 my $length1= length $string1; 5107 return index($string2,$string1)>=0 unless $length1>1; 5108 # fast first pass by looking at how many small substrings in common 5109 if ($min>.35) 5110 { my @words; 5111 for my $l (2,3) 5112 { push @words,map substr($string1,$_,$l), 0..($length1-$l); 5113 } 5114 my $common= grep index($string2,$_)>=0, @words; 5115 return 0 unless $common/@words > ($min-.25); 5116 # the main problem of this method is that longer string2 have higher scores, dividing by string2's length is not possible if you want to search sof substrings of string2 5117 } 5118 # local levenshtein distance (much slower) 5119 # note that some strings with low enough distance might have already been discarded because they didn't have enough small substrings in common 5120 my @mat=([(0)x (1+length$string2)]); 5121 $mat[$_]=[$_] for 1..$length1; 5122 for my $j (1..length $string2) 5123 { for my $i (1..$length1) 5124 { #if (substr($string1,$i-1,1) eq substr($string2,$j-1,1)) 5125 if (substr($string1,$i-1,1) eq substr($string2,$j-1,1) || substr($string1,$i-1,1) eq "'" || substr($string2,$j-1,1) eq "'") # treat single quote as equal to any character 5126 { my $ident= $mat[$i-1][$j-1]; 5127 if ($i==$length1) { my $ins=$mat[$i][$j-1]; $ident=$ins if $ins<$ident; } 5128 $mat[$i][$j]= $ident; 5129 } 5130 else 5131 { my $del= $mat[$i-1][$j]+1; 5132 my $ins= ($i==$length1) ? $mat[$i][$j-1] : $mat[$i][$j-1]+1; 5133 my $sub= $mat[$i-1][$j-1]+1; 5134 my $min= $del<$ins ? $del : $ins; 5135 $mat[$i][$j]= $min < $sub ? $min : $sub; 5136 } 5137 } 5138 } 5139 return 1-$mat[-1][-1]/$length1 > $min; 5140} 5141 5142package IdleFilter; 5143our %InProgress; 5144 5145sub clear { %InProgress=(); } 5146 5147sub new 5148{ my ($class,$filter,$callback)=@_; 5149 $filter=Filter->new($filter) unless ref $filter; 5150 my ($greponly)= $filter->info; 5151 return 'non-grep filter' unless $greponly; 5152 my $self= bless {filter => $filter, callback=>$callback, started=>time }, $class; 5153 $self->start; 5154 return $self; 5155} 5156sub start 5157{ my $self=shift; 5158 $self->{idle_handle}=Glib::Idle->add(\&filter_some,$self,1000); # 1000 is very low priority (default is 200, Glib::G_PRIORITY_LOW is 300) 5159 $self->{count}++; 5160} 5161sub is_cached { $_[0]{filter}->is_cached; } 5162 5163sub get_progress 5164{ my $self=shift; 5165 my $filter=$self->{filter}; 5166 my $progress= $InProgress{$filter->{string}}; 5167 unless ($progress) 5168 { return 1 if $filter->is_cached; 5169 if ($self->{count}++ >5 || $self->{started}>15+time) # give up if progress reset too many times or if it has been too long 5170 { $self->abort; 5171 return 0; 5172 } 5173 my $todo; 5174 $todo= $filter->simplify_with_superset_cache if $filter->{superset_filters}; 5175 #warn "idlefilter: todo=".(scalar @$todo)." avoided=".(@$::Library-@$todo)."\n" if $todo; 5176 #warn "no cache helped\n" unless $todo; 5177 $todo ||= [@$::Library]; 5178 $progress= $InProgress{$filter->{string}}= { found=>[], todo=>$todo }; 5179 } 5180 return $progress; 5181} 5182 5183sub filter_some 5184{ my $self=shift; 5185 my $filter=$self->{filter}; 5186 my $progress= $self->get_progress; 5187 if (!$progress) { return $self->{idle_handle}=0 }# progress is 0 if given up 5188 if (ref $progress) 5189 { my $sub=$filter->{'sub'} || $filter->makesub; 5190 my $todo= $progress->{todo}; 5191 my @next= splice @$todo,0,100; 5192 push @{$progress->{found}}, @{ $sub->(\@next) }; 5193 #warn "idlefilter $self found=".scalar(@{$progress->{found}})." todo=".scalar(@$todo)."\n"; 5194 if (scalar @$todo) { return 1 } # not finished => keep idle 5195 # last batch done => put results in cache 5196 delete $InProgress{$filter->{string}}; 5197 $filter->cache_result($progress->{found}); 5198 } 5199 5200 # finished 5201 $self->{callback}->(); 5202 return $self->{idle_handle}=0; #remove idle 5203} 5204 5205sub abort 5206{ my $self=shift; 5207 $self->{aborted}=1; 5208 Glib::Source->remove(delete $self->{idle_handle}) if $self->{idle_handle}; 5209} 5210 5211package Random; 5212our %ScoreTypes; 5213 5214INIT 5215{ 5216 %ScoreTypes= 5217 ( f => 5218 { desc => _"Label is set", #depend => 'label', 5219 default=> '.5f', 5220 filter => 'label:~:', 5221 boolean=>1, 5222 }, 5223 g => 5224 { desc => _"Genre is set", #depend => 'genre', 5225 default=> '.5g', 5226 filter => 'genre:~:', 5227 boolean=>1, 5228 }, 5229 l => 5230 { depend => 'lastplay', desc => _"Number of days since last played", unit => _"days", 5231 round => '%.1f', default=> '-1l10', 5232 value => 'lastplay:daycount', 5233 time_dependant =>1, 5234 }, 5235 L => 5236 { depend => 'lastskip', desc => _"Number of days since last skipped", unit => _"days", 5237 round => '%.1f', default=> '1L10', 5238 value => 'lastskip:daycount', 5239 time_dependant =>1, 5240 }, 5241 a => 5242 { depend => 'added', desc => _"Number of days since added", unit => _"days", 5243 round => '%.1f', default=> '1a50', 5244 value => 'added:daycount', 5245 time_dependant =>1, 5246 }, 5247 M => 5248 { depend => 'modif', desc => _"Number of days since modified", unit => _"days", 5249 round => '%.1f', default=> '1M50', 5250 value => 'modif:daycount', 5251 time_dependant =>1, 5252 }, 5253 n => 5254 { depend => 'playcount', desc => _"Number of times played", unit => _"times", 5255 round => '%d', default=> '1n5', 5256 value => 'playcount:get', 5257 }, 5258 N => 5259 { depend => 'skipcount', desc => _"Number of times skipped", unit => _"times", 5260 round => '%d', default=> '-1N5', 5261 value => 'skipcount:get', 5262 }, 5263 r => 5264 { depend => 'rating', desc => _"Rating", unit => '%', 5265 round => '%d', default=> '1r0_.1_.2_.3_.4_.5_.6_.7_.8_.9_1', 5266 value => 'rating:percent', #score => sub { my ($value,$extra)=@_;my @l=split /,/,$extra; return undef unless @l==11; return '('.$extra.')[int('.$value.'/10)]' }, 5267 }, 5268 ); 5269} 5270 5271sub new 5272{ my ($class,$string,$list)=@_; 5273 my $self=bless {}, $class; 5274 $string=~s/^random://; 5275 $self->{string}=$string; 5276 $self->{lref}=$list; 5277 return $self; 5278} 5279sub OneTimeDraw 5280{ my ($class,$string,$list,$nb)=@_; 5281 $string=$string->{string} if ref $string; 5282 my $self=$class->new($string,$list); 5283 $self->Draw($nb); 5284} 5285 5286sub fields 5287{ my $self=shift; 5288 $self->make unless exists $self->{depends}; 5289 return [split / /,$self->{depends}]; 5290} 5291 5292sub make 5293{ my $self=shift; 5294 return ($self->{before},$self->{score}) if $self->{score}; 5295 $self->{hashes}=[]; 5296 my %depends; 5297 my @scores; 5298 ::setlocale(::LC_NUMERIC, 'C'); 5299 for my $s ( split /\x1D/, $self->{string} ) 5300 { my ($inverse,$weight,$type,$extra)=$s=~m/^(-?)(\d*\.?\d+)([a-zA-Z])(.*)/; 5301 next unless $type; 5302 my $score; 5303 if (my $value=$ScoreTypes{$type}{value}) 5304 { $score= Songs::Code(split(/:/,$value), ID => '$_', QVAL => quotemeta $extra); 5305 $depends{$_}=undef for Songs::Depends( $ScoreTypes{$type}{depend} ); 5306 } 5307 else 5308 { my $filter= ($ScoreTypes{$type}{filter} || '').$extra; 5309 $filter=Filter->new($filter); 5310 $score= $filter->singlesong_code(\%depends,$self->{hashes}); 5311 } 5312 $self->{time_computed}=1 if $ScoreTypes{$type}{time_dependant}; #indicate that the values must be recomputed as time pass 5313 if ($type eq 'f' || $type eq 'g') 5314 { #$score=&$score($extra); 5315 } 5316 elsif ($type eq 'r') 5317 { my @l=split /,/,$extra; 5318 next unless @l==11; 5319 $score='('.$extra.')[int('.$score.'/10)]'; 5320 } 5321 else 5322 { $inverse=!$inverse; 5323 if (my $halflife=$extra) 5324 { my $lambda=log(2)/$halflife; 5325 $score="exp(-$lambda*$score)"; 5326 } 5327 else {$score='0';} 5328 } 5329 $inverse=($inverse)? '1-':''; 5330 $score=(1-$weight).'+'.$weight.'*('.$inverse.$score.')'; 5331 push @scores,$score; 5332 } 5333 unless (@scores) { @scores=(1); } 5334 $self->{depends}=join ' ',keys %depends; 5335 $self->{before}=''; 5336 if ($self->{hashes}) { $self->{before}.="my \$hash$_=\$self->{hashes}[$_];" for 0..$#{$self->{hashes}}; } 5337 $self->{score}="\n(".join(")\n*(",@scores).')'; 5338 ::setlocale(::LC_NUMERIC, ''); 5339 return ($self->{before}, $self->{score}); 5340} 5341 5342#sub SetList 5343#{ my ($self,$list)=@_; 5344# $self->{lref}=$list; 5345# $self->{valid}=0;; 5346#} 5347 5348#returns a function, that function takes a listref of IDs as argument, and returns a hashref of groupid=>score 5349#returns nothing on error 5350sub MakeGroupScoreFunction 5351{ my ($self,$field)=@_; 5352 my ($keycode,$multi)= Songs::LookupCode($field, 'hash','hashm', [ID => '$_']); 5353 unless ($keycode || $multi) { warn "MakeGroupScoreFunction error : can't find code for field $field\n"; return } #return dummy sub ? 5354 ($keycode,my $keyafter)= split / +---- +/,$keycode||$multi,2; 5355 if ($keyafter) { warn "MakeGroupScoreFunction with field $field is not supported yet\n"; return } #return dummy sub ? 5356 my ($before,$score)=$self->make; 5357 my $calcIDscore= $multi ? 'my $IDscore='.$score.'; for my $key ('.$keycode.') {$score{$key}+=$IDscore}' : "\$score\{$keycode}+=$score;"; 5358 my $code= $before.'; sub { my %score; for (@{$_[0]}) { '.$calcIDscore.' } return \%score; }'; 5359 my $sub=eval $code; 5360 if ($@) { warn "Error in eval '$code' :\n$@"; return } 5361 return $sub; 5362} 5363 5364sub MakeScoreFunction 5365{ my $self=shift; 5366 my @Score; 5367 $self->{Slist}=\@Score; 5368 my ($before,$score)=$self->make; 5369 my $func= $before.'; sub { $Score[$_]='.$score.' for @{$_[0]}; }'; 5370 my $sub=eval $func; 5371 if ($@) { warn "Error in eval '$func' :\n$@"; $Score[$_]=1 for @{$_[0]}; } 5372 $self->{UpdateIDsScore}=$sub; 5373} 5374sub AddIDs 5375{ my $self=shift; 5376 $self->{UpdateIDsScore}(\@_) if $self->{valid}; 5377 $self->{Sum}=undef; 5378} 5379sub RmIDs 5380{ $_[0]{Sum}=undef; 5381} 5382sub Invalidate 5383{ my $self=shift; 5384 #@{ $self->{Slist} }=(); 5385 $self->{valid}=0; 5386} 5387 5388sub Draw 5389{ my ($self,$nb,$no_list)=@_; 5390 #my $time=times; 5391 #(re)compute scores if invalid or (older than 10 min and time-dependant) 5392 if (!$self->{valid} || ($self->{time_computed} && time-$self->{time_computed}>10*60)) 5393 { $self->MakeScoreFunction unless $self->{UpdateIDsScore}; 5394 $self->{UpdateIDsScore}($self->{lref}); 5395 $self->{time_computed}=time if $self->{time_computed}; 5396 $self->{valid}=1; 5397 $self->{Sum}=undef; 5398 } 5399 my $lref=$self->{lref}; 5400 my @scores=@{ $self->{Slist} }; 5401 my (@list,$sum); 5402 if ($no_list) #list of IDs that must not be picked 5403 { my %no; 5404 $no{$_}++ for @$no_list; 5405 @list=grep !$no{$_}, @$lref; 5406 $sum=0; 5407 $sum+=$scores[$_] for @list; 5408 } 5409 else 5410 { @list=@$lref; 5411 $sum=$self->{Sum}; 5412 if (!defined $sum) 5413 { $sum=0; 5414 $sum+=$scores[$_] for @$lref; 5415 $self->{Sum}=$sum; 5416 } 5417 } 5418 if ($nb) { $nb=@list if $nb>@list; } 5419 else 5420 { return () if defined $nb; 5421 $nb=@list; 5422 } 5423 my @drawn; 5424 #my $time=times; 5425 my (@chunknb,@chunksum); 5426 if ($nb>1) 5427 { my $chunk=0; my $count; 5428 my $size=int(@list/60); $size=15 if $size<15; 5429 for my $id (@list) 5430 { $chunksum[$chunk]+=$scores[$id]; 5431 $chunknb[$chunk]++; 5432 $count||=$size; 5433 $chunk++ unless --$count; 5434 } 5435 } 5436 else { $chunksum[0]=$sum; $chunknb[0]=@list; } 5437 #warn "\@chunknb=@chunknb\n" if $::debug; 5438 #warn "\@chunksum=@chunksum\n" if $::debug; 5439 NEXTDRAW:while ($nb>0) 5440 { last unless $sum>0; 5441 my $r=rand $sum; my $savedr=$r; 5442 my $start=my $chunk=0; 5443 until ($chunksum[$chunk]>$r) 5444 { $start+=$chunknb[$chunk]; 5445 $r-=$chunksum[$chunk++]; 5446 #warn "no more chunks : savedr=$savedr r=$r chunk=$chunk" if $chunk>$#chunksum; 5447 last NEXTDRAW if $chunk>$#chunksum;#FIXME rounding error 5448 } 5449 for my $i ($start..$start+$chunknb[$chunk]-1) 5450 { next if ($r-=$scores[$list[$i]])>0; 5451 $nb--; 5452 my $id=splice @list,$i,1; 5453 push @drawn,$id; 5454 $sum-=$scores[$id]; 5455 if (--$chunknb[$chunk]) { $chunksum[$chunk]-=$scores[$id]; } 5456 else 5457 { splice @chunknb,$chunk,1; 5458 splice @chunksum,$chunk,1; 5459 } 5460 next NEXTDRAW; 5461 } 5462 #warn $r; warn $nb; 5463 last; 5464 } 5465 #warn "drawing took ".(times-$time)." s\n" if $::debug; 5466 5467 if ($nb && @list) #if still need more -> select at random (no weights) 5468 { $nb=@list if $nb>@list; 5469 my @rand; push @rand,rand for @list; 5470 push @drawn,map $list[$_], (sort { $rand[$a] <=> $rand[$b] } 0..$#list)[0..$nb-1]; 5471 } 5472 return @drawn; 5473} 5474 5475sub MakeTab 5476{ my ($self,$nbcols)=@_; 5477 my ($before,$score)=$self->make; 5478 my $func= $before.'my $sum;my @tab=(0)x'.$nbcols.'; for (@$::ListPlay) { $sum+=my $s='.$score.'; $tab[int(.5+'.($nbcols-1).'*$s)]++;}; return \@tab,$sum;'; 5479 my ($tab,$sum)=eval $func; 5480 if ($@) 5481 { warn "Error in eval '$func' :\n$@"; 5482 $tab=[(0)x$nbcols]; $sum=@$::ListPlay; 5483 } 5484 return $tab,$sum; 5485} 5486 5487sub CalcScore 5488{ my ($self,$ID)=@_; 5489 my ($before,$score)=$self->make; 5490 local $_=$ID; #ID needs to be in $_ for eval 5491 eval $before.$score; 5492} 5493 5494sub MakeExample 5495{ my ($class,$string,$ID)=@_; 5496 ::setlocale(::LC_NUMERIC, 'C'); 5497 my ($inverse,$weight,$type,$extra)=$string=~m/^(-?)(\d*\.?\d+)([a-zA-Z])(.*)/; 5498 return 'error' unless $type; 5499 my $round=$ScoreTypes{$type}{round}||'%s'; 5500 my $unit= $ScoreTypes{$type}{unit}||''; 5501 my $value=$ScoreTypes{$type}{value}; 5502 if ($value) { $value= Songs::Code(split(/:/,$value), ID => '$_', QVAL => quotemeta $extra); } 5503 else 5504 { my $filter= ($ScoreTypes{$type}{filter} || '').$extra; 5505 $filter=Filter->new($filter); 5506 $value= $filter->singlesong_code(); 5507 } 5508 my $score; 5509 if ($ScoreTypes{$type}{boolean}) 5510 { $score=$value; 5511 $value="($score)? '"._("true")."' : '"._("false")."'"; 5512 } 5513 elsif ($type eq 'r') 5514 { my @l=split /,/,$extra; 5515 return 'error' unless @l==11; 5516 $score='('.$extra.')[int('.$value.'/10)]'; 5517 } 5518 else 5519 { $inverse=!$inverse; 5520 if (my $halflife=$extra) 5521 { my $lambda=log(2)/$halflife; 5522 $score="exp(-$lambda*$value)"; 5523 } 5524 else {$score='0';} 5525 } 5526 $inverse=($inverse)? '1-':''; 5527 $score=(1-$weight).'+'.$weight.'*('.$inverse.$score.')'; 5528 ::setlocale(::LC_NUMERIC, ''); 5529 my $func='return (('.$value.'),('.$score.'));'; 5530 local $_=$ID; #ID needs to be in $_ for eval 5531 my ($v,$s)=eval $func; 5532 return 'error' if $@; 5533 my $string_value= $ScoreTypes{$type}{boolean} ? $v : ::format_number($v,$round)." $unit"; 5534 my $string_score= ::format_number($s,'%.2f'); 5535 return "$string_value -> $string_score"; 5536} 5537 5538 55391; 5540