Permalink
Fetching contributors…
Cannot retrieve contributors at this time
executable file 10199 lines (9558 sloc) 361 KB
#!/usr/bin/perl
# Copyright (C) 2005-2015 Quentin Sculo <squentin@free.fr>
#
# This file is part of Gmusicbrowser.
# Gmusicbrowser is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 3, as
# published by the Free Software Foundation
#
# Gmusicbrowser is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use warnings;
use utf8;
binmode STDERR,':utf8';
binmode STDOUT,':utf8';
package main;
use Gtk2 '-init';
use Glib qw/filename_from_unicode filename_to_unicode/;
use Gtk2::Pango; #for PANGO_WEIGHT_BOLD, PANGO_WEIGHT_NORMAL
use POSIX qw/setlocale LC_NUMERIC LC_MESSAGES LC_TIME strftime mktime getcwd _exit/;
use Encode qw/_utf8_on _utf8_off/;
{no warnings 'redefine'; #some work arounds for old versions of perl-Gtk2 and/or gtk2
*filename_to_utf8displayname=\&Glib::filename_display_name if *Glib::filename_display_name{CODE};
*PangoEsc=\&Glib::Markup::escape_text if *Glib::Markup::escape_text{CODE}; #needs perl-Gtk2 version >=1.092
*Gtk2::Notebook::set_tab_reorderable= sub {} unless *Gtk2::Notebook::set_tab_reorderable{CODE};
*Gtk2::AboutDialog::set_url_hook= sub {} unless *Gtk2::AboutDialog::set_url_hook{CODE}; #for perl-Gtk2 version <1.080~1.083
*Gtk2::Label::set_ellipsize= sub {} unless *Gtk2::Label::set_ellipsize{CODE}; #for perl-Gtk2 version <1.080~1.083
*Gtk2::Pango::Layout::set_height= sub {} unless *Gtk2::Pango::Layout::set_height{CODE}; #for perl-Gtk2 version <1.180 pango <1.20
*Gtk2::Label::set_line_wrap_mode= sub {} unless *Gtk2::Label::set_line_wrap_mode{CODE}; #for gtk2 version <2.9 or perl-Gtk2 <1.131
*Gtk2::Scale::add_mark= sub {} unless *Gtk2::Scale::add_mark{CODE}; #for gtk2 version <2.16 or perl-Gtk2 <1.230
*Gtk2::ImageMenuItem::set_always_show_image= sub {} unless *Gtk2::ImageMenuItem::set_always_show_image{CODE};#for gtk2 version <2.16 or perl-Gtk2 <1.230
*Gtk2::Widget::set_visible= sub { my ($w,$v)=@_; if ($v) {$w->show} else {$w->hide} } unless *Gtk2::Widget::set_visible{CODE}; #for gtk2 version <2.18 or perl-Gtk2 <1.231
unless (*Gtk2::Widget::set_tooltip_text{CODE}) #for Gtk2 version <2.12
{ my $Tooltips=Gtk2::Tooltips->new;
*Gtk2::Widget::set_tooltip_text= sub { $Tooltips->set_tip($_[0],$_[1]); };
*Gtk2::Widget::set_tooltip_markup= sub { my $markup=$_[1]; $markup=~s/<[^>]*>//g; ;$Tooltips->set_tip($_[0],$markup); }; #remove markup
*Gtk2::ToolItem::set_tooltip_text= sub { $_[0]->set_tooltip($Tooltips,$_[1],''); };
*Gtk2::ToolItem::set_tooltip_markup= sub { my $markup=$_[1]; $markup=~s/<[^>]*>//g; $_[0]->set_tooltip($Tooltips,$markup,''); };
}
my $set_clip_rectangle_orig=\&Gtk2::Gdk::GC::set_clip_rectangle;
*Gtk2::Gdk::GC::set_clip_rectangle=sub { &$set_clip_rectangle_orig if $_[1]; } if $Gtk2::VERSION <1.102; #work-around $rect can't be undef in old bindings versions
if (eval($POSIX::VERSION)<1.18) #previously, date strings returned by strftime needed to be decoded by the locale encoding
{ my ($encoding)= setlocale(LC_TIME)=~m#\.([^@]+)#;
$encoding='cp'.$encoding if $^O eq 'MSWin32' && $encoding=~m/^\d+$/;
if (!Encode::resolve_alias($encoding)) {warn "Can't find dates encoding used for dates, (LC_TIME=".setlocale(LC_TIME)."), dates may have wrong encoding\n";$encoding=undef}
*strftime_utf8= sub { $encoding ? Encode::decode($encoding, &strftime) : &strftime; };
}
}
use List::Util qw/min max sum first/;
use File::Copy;
use Fcntl qw/O_NONBLOCK O_WRONLY O_RDWR SEEK_SET/;
use Scalar::Util qw/blessed weaken refaddr/;
use Unicode::Normalize 'NFKD'; #for accent-insensitive sort and search, only used via superlc()
use Carp;
$SIG{INT} = \&Carp::confess;
#use constant SLASH => ($^O eq 'MSWin32')? '\\' : '/';
use constant SLASH => '/'; #gtk file chooser use '/' in win32 and perl accepts both '/' and '\'
# Find dir containing other files (*.pm & pix/) -> $DATADIR
use FindBin;
our $DATADIR;
BEGIN
{ my @dirs=( $FindBin::RealBin,
join (SLASH,$FindBin::RealBin,'..','share','gmusicbrowser') #FIXME remove, all perl files will be in $FindBin::RealBin, gmusicbrowser.pl symlinked to /usr/bin/gmusibrowser
);
($DATADIR)=grep -e $_.SLASH.'gmusicbrowser_layout.pm', @dirs;
die "Can't find folder containing data files, looked in @dirs\n" unless $DATADIR;
}
use lib $DATADIR;
use constant
{
TRUE => 1,
FALSE => 0,
VERSION => '1.101502',
VERSIONSTRING => '1.1.15.2',
PIXPATH => $DATADIR.SLASH.'pix'.SLASH,
PROGRAM_NAME => 'gmusicbrowser',
DRAG_STRING => 0, DRAG_USTRING => 1, DRAG_FILE => 2,
DRAG_ID => 3, DRAG_ARTIST => 4, DRAG_ALBUM => 5,
DRAG_FILTER => 6, DRAG_MARKUP => 7,
PI => 4 * atan2(1, 1), #needed for cairo rotation functions
KB => 1000, #1024 # bytes in a KB
};
use constant MB => KB()**2;
sub _ ($) {$_[0]} #dummy translation functions
sub _p ($$) {_($_[1])}
sub __ { sprintf( ($_[2]>1 ? $_[1] : $_[0]), $_[2]); }
sub __p {shift;&__}
sub __np {shift;&__n}
sub __n { replace_fnumber( ($_[2]>1 ? $_[1] : $_[0]), $_[2]); }
sub __x { my ($s,%h)=@_; $s=~s/{(\w+)}/$h{$1}/g; $s; }
sub replace_fnumber { my $s=$_[0]; use locale; $s=~s/%d/format_number($_[1])/e; $s } #replace %d by the formated number, could use sprintf($_[0],$_[1]) instead but would require changing %d to %s
BEGIN
{no warnings 'redefine';
my $localedir=$DATADIR;
$localedir= $FindBin::RealBin.SLASH.'..'.SLASH.'share' unless -d $localedir.SLASH.'locale';
$localedir.=SLASH.'locale';
my $domain='gmusicbrowser';
eval {require Locale::Messages;};
if ($@)
{ eval {require Locale::gettext};
if ($@) { warn "neither Locale::Messages, nor Locale::gettext found -> no translations\n"; }
elsif ($Locale::gettext::VERSION<1.04) { warn "Needs at least version 1.04 of Locale::gettext, v$Locale::gettext::VERSION found -> no translations\n" }
else
{ warn "Locale::Messages not found, using Locale::gettext instead\n" if $::debug;
my $d= eval { Locale::gettext->domain($domain); };
if ($@) { warn "Locale::gettext error : $@\n -> no translations\n"; }
else
{ $d->dir($localedir);
*_=sub ($) { $d->get($_[0]); };
*__=sub { sprintf $d->nget(@_),$_[2]; };
*__n=sub { replace_fnumber($d->nget(@_),$_[2]); };
}
}
}
else
{ Locale::Messages::textdomain($domain);
Locale::Messages::bindtextdomain($domain=> $localedir);
Locale::Messages::bind_textdomain_codeset($domain=> 'utf-8');
Locale::Messages::bind_textdomain_filter($domain=> \&Locale::Messages::turn_utf_8_on);
*_ = \&Locale::Messages::gettext;
*_p = \&Locale::Messages::pgettext;
*__ =sub { sprintf Locale::Messages::ngettext(@_),$_[2]; };
*__p=sub { sprintf Locale::Messages::npgettext(@_),$_[3];};
*__n =sub { replace_fnumber( Locale::Messages::ngettext(@_),$_[2] );};
*__np=sub { replace_fnumber( Locale::Messages::npgettext(@_),$_[3]);};
}
}
my $thousandsep;
BEGIN { $thousandsep= POSIX::localeconv()->{thousands_sep}; }
sub format_number
{ my ($d,$f)=@_;
use locale;
$d= $f ? sprintf($f,$d) : ''.($d+0); # ''.($d+0) to force stringification of the number with the locale
return $d unless $d=~s/^(-?\d{4,})//; # $d now contains the fractional part
my $i=$1; # integer part
$i =~ s/(?<=\d)(?=(?:\d\d\d)+\b)/$thousandsep/g;
return $i.$d;
}
our $QSLASH; #quoted SLASH for use in regex
# %html_entities and decode_html() are only used if HTML::Entities is not found
my %html_entities=
( amp => '&', 'lt' => '<', 'gt' => '>', quot => '"', apos => "'",
raquo => '»', copy => '©', middot => '·',
acirc => 'â', eacute => 'é', egrave => 'è', ecirc => 'ê',
agrave=> 'à', ccedil => 'ç',
);
sub decode_html
{ my $s=shift;
$s=~s/&(?:#(\d+)|#x([0-9A-F]+)|([a-z]+));/$1 ? chr($1) : $2 ? chr(hex $2) : $html_entities{$3}||'?'/egi;
return $s;
}
BEGIN
{ no warnings 'redefine';
eval {require HTML::Entities};
*decode_html= \&HTML::Entities::decode_entities unless $@;
$QSLASH=quotemeta SLASH;
}
sub file_name_is_absolute
{ my $path=shift;
$^O eq 'MSWin32' ? $path=~m#^\w:$QSLASH#o : $path=~m#^$QSLASH#o;
}
sub rel2abs
{ my ($path,$base)=@_;
return $path if file_name_is_absolute($path);
$base||= POSIX::getcwd;
return catfile($base,$path);
}
sub catfile
{ my $path=join SLASH,@_;
$path=~s#$QSLASH{2,}#SLASH#goe;
return $path;
}
sub pathslash
{ #return catfile($_[0],'');
my $path=shift;
$path.=SLASH unless $path=~m/$QSLASH$/o;
return $path;
}
sub simplify_path
{ my ($path,$end_with_slash)=@_;
1 while $path=~s#$QSLASH+[^$QSLASH]+$QSLASH\.\.(?:$QSLASH+|$)#SLASH#oe;
return cleanpath($path,$end_with_slash);
}
sub cleanpath #remove repeated slashes, /./, and make sure it (does or doesn't) end with a slash
{ my ($path,$end_with_slash)=@_;
$path=~s#$QSLASH\.$QSLASH#SLASH#goe;
$path=~s#$QSLASH{2,}#SLASH#goe;
$path=~s#$QSLASH$##o;
$path.=SLASH if $end_with_slash || $path!~m#$QSLASH#o; # $end_with_slash or root folder
return $path;
}
sub splitpath
{ my $path=shift;
my $file= $path=~s#$QSLASH+([^$QSLASH]+)$##o ? $1 : '';
$path.=SLASH unless $path=~m#$QSLASH#o; #root folder
return $path,$file;
}
sub dirname
{ (&splitpath)[0];
}
sub parentdir
{ my $path=shift;
$path=~s#$QSLASH+$##o;
return $path=~m#$QSLASH#o ? dirname($path) : undef;
}
sub basename
{ my $file=shift;
return $file=~m#([^$QSLASH]+)$#o ? $1 : '';
}
sub barename #filename without extension
{ my $file=&basename;
my $ext= $file=~s#\.([^.]*)$##o ? $1 : '';
return wantarray ? ($file,$ext) : $file;
}
our %Alias_ext; #define alternate file extensions (ie: .ogg files treated as .oga files)
INIT {%Alias_ext=(mp2=>'mp3', ogg=> 'oga', m4b=>'m4a');} #needs to be in a INIT block because used in a INIT block in gmusicbrowser_tags.pm
our @ScanExt= qw/mp3 mp2 ogg oga flac mpc ape wv m4a m4b/;
our ($Verbose,$debug);
our %CmdLine;
our ($HomeDir,$SaveFile,$FIFOFile,$ImportFile,$DBus_id,$DBus_suffix);
our $TempDir;
sub find_gmbrc_file { my @f= map $_[0].$_, '','.gz','.xz'; return wantarray ? (grep { -e $_ } @f) : first { -e $_ } @f }
my $gmbrc_ext_re= qr/\.gz$|\.xz$/;
# Parse command line
BEGIN # in a BEGIN block so that commands for a running instance are sent sooner/faster
{ $DBus_id='org.gmusicbrowser'; $DBus_suffix='';
my $default_home= Glib::get_user_config_dir.SLASH.'gmusicbrowser';
if (!-d $default_home && -d (my $old= Glib::get_home_dir.SLASH.'.gmusicbrowser' ) )
{ warn "Using folder $old for configuration, you could move it to $default_home to conform to the XDG Base Directory Specification\n";
$default_home=$old;
}
my $help=PROGRAM_NAME.' v'.VERSIONSTRING." (c)2005-2015 Quentin Sculo
options :
-nocheck: don't check for updated/deleted songs on startup
-noscan : don't scan folders for songs on startup
-demo : don't save settings/tags on exit
-ro : prevent modifying/renaming/deleting song files
-rotags : prevent modifying tags of music files
-play : start playing on startup
-gst0 : prefer gstreamer-0.10 over gstreamer-1.x if both are available
-nogst : do not load any gstreamer librairies
-server : send playing song to connected icecast clent
-port N : listen for connection on port N in icecast server mode
-verbose: print some info, like the file being played
-debug : print lots of mostly useless informations, implies -verbose
-backtrace : print a backtrace for every warning
-nodbus : do not provide DBus services
-dbus-id KEY : append .KEY to the DBus service id used by gmusicbrowser (org.gmusicbrowser)
-nofifo : do not create/use named pipe
-F FIFO, -fifo FILE : use FIFO as named pipe to receive commands (instead of 'gmusicbrowser.fifo' in default folder)
-C FILE, -cfg FILE : use FILE as configuration file (instead of 'gmbrc' in default folder),
if FILE is a folder, sets the default folder to FILE.
-l NAME, -layout NAME : Use layout NAME for player window
+plugin NAME : Enable plugin NAME
-plugin NAME : Disable plugin NAME
-noplugins : Disable all plugins
-searchpath FOLDER : Additional FOLDER to look for plugins and layouts
-use-gnome-session : Use gnome libraries to save tags/settings on session logout
-workspace N : move initial window to workspace N (requires Gnome2::Wnck)
-gzip : force not compressing gmbrc
+gzip : force compressing gmbrc with gzip
+xz : force compressing gmbrc with xz
-cmd CMD : add CMD to the list of commands to execute
-ifnotrunning MODE : change behavior when no running gmusicbrowser instance is found
MODE can be one of :
* normal (default) : launch a new instance and execute commands
* nocmd : launch a new instance but discard commands
* abort : do nothing
-nolaunch : same as : -ifnotrunning abort
Running instances of gmusicbrowser are detected via the fifo or via DBus.
To run more than one instance, use a unique fifo and a unique DBus-id, or deactivate them.
Options to change what is done with files/folders passed as arguments (done in running gmusicbrowser if there is one) :
-playlist : Set them as playlist (default)
-enqueue : Enqueue them
-addplaylist : Add them to the playlist
-insertplaylist : Insert them in the playlist after current song
-add : Add them to the library
-tagedit FOLDER_OR_FILE ... : Edittag mode
-listplugin : list the available plugins and exit
-listcmd : list the available fifo commands and exit
-listlayout : list the available layouts and exit
";
unshift @ARGV,'-tagedit' if $0=~m/tagedit/;
my (@files,$filescmd,@cmd,$ignore);
my $ifnotrunning='normal';
while (defined (my $arg=shift))
{ if ($arg eq '-c' || $arg eq '-nocheck') {$CmdLine{nocheck}=1}
elsif($arg eq '-s' || $arg eq '-noscan') {$CmdLine{noscan}=1}
elsif($arg eq '-demo') {$CmdLine{demo}=1}
elsif($arg eq '-play') {$CmdLine{play}=1}
elsif($arg eq '-hide') {$CmdLine{hide}=1}
elsif($arg eq '-server') {$CmdLine{server}=1}
elsif($arg eq '-nodbus') {$CmdLine{noDBus}=1}
elsif($arg eq '-nogst') {$CmdLine{nogst}=1}
elsif($arg eq '-gst0') {$CmdLine{gst0}=1} #prefer gstreamer-0.10
elsif($arg eq '-ro') {$CmdLine{ro}=$CmdLine{rotags}=1}
elsif($arg eq '-rotags') {$CmdLine{rotags}=1}
elsif($arg eq '-port') {$CmdLine{port}=shift if $ARGV[0]}
elsif($arg eq '-verbose') {$Verbose=1}
elsif($arg eq '-debug') {$debug=$Verbose=4}
elsif($arg eq '-backtrace') { $SIG{ __WARN__ } = \&Carp::cluck; $SIG{ __DIE__ } = \&Carp::confess; }
elsif($arg eq '-nofifo') {$FIFOFile=''}
elsif($arg eq '-workspace') {$CmdLine{workspace}=shift if defined $ARGV[0]} #requires Gnome2::Wnck
elsif($arg eq '-C' || $arg eq '-cfg') {$CmdLine{savefile}=shift if $ARGV[0]}
elsif($arg eq '-F' || $arg eq '-fifo') {$FIFOFile=rel2abs(shift) if $ARGV[0]}
elsif($arg eq '-l' || $arg eq '-layout') {$CmdLine{layout}=shift if $ARGV[0]}
elsif($arg eq '-import') { $ImportFile=rel2abs(shift) if $ARGV[0]}
elsif($arg eq '-searchpath') { push @{ $CmdLine{searchpath} },shift if $ARGV[0]}
elsif($arg=~m/^([+-])plugin$/) { $CmdLine{plugins}{shift @ARGV}=($1 eq '+') if $ARGV[0]}
elsif($arg eq '-noplugins') { $CmdLine{noplugins}=1; delete $CmdLine{plugins}; }
elsif($arg=~m/^([+-])gzip$/) { $CmdLine{gzip}= $1 eq '+' ? 'gzip':''}
elsif($arg=~m/^([+-])xz$/) { $CmdLine{gzip}= $1 eq '+' ? 'xz':''}
elsif($arg eq '-geometry') { $CmdLine{geometry}=shift if $ARGV[0]; }
elsif($arg eq '-tagedit') { $CmdLine{tagedit}=1; $ignore=1; last; }
elsif($arg eq '-listplugin') { $CmdLine{pluginlist}=1; $ignore=1; last; }
elsif($arg eq '-listcmd') { $CmdLine{cmdlist}=1; $ignore=1; last; }
elsif($arg eq '-listlayout') { $CmdLine{layoutlist}=1; $ignore=1; last; }
elsif($arg eq '-cmd') { push @cmd, shift if $ARGV[0]; }
elsif($arg eq '-ifnotrunning') { $ifnotrunning=shift if $ARGV[0]; }
elsif($arg eq '-nolaunch') { $ifnotrunning='abort'; }
elsif($arg eq '-dbus-id') { if (my $id=shift) { if ($id=~m/^\w+$/) { $DBus_id.= $DBus_suffix='.'.$id; } else { warn "invalid dbus-id '$id', only letters, numbers and _ allowed\n" }; } }
elsif($arg eq '-add') { $filescmd='AddToLibrary'; }
elsif($arg eq '-playlist') { $filescmd='OpenFiles'; }
elsif($arg eq '-enqueue') { $filescmd='EnqueueFiles'; }
elsif($arg eq '-addplaylist') { $filescmd='AddFilesToPlaylist'; }
elsif($arg eq '-insertplaylist'){ $filescmd='InsertFilesInPlaylist'; }
elsif($arg eq '-use-gnome-session'){ $CmdLine{UseGnomeSession}=1; }
elsif($arg=~m#^http://# || -e $arg) { push @files,$arg }
else
{ warn "unknown option '$arg'\n" unless $arg=~/^--?h(elp)?$/;
print $help;
exit;
}
}
# determine $HomeDir $SaveFile $ImportFile and $FIFOFile
my $save= delete $CmdLine{savefile};
if (defined $save)
{ my $isdir= $save=~m#/$#; ## $save is considered a folder if ends with a "/"
$save= rel2abs($save);
if (-d $save || $isdir) { $HomeDir = $save; }
else { $SaveFile= $save; }
}
warn "using '$HomeDir' folder for saving/setting folder instead of '$default_home'\n" if $debug && $HomeDir;
$HomeDir= pathslash(cleanpath($HomeDir || $default_home)); # $HomeDir must end with a slash
if (!-d $HomeDir)
{ warn "Creating folder $HomeDir\n";
my $current='';
for my $dir (split /$QSLASH/o,$HomeDir)
{ $current.=SLASH.$dir;
next if -d $current;
die "Can't create folder $HomeDir : $!\n" unless mkdir $current;
}
}
# auto import from old v1.0 tags file if using default savefile, it doesn't exist and old tags file exists
if (!$SaveFile && !find_gmbrc_file($HomeDir.'gmbrc') && -e $HomeDir.'tags') { $ImportFile||=$HomeDir.'tags'; }
$SaveFile||= $HomeDir.'gmbrc';
$FIFOFile= $HomeDir.'gmusicbrowser.fifo' if !defined $FIFOFile && $^O ne 'MSWin32';
unless ($ignore)
{ # filenames given in the command line
if (@files)
{ for my $f (@files)
{ unless ($f=~m#^http://#)
{ $f=rel2abs($f);
$f=~s/([^A-Za-z0-9])/sprintf('%%%02X', ord($1))/seg; #FIXME use url_escapeall, but not yet defined
}
}
$filescmd ||= 'OpenFiles';
my $cmd="$filescmd(@files)";
push @cmd, $cmd;
}
#check if there is an instance already running
my $running;
if ($FIFOFile && -p $FIFOFile)
{ my @c= @cmd ? @cmd : ('Show'); #fallback to "Show" command
my $ok=sysopen my$fifofh,$FIFOFile, O_NONBLOCK | O_WRONLY;
if ($ok)
{ print $fifofh "$_\n" and $running=1 for @c;
close $fifofh;
$running&&= "using '$FIFOFile'";
}
else {warn "Found orphaned fifo '$FIFOFile' : previous session wasn't closed properly\n"}
}
if (!$running && !$CmdLine{noDBus})
{ eval {require 'gmusicbrowser_dbus.pm'}
|| warn "Error loading gmusicbrowser_dbus.pm :\n$@ => controlling gmusicbrowser through DBus won't be possible.\n\n";
my $object= GMB::DBus::simple_call("$DBus_id org.gmusicbrowser/org/gmusicbrowser");
if ($object)
{ $object->RunCommand($_) for @cmd;
$running="using DBus id=$DBus_id";
}
}
if ($running)
{ warn "Found a running instance ($running)\n";
exit;
}
else
{ exit if $ifnotrunning eq 'abort';
@cmd=() if $ifnotrunning eq 'nocmd';
}
$CmdLine{runcmd}=\@cmd if @cmd;
}
}
# end of command line handling
our $HTTP_module;
our ($Play_package,%PlayPacks); my ($PlayNext_package,$Vol_package);
BEGIN{
require 'gmusicbrowser_songs.pm';
require 'gmusicbrowser_tags.pm';
require 'gmusicbrowser_layout.pm';
require 'gmusicbrowser_list.pm';
$HTTP_module= -e $DATADIR.SLASH.'simple_http_wget.pm' && (grep -x $_.SLASH.'wget', split /:/, $ENV{PATH}) ? 'simple_http_wget.pm' :
-e $DATADIR.SLASH.'simple_http_AE.pm' && (grep -f $_.SLASH.'AnyEvent'.SLASH.'HTTP.pm', @INC) ? 'simple_http_AE.pm' :
'simple_http.pm';
#warn "using $HTTP_module for http requests\n";
#require $HTTP_module;
# load gstreamer backend module
if (!$CmdLine{nogst})
{ my @gst= ('gmusicbrowser_gstreamer-1.x.pm', 'gmusicbrowser_gstreamer-0.10.pm');
my $error;
@gst= reverse @gst if $CmdLine{gst0};
{ my $file= shift @gst;
eval { require $file; }; #each file sets $::PlayPacks{PACKAGENAME} to 1 for each of its included playback packages
if ($@)
{ warn $@ if $::debug;
if (@gst) {$error=$@; redo unless $::gstreamer_version} # keep first error message, try next file unless parts already loaded
$error=~s/\n.*//s; #only keep first line, others are noise
my $error0= "Can't load either gstreamer-1.x (via Glib::Object::Introspection) or gstreamer-0.10 (via GStreamer)";
if (@gst) { $error0= "Error loading gstreamer-$::gstreamer_version" }
warn "\n$error0 -> gstreamer output won't be available :\n $error\n\n";
}
warn "Using gstreamer-.$::gstreamer_version.\n" if $::debug;
}
}
# load non-gstreamer backend modules
for my $file (qw/gmusicbrowser_123.pm gmusicbrowser_mplayer.pm gmusicbrowser_mpv.pm gmusicbrowser_server.pm/)
{ eval { require $file } || warn $@; #each file sets $::PlayPacks{PACKAGENAME} to 1 for each of its included playback packages
}
$TempDir= Glib::get_tmp_dir.SLASH; _utf8_off($TempDir); #turn utf8 flag off to not auto-utf8-upgrade other filenames in the same strings
}
our $CairoOK;
my ($UseGtk2StatusIcon,$TrayIconAvailable);
BEGIN
{ if (*Gtk2::StatusIcon::set_has_tooltip{CODE}) { $TrayIconAvailable= $UseGtk2StatusIcon= 1; }
else
{ eval { require Gtk2::TrayIcon; $TrayIconAvailable=1; };
if ($@) { warn "Gtk2::TrayIcon not found -> tray icon won't be available\n"; }
}
eval { require Cairo; $CairoOK=1; };
if ($@) { warn "Cairo perl module not found -> transparent windows and other effects won't be available\n"; }
}
our $Image_ext_re; # = qr/\.(?:jpe?g|png|gif|bmp)$/i;
BEGIN
{ my $re=join '|', sort map @{$_->{extensions}}, Gtk2::Gdk::Pixbuf->get_formats;
$Image_ext_re=qr/\.(?:$re)$/i;
}
our $EmbImage_ext_re= qr/\.(?:mp3|flac|m4a|m4b|ogg|oga)/i; # warning: doesn't force end of string (with a "$") as sometimes needs to include/extract a :\w+ at the end, so need to use it with /$EmbImage_ext_re$/ or /$EmbImage_ext_re(:\w+)?$/
##########
#our $re_spaces_unlessinbrackets=qr/([^( ]+(?:\(.*?\))?)(?: +|$)/; #breaks "widget1(options with spaces) widget2" in "widget1(options with spaces)" and "widget2" #replaced by ExtractNameAndOptions
my ($browsercmd,$opendircmd);
#changes to %QActions must be followed by a call to Update_QueueActionList()
# changed : called from Queue or QueueAction changed
# action : called when queue is empty
# keep : do not clear mode once empty
# save : save mode when RememberQueue is on
# condition : do not show mode if return false
# order : used to sort modes
# autofill : indicate that this mode use the maxautofill value
# can_next : this mode can be use with $NextAction
our %QActions=
( '' => {order=>0, short=> _"normal", long=> _"Normal mode", can_next=>1, },
autofill=> {order=>10, icon=>'gtk-refresh', short=> _"autofill", long=> _"Auto-fill queue", changed=>\&QAutoFill, keep=>1,save=>1,autofill=>1, },
'wait' => {order=>20, icon=>'gmb-wait', short=> _"wait for more", long=> _"Wait for more when queue empty", action=>\&Stop, changed=>\&QWaitAutoPlay,keep=>1,save=>1, },
stop => {order=>30, icon=>'gtk-media-stop', short=> _"stop", long=> _"Stop when queue empty", action=>\&Stop,
can_next=>1, long_next=>_"Stop after this song", },
quit => {order=>40, icon=>'gtk-quit', short=> _"quit", long=> _"Quit when queue empty", action=>\&Quit,
can_next=>1, long_next=>_"Quit after this song"},
turnoff => {order=>50, icon=>'gmb-turnoff', short=> _"turn off", long=> _"Turn off computer when queue empty", action=>sub {Stop(); TurnOff();},
condition=> sub { $::Options{Shutdown_cmd} }, can_next=>1, long_next=>_"Turn off computer after this song"},
);
our %StockLabel=( 'gmb-turnoff' => _"Turn Off" );
our @DRAGTYPES;
@DRAGTYPES[DRAG_FILE,DRAG_USTRING,DRAG_STRING,DRAG_MARKUP,DRAG_ID,DRAG_ARTIST,DRAG_ALBUM,DRAG_FILTER]=
( ['text/uri-list'],
['text/plain;charset=utf-8'],
['STRING'],
['markup'],
[SongID =>
{ DRAG_FILE, sub { Songs::Map('uri',\@_); },
DRAG_ARTIST, sub { @{Songs::UniqList('artist',\@_,1)}; },
DRAG_ALBUM, sub { @{Songs::UniqList('album',\@_,1)}; },
DRAG_USTRING, sub { (@_==1)? Songs::Display($_[0],'title') : __n("%d song","%d songs",scalar@_) },
#DRAG_STRING, undef, #will use DRAG_USTRING
DRAG_STRING, sub { Songs::Map('uri',\@_); },
DRAG_FILTER, sub {Filter->newadd(FALSE,map 'title:~:'.Songs::Get($_,'title'),@_)->{string}},
DRAG_MARKUP, sub { return ReplaceFieldsAndEsc($_[0],_"<b>%t</b>\n<small><small>by</small> %a\n<small>from</small> %l</small>") if @_==1;
my $nba=@{Songs::UniqList2('artist',\@_)};
my $artists= ($nba==1)? Songs::DisplayEsc($_[0],'artist') : __("%d artist","%d artists",$nba);
__x( _("{songs} by {artists}") . "\n<small>{length}</small>",
songs => __n("%d song","%d songs",scalar@_),
artists => $artists,
'length' => CalcListLength(\@_,'length')
)},
}],
[Artist => { DRAG_USTRING, sub { (@_<10)? join("\n",@{Songs::Gid_to_Display('artist',\@_)}) : __("%d artist","%d artists",scalar@_) },
#DRAG_STRING, undef, #will use DRAG_USTRING
DRAG_STRING, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('artists',$_),@_)->filter; SortList($l); Songs::Map('uri',$l); },
DRAG_FILE, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('artists',$_),@_)->filter; SortList($l); Songs::Map('uri',$l); },
DRAG_FILTER, sub { Filter->newadd(FALSE,map Songs::MakeFilterFromGID('artists',$_),@_)->{string} },
DRAG_ID, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('artists',$_),@_)->filter; SortList($l); @$l; },
}],
[Album => { DRAG_USTRING, sub { (@_<10)? join("\n",@{Songs::Gid_to_Display('album',\@_)}) : __("%d album","%d albums",scalar@_) },
#DRAG_STRING, undef, #will use DRAG_USTRING
DRAG_STRING, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('album',$_),@_)->filter; SortList($l); Songs::Map('uri',$l); },
DRAG_FILE, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('album',$_),@_)->filter; SortList($l); Songs::Map('uri',$l); },
DRAG_FILTER, sub { Filter->newadd(FALSE,map Songs::MakeFilterFromGID('album',$_),@_)->{string} },
DRAG_ID, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('album',$_),@_)->filter; SortList($l); @$l; },
}],
[Filter =>
{ DRAG_USTRING, sub {Filter->new($_[0])->explain},
#DRAG_STRING, undef, #will use DRAG_USTRING
DRAG_STRING, sub { my $l=Filter->new($_[0])->filter; SortList($l); Songs::Map('uri',$l); },
DRAG_ID, sub { my $l=Filter->new($_[0])->filter; SortList($l); @$l; },
DRAG_FILE, sub { my $l=Filter->new($_[0])->filter; SortList($l); Songs::Map('uri',$l); },
}
],
);
our %DRAGTYPES;
$DRAGTYPES{$DRAGTYPES[$_][0]}=$_ for DRAG_FILE,DRAG_USTRING,DRAG_STRING,DRAG_ID,DRAG_ARTIST,DRAG_ALBUM,DRAG_FILTER,DRAG_MARKUP;
our @submenuRemove=
( { label => sub {$_[0]{mode} eq 'Q' ? _"Remove from queue" : $_[0]{mode} eq 'A' ? _"Remove from playlist" : _"Remove from list"}, code => sub { $_[0]{self}->RemoveSelected; }, mode => 'BLQA', istrue=> 'allowremove', },
{ label => _"Remove from library", code => sub { SongsRemove($_[0]{IDs}); }, },
{ label => _"Remove from disk", code => sub { DeleteFiles($_[0]{IDs}); }, test => sub {!$CmdLine{ro}}, stockicon => 'gtk-delete' },
);
our @submenuQueue=
( { label => _"Prepend", code => sub { QueueInsert( @{ $_[0]{IDs} } ); }, },
{ label => _"Replace", code => sub { ReplaceQueue( @{ $_[0]{IDs} } ); }, },
{ label => _"Append", code => sub { Enqueue( @{ $_[0]{IDs} } ); }, },
);
#modes : S:Search, B:Browser, Q:Queue, L:List, P:Playing song in the player window, F:Filter Panels (submenu "x songs")
our @SongCMenu;
unshift @SongCMenu, #unshift instead of "=" because the replaygain submenu (and maybe more in the future) has already been added to @::SongCMenu
( { label => _"Song Properties", code => sub { DialogSongProp (@{ $_[0]{IDs} }); }, onlyone => 'IDs', stockicon => 'gtk-edit' },
{ label => _"Songs Properties", code => sub { DialogSongsProp(@{ $_[0]{IDs} }); }, onlymany=> 'IDs', stockicon => 'gtk-edit' },
{ label => _"Play Only Selected",code => sub { Select(song => 'first', play => 1, staticlist => $_[0]{IDs} ); },
onlymany => 'IDs', stockicon => 'gtk-media-play'},
{ label => _"Play Only Displayed",code => sub { Select(song => 'first', play => 1, staticlist => \@{$_[0]{listIDs}} ); },
test => sub { @{$_[0]{IDs}}<2 }, notmode => 'A', onlymany => 'listIDs', stockicon => 'gtk-media-play' },
{ label => _"Append to playlist",code => sub { ::DoActionForList('addplay',$_[0]{IDs}); },
notempty => 'IDs', test => sub { $::ListMode }, },
{ label => _"Enqueue Selected", code => sub { Enqueue(@{ $_[0]{IDs} }); }, submenu3=> \@submenuQueue,
notempty => 'IDs', notmode => 'QP', stockicon => 'gmb-queue' },
{ label => _"Enqueue Displayed", code => sub { Enqueue(@{ $_[0]{listIDs} }); },
empty => 'IDs', notempty=> 'listIDs', notmode => 'QP', stockicon => 'gmb-queue' },
{ label => _"Add to list", submenu => \&AddToListMenu, notempty => 'IDs' },
# edit submenu for label-type fields
{ label => sub { Songs::Field_Edit_string($_[0]{field}); }, notempty => 'IDs',
submenu=>sub { LabelEditMenu($_[0]{field},$_[0]{IDs}); },
foreach=>sub { 'field', Songs::FieldList(true=>'editsubmenu',type=>'flags'); }, },
# edit submenu for rating-type fields
{ label => sub { Songs::Field_Edit_string($_[0]{field}); }, notempty => 'IDs',
submenu=>sub { Stars::createmenu($_[0]{field},$_[0]{IDs}); },
foreach=>sub { 'field', Songs::FieldList(true=>'editsubmenu',type=>'rating'); }, },
{ label => _"Find songs with the same names", code => sub { SearchSame('title',$_[0]) }, mode => 'B', notempty => 'IDs' },
{ label => _"Find songs with same artists", code => sub { SearchSame('artists',$_[0])}, mode => 'B', notempty => 'IDs' },
{ label => _"Find songs in same albums", code => sub { SearchSame('album',$_[0]) }, mode => 'B', notempty => 'IDs' },
{ label => _"Rename file", code => sub { DialogRename( @{ $_[0]{IDs} }); }, onlyone => 'IDs', test => sub {!$CmdLine{ro}}, },
{ label => _"Mass Rename", code => sub { DialogMassRename( @{ $_[0]{IDs} }); }, onlymany=> 'IDs', test => sub {!$CmdLine{ro}}, },
{ label => _"Copy", code => sub { CopyMoveFilesDialog($_[0]{IDs},TRUE); },
notempty => 'IDs', stockicon => 'gtk-copy', notmode => 'P' },
{ label => _"Move", code => sub { CopyMoveFilesDialog($_[0]{IDs},FALSE); },
notempty => 'IDs', notmode => 'P', test => sub {!$CmdLine{ro}}, },
#{ label => sub {'Remove from '.($_[0]{mode} eq 'Q' ? 'queue' : 'this list')}, code => sub { $_[0]{self}->RemoveSelected; }, stockicon => 'gtk-remove', notempty => 'IDs', mode => 'LQ' }, #FIXME
{ label => _"Remove", submenu => \@submenuRemove, stockicon => 'gtk-remove', notempty => 'IDs', notmode => 'P' },
{ label => _"Re-read tags", code => sub { ReReadTags(@{ $_[0]{IDs} }); },
notempty => 'IDs', notmode => 'P', stockicon => 'gtk-refresh' },
{ label => _"Same Title", submenu => sub { ChooseSongsTitle( $_[0]{IDs}[0] ); }, mode => 'P' },
{ label => _"Edit Lyrics", code => sub { EditLyrics( $_[0]{IDs}[0] ); }, mode => 'P' },
{ label => _"Lookup in google", code => sub { Google( $_[0]{IDs}[0] ); }, mode => 'P' },
{ label => _"Open containing folder", code => sub { openfolder( Songs::Get( $_[0]{IDs}[0], 'path') ); }, onlyone => 'IDs' },
{ label => _"Queue options", submenu => \@Layout::MenuQueue, mode => 'Q', }
);
our @cMenuAA=
( { label => _"Lock", code => sub { ToggleLock($_[0]{lockfield}); }, check => sub { $::TogLock && $::TogLock eq $_[0]{lockfield}}, mode => 'P',
test => sub { $_[0]{field} eq $_[0]{lockfield} || $_[0]{gid} == Songs::Get_gid($::SongID,$_[0]{lockfield}); },
},
{ label => _"Lookup in AMG", code => sub { AMGLookup( $_[0]{mainfield}, $_[0]{aaname} ); },
test => sub { $_[0]{mainfield} =~m/^album$|^artist$|^title$/; },
},
{ label => _"Filter", code => sub { Select(filter => Songs::MakeFilterFromGID($_[0]{field},$_[0]{gid})); }, stockicon => 'gmb-filter', mode => 'P' },
{ label => \&SongsSubMenuTitle, submenu => \&SongsSubMenu, },
{ label => sub {$_[0]{mode} eq 'P' ? _"Display Songs" : _"Filter"}, code => \&FilterOnAA,
test => sub { GetSonglist( $_[0]{self} ) }, },
{ label => _"Set Picture", code => sub { ChooseAAPicture($_[0]{ID},$_[0]{mainfield},$_[0]{gid}); },
stockicon => 'gmb-picture' },
);
our @TrayMenu=
( { label=> sub {$::TogPlay ? _"Pause" : _"Play"}, code => \&PlayPause, stockicon => sub { $::TogPlay ? 'gtk-media-pause' : 'gtk-media-play'; }, id=>'playpause' },
{ label=> _"Stop", code => \&Stop, stockicon => 'gtk-media-stop' },
{ label=> _"Next", code => \&NextSong, stockicon => 'gtk-media-next', id=>'next', },
{ label=> _"Recently played", submenu => sub { my $m=ChooseSongs([GetPrevSongs(8)]); }, stockicon => 'gtk-media-previous' },
{ label=> sub {$::TogLock && $::TogLock eq 'first_artist'? _"Unlock Artist" : _"Lock Artist"}, code => sub {ToggleLock('first_artist');} },
{ label=> sub {$::TogLock && $::TogLock eq 'album' ? _"Unlock Album" : _"Lock Album"}, code => sub {ToggleLock('album');} },
{ label=> _"Windows", code => \&PresentWindow, submenu_ordered_hash =>1,
submenu => sub { [map { $_->layout_name => $_ } grep $_->isa('Layout::Window'), Gtk2::Window->list_toplevels]; }, },
{ label=> sub { IsWindowVisible($::MainWindow) ? _"Hide": _"Show"}, code => sub { ShowHide(); }, id=>'showhide', },
{ label=> _"Fullscreen", code => \&ToggleFullscreenLayout, stockicon => 'gtk-fullscreen' },
{ label=> _"Settings", code => 'OpenPref', stockicon => 'gtk-preferences' },
{ label=> _"Quit", code => \&Quit, stockicon => 'gtk-quit' },
);
our %Artists_split=
( '\s*&\s*' => "&",
'\s*\\+\s*' => "+",
'\s*\\|\s*' => "|",
'\s*;\s*' => ";",
'\s*/\s*' => "/",
'\s*,\s+' => ", ",
',?\s+and\s+' => "and", #case-sensitive because the user might want to use "And" in artist names that should NOT be splitted
',?\s+And\s+' => "And",
'\s+featuring\s+' => "featuring",
'\s+feat\.\s+' => "feat.",
'\s+[Vv][Ss]\s+' => "VS",
);
our %Artists_from_title=
( '\(with\s+([^)]+)\)' => "(with X)",
'\(feat\.\s+([^)]+)\)' => "(feat. X)",
'\(featuring\s+([^)]+)\)' => "(featuring X)",
);
#a few inactive debug functions
sub red {}
sub blue {}
sub callstack {}
sub url_escapeall
{ my $s=$_[0];
_utf8_off($s); # or "use bytes" ?
$s=~s#([^A-Za-z0-9])#sprintf('%%%02X', ord($1))#seg;
return $s;
}
sub url_escape
{ my $s=$_[0];
_utf8_off($s);
$s=~s#([^/\$_.+!*'(),A-Za-z0-9-])#sprintf('%%%02X',ord($1))#seg;
return $s;
}
sub decode_url
{ my $s=$_[0];
return undef unless defined $s;
_utf8_off($s);
$s=~s#%([0-9A-F]{2})#chr(hex $1)#ieg;
return $s;
}
sub PangoEsc # escape special chars for pango ( & < > ) #replaced by Glib::Markup::escape_text if available
{ local $_=$_[0];
return '' unless defined;
s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g;
s/"/&quot;/g; s/'/&apos;/g; # doesn't seem to be needed
return $_;
}
sub MarkupFormat
{ my $format=shift;
sprintf $format, map PangoEsc($_), @_;
}
sub Gtk2::Label::new_with_format
{ my $class=shift;
my $label=Gtk2::Label->new;
$label->set_markup( MarkupFormat(@_) );
return $label;
}
sub Gtk2::Label::set_markup_with_format
{ my $label=shift;
$label->set_markup( MarkupFormat(@_) );
}
sub Gtk2::Dialog::add_button_custom
{ my ($dialog,$text,$response_id,%args)=@_;
my ($icon,$tip,$secondary)=@args{qw/icon tip secondary/};
my $button= Gtk2::Button->new;
$button->set_image( Gtk2::Image->new_from_stock($icon,'menu') ) if $icon;
$button->set_label($text);
$button->set_use_underline(1);
$button->set_tooltip_text($tip) if defined $tip;
$dialog->add_action_widget($button,$response_id);
if ($secondary)
{ my $bb=$button->parent;
if ($bb && $bb->isa('Gtk2::ButtonBox')) { $bb->set_child_secondary($button,1); }
}
return $button;
}
sub Gtk2::Window::force_present #force bringing the window to the current workspace, $win->present does not always do that
{ my $win=shift;
unless ($win->window && ($win->window->get_state >= 'sticky')) { $win->stick; $win->unstick; }
$win->present;
}
sub IncSuffix # increment a number suffix from a string
{ $_[0] =~ s/(?<=\D)(\d*)$/sprintf "%0".length($1)."d",($1||1)+1/e;
}
sub Ellipsize
{ my ($string,$max)=@_;
return length $string>$max+3 ? substr($string,0,$max)."\x{2026}" : $string;
}
sub Clamp
{ $_[0] > $_[2] ? $_[2] : $_[0] < $_[1] ? $_[1] : $_[0];
}
sub CleanupFileName
{ local $_=$_[0];
s#[[:cntrl:]/:><*?"\\^]##g;
s#^[- ]+##g;
$_=substr $_,0,255 if length>255;
s/[. ]+$//g;
return $_;
}
sub CleanupDirName
{ local $_=$_[0];
if ($^O eq 'MSWin32') { s#[[:cntrl:]/:><*?"^]##g; }
else { s#[[:cntrl:]:><*?"\\^]##g;}
s#^[- ]+##g;
$_=substr $_,0,255 if length>255;
s/[. ]+$//g;
return $_;
}
sub uniq
{ my %h;
map { $h{$_}++ == 0 ? $_ : () } @_;
}
sub sort_number_aware #sort (s1 s10 s2) into (s1 s2 s10)
{ my %h;
($h{$_} = superlc($_)) =~ s/(\d+)/"0"x(20-length($1)).$1/ge for @_; #format numbers with at least 20 digits, will fail for numbers with more than 20 digits, but probably not interesting anyway
return sort {$h{$a} cmp $h{$b}} @_;
}
sub superlc ##lowercase, normalize and remove accents/diacritics #not sure how good it is
{ #test if 8th bit set for any character, if not it's pure ascii and we can just return lc
use bytes; # test is much faster in bytes mode
return lc $_[0] unless $_[0]=~m/[\x80-\xff]/; # lc in bytes mode
no bytes;
my $s=NFKD($_[0]);
$s=~s/\pM//og; #remove Marks (see perlunicode)
#$s=Unicode::Normalize::compose($s); #almost never change anything and should not change comparison result anyway; so better leave it out as it's rather costly
return lc $s; # lc NOT in bytes mode
}
sub superlc_sort
{ return sort {superlc($a) cmp superlc($b)} @_;
}
sub sorted_keys #return keys of $hash sorted by $hash->{$_}{$sort_subkey} or by $hash->{$_} using superlc
{ my ($hash,$sort_subkey)=@_;
if (defined $sort_subkey)
{ return sort { superlc($hash->{$a}{$sort_subkey}) cmp superlc($hash->{$b}{$sort_subkey}) } keys %$hash;
}
else
{ return sort { superlc($hash->{$a}) cmp superlc($hash->{$b}) } keys %$hash;
}
}
sub WordIn #return true if 1st argument is a word in contained in the 2nd argument (space-separated words)
{ return 1 if first {$_[0] eq $_} split / +/,$_[1];
return 0;
}
sub OneInCommon #true if at least one string common to both list
{ my ($l1,$l2)=@_;
($l1,$l2)=($l2,$l1) if @$l1>@$l2;
return 0 if @$l1==0;
if (@$l1==1) { my $s=$l1->[0]; return defined first {$_ eq $s} @$l2 }
my %h;
$h{$_}=undef for @$l1;
return 1 if defined first { exists $h{$_} } @$l2;
return 0;
}
sub find_common_parent_folder
{ return unless @_;
my @folders= uniq(@_);
my $folder=$folders[0];
my $nb=@folders;
return $folder if $nb==1;
$folder=~s/$QSLASH+$//o;
until ($nb==grep m/^\Q$folder\E(?:$QSLASH|$)/, @folders)
{ $folder='' unless $folder=~m/$QSLASH/o; #for win32 drives
last unless $folder=~s/$QSLASH[^$QSLASH]+$//o;
}
$folder.=SLASH unless $folder=~m/$QSLASH/o;
return $folder;
}
sub ExtractNameAndOptions
{ local $_=$_[0]; #the passed string is modified unless wantarray
my $prefixre=$_[1];
my @res;
while ($_ ne '')
{ s#^\s*##;
my $prefix;
if ($prefixre)
{ $prefix=$1 if s/^$prefixre//;
}
m/[^(\s]*/g; #name in "name(options...)"
my $depth=0;
$depth=1 if m#\G\(#gc;
while ($depth)
{ m#\G(?:[^()]*[^()\\])?([()])?#gc; #search next ()
last unless $1; #end of string
# next if "\\" eq substr($_,pos()-2,1);#escaped () => ignore
if ($1 eq '(') {$depth++}
else {$depth--}
}
my $str=substr $_,0,pos,'';
$str=~s#\\([()])#$1#g; #unescape ()
$str=[$str,$prefix] if $prefixre;
$_[0]=$_ , return $str unless wantarray;
push @res, $str;
}
return @res;
}
sub ParseOptions
{ local $_=$_[0]; #warn "$_\n";
my %opt;
while (m#\G\s*([^= ]+)=\s*#gc)
{ my $key=$1;
if (m#\G(["'])#gc) #quotted
{ my $q= $1 ;
my $v;
if (m#\G((?:[^$q\\]|\\.)*)$q#gc)
{ $v=$1;
$v=~s#\\$q#$q#g;
}
else
{ print "Can't find end of quote in ".(substr $_,pos()-1)."\n";
}
$opt{$key}=$v;
m#\G[^,]*(?:,|$)#gc; #skip the rest
}
else
{ m#\G([^,]*?)\s*(?:,|$)#gc;
$opt{$key}=$1;
}
}
#warn " $_ => $opt{$_}\n" for sort keys %opt; warn "\n";
return \%opt;
}
sub ReplaceExpr { my $expr=shift; $expr=~s#\\}#}#g; warn "FIXME : ReplaceExpr($expr)"; return ''; } #FIXME
sub ReplaceExprUsedFields {} #FIXME
our %ReplaceFields; #used in gmusicbrowser_tags for auto-fill FIXME PHASE1
#o => 'basefilename', maybe should be usage specific (=>only for renaming)
sub UsedFields
{ my $s=$_[0];
my @f= grep defined, map $ReplaceFields{$_}, $s=~m/(%[a-zA-Z])/g;
push @f, $s=~m#\$([a-zA-Z]\w*)#g;
push @f, ReplaceExprUsedFields($_) for $s=~m#\$\{(.*?(?<!\\))}#g;
return Songs::Depends(@f);
}
sub ReplaceFields
{ my ($ID,$string,$esc,$special)=@_;
$special||={};
my $display= $esc ? ref $esc ? sub { $esc->(Songs::Display(@_)) } : \&Songs::DisplayEsc : \&Songs::Display;
$string=~s#(?:\\n|<br>)#\n#g;
$string=~s#([%\$]){2}|(%[a-zA-Z]|\$[a-zA-Z\$]\w*)|\$\{(.*?(?<!\\))}#
$1 ? $1 :
defined $3 ? ReplaceExpr($3) :
exists $special->{$2} ? do {my $s=$special->{$2}; ref $s ? $s->($ID,$2) : $s} :
do {my $f=$ReplaceFields{$2}; $f ? $display->($ID,$f) : $2}
#ge;
return $string;
}
sub ReplaceFieldsAndEsc
{ ReplaceFields($_[0],$_[1],1);
}
sub ReplaceFieldsForFilename
{ # use filename_from_unicode for everything but %o (existing filename in unknown encoding), leave %o as is
my $f= ReplaceFields( $_[0], filename_from_unicode($_[1]), \&Glib::filename_from_unicode, {"%o"=> sub { Songs::Get($_[0],'barefilename') }, } );
CleanupFileName($f);
}
sub MakeReplaceTable
{ my ($fields,%special)=@_;
my $table=Gtk2::Table->new (4, 2, FALSE);
my $row=0; my $col=0;
for my $letter (split //,$fields)
{ for my $text ( '%'.$letter, $special{$letter}||Songs::FieldName($ReplaceFields{'%'.$letter}) )
{ my $l=Gtk2::Label->new($text);
$table->attach($l,$col++,$col,$row,$row+1,'fill','shrink',4,1);
$l->set_alignment(0,.5);
}
if ($col++>3) { $row++; $col=0; }
}
$table->set_col_spacing(2, 30);
my $align=Gtk2::Alignment->new(.5, .5, 0, 0);
$align->add($table);
return $align;
}
sub MakeReplaceText
{ my ($fields,%special)=@_;
my $text=join "\n", map "%$_ : ". ($special{$_}||Songs::FieldName($ReplaceFields{'%'.$_})), split //,$fields;
return $text;
}
our %DATEUNITS=
( s => [1,_"seconds"],
m => [60,_"minutes"],
h => [3600,_"hours"],
d => [86400,_"days"],
w => [604800,_"weeks"],
M => [2592000,_"months"],
y => [31536000,_"years"],
);
our %TIMEUNITS= ( map { $_=>$DATEUNITS{$_} } qw/s m h/);
our %SIZEUNITS=
( b => [1,_"bytes"],
k => [KB(),_"KB"],
m => [MB(),_"MB"],
);
sub strftime_utf8
{ utf8::upgrade($_[0]); &strftime;
}
# english and localized, full and abbreviated, day names
my %DAYS=( map( { ::superlc(strftime_utf8('%a',0,0,0,1,0,100,$_))=>$_,
::superlc(strftime_utf8('%A',0,0,0,1,0,100,$_))=>$_
} 0..6), sun=>0,mon=>1,tue=>2,wed=>3,thu=>4,fri=>5,sat=>6);
# english and localized, full and abbreviated, month names
my %MONTHS=( map( { ::superlc(strftime_utf8('%b',0,0,0,1,$_,100))=>$_+1,
::superlc(strftime_utf8('%B',0,0,0,1,$_,100))=>$_+1
} 0..11), jan=>1,feb=>2,mar=>3,apr=>4,may=>5,jun=>6,jul=>7,aug=>8,sep=>9,oct=>10,nov=>11,dec=>12);
for my $h (\%DAYS,\%MONTHS) #remove "." at the end of some localized day/month names
{ for my $key (keys %$h) { $h->{$key}= delete $h->{"$key."} if $key=~s/\.$//; }
}
sub dates_to_timestamps
{ my ($dates,$mode)=@_; #mode : 0: begin date, 1: end date, 2: range
if ($mode==2 && $dates!~m/\.\./ && $dates=~m/^[^-]*-[^-]*$/) { $dates=~s/-/../; } # no '..' and only one '-' => replace '-' by '..'
my ($date1,$range,$date2)=split /(\s*\.\.\s*)/,$dates,2;
if ($mode==0) { $date2=0; }
elsif ($mode==1) { $date2||=$date1; $date1=0; }
elsif ($mode==2) { $date2=$date1 unless $range; }
my $end=0;
for my $date ($date1,$date2)
{ if (!$date) {$date='';next}
elsif ($date=~m/^\d{9,}$/) {next} #seconds since epoch
my $past_step=1;
my $past_var;
my ($y,$M,$d,$h,$m,$s,$pm);
{ ($y,$M,$d,$h,$m,$s)= $date=~m#^(\d\d\d\d)(?:[-/.](\d\d?)(?:[-/.](\d\d?)(?:[-T ](\d\d?)(?:[:.](\d\d?)(?:[:.](\d\d?))?)?)?)?)?$# and last; # yyyy/MM/dd hh:mm:ss
($h,$m,$s,$pm)= $date=~m#^(\d\d?)[:](?:(\d\d?)(?:[:](\d\d?))?)?([ap]m?)?$#i and last; #hh:mm:ss or hh:mm or hh:
($d,$M,$y)= $date=~m#^(\d\d?)(?:[-/.](\d\d?)(?:[-/.](\d\d\d\d))?)?$# and last; # dd/MM or dd/MM/yyyy
($M,$y)= $date=~m#^(\d\d?)[-/.](\d\d\d\d)$# and last; # MM/yyyy
($y,$M,$d)= $date=~m#^(\d{4})(\d\d)(\d\d)$# and last; # yyyyMMdd
if ($date=~m#^(?:(\d\d?)[-/. ]?)?(\p{Alpha}+)(?:[-/. ]?(\d\d(?:\d\d)?))?$# && (my $month=$MONTHS{::superlc($2)})) # jan or jan99 or 10jan or 10jan12 or jan2012
{ ($d,$M,$y)=($1,$month,$3);
last;
}
if (defined(my $wday=$DAYS{::superlc$date})) #name of week day
{ my ($now_day,$now_wday)= (localtime)[3,6];
$d= $now_day - $now_wday + $wday;
$past_step=7; $past_var=3; #remove 7days if in future
last;
}
$date='';
}
next unless $date;
if (defined $y)
{ $y= $y>100 ? $y-=1900 : $y<70 ? $y+100 : $y; #>100 => 4digits year, <70 : 2digits 20xx year, else 2digits 19xx year
}
$M-- if defined $M;
$h+=( $pm=~m/^pm?$/ ? $h!=12 ? 12 : 0 : $h==12 ? -12 : 0 ) if defined $pm && defined $h;
my @now= (localtime)[0..5];
for ($y,$M,$d,$h,$m,$s) #complete relative dates with current date
{ last if defined;
$_= pop @now;
}
$past_var= scalar @now unless defined $past_var; #unit to change if in the future
if ($end) #if end date increment the smallest defined unit (to get the end of day/month/year/hour/min + 1 sec)
{ for ($s,$m,$h,$d,$M,$y)
{ if (defined) { $_++; last; }
}
}
my @date= ($s||0,$m||0,$h||0,$d||1,$M||0,$y);
$date= ::mktime(@date);
if ($past_var<6 && $date>time) #for relative dates, choose between previous and next match (for example, this year's july or previous year's july)
{ $date[$past_var]-= $past_step;
my $date_past= ::mktime(@date);
#use date in the past unless it's an end date and makes more sense relative to the first date
$date= $date_past unless $end && $date1 && $date>$date1 && $date_past<=$date1;
}
$date-- if $end;
}
continue {$end=1}
return $mode==0 ? $date1 : $mode==1 ? $date2 : ($date1,$date2);
}
sub ConvertTimeLength # convert date/time pattern into nb of seconds
{ my ($number,$unit)= $_[0]=~m/^\s*(\d*\.?\d+)\s*([a-zA-Z]*)\s*$/;
return 0 unless $number;
if (my $ref= $DATEUNITS{$unit}) { $number*= $ref->[0] }
elsif ($unit) { warn "ignoring unknown unit '$unit'\n" }
return $number;
}
sub ConvertTime # convert date pattern into nb of seconds since epoch
{ return time - &ConvertTimeLength;
}
sub ConvertSize
{ my ($size,$unit)= $_[0]=~m/^\s*(\d*\.?\d+)\s*([a-zA-Z]*)\s*$/;
return 0 unless $size;
if (my $ref= $SIZEUNITS{lc$unit}) { $size*= $ref->[0] }
elsif ($unit) { warn "ignoring unknown unit '$unit'\n" }
return $size;
}
#---------------------------------------------------------------
our $DAYNB=int(time/86400)-12417;#number of days since 01 jan 2004
our ($Library,$PlaySource);#,@Radio);
our (%GlobalBoundKeys,%CustomBoundKeys);
our ($SelectedFilter,$PlayFilter); our (%Filters,%FilterWatchers,%Related_FilterWatchers); our %SelID;
#our %SavedFilters;our (%SavedSorts,%SavedWRandoms);our %SavedLists;
my $SavedListsWatcher;
our $ListPlay;
our ($TogPlay,$TogLock);
our ($RandomMode,$SortFields,$ListMode);
our ($SongID,$prevID,$Recent,$RecentPos,$Queue); our $QueueAction=our $NextAction='';
our ($Position,$ChangedID,$ChangedPos,@NextSongs,$NextFileToPlay);
our ($MainWindow,$FullscreenWindow); my $OptionsDialog;
my $TrayIcon;
my %Editing; #used to keep track of opened song properties dialog and lyrics dialog
our $PlayTime;
our ($StartTime,$StartedAt,$PlayingID, @Played_segments);
our $CurrentDir=$ENV{PWD};
$ENV{'PULSE_PROP_media.role'}='music'; # role hint for pulseaudio
$ENV{'PULSE_PROP_application.icon_name'}='gmusicbrowser'; # icon hint for pulseaudio, could also use Gtk2::Window->set_default_icon_name
our (%ToDo,%TimeOut,%Delayed);
my %EventWatchers;#for Save Vol Time Queue Lock Repeat Sort Filter Pos CurSong Playing SavedWRandoms SavedSorts SavedFilters SavedLists Icons Widgets connections
# also used for SearchText_ SelectedID_ followed by group id
# Picture_#mainfield#
my (%Watched,%WatchedFilt);
my ($IdleLoop,@ToAdd_Files,@ToAdd_IDsBuffer,@ToScan,%FollowedDirs,%AutoPicChooser);
our %Progress; my $ProgressWindowComing;
my $ToCheck=GMB::JobIDQueue->new(title => _"Checking songs",);
my $ToReRead=GMB::JobIDQueue->new(title => _"Re-reading tags",);
my $ToCheckLength=GMB::JobIDQueue->new(title => _"Checking length/bitrate",details => _"for files without a VBR header",);
my ($CheckProgress_cb,$ScanProgress_cb,$ProgressNBSongs,$ProgressNBFolders);
my %Plugins;
my $ScanRegex;
my %Encoding_pref;
$Encoding_pref{$_}=-2 for qw/null AdobeZdingbat ascii-ctrl dingbats MacDingbats/; #don't use these
$Encoding_pref{$_}=-1 for qw/UTF-32BE UTF-32LE/; #these can generate lots of warnings, skip them when trying encodings
$Encoding_pref{$_}=2 for qw/utf8 cp1252 iso-8859-15/; #use these first when trying encodings
#Default values
our %Options=
( Layout => 'Lists, Library & Context',
LayoutT => 'full with buttons',
LayoutB => 'Browser',
LayoutF => 'default fullscreen',
LayoutS => 'Search',
IconTheme => '',
MaxAutoFill => 5,
Repeat => 1,
Sort => 'shuffle', #default sort order
Sort_LastOrdered=> 'path file',
Sort_LastSR => 'shuffle',
Sessions => '',
StartCheck => 0, #check if songs have changed on startup
StartScan => 0, #scan @LibraryPath on startup for new songs
FilenameSchema => ['%a - %l - %n - %t','%l - %n - %t','%n-%t','%d%n-%t'],
FolderSchema => ['%A/%l','%A','%A/%Y-%l','%A - %l'],
PlayedMinPercent=> 80, # Threshold to count a song as played in percent
PlayedMinSeconds=> 600, # Threshold to count a song as played in seconds
DefaultRating => 50,
# Device => 'default',
# amixerSMC => 'PCM',
# gst_sink => 'alsa',
use_equalizer => 0,
equalizer => '0:0:0:0:0:0:0:0:0:0',
equalizer_presets => #taken from gstreamer equalizer plugin
{ ballad => '4:3.75:2.5:0:-4:-6:-3:0:2.5:9',
classic => '0:0:0:0:0:0:-6:-7:-7:-9.5',
club => '0:0:8:6:5.5:5:3:0:0:0',
dance => '9.6:7:2.5:0:0:-5.6:-7:-7:0:0',
party => '7:7:0:0:0:0:0:0:7:7',
pop => '-1.6:4.5:7:8:5.6:0:-2.5:-2:-1.6:-1.5',
reggae => '0:0:0:-5.5:0:6.5:6.5:0:0:0',
rock => '8:5:-5.5:-8:-3:4:8:11:11:11.5',
ska => '-2.5:-5:-4:0:4:5.5:8:9:11:9',
soft => '5:1.5:0:-2.5:0:4:8:9:11:12',
techno => '8:5.5:0:-5.5:-5:0:8:10:10:9',
"more bass" => '-8:10:10:5.5:1.5:-4:-8:-10:-11:-11',
"more treble" => '-10:-10:-10:-4:2.5:11:12:12:12:12',
"more bass and treble" => '8:5.5:0:-7:-5:1.5:8:11.2:12:12',
},
equalizer_preamp=> 1,
use_replaygain => 1,
rg_limiter => 1,
rg_preamp => 0,
rg_fallback => 0,
gst_rg_songmenu => 0,
gst_sync_EQpresets=>1,
use_GST_for_server=>1,
Icecast_port => '8000',
UseTray => 1,
CloseToTray => 0,
ShowTipOnSongChange => 0,
TrayTipTimeLength => 3000, #in ms
TAG_use_latin1_if_possible => 1,
TAG_no_desync => 1,
TAG_keep_id3v2_ver => 0,
'TAG_write_id3v2.4' => 0,
TAG_id3v1_encoding => 'iso-8859-1',
AutoRemoveCurrentSong => 0,
LengthCheckMode => 'add',
CustomKeyBindings => {},
VolumeStep => 10,
DateFormat_history => ['%c 604800 %A %X 86400 Today %X 60 now'],
AlwaysInPlaylist => 1,
PixCacheSize => 60, # in MB
Articles => 'the a an',
SavedSTGroupings=>
{ _"None" => '',
_"Artist & album" => 'artist|simple|album|pic',
_"Album with picture" => 'album|pic',
_"Album" => 'album|simple',
_"Folder" => 'folder|artistalbum',
},
SavedWRandoms=>
{ _"by rating" => 'random:1r0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1',
_"by play count"=> 'random:-1n5',
_"by lastplay" => 'random:1l10',
_"by added" => 'random:-1a50',
_"by lastplay & play count" => 'random:1l10'."\x1D".'-1n5',
_"by lastplay & bootleg" => 'random:1l10'."\x1D".'-.5fbootleg',
},
SavedSorts=>
{ _"Path,File" => 'path file',
_"Date" => 'year',
_"Title" => 'title',
_"Last played" => 'lastplay',
_"Artist,Album,Disc,Track" => 'artist album disc track',
_"Artist,Date,Album,Disc,Track" => 'artist year album disc track',
_"Path,Album,Disc,Track,File" => 'path album disc track file',
_"Shuffled albums" => 'album_shuffle disc track file',
_"Shuffled albums, shuffled tracks" => 'album_shuffle shuffle',
},
);
our $GlobalKeyBindings='Insert OpenSearch c-q Quit a-q EnqueueSelected p PlayPause c OpenContext q OpenQueue ca-f ToggleFullscreenLayout F11 ToggleFullscreen';
%GlobalBoundKeys=%{ make_keybindingshash($GlobalKeyBindings) };
sub make_keybindingshash
{ my $keybindings=$_[0];
my @list= ref $keybindings ? %$keybindings : ExtractNameAndOptions($keybindings);
my %h;
while (@list>1)
{ my $key=shift @list;
my $cmd=shift @list;
my $priority= $key=~s/^\+//;
my $mod= $key=~s/^([caws]+-)// ? $1 : '';
$key= lc $key;
$h{$mod.$key}=$cmd;
$h{'+'.$mod.$key}=$cmd if $priority;
}
return \%h;
}
sub keybinding_longname
{ my $key=$_[0];
return $key unless $key=~s/^([caws]+)-//;
my $mod=$1;
my %h=( c => _p('Keyboard',"Ctrl"), #TRANSLATION: Ctrl key
a => _p('Keyboard',"Alt"), #TRANSLATION: Alt key
w => _p('Keyboard',"Win"), #TRANSLATION: Windows key
s => _p('Keyboard',"Shift"), #TRANSLATION: Shift key
);
my $name=join '',map $h{$_}, split //,$mod;
return $name.'-'.$key;
}
our ($NBVolIcons,$NBQueueIcons); our %TrayIcon;
my $icon_factory;
my %IconsFallbacks=
( 'gmb-queue0' => 'gmb-queue',
'gmb-queue-window' => 'gmb-queue',
'gmb-random-album' => 'gmb-random',
'gmb-view-fullscreen'=>'gtk-fullscreen',
);
sub Find_all_stars #returns a hash used in the combobox of the starprefix option
{ my @dirs= ($HomeDir.'icons', PIXPATH);
my %stars=(''=>_"Default");
for my $dir (@dirs)
{ $dir.=SLASH;
opendir my($dh),$dir or next;
my @themes= ('.', grep -d $dir.$_, grep !m/^\./, readdir $dh);
closedir $dh;
for my $theme (@themes)
{ opendir my($dh),$dir.$theme or next;
for my $file (grep !m/^\./, readdir $dh)
{ next unless $file=~m/^(stars(?:-\w+?[a-z])?)0\.(?:png|svg)$/i;
my $prefix= "$theme/$1";
my $name= $theme eq '.' ? $1 : $prefix;
$stars{$prefix}=$name;
}
closedir $dh;
}
}
return \%stars;
}
sub Find_star_pictures
{ my $prefix= $_[0] || 'stars';
unless (file_name_is_absolute($prefix))
{ my @dirs= ($HomeDir.'icons'.SLASH, PIXPATH);
if ($prefix!~m/$QSLASH/o) # only look into theme subdir if $prefix doesn't contain a slash
{ unshift @dirs, grep defined, first { -d $_ } map $_.$Options{IconTheme}.SLASH, @dirs;
}
for my $path (@dirs)
{ next unless -f $path.$prefix.'0.svg' || -f $path.$prefix.'0.png'; #FIXME extension shouldn't be case-sensitive
$prefix= $path.$prefix;
last;
}
}
my $suffix= (-f $prefix.'0.svg') ? '.svg' : '.png'; #FIXME extension shouldn't be case-sensitive
my @files;
push @files, $prefix.@files.$suffix while -f $prefix.@files.$suffix;
return @files;
}
sub LoadIcons
{ my %icons;
unless (Gtk2::Stock->lookup('gtk-fullscreen')) #for gtk version 2.6
{ $icons{'gtk-fullscreen'}=PIXPATH.'fullscreen.png';
}
#load default icons
opendir my$dh,PIXPATH;
for my $file (grep m/^(?:gmb|plugin)-.*\.(?:png|svg)$/ && -f PIXPATH.$_, readdir $dh)
{ my $name=$file;
$name=~s/\.[^.]+$//;
$icons{$name}=PIXPATH.$file;
}
closedir $dh;
#load plugins icons
if (-d (my $dir=$HomeDir.'plugins'))
{ opendir my($dh),$dir;
for my $file (grep m/\.(?:png|svg)$/ && -f $dir.SLASH.$_, readdir $dh)
{ my $name='plugin-'.$file;
$name=~s/\.[^.]+$//;
$icons{$name}= $dir.SLASH.$file;
}
closedir $dh;
}
my @dirs=($HomeDir.'icons');
if (my $theme=$Options{IconTheme})
{ my $dir= $HomeDir.'icons'.SLASH.$theme;
$dir=PIXPATH.$theme unless -d $dir;
unshift @dirs,$dir;
}
#load theme icons and customs icons
for my $dir (@dirs)
{ next unless -d $dir;
opendir my($dh),$dir;
for my $file (grep m/\.(?:png|svg)$/ && -f $dir.SLASH.$_, readdir $dh)
{ my $name=$file;
$name=~s/\.[^.]+$//;
$name=Encode::decode('utf8',::decode_url($name));
$icons{$name}= $dir.SLASH.$file;
}
closedir $dh;
}
$icons{gmusicbrowser}||= PIXPATH.'gmusicbrowser.svg' unless Gtk2::IconTheme->get_default->get_icon_sizes('gmusicbrowser'); #fallback if no icon named 'gmusicbrowser' is installed
if (my $file=delete $icons{gmusicbrowser})
{ eval { Gtk2::Window->set_default_icon_from_file($file); };
warn $@ if $@;
}
else { Gtk2::Window->set_default_icon_name('gmusicbrowser'); }
#trayicons
{ %TrayIcon=();
my $prefix= $TrayIcon{'default'}= $icons{trayicon} || PIXPATH.'trayicon.png';
$prefix=~s/\.[^.]+$//;
for my $key (qw/play pause/)
{ ($TrayIcon{$key})= grep -r $_, map "$prefix-$key.$_",qw/png svg/;
}
UpdateTrayIcon(1);
}
$NBVolIcons=0;
$NBVolIcons++ while $icons{'gmb-vol'.$NBVolIcons};
$NBQueueIcons=0;
$NBQueueIcons++ while $icons{'gmb-queue'.($NBQueueIcons+1)};
# find rating pictures
for my $field (Songs::FieldList(type=>'rating'))
{ my $prefix= $Songs::Def{$field}{starprefix};
my @stars= Find_star_pictures($prefix);
@stars= Find_star_pictures('stars') unless @stars;
$Songs::Def{$field}{pixbuf}= [ map GMB::Picture::pixbuf($_), @stars ];
$Songs::Def{$field}{nbpictures}= @stars;
}
$icon_factory->remove_default if $icon_factory;
$icon_factory=Gtk2::IconFactory->new;
$icon_factory->add_default;
for my $stock_id (keys %icons,keys %IconsFallbacks)
{ next if $stock_id=~m/^trayicon/;
my %h= ( stock_id => $stock_id );
#label => $$ref[1],
#modifier => [],
#keyval => $Gtk2::Gdk::Keysyms{L},
#translation_domain => 'gtk2-perl-example',
if (exists $StockLabel{$stock_id}) { $h{label}=$StockLabel{$stock_id}; }
Gtk2::Stock->add(\%h) unless Gtk2::Stock->lookup($stock_id);
my $icon_set;
if (my $file=$icons{$stock_id})
{ $icon_set= eval {Gtk2::IconSet->new_from_pixbuf( Gtk2::Gdk::Pixbuf->new_from_file($file) )};
warn $@ if $@;
}
elsif (my $fallback=$IconsFallbacks{$stock_id})
{ $icon_set= $icon_factory->lookup($fallback) || Gtk2::IconFactory->lookup_default($fallback);
}
next unless $icon_set;
$icon_factory->add($stock_id,$icon_set);
}
$_->queue_draw for Gtk2::Window->list_toplevels;
HasChanged('Icons');
}
sub GetIconThemesList
{ my %themes;
$themes{''}=_"default";
for my $dir (PIXPATH,$HomeDir.'icons'.SLASH)
{ next unless -d $dir;
opendir my($dh),$dir;
$themes{$_}=$_ for grep !m/^\./ && -d $dir.$_, readdir $dh;
closedir $dh;
}
return \%themes;
}
##########
our %Command= #contains sub,description,argument_tip, argument_regex or code returning a widget, or '0' to hide it from the GUI edit dialog
( NextSongInPlaylist=> [\&NextSongInPlaylist, _"Next Song In Playlist"],
PrevSongInPlaylist=> [\&PrevSongInPlaylist, _"Previous Song In Playlist"],
NextAlbum => [sub {NextDiff('album')}, _"Next Album",],
NextArtist => [sub {NextDiff('first_artist')}, _"Next Artist",],
NextSong => [\&NextSong, _"Next Song"],
PrevSong => [\&PrevSong, _"Previous Song"],
PlayPause => [\&PlayPause, _"Play/Pause"],
Forward => [\&Forward, _"Forward",_"Number of seconds",qr/^\d+$/],
Rewind => [\&Rewind, _"Rewind",_"Number of seconds",qr/^\d+$/],
Seek => [sub {SkipTo($_[1])}, _"Seek",_"Number of seconds",qr/^-?\d+$/],
Stop => [\&Stop, _"Stop"],
Pause => [sub {Pause() if $TogPlay; }, _"Pause"],
Play => [sub {PlayPause() unless $TogPlay; },_"Play"],
Browser => [\&OpenBrowser, _"Open Browser"],
OpenQueue => [\&EditQueue, _"Open Queue window"],
OpenSearch => [sub { Layout::Window->new($Options{LayoutS}, uniqueid=>'Search'); }, _"Open Search window"],
OpenContext => [\&ContextWindow, _"Open Context window"],
OpenCustom => [sub { Layout::Window->new($_[1]); }, _"Open Custom window",_"Name of layout", sub { TextCombo::Tree->new( Layout::get_layout_list() ); }],
PopupCustom => [sub { PopupLayout($_[1],$_[0]); }, _"Popup Custom window",_"Name of layout", sub { TextCombo::Tree->new( Layout::get_layout_list() ); }],
CloseWindow => [sub { $_[0]->get_toplevel->close_window if $_[0];}, _"Close Window"],
SetPlayerLayout => [sub { SetOption(Layout=>$_[1]); CreateMainWindow(); },_"Set player window layout",_"Name of layout", sub { TextCombo::Tree->new( Layout::get_layout_list('G') ); }, ],
OpenPref => [sub{ PrefDialog($_[1]); }, _"Open Preference window"],
OpenSongProp => [sub { DialogSongProp($SongID) if defined $SongID }, _"Edit Current Song Properties"],
EditSelectedSongsProperties => [sub { my $songlist=GetSonglist($_[0]) or return; my @IDs=$songlist->GetSelectedIDs; DialogSongsProp(@IDs) if @IDs; }, _"Edit selected song properties"],
ShowHide => [sub {ShowHide();}, _"Show/Hide"],
Show => [sub {ShowHide(1);}, _"Show"],
Hide => [sub {ShowHide(0);}, _"Hide"],
Quit => [\&Quit, _"Quit"],
Save => [sub {SaveTags(1)}, _"Save Tags/Options"],
ChangeDisplay => [\&ChangeDisplay, _"Change Display",_"Display (:1 or host:0 for example)",qr/:\d/],
GoToCurrentSong => [\&Layout::GoToCurrentSong, _"Select current song"],
DeleteSelected => [sub { my $songlist=GetSonglist($_[0]) or return; my @IDs=$songlist->GetSelectedIDs; DeleteFiles(\@IDs); }, _"Delete Selected Songs"],
QueueInsertSelected=>[sub { my $songlist=GetSonglist($_[0]) or return; my @IDs=$songlist->GetSelectedIDs; QueueInsert(@IDs); }, _"Insert Selected Songs at the top of the queue"],
EnqueueSelected => [\&Layout::EnqueueSelected, _"Enqueue Selected Songs"],
EnqueueArtist => [sub {EnqueueSame('artist',$SongID)},_"Enqueue Songs from Current Artist"], # or use field 'artists' or 'first_artist' ?
EnqueueAlbum => [sub {EnqueueSame('album',$SongID)}, _"Enqueue Songs from Current Album"],
EnqueueAction => [sub {EnqueueAction($_[1])}, _"Enqueue Action", _"Queue mode" ,sub { TextCombo->new({map {$_ => $QActions{$_}{short}} sort keys %QActions}) }],
SetNextAction => [sub {SetNextAction($_[1])}, _"Set action when song ends", _"Action" ,sub { TextCombo->new({map {$_ => $QActions{$_}{short}} sort grep $QActions{$_}{can_next}, keys %QActions}) }],
ClearQueue => [\&::ClearQueue, _"Clear queue"],
ClearPlaylist => [sub {Select(staticlist=>[])}, _"Clear playlist"],
IncVolume => [sub {ChangeVol('up')}, _"Increase Volume"],
DecVolume => [sub {ChangeVol('down')}, _"Decrease Volume"],
TogMute => [sub {ChangeVol('mute')}, _"Mute/Unmute"],
RunSysCmd => [sub {call_run_system_cmd($_[0],$_[1],0,0)},
_"Run system command",_("System command")."\n"._("Some variables such as %f (current song filename) are available"),qr/./],
RunShellCmd => [sub {call_run_system_cmd($_[0],$_[1],0,1)},
_"Run shell command",_("Shell command")."\n"._("Some variables such as %f (current song filename) are available"),qr/./],
RunSysCmdOnSelected => [sub {call_run_system_cmd($_[0],$_[1],1,0)},
_"Run system command on selected songs",_("System command")."\n"._("Some variables such as %f (current song filename) are available")."\n"._('One command is used per selected songs, unless $files is used, which is replaced by the list of selected files'),qr/./],
RunShellCmdOnSelected => [sub {call_run_system_cmd($_[0],$_[1],1,1)},
_"Run shell command on selected songs",_("Shell command")."\n"._("Some variables such as %f (current song filename) are available")."\n"._('One command is used per selected songs, unless $files is used, which is replaced by the list of selected files'),qr/./],
RunPerlCode => [sub {eval $_[1]}, _"Run perl code",_"perl code",qr/./],
TogArtistLock => [sub {ToggleLock('first_artist')}, _"Toggle Artist Lock"],
TogAlbumLock => [sub {ToggleLock('album')}, _"Toggle Album Lock"],
TogSongLock => [sub {ToggleLock('fullfilename')}, _"Toggle Song Lock"],
ToggleRandom => [\&ToggleSort, _"Toggle between Random/Shuffle and Ordered"],
Shuffle => [\&Shuffle, _"Shuffle or re-shuffle the playlist"],
SetSongRating => [sub
{ return unless defined $SongID && $_[1]=~m/^([-+])?(\d*)$/;
my $r=$2;
if ($1)
{ my $step= $r||10;
$step*=-1 if $1 eq '-';
$r= Songs::Get($SongID, 'ratingnumber') + $step;
}
Songs::Set($SongID, rating=> $r);
}, _"Set Current Song Rating", _("Rating between 0 and 100, or empty for default")."\n"._("Can be relative by using + or -"), qr/^[-+]?\d*$/],
ToggleFullscreen=> [\&Layout::ToggleFullscreen, _"Toggle fullscreen mode"],
ToggleFullscreenLayout=> [\&ToggleFullscreenLayout, _"Toggle the fullscreen layout"],
OpenFiles => [\&OpenFiles, _"Play a list of files", _"url-encoded list of files",0],
AddFilesToPlaylist=> [sub { DoActionForList('addplay',Uris_to_IDs($_[1])); }, _"Add a list of files/folders to the playlist", _"url-encoded list of files/folders",0],
InsertFilesInPlaylist=> [sub { DoActionForList('insertplay',Uris_to_IDs($_[1])); }, _"Insert a list of files/folders at the start of the playlist", _"url-encoded list of files/folders",0],
EnqueueFiles => [sub { DoActionForList('queue',Uris_to_IDs($_[1])); }, _"Enqueue a list of files/folders", _"url-encoded list of files/folders",0],
AddToLibrary => [sub { AddPath(1,split / /,$_[1]); }, _"Add files/folders to library", _"url-encoded list of files/folders",0],
SetFocusOn => [sub { my ($w,$name)=@_;return unless $w; $w=get_layout_widget($w);$w->SetFocusOn($name) if $w;},_"Set focus on a layout widget", _"Widget name",0],
ShowHideWidget => [sub { my ($w,$name)=@_;return unless $w; $w=get_layout_widget($w);$w->ShowHide(split / +/,$name,2) if $w;},_"Show/Hide layout widget(s)", _"|-separated list of widget names",0],
PopupTrayTip => [sub {ShowTraytip($_[1])}, _"Popup Traytip",_"Number of milliseconds",qr/^\d*$/ ],
SetSongLabel => [sub{ Songs::Set($SongID,'+label' => $_[1]); }, _"Add a label to the current song", _"Label",qr/./],
UnsetSongLabel => [sub{ Songs::Set($SongID,'-label' => $_[1]); }, _"Remove a label from the current song", _"Label",qr/./],
ToggleSongLabel => [sub{ Songs::Set($SongID,'^label' => $_[1]); }, _"Toggle a label of the current song", _"Label",qr/./],
PlayListed => [sub{ my $songlist=GetSonglist($_[0]) or return; Select(song => 'first', play => 1, staticlist => $songlist->{array} ); }, _"Play listed songs"],
ClearPlayFilter => [sub {Select(filter => '') if defined $ListMode || !$SelectedFilter->is_empty;}, _"Clear playlist filter"],
MenuPlayFilter => [sub { Layout::FilterMenu(); }, _"Popup playlist filter menu"],
MenuPlayOrder => [sub { Layout::SortMenu(); }, _"Popup playlist order menu"],
MenuQueue => [sub { PopupContextMenu(\@Layout::MenuQueue,{ID=>$SongID, usemenupos=>1}); }, _"Popup queue menu"],
ReloadLayouts => [ \&Layout::InitLayouts, _"Re-load layouts", ],
ChooseSongFromAlbum=> [sub {my $ID= $_[0] ? GetSelID($_[0]) : $::SongID; ChooseSongsFromA( Songs::Get_gid($ID,'album'),nocover=>1 ); }, ],
SetEqualizer => [sub { SetEqualizer(smart=>$_[1]) }, _"Set equalizer", _"pre-set name or 10 numbers between 12 and -12 (-24 for gstreamer) separated by ':', or 0 (for off), or 1 (for on)"],
);
sub run_command
{ my ($self,$cmd)=@_; #self must be a widget or undef
$cmd="$1($2)" if $cmd=~m/^(\w+) (.*)/;
($cmd, my$arg)= $cmd=~m/^(\w+)(?:\((.*)\))?$/;
warn "executing $cmd($arg) (with self=$self)" if $::debug;
if (my $ref=$Command{$cmd}) { $ref->[0]->($self,$arg); }
else { warn "Unknown command '$cmd' => can't execute '$cmd($arg)'\n" }
}
sub split_with_quotes
{ local $_=shift;
s#\\(.)#$1 eq '"' ? "\\34" : $1 eq "'" ? "\\39" : $1 eq ' ' ? "\\32" : "\\92".$1#ge;
my @w= m/([^"'\s]+|"[^"]+"|'[^']+')/g;
for (@w) #remove quotes and put back unused backslashes
{ if (s/^"//) {s/"$//; s#\\39#\\92'#g; s#\\32#\\92 #g;}
elsif (s/^'//) {s/'$//; s#\\34#\\92"#g; s#\\32#\\92 #g;}
}
s#\\(\d\d)#chr $1#ge for @w;
return @w;
}
sub call_run_system_cmd
{ my ($widget,$cmd,$use_selected,$use_shell)=@_;
my @IDs;
if ($use_selected || $cmd=~s#%F\b#\$files#)
{ if ($widget and my $songlist=GetSonglist($widget)) { @IDs= $songlist->GetSelectedIDs; }
unless (@IDs) { warn "Not executing '$cmd' because no song is selected in the current window\n"; return }
}
else { @IDs=($SongID) if defined $SongID; }
run_system_cmd($cmd,\@IDs,$use_shell);
}
sub run_system_cmd
{ my ($cmd,$IDs,$use_shell)=@_;
return unless $cmd=~m/\S/; #check if command is empty
my $quotesub= sub { my $s=$_[0]; $s=Encode::encode("utf8",$s) if utf8::is_utf8($s); $use_shell ? quotemeta($s) : $s; };
my $join= $use_shell ? ' ' : "\x00";
if (!ref $cmd && !$use_shell) { $cmd=[split_with_quotes($cmd)] }
if (ref $cmd) { ($cmd,my @args)=@$cmd; $cmd=Encode::encode("utf8",$cmd); @args= map $quotesub->($_), @args; $cmd=join $join,$cmd,@args; }
else { $cmd= Encode::encode("utf8",$cmd); }
my (@cmds,$files);
if ($IDs)
{ if ($cmd=~m/\$files\b/) { $files= join $join,map $quotesub->(Songs::GetFullFilename($_)),@$IDs; }
if (@$IDs>1 && !$files) { @cmds= map ReplaceFields($_,$cmd,$quotesub), @$IDs; }
else { @cmds=( ReplaceFields($IDs->[0],$cmd,$quotesub, {'$files'=>$files}) ); }
}
else { @cmds=($cmd) }
if ($use_shell) { my $shell= $ENV{SHELL} || 'sh'; @cmds= map [$shell,'-c',$_], @cmds; }
else { @cmds= map [split /\x00/,$_], @cmds; }
forksystem(@cmds);
}
sub forksystem
{ use POSIX ':sys_wait_h'; #for WNOHANG in waitpid
my @cmd=@_; #can be (cmd,arg1,arg2,...) or ([cmd1,arg1,arg2,...],[cmd2,$arg1,arg2,...])
if (ref $cmd[0] && @cmd==1) { @cmd=@{$cmd[0]}; } #simplify if only 1 command
my $ChildPID=fork;
if (!defined $ChildPID) { warn ::ErrorMessage("forksystem : fork failed : $!"); }
if ($ChildPID==0) #child
{ if (ref $cmd[0])
{ system @$_ for @cmd; #execute multiple commands, one at a time, from the child process
}
else { exec @cmd; } #execute one command in the child process
POSIX::_exit(0);
}
while (waitpid(-1, WNOHANG)>0) {} #reap dead children
}
if ($CmdLine{cmdlist})
{ print "Available commands (for fifo or layouts) :\n";
my ($max)= sort {$b<=>$a} map length, keys %Command;
for my $cmd (sort keys %Command)
{ my $short= $Command{$cmd}[1];
next unless defined $short;
my $tip= $Command{$cmd}[2] || '';
if ($tip) { $tip=~s/\n.*//s; $tip=" (argument : $tip)"; }
printf "%-${max}s : %s %s\n", $cmd, $short, $tip;
}
exit;
}
my $fifofh;
if ($FIFOFile)
{ if (-e $FIFOFile) { unlink $FIFOFile unless -p $FIFOFile; }
else
{ #system('mknod',$FIFOFile,'p'); #can't use mknod to create fifo on freeBSD
system 'mkfifo',$FIFOFile;
}
if (-p $FIFOFile)
{ sysopen $fifofh,$FIFOFile, O_NONBLOCK;
#sysopen $fifofh,$FIFOFile, O_NONBLOCK | O_RDWR;
Glib::IO->add_watch(fileno($fifofh),['in','hup'], \&CmdFromFIFO);
}
}
Glib::set_application_name(PROGRAM_NAME);
Gtk2::AboutDialog->set_url_hook(sub {openurl($_[1])});
Edittag_mode(@ARGV) if $CmdLine{tagedit};
#make this a plugin ? don't know if it's possible, it may need to run early
my $gnomeclient;
if ($CmdLine{UseGnomeSession})
{ eval # use the gnome libraries, if present, to enable some session management
{ require Gnome2;
#my $application=Gnome2::Program->init(PROGRAM_NAME, VERSION, 'libgnomeui');
my $application=Gnome2::Program->init(PROGRAM_NAME, VERSION);
$gnomeclient=Gnome2::Client->master();
$gnomeclient->signal_connect('die' => sub { Gtk2->main_quit; });
$gnomeclient->signal_connect(save_yourself => sub { SaveTags(); return 1 });
#$gnomeclient->set_restart_command($0,'-C',$SaveFile); #FIXME
#$gnomeclient->set_restart_style('if-running');
};
if ($@) {warn "Error loading Gnome2.pm => can't use gnome-session :\n $@\n"}
}
#-------------INIT-------------
{ Watch(undef, SongArray => \&SongArray_changed);
Watch(undef, $_ => \&QueueChanged) for qw/QueueAction Queue/;
Watch(undef, $_ => \&QueueUpdateNextSongs) for qw/Playlist Queue Sort Pos QueueAction/;
Watch(undef, $_ => sub { return unless defined $SongID && $TogPlay; HasChanged('PlayingSong'); }) for qw/CurSongID Playing/;
Watch(undef,RecentSongs => sub { UpdateRelatedFilter('Recent'); });
Watch(undef,NextSongs => sub { UpdateRelatedFilter('Next'); });
Watch(undef,CurSong => sub { UpdateRelatedFilter('Play'); });
}
LoadPlugins();
if ($CmdLine{pluginlist}) { print "$_ : $Plugins{$_}{name}\n" for sort keys %Plugins; exit; }
$SIG{HUP} = 'IGNORE';
ReadSavedTags();
$Options{AutoRemoveCurrentSong}=0 if $CmdLine{demo};
# global Volume and Mute are used only for gstreamer and mplayer in SoftVolume mode
our $Volume= $Options{Volume};
$Volume=100 unless defined $Volume;
our $Mute= $Options{Volume_mute} || 0;
$PlayPacks{$_}= $_->init for keys %PlayPacks;
%CustomBoundKeys= %{ make_keybindingshash($Options{CustomKeyBindings}) };
$Options{version}=VERSION;
LoadIcons();
{ my $pp=$Options{AudioOut};
$pp= $Options{use_GST_for_server} ? 'Play_GST_server' : 'Play_Server' if $CmdLine{server};
for my $p ($pp, qw/Play_GST Play_123 Play_mplayer Play_mpv Play_GST_server Play_Server/)
{ next unless $p && $PlayPacks{$p};
$pp=$p;
last;
}
$Options{AudioOut}||=$pp;
$PlayNext_package=$PlayPacks{$pp};
SwitchPlayPackage();
}
IdleCheck() if $Options{StartCheck} && !$CmdLine{nocheck};
IdleScan() if $Options{StartScan} && !$CmdLine{noscan};
$Options{Icecast_port}=$CmdLine{port} if $CmdLine{port};
#$ListMode=[] if $CmdLine{empty};
$ListPlay=SongArray::PlayList->init;
Play() if $CmdLine{play} && !$PlayTime;
#SkipTo($PlayTime) if $PlayTime; #gstreamer (how I use it) needs the mainloop running to skip, so this is done after the main window is created
Layout::InitLayouts;
ActivatePlugin($_,'startup') for grep $Options{'PLUGIN_'.$_}, sort keys %Plugins;
Update_QueueActionList();
QueueChanged() if $QueueAction;
CreateMainWindow( $CmdLine{layout}||$Options{Layout} );
ShowHide(0) if $CmdLine{hide} || ($Options{StartInTray} && $Options{UseTray} && $TrayIconAvailable);
SkipTo($PlayTime) if $PlayTime; #done only now because of gstreamer
CreateTrayIcon();
if (my $cmds=delete $CmdLine{runcmd}) { run_command(undef,$_) for @$cmds; }
$SIG{TERM} = \&Quit;
#--------------------------------------------------------------
Gtk2->main;
exit;
sub Edittag_mode
{ my @dirs=@_;
$Songs::Def{$_}{flags}=~m/w/ || $Songs::Def{$_}{flags}=~s/e// for grep $Songs::Def{$_}{flags}, keys %Songs::Def; #quick hack to remove fields that are not written in the tag from the mass-tagging dialog
FirstTime(); Post_ReadSavedTags();
LoadIcons(); #for stars edit widget that shouldn't be shown anyway
$Options{LengthCheckMode}='never';
$_=rel2abs($_) for @dirs;
IdleScan(@dirs);
Gtk2->main_iteration while Gtk2->events_pending;
my $dialog = Gtk2::Dialog->new( _"Editing tags", undef,'modal',
'gtk-save' => 'ok',
'gtk-cancel' => 'none');
$dialog->signal_connect(destroy => sub {exit});
$dialog->set_default_size(500, 600);
my $edittag;
if (@$Library==1)
{ my $ID= $Library->[0];
$edittag=EditTagSimple->new($ID);
$dialog->signal_connect( response => sub
{ my ($dialog,$response)=@_;
if ($response eq 'ok')
{ my @set= $edittag->get_changes;
Songs::Set($ID,\@set,window=>$dialog,noidle=>1) if @set;
}
exit;
});
}
elsif (@$Library>1)
{ $edittag=MassTag->new(@$Library);
$dialog->signal_connect( response => sub
{ my ($dialog,$response)=@_;
if ($response eq 'ok') { $edittag->save( sub {exit} ); }
else {exit}
});
}
else {die "No songs found.\n";}
$dialog->vbox->add($edittag);
$dialog->show_all;
Gtk2->main;
}
sub ChangeDisplay
{ my $display=$_[1];
my $screen=0;
$screen=$1 if $display=~s/\.(\d+)$//;
$display=Gtk2::Gdk::Display->open($display);
return unless $display && $screen < $display->get_n_screens;
Gtk2::Gdk::DisplayManager->get->set_default_display($display);
$screen=$display->get_screen($screen);
for my $win (Gtk2::Window->list_toplevels)
{ $win->set_screen($screen);
}
}
sub filename_to_utf8displayname #replaced by Glib::filename_display_name if available
{ my $utf8name=eval {filename_to_unicode($_[0])};
if ($@)
{ $utf8name=$_[0];
#$utf8name=~s/[\x80-\xff]/?/gs; #doesn't seem to be needed
}
return $utf8name;
}
sub get_event_window
{ my $widget=shift;
$widget||= Gtk2->get_event_widget(Gtk2->get_current_event);
return $widget && find_ancestor($widget,'Gtk2::Window');
}
sub get_layout_widget
{ find_ancestor($_[0],'Layout');
}
sub find_ancestor
{ my ($widget,$class)=@_;
until ( $widget->isa($class) )
{ $widget= $widget->isa('Gtk2::Menu')? $widget->get_attach_widget : $widget->parent;
#warn "Can't find ancestor $class of widget $_[0]\n" unless $widget;
return undef unless $widget;
}
return $widget;
}
sub HVpack
{ my ($vertical,@list)=@_;
my $pad=2;
my $end=FALSE;
my $box= $vertical ? Gtk2::VBox->new : Gtk2::HBox->new;
while (@list)
{ my $w=shift @list;
next unless defined $w;
my $exp=FALSE;
unless (ref $w)
{ if ($w eq 'compact') { $pad=0; $box->set_spacing(0); next }
$exp=$w=~m/_/;
$end=1 if $w=~m/-/;
$pad=$1 if $w=~m/(\d+)/;
$w=shift @list;
next unless $w;
}
if (ref $w eq 'ARRAY')
{ $w=HVpack(!$vertical,@$w);
}
if ($end) {$box->pack_end ($w,$exp,$exp,$pad);}
else {$box->pack_start($w,$exp,$exp,$pad);}
}
return $box;
}
sub Hpack { HVpack(0,@_); }
sub Vpack { HVpack(1,@_); }
sub new_scrolledwindow
{ my ($widget,$shadow)=@_;
my $sw= Gtk2::ScrolledWindow->new;
$sw->set_shadow_type('etched-in') if $shadow;
$sw->set_policy('automatic','automatic');
$sw->add($widget);
return $sw;
}
sub IsEventInNotebookTabs
{ my ($nb,$event)=@_;
my (@rects)= map $_->allocation, grep $_->mapped, map $nb->get_tab_label($_), $nb->get_children;
my ($bw,$bh)=$nb->get('tab-hborder','tab-vborder');
my $x1=min(map $_->x,@rects)-$bw;
my $y1=min(map $_->y,@rects)-$bh;
my $x2=max(map $_->x+$_->width,@rects)+$bw;
my $y2=max(map $_->y+$_->height,@rects)+$bh;
my ($x,$y)=$event->window->get_position;
$x+=$event->x;
$y+=$event->y;
#warn "$x1,$y1,$x2,$y2 $x,$y";
return ($x1<$x && $x2>$x && $y1<$y && $y2>$y);
}
sub TurnOff
{ my $dialog=Gtk2::MessageDialog->new
( $MainWindow,[qw/modal destroy-with-parent/],
'warning','none',''
);
$dialog->add_buttons('gtk-cancel' => 2, 'gmb-turnoff'=> 1);
my $sec=21;
my $timer=sub #FIXME can be more than 1 second
{ return 0 unless $sec;
if (--$sec) {$dialog->set_markup(::PangoEsc(_("About to turn off the computer in :")."\n".__("%d second","%d seconds",$sec)))}
else { $dialog->response(1); }
return $sec;
};
Glib::Timeout->add(1000, $timer);
&$timer; #init the timer
$dialog->show_all;
my $ret=$dialog->run;
$dialog->destroy;
$sec=0;
return if $ret==2;
Quit('turnoff');
}
sub Quit
{ my $turnoff;
$turnoff=1 if $_[0] && $_[0] eq 'turnoff';
$Options{SavedPlayTime}= $PlayTime if $Options{RememberPlayTime};
&Stop if defined $TogPlay;
@ToScan=@ToAdd_Files=();
CloseTrayTip();
SaveTags();
HasChanged('Quit');
unlink $FIFOFile if $FIFOFile;
Gtk2->main_quit;
exec $Options{Shutdown_cmd} if $turnoff && $Options{Shutdown_cmd};
exit;
}
sub CmdFromFIFO
{ while (my $cmd=<$fifofh>)
{ chomp $cmd;
next if $cmd eq '';
$cmd="$1($2)" if $cmd=~m/^(\w+) (.*)/;
($cmd, my$arg)= $cmd=~m/^(\w+)(?:\((.*)\))?$/;
#if ($cmd eq 'Print') {print $fifofh "Told to print : $arg\n";return}
if (exists $Command{$cmd}) { Glib::Timeout->add(0, sub { $Command{$cmd}[0]($_[0],$arg); 0;},GetActiveWindow()); warn "fifo:received $cmd\n" if $debug; }
else {warn "fifo:received unknown command : '$cmd'\n"}
}
if (1) #FIXME replace 1 by gtk+ version check once the gtk+ bug is fixed (http://bugzilla.gnome.org/show_bug.cgi?id=321053)
{ #work around gtk bug that use 100% cpu after first command : close and reopen fifo
close $fifofh;
sysopen $fifofh,$FIFOFile, O_NONBLOCK;
#sysopen $fifofh,$FIFOFile, O_NONBLOCK | O_RDWR;
Glib::IO->add_watch(fileno($fifofh),['in','hup'], \&CmdFromFIFO);
return 0; #remove previous watcher
}
1;
}
sub GetActiveWindow
{ my ($win)= sort {$b->{last_focused} <=> $a->{last_focused}} grep $_->{last_focused}, Gtk2::Window->list_toplevels;
return $win;
}
sub SearchPicture # search for file with a relative path among a few folders, used to find pictures used by layouts
{ my ($file,@paths)=@_;
return $file if file_name_is_absolute($file);
push @paths, $HomeDir.'layouts', $CmdLine{searchpath}, PIXPATH, $DATADIR.SLASH.'layouts'; #add some default folders
@paths= grep defined, map ref() ? @$_ : $_, @paths;
for (@paths) { $_=dirname($_) if -f; } #replace files by their folder
my $found=first { -f $_.SLASH.$file } @paths;
return cleanpath($found.SLASH.$file) if $found;
warn "Can't find file '$file' (looked in : @paths)\n";
return undef;
}
sub FileList
{ my ($re,@search)=@_;
my @found;
@search=grep defined, @search;
@search=map ref() ? @$_ : $_, @search;
for my $search (@search)
{ if (-f $search) { push @found,$search if $search=~$re; next; }
next unless -d $search;
opendir my($dir),$search;
push @found, map $search.SLASH.$_,sort grep m/$re/, readdir $dir;
close $dir;
}
return grep -f, @found;
}
sub LoadPlugins
{ my @list= FileList( qr/\.p[lm]$/, $DATADIR.SLASH.'plugins', $HomeDir.'plugins', $CmdLine{searchpath} );
my %loaded; $loaded{$_}= $_->{file} for grep $_->{loaded}, values %Plugins;
for my $file (grep !$loaded{$_}, @list)
{ warn "Reading plugin $file\n" if $::debug;
my ($found,$id);
open my$fh,'<:utf8',$file or do {warn "error opening $file : $!\n";next};
while (my $line=<$fh>)
{ if ($line=~m/^=(?:begin |for )?gmbplugin(?: ([A-Za-z]\w*))?/)
{ my $id=$1;
my %plug= (version=>0,desc=>'',);
while ($line=<$fh>)
{ $line=~s/\s*[\n\r]+$//;
last if $line eq '=cut' || $line eq '=end gmbplugin';
my ($key,$val)= $line=~m/^\s*(\w+):?\s+(.+)/;
next unless $key;
if ($key eq 'id') { $id=$val }
elsif ($key eq 'desc')
{ $plug{desc} .= _($val)."\n";
}
elsif ($key eq 'author')
{ push @{$plug{author}}, $val;
}
else { $plug{$key}=$val; }
}
last unless $id;
last unless $plug{name};
chomp $plug{desc};
$plug{file}=$file;
$plug{version}=$1+($2||0)/100+($3||0)/10000 if $plug{version}=~m#(\d+)(?:\.(\d+)(?:\.(\d+)))#;
$plug{$_}=_($plug{$_}) for grep $plug{$_}, qw/name title/;
$found++;
if ($Plugins{$id})
{ last if $Plugins{$id}{loaded} || $Plugins{$id}{version}>=$plug{version};
}
warn "found plugin $id ($plug{name})\n" if $::debug;
$Plugins{$id}=\%plug;
last;
}
elsif ($line=~m/^\s*[^#\n\r]/) {last} #read until first non-empty and non-comment line
}
close $fh;
warn "No plugin found in $file, maybe it uses an old format\n" unless $found;
}
}
sub PluginsInit
{ if (delete $CmdLine{noplugins}) { $Options{'PLUGIN_'.$_}=0 for keys %Plugins; }
my $h=delete $CmdLine{plugins};
for my $p (keys %$h)
{ if (!$Plugins{$p}) { warn "Unknown plugin $p\n";next }
$Options{'PLUGIN_'.$p}=$h->{$p};
}
ActivatePlugin($_,'init') for grep $Options{'PLUGIN_'.$_}, sort keys %Plugins;
}
# $startup can be undef, 'init' or 'startup'
# - 'init' when called after loading settings, run Init if defined
# - 'startup' when called after the songs are loaded, run Start if defined
# - undef when activated by the user, runs Init then Start
sub ActivatePlugin
{ my ($plugin,$startup)=@_;
my $ref=$Plugins{$plugin};
if ( $ref->{loaded} || do $ref->{file} )
{ $ref->{loaded}=1;
delete $ref->{error};
my $package='GMB::Plugin::'.$plugin;
if ($startup && $startup eq 'init')
{ if ($package->can('Init'))
{ $package->Init;
warn "Plugin $plugin initialized.\n" if $debug;
}
}
else
{ $package->Init if !$startup && $package->can('Init');
$package->Start($startup) if $package->can('Start');
warn "Plugin $plugin activated.\n" if $debug;
}
$Options{'PLUGIN_'.$plugin}=1;
}
elsif (!$startup || $startup eq 'init')
{ warn "plugin $ref->{file} failed : $@\n";
$ref->{error}=$@;
}
}
sub DeactivatePlugin
{ my $plugin=$_[0];
my $package='GMB::Plugin::'.$plugin;
delete $Options{'PLUGIN_'.$plugin};
return unless $Plugins{$plugin}{loaded};
warn "Plugin $plugin De-activated.\n" if $debug;
$package->Stop if $package->can('Stop');
}
sub CheckPluginRequirement
{ my $plugin=shift;
my $ref=$Plugins{$plugin};
my $msg='';
if (my $req=$ref->{req})
{ my @req;
my @suggest;
while ($req=~m/\bperl\(([\w:]+)(?:\s*,\s*([-\.\w ]+))?\)/ig)
{ my ($module,$packages)=($1,$2);
my $file="/$module.pm";
$file=~s#::#/#g;
if (!grep -f $_.$file, @INC)
{ push @req, __x( _"the {name} perl module",name=>$module);
push @suggest, $packages;
}
}
while ($req=~m/\bexec\((\w+)(?:\s*,\s*([-\.\w ]+))?\)/ig)
{ my ($exec,$packages)=($1,$2);
if (!findcmd($exec))
{ push @req, __x( _"the command {name}",name=>$exec);
push @suggest, $packages;
}
}
while ($req=~m/\bfile\(([-\w\.\/]+)(?:\s*,\s*([-\.\w ]+))?\)/ig)
{ my ($file,$packages)=($1,$2);
if (!-r $file)
{ push @req, __x( _"the file {name}",name=>$file);
push @suggest, $packages;
}
}
return unless @req;
my $msg= PangoEsc(_"This plugin requires :")."\n\n";
while (@req)
{ my $r=shift @req;
my $packages=shift @suggest;
$packages= $packages ? ("Possible package names providing this :".' '.$packages."\n") : '';
$msg.= MarkupFormat("- %s\n<small>%s</small>\n", $r, $packages);
}
return $msg;
}
}
sub ChangeVol
{ my $cmd;
if ($_[0] eq 'mute')
{ $cmd=$Vol_package->GetMute? 'unmute':'mute' ;
}
else
{ $cmd=(ref $_[0])? $_[1]->direction : $_[0];
if ($Vol_package->GetMute) {$cmd='unmute'}
elsif ($cmd eq 'up') {$cmd="+$Options{VolumeStep}"}
elsif ($cmd eq 'down'){$cmd="-$Options{VolumeStep}"}
}
warn "volume $cmd ...\n" if $debug;
UpdateVol($cmd);
warn "volume $cmd" if $debug;
}
sub UpdateVol
{ $Vol_package->SetVolume($_[0]);
}
sub GetVol
{ $Vol_package->GetVolume;
}
sub GetMute
{ $Vol_package->GetMute;
}
sub SetEqualizer
{ my ($key,$value)=@_;
my ($eq,$preset,$preamp);
my $on_off;
if ($key eq 'smart') #for SetEqualizer command
{ if ($value=~m/^[01]$/) { $key='active' }
elsif (exists $::Options{equalizer_presets}{$value}) {$key='preset'}
elsif ($value=~m#^(?:(?:-?\d*\.?\d+):){9}(?:-?\d*\.?\d+)$#) {$key='set'}
else { warn "SetEqualizer: invalid argument : $value\n" }
}
if ($key eq 'active')
{ ::SetOption(use_equalizer => $value ? 1 : 0);
$eq= $value ? $::Options{equalizer} : '0:0:0:0:0:0:0:0:0:0';
$preamp= $value ? $::Options{equalizer_preamp} : 1;
$on_off=1; # set equalizer values and preamp without changing $options
}
elsif ($key eq 'set' && $value=~m#^(?:(?:-?\d*\.?\d+):){9}(?:-?\d*\.?\d+)$#)
{ $eq= $value;
$preset='';
}
elsif ($key eq 'preamp')
{ $preamp= $value;
}
elsif ($key eq 'preset' && exists $::Options{equalizer_presets}{$value})
{ $eq= $::Options{equalizer_presets}{$value};
$preset= $value;
}
elsif ($key eq 'preset_save' && $value=~m/\S/)
{ $::Options{equalizer_presets}{$value}= $::Options{equalizer};
$::Play_package->EQ_Save_Preset($value,$::Options{equalizer}) if $::Play_package->can('EQ_Save_Preset');
::HasChanged(Equalizer=>'presetlist');
$preset= $value;
}
elsif ($key eq 'preset_delete')
{ delete $::Options{equalizer_presets}{$value};
$::Play_package->EQ_Save_Preset($value) if $::Play_package->can('EQ_Save_Preset');
::HasChanged(Equalizer=>'presetlist');
$preset='';
}
elsif ($key=~m/^[0-9]$/) #$key is band number 0..9
{ my @vals= split /:/, $::Options{equalizer};
$vals[$key]=$value;
::setlocale(::LC_NUMERIC, 'C');
$eq= join ':',@vals;
::setlocale(::LC_NUMERIC, '');
$preset='';
}
else {return}
unless ($on_off)
{ $::Options{equalizer}= $eq if $eq;
$::Options{equalizer_preamp}= $preamp if defined $preamp;
$::Options{equalizer_preset}= $preset if defined $preset;
}
if ($::Options{use_equalizer} || $on_off)
{ $::Play_package->set_equalizer($eq) if $eq && $::Play_package->{EQ};
$::Play_package->set_equalizer_preamp($preamp) if defined $preamp && $::Play_package->{EQpre};
}
if ($on_off)
{ ::HasChanged(Equalizer=>'active')
}
else
{ ::HasChanged(Equalizer=>'values') if $eq;
::HasChanged(Equalizer=>'preamp') if defined $preamp;
::HasChanged(Equalizer=>'preset') if defined $preset;
}
}
sub GetPresets
{ return ::superlc_sort(keys %{$::Options{equalizer_presets}});
}
sub FirstTime
{ #Default filters
$Options{SavedFilters}=
{ _"never played" => 'playcount:<:1',
_"50 Most Played" => 'playcount:h:50',
_"50 Last Played" => 'lastplay:h:50',
_"50 Last Added" => 'added:h:50',
_"Played Today" => 'lastplay:<ago:1d',
_"Added Today" => 'added:<ago:1d',
_"played>4" => 'playcount:>:4',
_"not bootleg" => 'label:-~:bootleg',
};
$_=Filter->new($_) for values %{ $Options{SavedFilters} };
my @dirs= reverse map $_.SLASH.'gmusicbrowser', Glib::get_system_config_dirs;
for my $dir ($DATADIR,@dirs)
{ next unless -r $dir.SLASH.'gmbrc.default';
open my($fh),'<:utf8', $dir.SLASH.'gmbrc.default';
my @lines=<$fh>;
close $fh;
chomp @lines;
my $opt={};
ReadRefFromLines(\@lines,$opt);
%Options= ( %Options, %$opt );
}
Post_Options_init();
}
my %artistsplit_old_to_new= #for versions <= 1.1.5 : to upgrade old ArtistSplit regexp to new default regexp
( ' & ' => '\s*&\s*',
', ' => '\s*,\s+',
' \\+ ' => '\s*\\+\s*',
'; *' => '\s*;\s*',
';' => '\s*;\s*',
);
sub ReadOldSavedTags
{ my $fh=$_[0];
while (<$fh>)
{ chomp; last if $_ eq '';
$Options{$1}=$2 if m/^([^=]+)=(.*)$/;
}
my $oldversion=delete $Options{version} || VERSION;
if ($oldversion<0.9464) {delete $Options{$_} for qw/BrowserTotalMode FilterPane0Page FilterPane0min FilterPane1Page FilterPane1min LCols LSort PlayerWinPos SCols Sticky WSBrowser WSEditQueue paned StickyFilters/;} #cleanup old options
$Options{'123options_mpg321'}=delete $Options{'123options_mp3'};
$Options{'123options_ogg123'}=delete $Options{'123options_ogg'};
$Options{'123options_flac123'}=delete $Options{'123options_flac'};
delete $Options{$_} for qw/Device 123options_mp3 123options_ogg 123options_flac test Diacritic_sort gst_volume Simplehttp_CacheSize/; #cleanup old options
delete $Options{$_} for qw/SavedSongID SavedPlayTime Lock SavedSort/; #don't bother supporting upgrade for these
$Options{CustomKeyBindings}= { ExtractNameAndOptions($Options{CustomKeyBindings}) };
delete $Options{$_} for grep m/^PLUGIN_MozEmbed/,keys %Options; #for versions <=1.0
delete $Options{$_} for grep m/^PLUGIN_WebContext_Disable/,keys %Options;
delete $Options{$_} for grep m/^Layout(?:LastSeen)?_/, keys %Options;
$Options{WindowSizes}{$_}= join 'x',split / /,delete $Options{"WS$_"} for map m/^WS(.*)/, keys %Options;
delete $Options{RecentFilters}; #don't bother upgrading them
$Options{FilenameSchema}= [split /\x1D/,$Options{FilenameSchema}];
$Options{FolderSchema}= [split /\x1D/,$Options{FolderSchema}];
$Options{LibraryPath}= delete $Options{Path};
$Options{Labels}=delete $Options{Flags} if $oldversion<=0.9571;
$Options{Labels}=[ split "\x1D",$Options{Labels} ] unless ref $Options{Labels}; #for version <1.1.2
$Options{Fields_options}{label}{persistent_values}= delete $Options{Labels};
$Options{Artists_split_re}= [ map { $artistsplit_old_to_new{$_}||$_ } grep $_ ne '$', split /\|/, delete $Options{ArtistSplit} ];
$Options{TrayTipDelay}&&=900;
Post_Options_init();
my $oldID=-1;
no warnings 'utf8'; # to prevent 'utf8 "\xE9" does not map to Unicode' type warnings about path and file which are stored as they are on the filesystem #FIXME find a better way to read lines containing both utf8 and unknown encoding
my ($loadsong)=Songs::MakeLoadSub({},split / /,$Songs::OLD_FIELDS);
my (%IDforAlbum,%IDforArtist);
my @newIDs; SongArray::start_init();
my $lengthcheck=SongArray->new;
while (<$fh>)
{ chomp; last if $_ eq '';
$oldID++;
next if $_ eq ' '; #deleted entry
s#\\([n\\])#$1 eq "n" ? "\n" : "\\"#ge unless $oldversion<0.9603;
my @song=split "\x1D",$_,-1;
next unless $song[0] && $song[1] && $song[2]; # 0=SONG_FILE 1=SONG_PATH 2=SONG_MODIF
my $album=$song[11]; my $artist=$song[10];
$song[10]=~s/^<Unknown>$//; #10=SONG_ARTIST
$song[11]=~s/^<Unknown>.*//; #11=SONG_ALBUM
$song[12]=~s#/.*$##; ##12=SONG_DISC
#$song[13]=~s#/.*$##; ##13=SONG_TRACK
for ($song[0],$song[1]) { _utf8_off($_); $_=Songs::filename_escape($_) } # file and path
my $misc= $song[24]||''; #24=SONG_MISSINGSINCE also used for estimatedlength and radio
next if $misc eq 'R'; #skip radios (was never really enabled)
$song[24]=0 unless $misc=~m/^\d+$/;
my $ID= $newIDs[$oldID]= $loadsong->(@song);
$IDforAlbum{$album}=$IDforArtist{$artist}=$ID;
push @$lengthcheck,$ID if $misc eq 'l';
unless ($misc=~m/^\d+$/ && $misc>0) { push @$Library,$ID };
}
while (<$fh>)
{ chomp; last if $_ eq '';
my ($key,$p)=split "\x1D";
next if $p eq '';
_utf8_off($p);
my $ID=$IDforArtist{$key};
next unless defined $ID;
my $gid=Songs::Get_gid($ID,'artist');
Songs::Picture($gid,'artist_picture','set',$p);
}
while (<$fh>)
{ chomp; last if $_ eq '';
my ($key,$p)=split "\x1D";
next if $p eq '';
_utf8_off($p);
my $ID=$IDforAlbum{$key};
next unless defined $ID;
my $gid=Songs::Get_gid($ID,'album');
Songs::Picture($gid,'album_picture','set',$p);
}
$Options{$_}={} for qw/SavedFilters SavedSorts SavedWRandoms SavedLists SavedSTGroupings/;
while (<$fh>)
{ chomp;
my ($key,$val)=split "\x1D",$_,2;
$key=~s/^(.)//;
if ($1 eq 'F')
{ $val=~s/((?:^|\x1D)-?)(\d+)?([^0-9()])/$1.(defined $2? Songs::FieldUpgrade($2) : '').":$3:"/ge;
$val=~s/((?:^|\x1D)-?(?:label|genre)):e:(?=\x1D|$)/$1:ecount:0/g;
$val=~s/((?:^|\x1D)-?(?:label|genre)):f:/$1:~:/g;
$Options{SavedFilters}{$key}=Filter->new_from_string($val);
}
elsif ($1 eq 'S')
{ $Options{SavedSorts}{$key}=$val;
}
elsif ($1 eq 'R')
{ $Options{SavedWRandoms}{$key}=$val;
}
elsif ($1 eq 'L')
{ $Options{SavedLists}{$key}= SongArray::Named->new_from_string($val);
}
elsif ($1 eq 'G')
{ $Options{SavedSTGroupings}{$key}=$val;
}
}
if (my $f=delete $Options{LastPlayFilter})
{ if ($f=~s/^(filter|savedlist|list) //)
{ $Options{LastPlayFilter}=
$1 eq 'filter' ? Filter->new_from_string($f) :
$1 eq 'savedlist' ? $f :
$1 eq 'list' ? SongArray->new_from_string($f):
undef;
}
}
s/^r/random:/ || s/([0-9s]+)(i?)/($1 eq 's' ? 'shuffle' : Songs::FieldUpgrade($1)).($2 ? ':i' : '')/ge
for values %{$Options{SavedSorts}},values %{$Options{SavedWRandoms}},$Options{Sort},$Options{AltSort};
$Options{Sort_LastOrdered}=$Options{Sort_LastSR}= delete $Options{AltSort};
if ($Options{Sort}=~m/random|shuffle/) { $Options{Sort_LastSR}=$Options{Sort} } else { $Options{Sort_LastOrdered}=$Options{Sort}||'path file'; }
$Options{SongArray_Recent}= SongArray->new_from_string(delete $Options{RecentIDs});
SongArray::updateIDs(\@newIDs);
SongArray->new($Library); #done after SongArray::updateIDs because doesn't use old IDs
Songs::Set($_,length_estimated=>1) for @$lengthcheck;
$Options{LengthCheckMode}='add';
}
sub Filter_new_from_string_with_upgrade # for versions <=1.1.7
{ my @filter=split /\x1D/,$_[1];
my @new;
for my $f (@filter)
{ if ($f=~m/^[()]/) { push @new,$f; next }
my ($field,$cmd,$pat)=split ':',$f,3;
if ($cmd eq 's') {$cmd='si'}
elsif ($cmd eq 'S') {$cmd='s'}
elsif ($cmd eq 'l') { $field='list'; $cmd='e'; }
elsif ($cmd eq 'i') { $pat=~s#([^/\$_.+!*'(),A-Za-z0-9-])#sprintf('%%%02X',ord($1))#seg; }
elsif ($field eq 'rating' && $cmd eq 'e') { $cmd='~'}
elsif ($cmd=~m/^[b<>]$/ && $field=~m/^-?lastplay$|^-?lastskip$|^-?added$|^-?modif$/)
{ if ($pat=~m/[a-zA-Z]/)
{ $cmd= $cmd eq '<' ? '>ago' :
$cmd eq '>' ? '<ago' : 'bago';
}
else { $pat=~s/(\d\d\d\d)-(\d\d?)-(\d\d?)/mktime(0,0,0,$3,$2-1,$1-1900)/eg }
}
elsif ($cmd eq 'b')
{ my ($n1,$n2)= split / /,$pat;
if ($field=~s/^-//) { push @new, '(|', "$field:<:$n1", "$field:->:$n2",')'; }
else { push @new, '(&', "$field:-<:$n1", "$field:<:$n2" ,')'; }
next
}
$cmd= '-'.$cmd if $field=~s/^-//;
push @new, "$field:$cmd:$pat";
}
my $string= join "\x1D", @new;
return Filter->new_from_string_real($string);
}
sub ReadSavedTags #load tags _and_ settings
{ my ($fh,$loadfile,$ext)= Open_gmbrc( $ImportFile || $SaveFile,0);
unless ($fh)
{ if ($loadfile && -e $loadfile && -s $loadfile)
{ die "Can't open '$loadfile', aborting...\n" unless $fh;
}
else
{ FirstTime();
Post_ReadSavedTags();
return;
}
}
warn "Reading saved tags in $loadfile ...\n";
$SaveFile.=$1 if $loadfile=~m#($gmbrc_ext_re)# && $SaveFile!~m#$gmbrc_ext_re#; # will use .gz/.xz to save if read from a .gz/.xz gmbrc
setlocale(LC_NUMERIC, 'C'); # so that '.' is used as a decimal separator when converting numbers into strings
# read first line to determine if old version, version >1.1.7 stars with "# gmbrc version=", version <1.1 starts with a letter, else it's version<=1.1.7 (starts with blank or # (for comments) or [ (section name))
my $firstline=<$fh>;
unless (defined $firstline) { die "Can't read '$loadfile', aborting...\n" }
my $oldversion;
if ($firstline=~m/^#?\s*gmbrc version=(\d+\.\d+)/) { $oldversion=$1 }
elsif ($ext) { die "Can't find gmbrc header in '$loadfile', aborting...\n" } # compressed gmbrc not supported with old versions, because can't seek backward in compressed fh
elsif ($firstline=~m/^\w/) { seek $fh,0,SEEK_SET; ReadOldSavedTags($fh); $oldversion=1 }
else # version <=1.1.7
{ seek $fh,0,SEEK_SET;
no warnings qw/redefine once/;
*Filter::new_from_string_real= \&Filter::new_from_string;
*Filter::new_from_string= \&Filter_new_from_string_with_upgrade;
}
if (!$oldversion || $oldversion>1) # version >=1.1
{ my %lines;
my $section='HEADER';
while (<$fh>)
{ if (m/^\[([^]]+)\]/) {$section=$1; next}
chomp;
next unless length;
push @{$lines{$section}},$_;
}
close $fh;
unless ($lines{EOF} || $oldversion<=1.1015)
{ my $dialog = Gtk2::MessageDialog->new(undef,'modal','error','none','%s', _"The save file seems incomplete, you may want to use a backup instead.");
$dialog->set_title(PROGRAM_NAME);
$dialog->add_button_custom(_"Continue anyway",1);
$dialog->add_button_custom(_"Exit",2, icon=>'gtk-quit', tip=>__x(_"You can find backups in {folder}",folder=>dirname($SaveFile)));
$dialog->show_all;
exit unless $dialog->run eq '1';
$dialog->destroy;
}
unless ($lines{Options}) { warn "Can't find Options section in '$loadfile', it's probably not a gmusicbrowser save file -> aborting\n"; exit 1; }
SongArray::start_init(); #every SongArray read in Options will be updated to new IDs by SongArray::updateIDs later
ReadRefFromLines($lines{Options},\%Options);
$oldversion||=delete $Options{version} || VERSION; # for version <=1.1.7
if ($oldversion>VERSION) { warn "Loading a gmbrc saved with a more recent version of gmusicbrowser, try upgrading gmusicbrowser if there are problems\n"; }
if ($oldversion<1.10091) {delete $Options{$_} for qw/Diacritic_sort gst_volume Simplehttp_CacheSize mplayer_use_replaygain/;} #cleanup old options
if ($oldversion<=1.1011) {delete $Options{$_} for qw/ScanPlayOnly/;} #cleanup old options
$Options{AutoRemoveCurrentSong}= delete $Options{TAG_auto_check_current} if $oldversion<1.1005 && exists $Options{TAG_auto_check_current};
$Options{PlayedMinPercent}= 100*delete $Options{PlayedPercent} if exists $Options{PlayedPercent};
if ($Options{ArtistSplit}) # for versions <= 1.1.5
{ $Options{Artists_split_re}= [ map { $artistsplit_old_to_new{$_}||$_ } grep $_ ne '$', split /\|/, delete $Options{ArtistSplit} ];
}
if ($oldversion<1.1007) { for my $re (@{$Options{Artists_split_re}}) { $re='\s*,\s+' if $re eq '\s*,\s*'; } }
if ($oldversion<1.1008) { my $d=$Options{TrayTipDelay}||0; $Options{TrayTipDelay}= $d==1 ? 900 : $d; }
if ($Options{Labels}) { $Options{Fields_options}{label}{persistent_values}= delete $Options{Labels} }
if ($oldversion<=1.1014) { $Options{$_}= delete $Options{"gst_$_"} for qw/equalizer use_equalizer equalizer_preset equalizer_preamp use_replaygain rg_albummode rg_fallback rg_preamp rg_limiter/; }
Post_Options_init();
my $songs=$lines{Songs};
my $fields=shift @$songs;
my ($loadsong,$extra_sub)=Songs::MakeLoadSub(\%lines,split /\t/,$fields);
my @newIDs;
while (my $line=shift @$songs)
{ my ($oldID,@vals)= split /\t/, $line,-1;
s#\\x([0-9a-fA-F]{2})#chr hex $1#eg for @vals;
$newIDs[$oldID]= $loadsong->(@vals);
}
#load fields properties, like album pictures ...
for my $extra (keys %$extra_sub)
{ my $lines=$lines{$extra};
next unless $lines;
shift @$lines; #my @properties=split / /, shift @$lines;
my $sub=$extra_sub->{$extra};
while (my $line=shift @$lines)
{ my ($key,@vals)= split /\t/, $line,-1;
s#\\x([0-9a-fA-F]{2})#chr hex $1#eg for $key,@vals;
$sub->($key,@vals);
}
}
SongArray::updateIDs(\@newIDs);
if (my $l=delete $Options{SongArray_Estimated}) # for $oldversion<1.1008
{ $Recent= SongArray->new; # $Recent is used in SongsChanged() so must exists, will be replaced
Songs::Set($_,length_estimated=>1) for @$l;
$Options{LengthCheckMode}='add';
}
my $mfilter= $Options{MasterFilterOn} && $Options{MasterFilter} || '';
my $filter= Filter->newadd(TRUE,'missing:e:0', $mfilter);
$Library=[]; #dummy array to avoid a warning when filtering in the next line
$Library= SongArray->new( $filter->filter_all );
}
if ($oldversion<=1.1009)
{ bless $_,'SongArray::Named' for values %{$Options{SavedLists}}; #named lists now use SongArray::Named instead of plain SongArray
no warnings 'once';
for my $floatvector ($Songs::Songs_replaygain_track_gain__,$Songs::Songs_replaygain_track_peak__,$Songs::Songs_replaygain_album_gain__,$Songs::Songs_replaygain_album_peak__)
{ $floatvector= pack "F*",map $_||"nan", unpack("F*",$floatvector) if $floatvector; # undef is now stored as nan rather than 0, upgrade assuming all 0s were undef
}
}
elsif ($oldversion==1.100901) #fix version 1.1.9.1 mistakenly upgrading by replacing float values of 0 by inf instead of nan
{ for my $floatvector ($Songs::Songs_replaygain_track_gain__,$Songs::Songs_replaygain_track_peak__,$Songs::Songs_replaygain_album_gain__,$Songs::Songs_replaygain_album_peak__)
{ $floatvector= pack "F*",map {$_!="inf" ? $_ : "nan"} unpack("F*",$floatvector) if $floatvector; }
}
if ($oldversion<1.101502)
{ IdleDo('0_Updatemp3filetype', 10,sub { my $h=Songs::BuildHash('filetype',undef,'','id:list'); while (my ($gid,$IDs)=each %$h) { my $type= Songs::Gid_to_Get('filetype',$gid); $type=~s/2,5/2.5/; $type=~s/^mp3 l(\d)v(\d.*)/mp$1 mpeg-$2 l$1/ && Songs::Set($IDs,filetype=>$type); } });
}
delete $Options{LastPlayFilter} unless $Options{RememberPlayFilter};
$QueueAction= $Options{QueueAction} || '';
unless ($Options{RememberQueue})
{ $Options{SongArray_Queue}=undef;
$QueueAction= '';
}
if ($Options{RememberPlayFilter})
{ $TogLock=$Options{Lock};
}
if ($Options{RememberPlaySong} && $Options{SavedSongID})
{ $SongID= (delete $Options{SavedSongID})->[0]; }
if ($Options{RememberPlaySong} && $Options{RememberPlayTime}) { $PlayTime=delete $Options{SavedPlayTime}; }
$Options{LibraryPath}||=[];
$Options{LibraryPath}= [ map url_escape($_), split "\x1D", $Options{LibraryPath}] unless ref $Options{LibraryPath}; #for versions <=1.1.1
&launchIdleLoop;
setlocale(LC_NUMERIC, '');
warn "Reading saved tags in $loadfile ... done\n";
Post_ReadSavedTags();
}
sub Post_Options_init
{ PluginsInit();
Songs::UpdateFuncs();
}
sub Post_ReadSavedTags
{ $Library||= SongArray->new;
$Recent= $Options{SongArray_Recent} ||= SongArray->new;
$Queue= $Options{SongArray_Queue} ||= SongArray->new;
$Options{LibraryPath}||=[];
#CheckLength() if $Options{LengthCheckMode} eq 'add';
}
sub Open_gmbrc
{ my ($file,$write)=@_;
my $encoding='utf8';
my ($fh,$ext,@cmd);
if ($write)
{ my @cmd;
if ($file=~m#\.gz$#) { $ext='.gz'; @cmd=qw/gzip/; }
elsif ($file=~m#\.xz$#) { $ext='.xz'; @cmd=qw/xz -0/; }
if (@cmd)
{ if (findcmd($cmd[0]))
{ open $fh,'|-:'.$encoding,"@cmd > \Q$file\E" or warn "Failed opening '$file' for writing (using $cmd[0]) : $!\n";
}
else { $file=~s#\.xz$|\.gz$##; @cmd=(); warn "Can't find $cmd[0], saving without compression\n"; }
}
if (!@cmd)
{ open $fh,'>:'.$encoding,$file or warn "Failed opening '$file' for writing : $!\n";
$ext='';
}
return ($fh,$file,$ext);
}
else # open for reading
{ unless (-e $file) #if not found as is try with/without .gz/.xz
{ $file=~s#$gmbrc_ext_re##;
$file= find_gmbrc_file($file);
}
return unless $file;
if (-z $file) { warn "Warning: save file '$file' is empty\n"; return }
my $cmpr;
if ($file=~m#(\.gz|\.xz)$#) { $cmpr=$ext=$1; }
else
{ open $fh,'<',$file or warn "Failed opening '$file' for reading : $!\n";
$cmpr=$ext='';
# check if file compressed in spite of not having a .gz/.xz extension
binmode($fh); # need to read binary data, so do not set utf8 layer yet
read $fh,my($header),6;
if ($header =~m#^\x1f\x8b#) { $cmpr='.gz'; } #gzip header : will open it as a .gz file
elsif ($header eq "\xFD7zXZ\x00") { $cmpr='.xz'; } #xz header
else { seek $fh,0,SEEK_SET; binmode($fh,':utf8'); } #no gzip header, rewind, and set utf8 layer
}
if ($cmpr eq '.gz') { @cmd=qw/gzip -cd/; }
elsif ($cmpr eq '.xz') { @cmd=qw/xz -cd/; }
if (@cmd)
{ close $fh if $fh; #close compressed files without extension
if (findcmd($cmd[0]))
{ open $fh,'-|:'.$encoding,"@cmd \Q$file\E" or warn "Failed opening '$file' for reading (using $cmd[0]) : $!\n";
}
else { warn "Can't find $cmd[0], you could uncompress '$file' manually\n"; }
}
return ($fh,$file,$ext,$cmpr);
}
}
sub SaveTags #save tags _and_ settings
{ my $fork=shift; #if true, save in a forked process
HasChanged('Save');
if ($CmdLine{demo}) { warn "-demo option => not saving tags/settings\n" if $Verbose || !$fork; return }
my $ext='';
my $SaveFile= $SaveFile; #do a local copy to locally remove .gz extension if present
$ext=$1 if $SaveFile=~s#($gmbrc_ext_re)$##; #remove .gz/.xz extension from the copy of $SaveFile, put it in $ext
if (exists $CmdLine{gzip}) { $ext= $CmdLine{gzip} eq 'gzip' ? '.gz' : $CmdLine{gzip} eq 'xz' ? '.xz' : '' }
#else { $ext='.gz' } # use gzip by default
my ($savedir,$savefilename)= splitpath($SaveFile);
unless (-d $savedir) { warn "Creating folder $savedir\n"; mkdir $savedir or warn $!; }
opendir my($dh),$savedir;
unlink $savedir.SLASH.$_ for grep m/^\Q$savefilename\E\.new\.\d+(?:$gmbrc_ext_re)?$/, readdir $dh; #delete old temporary save files
closedir $dh;
if ($fork)
{ my $pid= fork;
if (!defined $pid) { $fork=undef; } # error, fallback to saving in current process
elsif ($pid)
{ while (waitpid(-1, WNOHANG)>0) {} #reap dead children
return
}
}
setlocale(LC_NUMERIC, 'C');
$Options{Lock}= $TogLock || '';
$Options{SavedSongID}= SongArray->new([$SongID]) if $Options{RememberPlaySong} && defined $SongID;
$Options{QueueAction}= $QActions{$QueueAction}{save} ? $QueueAction : '';
$Options{SavedOn}= time;
my $tooold=0;
my @sessions=split ' ',$Options{Sessions};
unless (@sessions && $DAYNB==$sessions[0])
{ unshift @sessions,$DAYNB;
$tooold=pop @sessions if @sessions>20;
$Options{Sessions}=join ' ',@sessions;
}
for my $key (keys %{$Options{Layouts}}) #cleanup options for layout that haven't been seen for a while
{ my $lastseen=$Options{LayoutsLastSeen}||={};
if (exists $Layout::Layouts{$key}) { delete $lastseen->{$key}; }
elsif (!$lastseen->{$key}) { $lastseen->{$key}=$DAYNB; }
elsif ($lastseen->{$key}<$tooold) { delete $_->{$key} for $Options{Layouts},$lastseen; }
}
local $SIG{PIPE} = 'DEFAULT'; # default is, for some reason, IGNORE, which causes "gzip: stdout: Broken pipe" after closing $fh when using gzip for unclear reasons
my $error;
(my$fh,my$tempfile,$ext)= Open_gmbrc("$SaveFile.new.$$"."$ext",1);
unless ($fh) { warn "Save aborted\n"; POSIX::_exit(0) if $fork; return; }
warn "Writing tags in $SaveFile$ext ...\n" if $Verbose || !$fork;
print $fh "# gmbrc version=".VERSION." time=".time."\n" or $error||=$!;
my $optionslines=SaveRefToLines(\%Options);
print $fh "[Options]\n$$optionslines\n" or $error||=$!;
my ($savesub,$fields,$extrasub,$extra_subfields)=Songs::MakeSaveSub();
print $fh "[Songs]\n".join("\t",@$fields)."\n" or $error||=$!;
for my $ID (@{ Songs::AllFilter('missing:-b:1 '.($tooold||1)) })
{ my @vals=$savesub->($ID);
s#([\x00-\x1F\\])#sprintf "\\x%02x",ord $1#eg for @vals;
my $line= join "\t", $ID, @vals;
print $fh $line."\n" or $error||=$!;
}
#save fields properties, like album pictures ...
for my $field (sort keys %$extrasub)
{ print $fh "\n[$field]\n$extra_subfields->{$field}\n" or $error||=$!;
my $h= $extrasub->{$field}->();
for my $key (sort keys %$h)
{ my $vals= $h->{$key};
s#([\x00-\x1F\\])#sprintf "\\x%02x",ord $1#eg for $key,@$vals;
$key=~s#^\[#\\x5b#; #escape leading "["
my $line= join "\t", @$vals;
next if $line=~m/^\t*$/;
print $fh "$key\t$line\n" or $error||=$!;
}
}
print $fh "\n[EOF]\nEOF\n" or $error||=$!;
close $fh or $error||=$!;
setlocale(LC_NUMERIC, '');
if ($error)
{ rename $tempfile,$SaveFile.'.error'.$ext;
warn "Writing tags in $SaveFile$ext ... error : $error\n";
POSIX::_exit(1) if $fork;
return;
}
if ($fork && !-e $tempfile) { POSIX::_exit(0); } #tempfile disappeared, probably deleted by a subsequent save from another process => ignore
my $previous= $SaveFile.$ext;
$previous= find_gmbrc_file($SaveFile) unless -e $previous;
if ($previous) #keep some old files as backup
{ { my ($bfh,$previousbak,$ext2,$cmpr)= Open_gmbrc($SaveFile.'.bak'.$ext,0);
last unless $bfh;
local $_; my $date;
while (<$bfh>) { if (m/^SavedOn:\s*(\d+)/) {$date=$1;last} last if m/^\[(?!Options])/}
close $bfh;
last unless $date;
$date=strftime('%Y%m%d',localtime($date));
if (find_gmbrc_file($SaveFile.'.bak.'.$date)) { unlink $previousbak; last} #remove .bak if already a backup for that day
rename $previousbak, "$SaveFile.bak.$date$ext2" or warn $!;
if (!$cmpr && (!exists $CmdLine{gzip} || $CmdLine{gzip})) #compress old backups unless "-gzip" option is used
{ my $cmd= $CmdLine{gzip} || 'xz';
$cmd= findcmd($cmd,'xz','gzip');
system($cmd,'-1','-f',"$SaveFile.bak.$date") if $cmd;
}
my @files=FileList(qr/^\Q$savefilename\E\.bak\.\d{8}(?:$gmbrc_ext_re)?$/, $savedir);
last unless @files>5;
splice @files,-5; #keep the 5 newest versions
unlink @files;
}
my $rename= $previous;
$rename=~s#($gmbrc_ext_re?)$#.bak$1#;
rename $previous, $rename or warn $!;
unlink $_ for find_gmbrc_file($SaveFile); #make sure there is no other old gmbrc without .bak, as they could cause confusion
}
rename $tempfile,$SaveFile.$ext or warn $!;
warn "Writing tags in $SaveFile$ext ... done\n" if $Verbose || !$fork;
POSIX::_exit(0) if $fork;
}
sub ReadRefFromLines # convert a string written by SaveRefToLines to a hash/array # can only read a small subset of YAML
{ my ($lines,$return)=@_;
my @todo;
my ($ident,$ref)=(0,$return);
my $parentval; my @objects;
for my $line (@$lines)
{ next if $line=~m/^\s*(?:#|$)/; #skip comment or empty line
my ($d,$array,$key,$val)= $line=~m/^(\s*)(?:(-)|(?:("[^"]*"|\S*)\s*:))\s*(.*)$/;
$d= length $d;
if ($parentval) #first value of new array or hash
{ next unless $d>=$ident;
push @todo, $ref,$ident;
$ident=$d;
$ref=$$parentval= $array ? [] : {};
$parentval=undef;
}
elsif ($ident-$d)
{ next unless $ident>$d;
while ($ident>$d) { $ident=pop @todo; $ref=pop @todo; }
}
if (!$array && $key=~s/^"//) { $key=~s/"$//; $key=~s#\\x([0-9a-fA-F]{2})#chr hex $1#ge; }
$val=~s/\s+$//;
my $class;
if ($val=~m/^!/) #object
{ if ($val=~s/^!([^ !]+)\s*//) {$class=$1}
else { warn "Unsupported value : '$val'\n"; next }
}
if ($val eq '') #array or hash or object as array/hash
{ $parentval= $array ? \$ref->[@$ref] : \$ref->{$key};
push @objects, $class,$parentval if $class;
}
else #scalar or empty array/hash or object as string
{ if ($val eq '~') {$val=undef}
elsif ($val=~m/^'(.*)'$/) {$val=$1; $val=~s/''/'/g; }
elsif ($val=~m/^"(.*)"$/)
{ $val=$1;
$val=~s/\\"/"/g;
$val=~s#\\x([0-9a-fA-F]{2})#chr hex $1#ge;
}
elsif ($val eq '[]') {$val=[];}
elsif ($val eq '{}') {$val={};}
if ($class) { $val= $class->new_from_string($val); }
if ($array) { push @$ref,$val; }
else { $ref->{$key}=$val; }
}
}
while (@objects)
{ my ($class,$ref)= splice @objects,-2; #start with the end -> if object contain other objects they will be created first
$$ref= $class->new_from_string($$ref);
}
return @todo ? $todo[0] : $ref;
}
sub SaveRefToLines #convert hash/array into a YAML string readable by ReadRefFromLines
{ my $ref=$_[0];
my (@todo,$keylist,$ref_is_array);
my $lines='';
my $pre='';
my $depth=0;
if (ref $ref eq 'ARRAY'){ $keylist=0; $ref_is_array=1; }
else { $keylist=[sort keys %$ref]; }
while (1)
{ my ($val,$next,$up);
if ($ref_is_array) #ARRAY
{ if ($keylist<@$ref)
{ $val=$ref->[$keylist++];
$lines.= $pre.'-';
$next=$val if ref $val;
}
else {$up=1}
}
else #HASH
{ if (@$keylist)
{ my $key=shift @$keylist;
$val=$ref->{$key};
if ($key eq '') {$key='""'}
elsif ($key=~m/[\x00-\x1f\n:# ]/ || $key=~m#^\W#)
{ $key=~s/([\x00-\x1f\n"\\])/sprintf "\\x%02x",ord $1/ge;
$key=qq/"$key"/;
}
$lines.= $pre.$key.':';
$next=$val if ref $val;
}
else {$up=1}
}
if ($next)
{ my $is_array= ref $next eq 'ARRAY';
my $is_string;
if (!$is_array && ref $next ne 'HASH') #save object
{ $val=$next->save_to_string;
$lines.= ' !'.ref($next);
if (!ref $val) { $is_string=1 }
else { $next=$val; $is_array= UNIVERSAL::isa($val,"ARRAY") ? 1 : 0; }
}
if (!$is_string)
{ if ( $is_array && !@$next) { $lines.=" []\n";next; }
elsif (!$is_array && !keys(%$next)) { $lines.=" {}\n";next; }
$lines.="\n";
$depth++;
$pre=' 'x$depth;
push @todo,$ref,$ref_is_array,$keylist;
$ref=$next;
$ref_is_array= $is_array;
if ($ref_is_array) { $keylist=0; }
else { $keylist=[sort keys %$ref]; }
next;
}
}
elsif ($up)
{ if ($depth)
{ $depth--;
$pre=' 'x$depth;
($ref,$ref_is_array,$keylist)= splice @todo,-3;
next;
}
else {last}
}
if (!defined $val) {$val='~'}
elsif ($val eq '') {$val="''"}
elsif ($val=~m/[\x00-\x1f\n:#]/ || $val=~m#^'#)
{ $val=~s/([\x00-\x1f\n"\\])/sprintf "\\x%02x",ord $1/ge;
$val=qq/"$val"/;
}
elsif ($val=~m/^\W/ || $val=~m/\s$/ || $val=~m/^true$|^false$|^null$/i)
{ $val=~s/'/''/g;
$val="'$val'";
}
$lines.= ' '.$val."\n";
}
return \$lines;
}
sub SetWSize
{ my ($win,$wkey,$default)=@_;
$win->set_role($wkey);
$win->set_name($wkey);
my $prevsize= $Options{WindowSizes}{$wkey} || $default;
$win->resize(split 'x',$prevsize,2) if $prevsize;
$win->signal_connect(unrealize => sub
{ $Options{WindowSizes}{$_[1]}=join 'x',$_[0]->get_size; }
,$wkey);
}
sub Rewind
{ my $sec=$_[1];
return unless $sec;
$sec=(defined $PlayTime && $PlayTime>$sec)? $PlayTime-$sec : 0;
SkipTo($sec);
}
sub Forward
{ my $sec=$_[1];
return unless $sec;
$sec+=$PlayTime if defined $PlayTime;
SkipTo($sec);
}
sub SkipTo
{ return unless defined $SongID;
my $sec=shift;
if ($sec && $sec<0) { $sec+= Songs::Get($SongID,'length'); $sec=0 if $sec<0; }
if (defin