8 use Getopt
::Long
qw{:config gnu_compat bundling
9 require_order no_getopt_compat
};
10 use POSIX
qw{:errno_h
:fcntl_h
};
12 ###--------------------------------------------------------------------------
15 my %C = (config
=> "$ENV{HOME}/.disorder/passwd",
16 lockdir
=> "$ENV{HOME}/.disorder/",
19 (my $PROG = $0) =~ s
:^.*/::;
20 my $TITLE = "DisOrder";
21 my $VARIANT = "default";
22 if (-l
$C{config
} && (my $t = readlink $C{config
}) =~ /^passwd\.(.*)$/)
23 { $VARIANT = $1; $TITLE .= " ($1)"; }
25 ###--------------------------------------------------------------------------
28 sub run_discard_output
(@
) {
31 open STDOUT
, ">/dev/null" or die "open /dev/null: $!";
37 if ($?
>= 256) { $st = sprintf "rc = %d", $?
>> 8; }
38 else { $st = sprintf "signal %d", $?
; }
39 die "$_[0] failed ($st)";
44 my ($head, $body) = @_;
46 $body =~ s
:\
&:&
;:g
;
50 ##print "****************\n$head\n\n$body\n"; return;
52 run_discard_output
"notify-send",
53 "-c", "DisOrder", "-i", "audio-volume-high", "-t", "5000",
60 die $@
if $@
and $@
->errno != ENOENT
;
63 ###--------------------------------------------------------------------------
66 my $LKFILE = "$C{lockdir}/disorder-notify-$VARIANT.lock";
71 ## Try to open the lock file. If it's not there, then obviously it's not
74 eval { open $fh, "<", $LKFILE; };
76 return undef if $@
->errno == ENOENT
;
80 ## Take out a non-exclusive lock on the lock file.
81 my $lk = new File
::FcntlLock
;
82 $lk->l_type(F_RDLCK
); $lk->l_whence(SEEK_SET
);
83 $lk->l_start(0); $lk->l_len(0);
84 if ($lk->lock($fh, F_SETLK
)) { close $fh; return undef; }
86 ## Read the pid of the current lock-holder.
87 chomp (my $pid = (readline $fh) // "<unknown>");
93 sysopen my $fh, $LKFILE, O_CREAT
| O_WRONLY
;
95 my $lk = new File
::FcntlLock
;
96 $lk->l_type(F_WRLCK
); $lk->l_whence(SEEK_SET
);
97 $lk->l_start(0); $lk->l_len(0);
98 if (!$lk->lock($fh, F_SETLK
)) {
99 return undef if $! == EAGAIN
;
100 die "failed to lock `$LKFILE': $!";
110 ###--------------------------------------------------------------------------
111 ### DisOrder utilities.
118 my @f = split_fields
readline $sk;
119 if ($f[1] ne "state") { last LINE
; }
120 elsif ($f[2] eq "enable_random") { $st{random
} = 1; }
121 elsif ($f[2] eq "disable_random") { $st{random
} = 0; }
122 elsif ($f[2] eq "enable_play") { $st{play
} = 1; }
123 elsif ($f[2] eq "disable_play") { $st{play
} = 0; }
124 elsif ($f[2] eq "resume") { $st{pause
} = 0; }
125 elsif ($f[2] eq "pause") { $st{pause
} = 1; }
132 sub configured_connection
(;$) {
134 $CONF //= load_config
$C{config
};
135 return connect_to_server
%$CONF, $quietp // 0;
139 my $sk = configured_connection
;
140 send_command0
$sk, "log";
141 my $st = get_state0
$sk;
146 sub decode_track_name
($\
%) {
147 my ($sk, $info) = @_;
148 return unless exists $info->{track
};
149 my $track = $info->{track
};
150 for my $i ("artist", "album", "title") {
151 my @f = split_fields send_command
$sk, "part", $track, "display", "$i";
156 sub fmt_duration
($) {
158 return sprintf "%d:%02d", int $n/60, $n%60;
161 sub format_now_playing
(\
%) {
163 exists $info->{track
} or return "Nothing.";
164 my $r = "$info->{artist}: ‘$info->{title}’";
165 $r .= ", from ‘$info->{album}’" if $info->{album
};
166 exists $info->{sofar
} && exists $info->{length} and
167 $r .= sprintf " (%s/%s)",
168 fmt_duration
$info->{sofar
}, fmt_duration
$info->{length};
169 $r .= "\n(chosen by $info->{submitter})" if exists $info->{submitter
};
173 sub get_now_playing
($) {
175 my $r = send_command
$sk, "playing";
176 defined $r or return {};
177 my %info = split_fields
$r;
178 decode_track_name
$sk, %info;
179 exists $info{sofar
} and
180 $info{length} = send_command
$sk, "length", $info{track
};
184 sub watch_and_notify0
($) {
185 my ($now_playing) = @_;
187 my $sk = configured_connection
1;
188 my $sk_log = configured_connection
1;
190 send_command0
$sk_log, "log";
191 my $st = get_state0
$sk_log;
192 my $msg = "playing " . ($st->{play
} ?
"enabled" : "disabled");
193 $msg .= "; random play " . ($st->{random
} ?
"enabled" : "disabled");
194 $msg .= "; " . ($st->{pause
} ?
"paused" : "playing");
195 notify
"$TITLE state", "Connected: $msg";
196 if ($st->{play
} && $now_playing) {
197 my $info = get_now_playing
$sk;
198 notify
"$TITLE: Now playing", format_now_playing
%$info;
201 fcntl $sk_log, F_SETFL
, (fcntl $sk_log, F_GETFL
, 0) | O_NONBLOCK
;
204 my $rdin = ""; vec($rdin, (fileno $sk_log), 1) = 1;
208 for my $line (@lines) {
209 my @f = split_fields
$line;
210 if ($f[1] eq "state") {
212 if ($f[2] eq "disable_random") { $msg = "Random play disabled"; }
213 elsif ($f[2] eq "enable_random") { $msg = "Random play enabled"; }
214 elsif ($f[2] eq "disable_play") { $msg = "Playing disabled"; }
215 elsif ($f[2] eq "enable_play") { $msg = "Playing enabled"; }
216 elsif ($f[2] eq "pause") { $msg = "Paused"; }
217 elsif ($f[2] eq "resume") { $msg = "Playing"; }
218 notify
"$TITLE state", $msg if defined $msg;
219 } elsif ($f[1] eq "playing") {
221 $info{track
} = $f[2];
222 $info{submitter
} = $f[3] if @f > 3;
223 decode_track_name
$sk, %info;
224 notify
"$TITLE: Now playing", format_now_playing
%info;
225 } elsif ($f[1] eq "scratched") {
227 $info{track
} = $f[2];
228 decode_track_name
$sk, %info;
229 notify
"$TITLE: Scratched by $f[3]", format_now_playing
%info;
233 if (!$sk_log) { $loss = "EOF from server"; last WATCH
; }
234 my $nfd = select my $rdout = $rdin, undef, undef, 60;
236 eval { print $sk_log "."; flush
$sk_log; };
237 if ($@
) { $loss = "error from write: " . $@
->errno; last WATCH
; }
242 eval { $n = sysread $sk_log, $b, 4096; };
243 if ($@
&& $@
->errno == EAGAIN
) { last READ
; }
244 elsif ($@
) { $loss = "error from read: " . $@
->errno; last WATCH
; }
245 elsif (!$n) { close $sk_log; $sk_log = undef; last READ
; }
246 else { $buffer .= $b; }
249 @lines = split /\n/, $buffer, -1;
250 $buffer = pop @lines;
254 notify
"$TITLE state", "Lost connection: $loss";
257 close $sk_log if defined $sk_log;
260 sub watch_and_notify
($) {
261 my ($now_playing) = @_;
263 claim_lock
or exit 1;
266 eval { watch_and_notify0
$now_playing; };
272 ###--------------------------------------------------------------------------
273 ### User-facing operations.
278 sub { run_discard_output
"amixer", "sset", $C{mixer
}, "5\%+"; };
280 sub { run_discard_output
"amixer", "sset", $C{mixer
}, "5\%-"; };
282 $OP{"scratch"} = sub {
283 my $sk = configured_connection
;
284 send_command
$sk, "scratch";
288 $OP{"enable/disable"} = sub {
290 my $sk =configured_connection
;
291 if ($st->{play
}) { send_command
$sk, "disable"; }
292 else { send_command
$sk, "enable"; }
296 $OP{"play/pause"} = sub {
298 my $sk = configured_connection
;
300 send_command
$sk, "enable";
301 if ($st->{pause
}) { send_command
$sk, "resume"; }
303 if ($st->{pause
}) { send_command
$sk, "resume"; }
304 else { send_command
$sk, "pause"; }
310 if (defined (my $lkpid = locked_by
)) {
311 print STDERR
"$0: already watched by pid $lkpid\n";
317 $OP{"now-playing"} = sub {
318 my $sk = configured_connection
;
319 my $info = get_now_playing
$sk;
321 print format_now_playing
%$info;
325 $OP{"notify-now-playing"} = sub {
326 my $sk = configured_connection
;
327 my $info = get_now_playing
$sk;
329 notify
"$TITLE: Now playing", format_now_playing
%$info;
330 unless (defined locked_by
) {
336 $OP{"next-config"} = sub {
337 (my $dir = $C{config
}) =~ s
:/[^/]*$::;
338 my (@conf, $curr, $conf, $min);
340 if (-l
$C{config
} && (my $t = readlink $C{config
}) =~ /^passwd\.(.*)$/)
343 opendir my $dh, +$dir;
344 FILE
: while (my $f = readdir $dh)
345 { push @conf, $1 if $f =~ /^passwd\.(.*[^~])$/; }
347 for (my $i = 0; $i < @conf; $i++) {
348 $min = $conf[$i] if (!defined $min) || $conf[$i] lt $min;
350 if ((!defined $curr) || $curr lt $conf[$i]) &&
351 ((!defined $conf) || $conf[$i] lt $conf);
353 $conf = $min unless defined $conf;
355 try_unlink
"$dir/passwd.new";
356 symlink "passwd.$conf", "$dir/passwd.new";
357 rename "$dir/passwd.new", "$dir/passwd";
358 notify
"DisOrder configuration", "Switched to `$conf'";
361 ###--------------------------------------------------------------------------
366 print $fh "usage: $PROG [-u CONFIG] COMMAND\n";
373 Command-line options:
374 -h, --help Show this help text
375 -u, --user-config Set user configuration file
392 "h|help" => sub { help
; exit 0; },
393 "u|user-config=s" => \
$C{config
}
395 @ARGV == 1 or $bad = 1;
396 if ($bad) { usage
*STDERR
; exit 2; }
398 if (!exists $OP{$op}) { print STDERR
"$0: unknown op `$op'\n"; exit 2; }
401 ###----- That's all, folks --------------------------------------------------