8 use POSIX
qw{:errno_h
:fcntl_h
};
10 ###--------------------------------------------------------------------------
13 my %C = (config
=> "$ENV{HOME}/.disorder/passwd",
14 lockdir
=> "$ENV{HOME}/.disorder/",
17 my $TITLE = "DisOrder";
18 my $VARIANT = "default";
19 if (-l
$C{config
} && (my $t = readlink $C{config
}) =~ /^passwd\.(.*)$/)
20 { $VARIANT = $1; $TITLE .= " ($1)"; }
22 ###--------------------------------------------------------------------------
25 sub run_discard_output
(@
) {
28 open STDOUT
, ">/dev/null" or die "open /dev/null: $!";
34 if ($?
>= 256) { $st = sprintf "rc = %d", $?
>> 8; }
35 else { $st = sprintf "signal %d", $?
; }
36 die "$_[0] failed ($st)";
41 my ($head, $body) = @_;
43 $body =~ s
:\
&:&
;:g
;
47 ##print "****************\n$head\n\n$body\n"; return;
49 run_discard_output
"notify-send",
50 "-c", "DisOrder", "-i", "audio-volume-high", "-t", "5000",
57 die $@
if $@
and $@
->errno != ENOENT
;
60 ###--------------------------------------------------------------------------
63 my $LKFILE = "$C{lockdir}/disorder-notify-$VARIANT.lock";
68 ## Try to open the lock file. If it's not there, then obviously it's not
71 eval { open $fh, "<", $LKFILE; };
73 return undef if $@
->errno == ENOENT
;
77 ## Take out a non-exclusive lock on the lock file.
78 my $lk = new File
::FcntlLock
;
79 $lk->l_type(F_RDLCK
); $lk->l_whence(SEEK_SET
);
80 $lk->l_start(0); $lk->l_len(0);
81 if ($lk->lock($fh, F_SETLK
)) { close $fh; return undef; }
83 ## Read the pid of the current lock-holder.
84 chomp (my $pid = (readline $fh) // "<unknown>");
90 sysopen my $fh, $LKFILE, O_CREAT
| O_WRONLY
;
92 my $lk = new File
::FcntlLock
;
93 $lk->l_type(F_WRLCK
); $lk->l_whence(SEEK_SET
);
94 $lk->l_start(0); $lk->l_len(0);
95 if (!$lk->lock($fh, F_SETLK
)) {
96 return undef if $! == EAGAIN
;
97 die "failed to lock `$LKFILE': $!";
107 ###--------------------------------------------------------------------------
108 ### DisOrder utilities.
115 my @f = split_fields
readline $sk;
116 if ($f[1] ne "state") { last LINE
; }
117 elsif ($f[2] eq "enable_random") { $st{random
} = 1; }
118 elsif ($f[2] eq "disable_random") { $st{random
} = 0; }
119 elsif ($f[2] eq "enable_play") { $st{play
} = 1; }
120 elsif ($f[2] eq "disable_play") { $st{play
} = 0; }
121 elsif ($f[2] eq "resume") { $st{pause
} = 0; }
122 elsif ($f[2] eq "pause") { $st{pause
} = 1; }
128 my $sk = connect_to_server
$C{config
};
129 send_command0
$sk, "log";
130 my $st = get_state0
$sk;
135 sub decode_track_name
($\
%) {
136 my ($sk, $info) = @_;
137 return unless exists $info->{track
};
138 my $track = $info->{track
};
139 for my $i ("artist", "album", "title") {
140 my @f = split_fields send_command
$sk, "part", $track, "display", "$i";
145 sub fmt_duration
($) {
147 return sprintf "%d:%02d", int $n/60, $n%60;
150 sub format_now_playing
(\
%) {
152 exists $info->{track
} or return "Nothing.";
153 my $r = "$info->{artist}: ‘$info->{title}’";
154 $r .= ", from ‘$info->{album}’" if $info->{album
};
155 exists $info->{sofar
} && exists $info->{length} and
156 $r .= sprintf " (%s/%s)",
157 fmt_duration
$info->{sofar
}, fmt_duration
$info->{length};
158 $r .= "\n(chosen by $info->{submitter})" if exists $info->{submitter
};
162 sub get_now_playing
($) {
164 my $r = send_command
$sk, "playing";
165 defined $r or return {};
166 my %info = split_fields
$r;
167 decode_track_name
$sk, %info;
168 exists $info{sofar
} and
169 $info{length} = send_command
$sk, "length", $info{track
};
173 sub watch_and_notify0
($) {
174 my ($now_playing) = @_;
176 my $sk = connect_to_server
$C{config
}, 1;
177 my $sk_log = connect_to_server
$C{config
}, 1;
179 send_command0
$sk_log, "log";
180 my $st = get_state0
$sk_log;
181 my $msg = "playing " . ($st->{play
} ?
"enabled" : "disabled");
182 $msg .= "; random play " . ($st->{random
} ?
"enabled" : "disabled");
183 $msg .= "; " . ($st->{pause
} ?
"paused" : "playing");
184 notify
"$TITLE state", "Connected: $msg";
185 if ($st->{play
} && $now_playing) {
186 my $info = get_now_playing
$sk;
187 notify
"$TITLE: Now playing", format_now_playing
%$info;
190 while (my $line = readline $sk_log) {
191 my @f = split_fields
$line;
193 if ($f[1] eq "state") {
195 if ($f[2] eq "disable_random") { $msg = "Random play disabled"; }
196 elsif ($f[2] eq "enable_random") { $msg = "Random play enabled"; }
197 elsif ($f[2] eq "disable_play") { $msg = "Playing disabled"; }
198 elsif ($f[2] eq "enable_play") { $msg = "Playing enabled"; }
199 elsif ($f[2] eq "pause") { $msg = "Paused"; }
200 elsif ($f[2] eq "resume") { $msg = "Playing"; }
201 notify
"$TITLE state", $msg if defined $msg;
202 } elsif ($f[1] eq "playing") {
204 $info{track
} = $f[2];
205 $info{submitter
} = $f[3] if @f > 3;
206 decode_track_name
$sk, %info;
207 notify
"$TITLE: Now playing", format_now_playing
%info;
208 } elsif ($f[1] eq "scratched") {
210 $info{track
} = $f[2];
211 decode_track_name
$sk, %info;
212 notify
"$TITLE: Scratched by $f[3]", format_now_playing
%info;
216 notify
"$TITLE state", "Lost connection";
222 sub watch_and_notify
($) {
223 my ($now_playing) = @_;
226 claim_lock
or exit 1;
229 eval { watch_and_notify0
$now_playing; };
235 ###--------------------------------------------------------------------------
236 ### User-facing operations.
241 sub { run_discard_output
"amixer", "sset", $C{mixer
}, "5\%+"; };
243 sub { run_discard_output
"amixer", "sset", $C{mixer
}, "5\%-"; };
245 $OP{"scratch"} = sub {
246 my $sk = connect_to_server
$C{config
};
247 send_command
$sk, "scratch";
251 $OP{"enable/disable"} = sub {
253 my $sk = connect_to_server
$C{config
};
254 if ($st->{play
}) { send_command
$sk, "disable"; }
255 else { send_command
$sk, "enable"; }
259 $OP{"play/pause"} = sub {
261 my $sk = connect_to_server
$C{config
};
263 send_command
$sk, "enable";
264 if ($st->{pause
}) { send_command
$sk, "resume"; }
266 if ($st->{pause
}) { send_command
$sk, "resume"; }
267 else { send_command
$sk, "pause"; }
273 if (defined (my $lkpid = locked_by
)) {
274 print STDERR
"$0: already watched by pid $lkpid\n";
280 $OP{"now-playing"} = sub {
281 my $sk = connect_to_server
$C{config
};
282 my $info = get_now_playing
$sk;
284 print format_now_playing
%$info;
288 $OP{"notify-now-playing"} = sub {
289 my $sk = connect_to_server
$C{config
};
290 my $info = get_now_playing
$sk;
292 notify
"$TITLE: Now playing", format_now_playing
%$info;
293 defined locked_by
or watch_and_notify
0;
296 $OP{"next-config"} = sub {
297 (my $dir = $C{config
}) =~ s
:/[^/]*$::;
298 my (@conf, $curr, $conf, $min);
300 if (-l
$C{config
} && (my $t = readlink $C{config
}) =~ /^passwd\.(.*)$/)
303 opendir my $dh, +$dir;
304 FILE
: while (my $f = readdir $dh)
305 { push @conf, $1 if $f =~ /^passwd\.(.*[^~])$/; }
307 for (my $i = 0; $i < @conf; $i++) {
308 $min = $conf[$i] if (!defined $min) || $conf[$i] lt $min;
310 if ((!defined $curr) || $curr lt $conf[$i]) &&
311 ((!defined $conf) || $conf[$i] lt $conf);
313 $conf = $min unless defined $conf;
315 try_unlink
"$dir/passwd.new";
316 symlink "passwd.$conf", "$dir/passwd.new";
317 rename "$dir/passwd.new", "$dir/passwd";
318 notify
"DisOrder configuration", "Switched to `$conf'";
321 ###--------------------------------------------------------------------------
324 if (@ARGV != 1) { print STDERR
"usage: $0 OP\n"; exit 2; }
326 if (!exists $OP{$op}) { print STDERR
"$0: unknown op `$op'\n"; exit 2; }
329 ###----- That's all, folks --------------------------------------------------