ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/doomfrontend/doomfrontend
Revision: 1.2
Committed: Wed Apr 5 22:12:20 2023 UTC (14 months, 1 week ago) by root
Branch: MAIN
Changes since 1.1: +31 -11 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3     # todo hi cpu tie on fuji due to mpv runtime config
4    
5     # mpv over ass-events
6     # {\blur0\bord0\1c&H000000\iclip(4, m 30472 10072 l 30008 10072 l 30008 7584 l 30093 7500 l 30388 7500 l 30472 7584 l 30472 10072)}{\alpha&H62&}{\pos(0.000000,0.000000)}{\p4} m 30000 6720 l 30480 6720 l 30480 7412 l 30396 7496 l 30480 7580 l 30480 10080 l 30000 10080 l 30000 7580 l 30084 7496 l 30000 7412 l 30000 6720{\p0}
7     # {\blur0\bord0\1c&Hffffff}{\alpha&H4C&}{\pos(0.000000,0.000000)}{\p4} m 30472 10072 l 30008 10072 l 30008 7584 l 30093 7500 l 30388 7500 l 30472 7584 l 30472 10072{\p0}
8     # {\blur0\bord0\shad0\1c&H000000\fnDroid Sans\fs27\clip(4, m 30472 10072 l 30008 10072 l 30008 7584 l 30093 7500 l 30388 7500 l 30472 7584 l 30472 10072)}{\alpha&H36&}{\pos(3780.000000,1248.000000)}{\an2}100
9     # {\blur0\bord1\shad0\1c&Hffffff\3c&H000000}{\alpha&H4C&}{\pos(0.000000,0.000000)}{\p4} m 30098 10262 l 30156 10262 l 30232 10194 l 30232 10446 l 30156 10379 l 30098 10379 m 30274 10270 l 30274 10371 l 30299 10371 l 30299 10270 m 30333 10220 l 30333 10421 l 30358 10421 l 30358 10220{\p0}
10    
11    
12     BEGIN {
13     if ($ARGV[0] eq "-=reloaded=-") {
14     shift;
15     } elsif (-e "/root/mlockall.so" && $ENV{LD_PRELOAD} !~ /libmimalloc/) {
16     $ENV{LD_PRELOAD} = "/root/mlockall.so:/root/libmimalloc.so.1.7";
17     $ENV{MIMALLOC_LARGE_OS_PAGES} = 1;
18     system "echo always >/sys/kernel/mm/transparent_hugepage/defrag";
19     system "echo 3 > /proc/sys/vm/drop_caches";
20     system "echo 1 > /proc/sys/vm/compact_memory";
21     exec "nice", "-n-20", "ionice", "-c1", $0, "-=reloaded=-", @ARGV;
22     exit 255;
23     }
24     }
25    
26     use common::sense;
27    
28     use EV;
29    
30     use Fcntl ();
31     use Socket ();
32     use POSIX ();
33     use Cwd ();
34     use File::Glob ();
35     use Coro;
36     use File::Basename;
37     use AE ();
38     use CBOR::XS ();
39     use Compress::Zstd ();
40     use AnyEvent::AIO ();
41     use Coro::AIO;
42     use Coro::AnyEvent;
43     use JSON::XS ();
44     use AnyEvent::Handle ();
45     use AnyEvent::Socket ();
46     use Proc::FastSpawn ();
47     use PApp::SQL ();
48     use List::MoreUtils ();
49     use List::Util qw(min max);
50     use Text::Wrap ();
51     use Format::Human::Bytes ();
52     use AnyEvent::MPV ();
53    
54     IO::AIO::min_parallel 16;
55    
56     sub MAX_ISLANDS () { 5 }
57    
58     sub enc($) {
59     my $s = shift;
60     utf8::encode $s;
61     $s
62     }
63    
64     sub dec($) {
65     my $s = shift;
66     utf8::decode $s;
67     $s
68     }
69    
70     our $NODENAME = (POSIX::uname)[1];
71     our $DOOM = $NODENAME eq "doom";
72    
73     our $TESTING = $ARGV[0] eq "--testing";
74     #our $DPMS_DISABLE = $DOOM;
75    
76     our ($SW, $SH) = (3840, 2160);
77     our $FONTSIZE = $NODENAME eq "doom" ? 32 : 18;
78     our $FONT = "xft:inputmonocondensed:minspace:medium:hintstyle=hintfull:matrix=1 0 0 0.95:size=$FONTSIZE";
79    
80     # MUST be canonical, same as dfe
81     our $STATE_FILE = "/fs/doom/db/doomfrontend.state";
82     our $STATE_SHM = "/dev/shm/doomfrontend.state";
83     our @LIRC = ("unix/", "/run/lirc/lircd");
84     our $CONF_FILE = "/fs/doom/root/dfe.conf";
85 root 1.2 our $VIDEO_DIR = "/fs/doom/root/00_distant_worlds";
86     our $ARCHIVE_DIR = "/fs/doom/root/00_distant_worlds/00_archive"; # was /fs/doom/var/lib/mythvideo/02_ytd/00_distant_worlds/00_archive
87 root 1.1 our $MYTHTV_DIR = "/fs/doom/var/lib/mythtv";
88     our $MEDIAINFO = "/usr/bin/mediainfo";
89     our $MPV = "mpv";
90     our @MPV_ARGS = qw(
91     --audio-client-name=doomfrontend
92     --osd-on-seek=msg-bar --osd-bar-align-y=-0.85 --osd-bar-w=95
93     --screenshot-directory=/fs/doom/root --screenshot-template=screenshot-%F-%P
94     --sub-auto=exact --audio-file-auto=exact
95     );
96     our %SPONSOR_SKIP = (
97     "Sponsor" => 1,
98     "Intermission/Intro Animation" => 1,
99     "Interaction Reminder" => 1,
100     "Endcards/Credits" => 1,
101     "Unpaid/Self Promotion" => 1,
102     "Highlight" => 0,
103     "Preview/Recap" => 0,
104     "Non-Music Section" => 0,
105     "Filler Tangent" => 0,
106     "UNKNOWN<filler>" => 0,
107     );
108    
109     our $KODIPATH = "/fs/doom/var/www/html/doomfrontend";
110     our $KODIURL = "http://10.0.0.5/doomfrontend/";
111    
112     our $XRANDR_OUTPUT = "HDMI-0";
113     our $XRANDR_MODE = "3840x2160";
114     our $XRANDR_FPS = 60;
115     #our @XRANDR_RATES = ([60, 60], [59.94, 59.94], [50, 50], [29.97, 29.97], [25, 25], [23.98, 23.98]); # philips tv can't do 23.98fps
116     our @XRANDR_RATES = ([60, 60], [59.94, 59.94], [50, 50]);
117    
118     our @EXTERNAL; # current external events, if any
119    
120     our %STATE;
121    
122     our $SS_LENGTH = 300;
123    
124     #############################################################################
125    
126     # prevent xscreensaver from doing something stupid, such as starting dbus
127     $ENV{DBUS_SESSION_BUS_ADDRESS} = "/"; # prevent dbus autostart for sure
128     $ENV{XDG_CURRENT_DESKTOP} = "generic";
129    
130     if ($DOOM) {
131     unless (exists $ENV{XDG_RUNTIME_DIR}) {
132     $ENV{XDG_RUNTIME_DIR} = "/run/user/0";
133     mkdir $ENV{XDG_RUNTIME_DIR}, 0700;
134     }
135     }
136    
137     #############################################################################
138    
139     our $STATE_MTIME_TIMER;
140     our $STATE_MTIME;
141    
142     our $STATE_FILE_TIMER;
143     our $STATE_SHM_TIMER;
144     our $STATE_DIRTY;
145     our $STATE_SAVER;
146    
147     sub state_file_check;
148    
149     sub state_init {
150     my $state_load = sub {
151     open my $fh, "<", $_[0]
152     or die "$_[0]: $@\n";
153    
154     sysread $fh, my $buf, -s $fh;
155     *STATE = CBOR::XS::decode_cbor Compress::Zstd::decompress $buf;
156     };
157    
158     eval { $state_load->($STATE_SHM); 1 }
159     or eval { $state_load->($STATE_FILE); 1}
160     or %STATE = ();
161    
162     $STATE_MTIME = (stat $STATE_FILE)[9];
163    
164     $STATE_MTIME_TIMER = AE::timer 15, 15, sub {
165     async {
166     state_file_check;
167     };
168     };
169     }
170    
171     sub _state_save_shm {
172     undef $STATE_SHM_TIMER;
173    
174     return; #d# must check which file is newer
175     return unless $DOOM;
176    
177     if (open my $fh, ">", $STATE_SHM) {
178     syswrite $fh, $_[0];
179     }
180     }
181    
182     sub _state_save {
183     return if $TESTING;
184    
185     while ($STATE_DIRTY) {
186     undef $STATE_SHM_TIMER;
187    
188     my $fh = aio_open "$STATE_FILE~", IO::AIO::O_CREAT | IO::AIO::O_WRONLY, 0600
189     or last;
190    
191     undef $STATE_DIRTY;
192     last unless %STATE; # state not loaded - do not save
193    
194     $STATE{last_save} = time;
195     my $data = Compress::Zstd::compress +(CBOR::XS::encode_cbor \%STATE), 3;
196     _state_save_shm $data;
197    
198     aio_write $fh, undef, undef, $data, 0;
199     aio_fsync $fh;
200     my $new_mtime = (stat $fh)[9];
201     aio_close $fh;
202    
203     state_file_check;
204    
205     aio_rename "$STATE_FILE~", $STATE_FILE;
206     $STATE_MTIME = $new_mtime;
207     }
208     }
209    
210     sub _state_saver {
211     $STATE_SAVER ||= async {
212     _state_save;
213     undef $STATE_SAVER;
214     undef $STATE_FILE_TIMER;
215     };
216     }
217    
218     sub state_save {
219     $STATE_DIRTY = 1;
220     $STATE_FILE_TIMER ||= AE::timer 15, 0, sub {
221     _state_saver;
222     };
223     $STATE_SHM_TIMER ||= AE::timer 0.5, 0, sub {
224     _state_save_shm CBOR::XS::encode_cbor \%STATE;
225     };
226     }
227    
228     sub state_cleanup {
229     _state_saver;
230     $STATE_SAVER->join;
231     }
232    
233     our $SIGINT = AE::signal INT => sub { EV::unloop };
234     our $SIGTERM = AE::signal TERM => sub { EV::unloop };
235    
236     #############################################################################
237     # screensaver reset management
238    
239     system "xset", "s", $SS_LENGTH if $DOOM;
240    
241     our $WAKEUP_TIMER;
242     our $WAKEUP_WANT;
243    
244     sub wakeup {
245     if ($WAKEUP_TIMER) {
246     $WAKEUP_WANT = 1;
247     } else {
248     $WAKEUP_WANT = 0;
249     Proc::FastSpawn::spawn "/usr/bin/xset", ["xset", "s", "reset"];
250     $WAKEUP_TIMER = AE::timer $SS_LENGTH - 5, 0, sub {
251     undef $WAKEUP_TIMER;
252     wakeup () if $WAKEUP_WANT;
253     };
254     }
255     }
256    
257    
258     #############################################################################
259     # input queue
260    
261     my $input_queue = new Coro::Channel;
262     our ($INPUT, $INPUTS, $INPUT_DATA);
263    
264     sub input_context($) {
265     $INPUT = undef;
266    
267     for (split /,/, $INPUTS) {
268     if (/(.*):(.*)/) {
269     $INPUT = $2 if $1 eq $_[0];
270     } else {
271     $INPUT = $_;
272     }
273     }
274    
275     #warn "interpret<$INPUTS> as $_[0] gives <$INPUT>\n";
276     }
277    
278     sub input_set($$) {
279     $INPUT = undef;
280     $INPUTS = $_[0];
281     $INPUT_DATA = $_[1];
282    
283     input_context undef;
284     }
285    
286     sub input_next(;$) {
287     _win_refresh ();
288     &input_set (@{ $input_queue->get });
289     input_context $_[0] if @_;
290     }
291    
292     sub input_feed($;$) {
293     #use Data::Dump; ddx [input_feed => @_];#d#
294     $input_queue->put ([@_])
295     if defined $_[0];
296     }
297    
298     my %input_feed_key_map = (
299     "\e" => "esc",
300    
301     "\e[A" => "up",
302     "\e[B" => "down",
303     "\e[C" => "right",
304     "\e[D" => "left",
305     "\e[5~" => "pgup",
306     "\e[6~" => "pgdown",
307     "\r" => "enter",
308     "<" => "prev",
309     ">" => "next",
310     "d" => "red",
311     "i" => "green",
312     "r" => "return",
313     "m" => "popup",
314     (map { ($_, $_) } 0..9),
315     "." => "clear",
316     "]" => "stepfwd",
317     "[" => "steprev",
318     "p" => "play",
319     " " => "pause",
320     );
321    
322     sub input_feed_key($) {
323     input_feed $input_feed_key_map{$_[0]};
324     }
325    
326     sub external(@) {
327     push @EXTERNAL, [@_];
328     input_feed "external"; # sucks
329     }
330    
331     #############################################################################
332     # lirc
333    
334     async {
335     while () {
336     my $hdl = new AnyEvent::Handle
337     connect => \@LIRC,
338     on_error => Coro::rouse_cb,
339     on_read => sub {
340     $_[0]->push_read (line => sub {
341     $_[1] =~ /\S+ \S+ (\S+) \S+/
342     or return;
343     ::input_feed $1;
344     wakeup;
345     });
346     },
347     ;
348    
349     my (undef, $fatal, $msg) = Coro::rouse_wait;
350    
351     $hdl->destroy;
352    
353     #warn $msg;
354     } continue {
355     Coro::AnyEvent::sleep 10;
356     }
357     };
358    
359     #############################################################################
360     # mythmote
361    
362     our %MYTHREMOTE = (
363     "play speed pause" => "pause",
364     "play speed normal" => "pause",
365     "play stop" => "stop",
366     "key i" => "green",
367     "key up" => "up",
368     "key down" => "down",
369     "key left" => "left",
370     "key right" => "right",
371     "key enter" => "enter",
372     "key escape" => "return",
373     "key m" => "popup",
374     "key r" => "red",
375    
376     "key home" => "down",
377     "play seek backward" => "steprev",
378     "play seek forward" => "stepfwd",
379     "key end" => "up",
380    
381     "key f2" => "red",
382     "key f3" => "green",
383     "key f4" => "yellow",
384     "key f5" => "blue",
385    
386     #"key s" => up right
387     "play channel up" => "next",
388     "play channel down" => "prev",
389     "key h" => "play", # circle clock
390    
391     "key ]" => "vol+",
392     "key |" => "mute",
393     "key [" => "vol-",
394    
395     "key backspace" => "red",
396     (map { ("key $_" => "num$_") } 0..9),
397     );
398    
399     our $mythremote = AnyEvent::Socket::tcp_server undef, 6546, sub {
400     my ($fh) = @_;
401    
402     my $hdl; $hdl = new AnyEvent::Handle
403     fh => $fh,
404     on_error => sub {
405     #warn "mythremote error: $_[2]\n";
406     undef $hdl;
407     },
408     on_read => sub {
409     $_[0]->push_read (line => sub {
410     if (my $input = $MYTHREMOTE{$_[1]}) {
411     if ($input eq "vol+") {
412     Proc::FastSpawn::spawnp "/usr/bin/amixer", ["amixer", "sset", "Master", "1+"];
413     } elsif ($input eq "vol-") {
414     Proc::FastSpawn::spawnp "/usr/bin/amixer", ["amixer", "sset", "Master", "1-"];
415     } elsif ($input eq "mute") {
416     Proc::FastSpawn::spawnp "/usr/bin/amixer", ["amixer", "sset", "Master", "toggle"];
417     }
418     ::input_feed $input;
419     } elsif ($_[1] =~ /external/) {
420     if (open my $fh, "<", "/root/doomfrontend.external") {
421     unlink "/root/doomfrontend.external";
422     sysread $fh, my $buf, -s $fh;
423     external @{ JSON::XS::decode_json $buf };
424     }
425     } else {
426     warn "unknown mythremote command: <$_[1]>\n";
427     }
428     ::wakeup;
429     });
430     },
431     ;
432     };
433    
434     #############################################################################
435    
436     my $mpv = AnyEvent::MPV->new (
437     mpv => $MPV,
438     args => \@MPV_ARGS,
439     trace => 1,
440     on_event => sub {
441     input_feed "mpv/$_[1]", $_[2];
442     },
443     on_key => sub {
444     input_feed $_[1];
445     },
446     on_eof => sub {
447     input_feed "mpv/quit";
448     },
449     );
450    
451     #############################################################################
452     # rxvt
453    
454     qx<xrandr --current> =~ / connected primary (\d+)x(\d+)\+/a
455     or qx<xrandr --current> =~ / connected (\d+)x(\d+)\+/a
456     or "3840x2160" =~ /^(\d+)x(\d+)\z/a; # rather than crash
457    
458     ($SW, $SH) = ($1, $2);
459    
460     our $WIN_BORDER = 0; # > 0 not works
461     our ($WIN_FW, $WIN_FH) = (60, 60);
462    
463     our ($WIN, $WIN_SHOW, $WIN_W, $WIN_H, $WIN_TEXT);
464     our $WIN_TOW;
465    
466     our $WIN_RW;
467    
468     {
469     if (0) {
470     my $prop = qx<xprop -font \Q$FONT>;
471     $WIN_FW = $prop =~ /^AVERAGE_WIDTH = (\d+)0$/am ? $1 : die;
472     $WIN_FH = $prop =~ /^PIXEL_SIZE = (\d+)$/am ? $1 : die;
473     }
474     }
475    
476     our @DISPLAY;
477     our @DISPLAYED;
478    
479     our $WIN_DISPLAY_PREFIX;
480    
481     our $WIN_READY = AE::cv;
482    
483     sub __win_reset {
484     undef $WIN;
485     undef $WIN_RW;
486     @DISPLAYED = ();
487     undef $WIN_DISPLAY_PREFIX;
488     }
489    
490     sub _win_refresh {
491     undef $WIN_TOW;
492    
493     my $msg;
494    
495     unless ($WIN) {
496     socketpair $WIN, my $slave, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC;
497     fcntl $slave, Fcntl::F_SETFD, 0;
498     system "exec rxvt -bg black -fg gray -perl-ext '' -perl-ext-common '' -sl 0 +sb"
499     . " -fn \Q$FONT\E -b $WIN_BORDER -name doomfrontend"
500     . " --pointerBlank --pointerBlankDelay 1"
501     . " -geometry 1x1-0-0 -bl -pty-fd " . (fileno $slave) . " &";
502     close $slave;
503    
504     binmode $WIN, ":utf8";
505     $WIN->autoflush;
506    
507     $WIN_RW = AE::io $WIN, 0, sub {
508     sysread $WIN, my $buf, 64
509     or exit 1;
510    
511     # hacky parsing, but we expect only one reply
512     if ($buf =~ /^\x1b]776;([^\007]+)\007/) {
513     my @info = split /;/, $1;
514    
515     $WIN_FW = $info[0];
516     $WIN_FH = $info[1];
517     $WIN_W = int $SW / $WIN_FW;
518     $WIN_H = int $SH / $WIN_FH;
519    
520     my ($x, $y) = $WIN_SHOW
521     ? (($SW - $WIN_FW * $WIN_W) * 0.5, $WIN_BORDER * 2) # top
522     : ($SW + $WIN_BORDER, $SH - $WIN_BORDER);
523    
524     # do resize first, to avoid resize followed by Xserver moving, and another resize
525     my $init = sprintf "\e[8;%d;%dt", $WIN_H, $WIN_W;
526     #$init .= sprintf "\e[3;%d;%dt", $x - $WIN_BORDER, $y - $WIN_BORDER * 2;
527     $init .= sprintf "\e[3;%d;%dt", 0, 0;
528    
529     syswrite $WIN, $init;
530     select undef, undef, undef, 0.1;
531    
532     @DISPLAYED = ();
533     goto &_win_refresh;
534     }
535    
536     input_feed_key $buf;
537     };
538    
539     undef $WIN_FH;
540    
541     $msg = "\e]776;?\007" # cellinfo request
542     . "\e[?25l" # hide cursor
543     . "\e[?7l" # no wraparound
544     . "\e[H"; # clreos
545     }
546    
547     $msg .= $WIN_DISPLAY_PREFIX;
548     undef $WIN_DISPLAY_PREFIX;
549    
550     for my $y (0 .. $WIN_H - 1) {
551     if ($DISPLAY[$y] ne $DISPLAYED[$y]) {
552     $msg .= "\e[" . ($y + 1) . "H$DISPLAY[$y]\e[3K\e[m";
553     $DISPLAYED[$y] = $DISPLAY[$y];
554     }
555     }
556    
557     # my $txt = substr $WIN_TEXT, 0, $WIN_W;
558     # $msg .= " " x ($WIN_W - 1 - length $txt);
559     # $msg .= $txt;
560     # $msg .= "\e[J"; # clreos
561     $msg .= $WIN_TEXT;
562    
563     #utf8::encode $msg;
564    
565     print $WIN $msg;
566    
567     if (0) {#d#
568     for (my $ofs = 0; $ofs < length $msg; ) {
569     my $len = syswrite $WIN, $msg, (length $msg) - $ofs, $ofs;
570    
571     if ($len > 0) {
572     $ofs += $len;
573     } else {
574     __win_reset;
575     sleep 1;
576     goto &__win;
577     }
578     }
579     }
580    
581     $WIN_READY->() if $WIN_H;
582     }
583    
584     sub win_refresh {
585     $WIN_TOW ||= AE::timer 1/60, 0, \&_win_refresh;
586     }
587    
588     sub win_show {
589     return if $WIN_SHOW;
590     $WIN_SHOW = 1;
591     win_refresh;
592     }
593    
594     sub win_hide {
595     return unless $WIN_SHOW;
596     $WIN_SHOW = 0;
597     win_refresh;
598     }
599    
600     sub win_scroll($$;$) {
601     my ($y0, $y1, $up) = @_;
602    
603     $WIN_DISPLAY_PREFIX = sprintf "\e[%d;%dr\e[%dH", $y0 + 1, $y1 + 1, $y0 + 1;
604     $WIN_DISPLAY_PREFIX .= $up ? "\e[M" : "\e[L";
605     $WIN_DISPLAY_PREFIX .= "\e[r";
606    
607     for (\@DISPLAY, \@DISPLAYED) {
608     if ($up) {
609     splice @$_, $y1, 0, "";
610     splice @$_, $y0, 1;
611     } else {
612     splice @$_, $y1, 1;
613     splice @$_, $y0, 0, "";
614     }
615     }
616     }
617    
618     # expects unicode
619     sub win_set($$) {
620     $DISPLAY[$_[0]] = $_[1];
621     }
622    
623     sub win_clear {
624     @DISPLAY = ();
625    
626     # immediatelly clear, if possible
627     if ($WIN) {
628     syswrite $WIN, "\e[H\e[2J";
629     @DISPLAYED = ();
630     }
631    
632     win_show;
633     }
634    
635     sub win_nest(&) {
636     my @old_display = @DISPLAY;
637    
638     win_clear;
639     win_refresh;
640     $_[0]();
641    
642     @DISPLAY = @old_display;
643     win_refresh;
644     }
645    
646     __win_reset;
647     _win_refresh;
648     win_show;
649    
650     sub win_progress($) {
651     win_clear;
652     win_set 10, " $_[0]";
653     _win_refresh;
654     }
655    
656     sub win_progress_init {
657     my (@lines) = @_;
658    
659     my $msg;
660    
661     for my $y (0 .. $#lines) {
662     $msg .= "\e[" . ($y + 1) . "H$lines[$y]\e[3K\e[m";
663     }
664    
665     $msg .= "\e[J";
666    
667     print $WIN $msg;
668     }
669    
670     sub win_progress_update {
671     my ($y, $text) = @_;
672    
673     print $WIN "\e[" . ($y + 1) . "H$text\e[3K";
674     }
675    
676     sub win_progress_done {
677     win_refresh;
678     }
679    
680     #############################################################################
681    
682     package list {
683    
684     sub new {
685     my $class = shift;
686    
687     my $self = bless {
688     list => [], # format: [display-string, id, extra-unused]
689     state => {},
690     y0 => 0,
691     y1 => $WIN_H - 1,
692     ref => -2,
693     return => undef,
694     left => undef,
695     display_cb => sub { },
696     @_,
697     cur => 0,
698     }, $class;
699    
700     $self->{cur} = $self->{state}{curidx}*1;
701    
702     if (defined (my $curname = $self->{state}{curname})) {
703     my $list = $self->{list};
704     for (0 .. $#$list) {
705     if ($list->[$_][1] eq $curname) {
706     $self->{cur} = $_;
707     last;
708     }
709     }
710     }
711    
712     $self->reify;
713    
714     $self
715     }
716    
717     sub set {
718     $_[0]{list} = $_[1];
719     }
720    
721     sub reify {
722     my ($self) = @_;
723    
724     my $list = $self->{list};
725     my $cur = $self->{cur};
726    
727     $cur = List::Util::max $cur, 0;
728     $cur = List::Util::min $cur, $#$list;
729    
730     $self->{cur} = $cur;
731     }
732    
733    
734     sub draw {
735     my ($self) = @_;
736    
737     $self->reify;
738    
739     my $list = $self->{list};
740     my $cur = $self->{cur};
741     my $lines = $self->{y1} - $self->{y0} + 1;
742    
743     my $beg = List::Util::max 0, List::Util::min $cur - int $lines / 2, @$list - $lines;
744    
745     # scroll optimization
746     if ($self->{ref} + 1 == $beg) {
747     ::win_scroll $self->{y0}, $self->{y1}, 1;
748     } elsif ($self->{ref} - 1 == $beg) {
749     ::win_scroll $self->{y0}, $self->{y1}, 0;
750     }
751    
752     {
753     my $cb = $self->{display_cb};
754     my ($entry, $line); # speed
755     my $y0 = $self->{y0};
756     my $yb = List::Util::min @$list - $beg, $lines;
757     for (0 .. $yb - 1) {
758     $entry = $list->[$beg + $_];
759     $line = $entry->[0];
760     $line = "\e[30;43m$line" if $_ == $cur - $beg; # hilight selection
761     $line = $cb->($entry, $line) // $line;
762     $DISPLAY[$_ + $y0] = $line;
763     }
764    
765     if (0) { # random pattern
766     for my $line (@DISPLAY[$y0 + $yb .. $y0 + $lines - 1]) {
767     $line = " " x $WIN_W;
768     substr $line, (rand $WIN_W - 1), 1, "."
769     for 1 .. rand $WIN_W / $WIN_H;
770     $line =~ s/ +$//;
771     }
772     }
773    
774     $DISPLAY[$y0] = sprintf "%d more", $beg + 1
775     if $cur > $beg && $beg;
776    
777     if ($cur < $beg + $lines && @$list - $beg - $lines > 0) {
778     $DISPLAY[$y0 + $yb - 1] = sprintf "%d more", @$list - $beg - $lines + 1;
779     }
780     }
781    
782     $self->{cur} = $cur;
783     $self->{ref} = $beg;
784     }
785    
786     sub changed {
787     my ($self) = @_;
788    
789     $self->reify;
790    
791     $self->{state}{curidx} = $self->{cur};
792     $self->{state}{curname} = $self->{list}[$self->{cur}][1];
793     ::state_save;
794     }
795    
796     sub handle_event {
797     my ($self) = @_;
798    
799     return unless @{ $self->{list} };
800    
801     if ($::INPUT eq "up") {
802     $self->{cur} = ($self->{cur} - 1) % @{ $self->{list} }; $self->changed;
803     } elsif ($::INPUT eq "down") {
804     $self->{cur} = ($self->{cur} + 1) % @{ $self->{list} }; $self->changed;
805     } elsif ($::INPUT eq "pgup" or $::INPUT eq "num2") {
806     $self->{cur} -= ($self->{y1} - $self-> {y0} + 1) >> 1; $self->changed;
807     } elsif ($::INPUT eq "pgdown" or $::INPUT eq "num8") {
808     $self->{cur} += ($self->{y1} - $self-> {y0} + 1) >> 1; $self->changed;
809     } elsif ($::INPUT eq "num1") {
810     $self->{cur} = 0; $self->changed;
811     } elsif ($::INPUT eq "num9") {
812     $self->{cur} = $#{ $self->{list} }; $self->changed;
813     } else {
814     return;
815     }
816    
817     1 # event consumed
818     }
819    
820     # handle events until selection was made (return it)
821     # or an unknown input was received (return nothing)
822     sub handle_events {
823     my ($self) = @_;
824    
825     while () {
826     $self->draw;
827     ::input_next "list";
828     $self->handle_event
829     and return 1;
830    
831     my $nonempty = @{ $self->{list} };
832    
833     if ($::INPUT eq "enter") {
834     ::input_set "list/select", $self->{cur};
835     return if $nonempty;
836    
837     } elsif (($::INPUT eq "return" || $::INPUT eq "esc") && defined $self->{return}) {
838     $self->{cur} = $self->{return};
839     ::input_set "list/select", $self->{cur};
840     return if $nonempty;
841    
842     } elsif ($::INPUT eq "left" && defined $self->{left}) {
843     $self->{cur} = $self->{left};
844     ::input_set "list/select", $self->{cur};
845     return if $nonempty;
846    
847     } else {
848     return;
849     }
850     }
851     }
852    
853     sub selection {
854     $_[0]{list}[$_[0]{cur}]
855     }
856     }
857    
858     #############################################################################
859    
860     sub prepare_exit() {
861     state_cleanup;
862     $mpv->stop;
863     }
864    
865     #############################################################################
866    
867     sub menu_choice($%) {
868     my (%arg) = @_;
869    
870     my $list = new list
871     cur => 0,
872     y0 => 5,
873     %arg,
874     ;
875    
876     while () {
877     $list->handle_events and next;
878    
879     if ($INPUT eq "list/select") {
880     return $list->selection;
881     }
882     #TODO: return more?
883     }
884     }
885    
886     #############################################################################
887    
888 root 1.2 sub _canonpath {
889 root 1.1 my $path = $_[0];
890    
891 root 1.2 my $file;
892    
893     unless (-d $path) {
894     $path =~ s/((?:^|\/)[^\/]+\z)//;
895     $file = $1;
896     }
897    
898 root 1.1 $path = Cwd::realpath $path;
899     $path = "/fs/$NODENAME$path" unless $path =~ /^\/fs\//;
900    
901 root 1.2 "$path$file"
902     }
903    
904     our $VIDEO_DIR_CANON = _canonpath $VIDEO_DIR;
905    
906     sub canonpath {
907     my $path = _canonpath $_[0];
908     $path =~ s/^\Q$VIDEO_DIR_CANON\E(\z|\/)/$VIDEO_DIR$1/;
909 root 1.1 $path
910     }
911    
912     # check path for mythtv
913     sub is_myth($) {
914     my $a = canonpath $_[0];
915     my $b = canonpath $MYTHTV_DIR;
916     $a =~ /^\Q$b\E/
917     }
918    
919     our $CONF_MTIME;
920     our $CONF;
921     our %CONF_PLAYLIST;
922     our @CONF_PLAYLIST_ORDER;
923    
924     sub conf_postload {
925     %CONF_PLAYLIST = ();
926     @CONF_PLAYLIST_ORDER = ();
927    
928     my @pl = @{ $CONF->{playlists} };
929     while (@pl) {
930     my ($k, $v) = splice @pl, 0, 2;
931    
932     $k = "/$k";
933    
934     push @CONF_PLAYLIST_ORDER, $k
935     unless $v->{hide};
936    
937 root 1.2 $v->{cwd} = $v->{cwd} ? canonpath $v->{cwd} : $VIDEO_DIR;
938 root 1.1
939     my $state = $STATE{$k} //= {};
940     $CONF_PLAYLIST{$k} = $v;
941     $state->{from_conf} = 1;
942     }
943     }
944    
945     sub conf_check {
946     if ((stat $CONF_FILE)[9] != $CONF_MTIME) {
947     warn "reloading $CONF_FILE...\n";
948    
949     $CONF_MTIME = (stat _)[9];
950     $CONF = do $CONF_FILE;
951    
952     warn $@ if $@;
953    
954     conf_postload;
955     }
956     }
957    
958     #############################################################################
959    
960     sub playlist_names {
961     (
962     @CONF_PLAYLIST_ORDER,
963     grep
964     /^\//
965     && !exists $CONF_PLAYLIST{$_},
966     sort keys %STATE
967     )
968     }
969    
970     sub stat_video($;$) {
971     my ($path, $prefix) = @_;
972    
973     my $display = $path =~ s%^.*/%%r;
974    
975     $display =~ /^\./ and return;
976     $display =~ /\..{2,5}$/ or return;
977    
978     #next unless $name =~ /\.(mp4|mkv|webm|flv|ogg|mp3|m4a|mov|mpg|avi|ogv)$/i;
979    
980     utf8::downgrade $path;
981    
982     stat "$prefix$path" or return;
983     -f _ or return;
984    
985     utf8::decode $display;
986    
987     for ($display) {
988    
989     #s%\.[A-Za-z0-9]{3,4}$%%; # .mp4
990     #s%-[A-Za-z0-9\-_]{11}$%%; # youtube-id
991     s%-[A-Za-z0-9\-_]{11}.(mkv|webm|mp4|mov)$%.$1%; # youtube-id
992    
993     sub dfe::mangle_name ();
994     dfe::mangle_name;
995    
996     # "improve" some filenames/episode numbers, mostly for sorting
997     s{(?:\bpart|\bep\.?|episode|Ch\.|Chapter|\bE)\s*#?(\d+)\b}{sprintf "Ep.%03d", $1}geia;
998     #s{(-\s*)(\d{1,4})(\s*-)}{sprintf "%s#%03d%s", $1, $2, $3}geia;
999     s{\s+#(\d+)}{sprintf " #%03d", $1}geia;
1000     s{\[#?(\d+)\]}{sprintf "#%03d", $1}geia;
1001     s{\bs(\d+)e(\d+)\b}{sprintf "S%02dE%02d", $1, $2}geia;
1002    
1003     s{-20(\d\d)(\d\d)(\d\d)\.([^.]+)\z}{-20$1.$2.$3.$4}a;
1004    
1005     s/\s+/ /g;
1006     }
1007    
1008     $display = sprintf "%s [%dMB]", $display, (-s _) * 1e-6;
1009    
1010     [$display, $path]
1011     }
1012    
1013     sub video_sort {
1014     # schwartzian version sort on filename
1015     map $_->[0],
1016     sort { $a->[1] cmp $b->[1] }
1017     map [$_, lc $_->[0] =~ s/([0-9]+)/sprintf "%19d", $1/ger],
1018     @_
1019     }
1020    
1021     my $video_dir_cache;
1022    
1023     sub scan_video_dir($) {
1024     my ($path) = @_;
1025    
1026     my $cache = $video_dir_cache->{$path};
1027    
1028     opendir my $dir, $path
1029     or return []; #die "$path: $!\n";
1030     my $mtime = (stat $dir)[9];
1031    
1032     if ($mtime != $cache->[0]) {
1033     # hack to preload cache a bit
1034    
1035     $cache = $cache->[1];
1036    
1037     my @files =
1038     grep !/(?:\.(?:json|srt|vtt|part|ytdl|chapters|f\d\d\d\.[^.]+)$)/a,
1039     readdir $dir;
1040    
1041     win_progress_init "scan_video_dir", $path;
1042    
1043     # pre-cache files
1044     for my $file (@files) {
1045     IO::AIO::aio_stat "$path/$file"
1046     unless exists $cache->{$file};
1047     }
1048    
1049     my %new_cache;
1050     my $progress = 0;
1051     for my $file (@files) {
1052     $new_cache{$file} = (delete $cache->{$file}) || (stat_video "$path/$file") || next;
1053    
1054     win_progress_update 2, "$progress/" . @files
1055     unless ++$progress & 15;
1056     }
1057    
1058     $cache = $video_dir_cache->{$path} = [$mtime, \%new_cache];
1059    
1060     win_progress_done;
1061     }
1062    
1063     [ video_sort values %{$cache->[1]} ]
1064     }
1065    
1066     sub scan_video_dir_clear_cache() {
1067     $video_dir_cache = undef;
1068     }
1069    
1070     sub scan_00_distant_worlds {
1071     (
1072     "",
1073     [
1074     video_sort #d#
1075 root 1.2 @{ scan_video_dir $VIDEO_DIR },
1076 root 1.1 @{ scan_video_dir "/fs/doom/root/ytnew" },
1077     @{ scan_video_dir "/seagate2tb/sinatar" },
1078     ]
1079     )
1080     }
1081    
1082     sub scan_islands($) {
1083     my ($path) = @_;
1084    
1085     my $list = scan_video_dir $path;
1086    
1087     my %byuploader;
1088     for (@$list) {
1089     push @{ $byuploader{$1} }, $_
1090     if $_->[1] =~ /^([^-]+)-/;
1091     }
1092    
1093     (
1094     "",
1095     [
1096     sort { "\L$a->[0]" cmp "\L$b->[0]" }
1097     map @$_,
1098     grep @$_ <= MAX_ISLANDS,
1099     values %byuploader
1100     ]
1101     )
1102     }
1103    
1104     sub state_scan_recursive($) {
1105     my ($path) = @_;
1106    
1107     my @list;
1108    
1109     my $scan = sub {
1110     my ($path, $display) = @_;
1111    
1112     my @dirs;
1113    
1114 root 1.2 $path = canonpath $path;
1115    
1116 root 1.1 opendir my $fh, $path
1117     or return;
1118     for (sort readdir $fh) {
1119     next if /^\.\.?$/;
1120     stat "$path/$_" or next;
1121    
1122     if (-d _) {
1123     my $dis = dec $_;
1124     $dis = length $dis > 25 ? (substr $dis, 0, 24) . "…" : $dis;
1125    
1126     push @dirs, ["$path/$_", "$display/$dis"];
1127    
1128     } elsif (-f _) {
1129     my $dis = dec $_;
1130 root 1.2 push @list, [(substr "$display/$dis", 1), "$path/$_"];
1131 root 1.1 }
1132     }
1133    
1134     __SUB__->(@$_)
1135     for @dirs;
1136     };
1137    
1138     $scan->($path, "");
1139    
1140     utf8::decode $_->[0] for @list;
1141    
1142     \@list
1143     }
1144    
1145     sub mythtv_dbh() {
1146     DBI->connect ("DBI:mysql:database=mythconverg;mysql_read_default_file=/root/.my.cnf;host=doom;user=root")
1147     or die "unable to connect to mythtv database"
1148     }
1149    
1150     sub scan_mythtv($) {
1151     my $dbh = mythtv_dbh;
1152    
1153     my $rv = $dbh->selectall_arrayref (
1154     "select basename, convert_tz(starttime, 'UTC', 'Europe/Berlin'), title, subtitle
1155     from recorded
1156     where recgroup not in ('Deleted', 'LiveTV')
1157     order by starttime asc
1158     ");
1159    
1160     for (@$rv) {
1161     utf8::decode $_->[2];
1162     utf8::decode $_->[3];
1163     }
1164    
1165     (
1166     "$MYTHTV_DIR/",
1167     [
1168     map ["$_->[1] " . (dec $_->[2]) . " (" . (dec $_->[3]) . ")", $_->[0]], @$rv
1169     ]
1170     )
1171     }
1172    
1173     # delete /playlist, maybe switch away if current playlist
1174     sub playlist_delete {
1175     my ($playlist) = @_;
1176    
1177     delete $STATE{$playlist};
1178    
1179     if ($STATE{curdir} eq $playlist) {
1180     $STATE{curdir} = "/playlist";
1181     ::state_save;
1182     external "--playlist=playlist";
1183     }
1184     }
1185    
1186     our ($PLAYING_STATE, $PLAYING_PATH);
1187    
1188     sub play_video_speed_mult {
1189     sprintf "%.2f", 1.032 ** $PLAYING_STATE->{speed}
1190     }
1191    
1192     sub play_video_set_speed {
1193     my $speed = play_video_speed_mult;
1194     delete $PLAYING_STATE->{speed} unless $PLAYING_STATE->{speed};
1195    
1196     $mpv->cmd ("set", "speed", "$speed");
1197     $mpv->cmd ("show-text", "playback speed $speed");
1198     }
1199    
1200     our $OSD_LEVEL = $DOOM ? 3 : 3; # was 1 on doom
1201    
1202     sub sprintf_time($$) {
1203     sprintf $_[0],
1204     sprintf "%02d:%02d:%02d.%03d",
1205     $_[1] / 60 / 60 % 60,
1206     $_[1] / 60 % 60,
1207     $_[1] % 60,
1208     $_[1] * 1000 % 1000;
1209     }
1210    
1211     my $curfps;
1212    
1213     sub set_fps {
1214     return unless $DOOM;
1215    
1216     my ($target) = @_;
1217    
1218     my $new = $XRANDR_FPS;
1219    
1220     if (defined $target) {
1221     my $maxerr = 0.02; # max. 2% off allowed
1222     for (@XRANDR_RATES) {
1223     for my $div (1..10) {
1224     my $err = abs ($target * $div / $_->[0] - 1);
1225     if ($err < $maxerr) {
1226     $maxerr = $err;
1227     $new = $_->[0];
1228     }
1229     }
1230     }
1231     }
1232    
1233     if ($curfps != $new && defined $new) {
1234     warn "REFRESHRATE CHANGE current=$curfps, target=$target, selected=$new\n";
1235     system "xrandr", "--output", $XRANDR_OUTPUT, "--mode", $XRANDR_MODE, "--rate", $new;
1236     $curfps = $new;
1237     }
1238     }
1239    
1240     # does not work: deinterlace, because it returns a boolean and expects i have no clue
1241     our %SAVE_PROPERTY = (aid => 1, sid => 1, "audio-delay" => 1);
1242    
1243     sub mpv_init {
1244     $mpv->start ("--idle=yes", "--pause", "--force-window=no"); # "--start=$playback_start", "--", $mpv_path;
1245    
1246     for (
1247     List::Util::pairs qw(
1248     ESC return
1249     q return
1250     ENTER enter
1251     SPACE pause
1252     [ steprev
1253     ] stepfwd
1254     j subtitle
1255     BS red
1256     i green
1257     o yellow
1258     b blue
1259     D triangle
1260     UP up
1261     DOWN down
1262     RIGHT right
1263     LEFT left
1264     ),
1265     (map { ("KP$_" => "num$_") } 0..9),
1266     KP_INS => 0, # KP0, but different
1267     ) {
1268     $mpv->bind_key ($_->[0] => $_->[1]);
1269     }
1270    
1271     $mpv->cmd (observe_property => 1, "chapter-metadata");
1272    
1273     eval {
1274     # the profile is optional
1275     $mpv->cmd ("apply-profile" => "doomfrontend");
1276     };
1277     }
1278    
1279     sub play_video {
1280     ($PLAYING_STATE, $PLAYING_PATH, my $continue) = @_;
1281    
1282 root 1.2 my $playback_start = 0;
1283 root 1.1
1284     if ($continue) {
1285     $playback_start = $PLAYING_STATE->{curpos} // 0;
1286     } else {
1287     my @menu = ([beginning => 0], [cancel => undef]);
1288    
1289     for my $idx (reverse 0..9) {
1290     if (my $pos = $PLAYING_STATE->{"bookmark$idx"}) {
1291     unshift @menu, [(sprintf_time "bookmark $idx (%s)", $pos) => $pos];
1292     }
1293     }
1294    
1295     if (my $pos = $PLAYING_STATE->{curpos}) {
1296     unshift @menu, [(sprintf_time "current (%s)", $pos) => $pos];
1297     }
1298    
1299     if (@menu > 2) {
1300     win_clear;
1301     win_set 3, "\e[33mmultiple start locations available:";
1302    
1303     my $selection = menu_choice
1304     list => \@menu,
1305     y0 => 5,
1306     return => $#menu,
1307     left => $#menu,
1308     ;
1309    
1310     $playback_start = $selection->[1];
1311    
1312     defined $playback_start
1313     or return;
1314    
1315     } else {
1316     $playback_start = 0;
1317     }
1318     }
1319    
1320     win_clear;
1321     win_set 0, "starting video...";
1322     _win_refresh;
1323    
1324     my $mpv_path = $PLAYING_PATH;
1325     my $initial_deinterlace;
1326    
1327     if (is_myth $mpv_path) {
1328     $mpv_path = "appending://$mpv_path";
1329     $initial_deinterlace = 1;
1330     }
1331    
1332     $mpv->cmd ("script-message", "osc-visibility", "never", "dummy");
1333     $mpv->cmd ("set", "vid", "auto");
1334     $mpv->cmd ("set", "aid", "auto");
1335     $mpv->cmd ("set", "sid", "no");
1336 root 1.2 #$mpv->cmd ("set", "sub-delay", "-19.100");
1337     #$mpv->cmd ("set", "sub-codepage", "UTF-8-BROKEN");
1338 root 1.1 $mpv->cmd ("set", "file-local-options/chapters-file", $mpv->escape_binary ("$mpv_path.chapters"));
1339 root 1.2 $mpv->cmd ("set", "options/start" => "$playback_start"); # file-local-options, or just start do not work
1340 root 1.1 $mpv->cmd ("loadfile", $mpv->escape_binary ($mpv_path));
1341     $mpv->cmd ("script-message", "osc-visibility", "auto", "dummy");
1342     #$mpv->cmd ("playlist-clear");
1343    
1344     my $oid = 100;
1345    
1346     #$mpv->cmd ("observe_property", ++$oid, "shared-script-properties");
1347    
1348     #$mpv->cmd ("get_property", "playback-time");
1349     #$mpv->cmd ("get_time_us");
1350    
1351     my $playback_time;
1352    
1353     my $status = 0;
1354     my $arg;
1355    
1356     my $fps;
1357    
1358     my $skip_delay;
1359    
1360     while () {
1361     input_next "play";
1362    
1363     if ($INPUT =~ /^num([0-9])$/ or $INPUT eq "red") {
1364     $INPUT eq "red"
1365     ? substr $arg, -1, 1, ""
1366     : ($arg .= $1);
1367    
1368     $mpv->cmd ("osd-msg", "show-text", "argument: ${arg}_", 600000);
1369     $mpv->cmd ("osd-msg", "show-text", "") unless length $arg;
1370     next;
1371     }
1372    
1373     if ($INPUT eq "mpv/quit") { # should not happen, but allows user to kill etc. without consequence
1374     $status = 1;
1375     mpv_init; # try reinit
1376     last;
1377    
1378     } elsif ($INPUT eq "mpv/idle") { # normal end-of-file
1379     last;
1380    
1381     } elsif ($INPUT eq "return") {
1382     $status = 1;
1383     last;
1384    
1385     } elsif ($INPUT eq "mpv/file-loaded") { # start playing, configure video
1386 root 1.2 #$mpv->cmd ("seek", $playback_start, "absolute+exact") if $playback_start > 0;
1387 root 1.1
1388     my $target_fps = eval { $mpv->cmd_recv ("get_property", "container-fps") } || 60;
1389     $target_fps *= play_video_speed_mult;
1390     set_fps $target_fps;
1391    
1392     unless (eval { $mpv->cmd_recv ("get_property", "video-format") }) {
1393     # assume audio-only TODO: better test
1394     $mpv->cmd ("set", "file-local-options/lavfi-complex", "[aid1] asplit [ao], showcqt=fps=60:size=hd720:count=1:bar_g=2:sono_g=3:sono_v=9:fontcolor='st(0, (midi(f)-53.5)/12); st(1, 0.5 - 0.5 * cos(PI*ld(0))); r(1-ld(1)) + b(ld(1))':tc=0.33:tlength='st(0,0.17); 384*tc / (384 / ld(0) + tc*f /(1-ld(0))) + 384*tc / (tc*f / ld(0) + 384 /(1-ld(0)))', format=yuv420p [vo]");
1395     };
1396    
1397     for my $prop (keys %SAVE_PROPERTY) {
1398     if (exists $PLAYING_STATE->{"mpv_$prop"}) {
1399     $mpv->cmd ("set", "$prop", $PLAYING_STATE->{"mpv_$prop"} . "");
1400     }
1401    
1402     $mpv->cmd ("observe_property", ++$oid, $prop);
1403     }
1404    
1405     play_video_set_speed;
1406     $mpv->cmd ("set", "osd-level", "$OSD_LEVEL");
1407     $mpv->cmd ("observe_property", ++$oid, "osd-level");
1408     $mpv->cmd ("set", "pause", "no");
1409    
1410     $mpv->cmd ("set_property", "deinterlace", "yes")
1411     if $initial_deinterlace;
1412    
1413     $mpv->cmd ("show-text", "FPS: target $target_fps, current $curfps", 2000)
1414     if $curfps != $fps;#d#
1415    
1416     win_clear;
1417    
1418     } elsif ($INPUT eq "stepfwd") {
1419     ++$PLAYING_STATE->{speed};
1420     play_video_set_speed;
1421     ::state_save;
1422     } elsif ($INPUT eq "steprev") {
1423     --$PLAYING_STATE->{speed};
1424     play_video_set_speed;
1425     ::state_save;
1426    
1427     } elsif ($INPUT eq "pause") {
1428     $mpv->cmd ("cycle", "pause");
1429     $PLAYING_STATE->{curpos} = $mpv->cmd_recv ("get_property", "playback-time");
1430     ::state_save;
1431    
1432     } elsif ($INPUT eq "green") {
1433     if (length $arg) { # seek-to
1434     if ($arg <= 99) { # MM
1435     $arg = sprintf "%02d:00", $arg;
1436     } elsif ($arg <= 9999) { # HHMM
1437     $arg = sprintf "%02d:%02d:00", $arg / 100, $arg % 100;
1438     } else { # HHMMSS
1439     $arg = sprintf "%02d:%02d:%02d", $arg / 100 / 100, $arg / 100 % 100, $arg % 100;
1440     }
1441     $mpv->cmd ("osd-msg", "seek", $arg, "absolute+exact");
1442     } else {
1443     $mpv->cmd ("osd-msg-bar", "show-progress");
1444     }
1445    
1446     } elsif ($INPUT eq "yellow") {
1447     $mpv->cmd ("osd-auto", "cycle-values", "osd-level", "2", "3", "0", "1");
1448    
1449     } elsif ($INPUT eq "right") {
1450     $mpv->cmd ("osd-msg-bar", "seek", $arg * 60 || 30, "relative+exact");
1451     } elsif ($INPUT eq "left") {
1452     $mpv->cmd ("osd-msg-bar", "seek", -$arg * 60 || -5, "relative+exact");
1453     } elsif ($INPUT eq "up") {
1454     $mpv->cmd ("osd-msg-bar", "seek", +600, "relative+exact");
1455     } elsif ($INPUT eq "down") {
1456     $mpv->cmd ("osd-msg-bar", "seek", -600, "relative+exact");
1457     } elsif ($INPUT eq "select") {
1458     $mpv->cmd ("osd-msg-bar", "add", "audio-delay", "-0.100");
1459     } elsif ($INPUT eq "start") {
1460     $mpv->cmd ("osd-msg-bar", "add", "audio-delay", "0.100");
1461     } elsif ($INPUT eq "intfwd") {
1462     $mpv->cmd ("no-osd", "frame-step");
1463     } elsif ($INPUT eq "intrev") {
1464     $mpv->cmd ("no-osd", "frame-back-step");
1465    
1466     } elsif ($INPUT eq "enter") {
1467     eval {
1468     my $pos = $mpv->cmd_recv ("get_property", "playback-time");
1469     $mpv->cmd ("show-text", "saving bookmark $arg position at $pos");
1470     $PLAYING_STATE->{"bookmark$arg"} = $pos;
1471     ::state_save;
1472     };
1473    
1474     } elsif ($INPUT eq "blue") { # recall bookmark
1475     my $pos = $mpv->cmd_recv ("get_property", "playback-time");
1476     $mpv->cmd ("no-osd", "seek", $PLAYING_STATE->{"bookmark$arg"}, "absolute+exact");
1477     $PLAYING_STATE->{"bookmark9"} = $pos;
1478     $mpv->cmd ("expand-properties", "show-text", "recalling bookmark $arg position \${playback-time}, recall bookmark 9 to return", 5000);
1479     ::state_save;
1480    
1481     } elsif ($INPUT eq "square") {
1482     $mpv->cmd ("osd-auto", "screenshot", "video");
1483    
1484     } elsif ($INPUT eq "audio") {
1485     $mpv->cmd ("osd-auto", "cycle", "audio");
1486    
1487     } elsif ($INPUT eq "subtitle") {
1488     $mpv->cmd ("osd-auto", "cycle", "sub");
1489    
1490     } elsif ($INPUT eq "triangle") {
1491     $mpv->cmd ("osd-auto", "cycle", "deinterlace");
1492    
1493     } elsif ($INPUT eq "mpv/property-change") {
1494     my $prop = $INPUT_DATA->{name};
1495    
1496     if ($prop eq "osd-level") {
1497     $OSD_LEVEL = $INPUT_DATA->{data};
1498     #win_set 0, "playback position $playback_time";
1499     #warn "$playback_time\n";#d#
1500     #$mpv->cmd ("expand-properties", "show-text", '${time-pos}', "1500");
1501     } elsif ($prop eq "chapter-metadata") {
1502     if ($INPUT_DATA->{data}{TITLE} =~ /^\[SponsorBlock\]: (.*)/) {
1503     my $section = $1;
1504     my $skip;
1505    
1506     $skip ||= $SPONSOR_SKIP{$_}
1507     for split /\s*,\s*/, $section;
1508    
1509     if (defined $skip) {
1510     if ($skip) {
1511     # delay a bit, in case we get two metadata changes in quick succession, e.g.
1512     # because we have a skip at file load time.
1513     $skip_delay = AE::timer 2/50, 0, sub {
1514     $mpv->cmd ("no-osd", "add", "chapter", 1);
1515     $mpv->cmd ("show-text", "skipped sponsorblock section \"$section\"", 3000);
1516     };
1517     } else {
1518     undef $skip_delay;
1519     $mpv->cmd ("show-text", "NOT skipping sponsorblock section \"$section\"", 3000);
1520     }
1521     } else {
1522     $mpv->cmd ("show-text", "UNRECOGNIZED sponsorblock section \"$section\"", 60000);
1523     }
1524     } else {
1525     # cancel a queued skip
1526     undef $skip_delay;
1527     }
1528    
1529     } elsif (exists $SAVE_PROPERTY{$prop}) {
1530     $PLAYING_STATE->{"mpv_$prop"} = $INPUT_DATA->{data};
1531     ::state_save;
1532     }
1533     }
1534    
1535     undef $arg;
1536     }
1537    
1538     $mpv->cmd ("set", "pause", "yes");
1539    
1540     while ($oid > 100) {
1541     $mpv->cmd ("unobserve_property", $oid--);
1542     }
1543    
1544     if ($status) {
1545     eval {
1546     $PLAYING_STATE->{curpos} = $mpv->cmd_recv ("get_property", "playback-time");
1547     ::state_save;
1548     };
1549     warn $@ if $@;#d#
1550     } else {
1551     $PLAYING_STATE->{watched} = int AE::now;
1552     ::state_save;
1553     }
1554    
1555     $mpv->cmd_recv ("stop");
1556    
1557     # make sure state is clean, even if its slower
1558 root 1.2 #$mpv->stop;
1559     #mpv_init;
1560 root 1.1
1561     #if ($DPMS_DISABLE) {
1562     # system "xse", "-dpms";
1563     #}
1564     }
1565    
1566     sub play_video_kodi($$$) {
1567     my ($host, $path, $state) = @_;
1568    
1569     unlink "$KODIPATH/$host.bin";
1570     symlink $path, "$KODIPATH/$host.bin";
1571     system "chmod", "o+r", "--", "$KODIPATH/$host.bin";
1572    
1573     my $conn; $conn = new AnyEvent::Handle
1574     connect => [$host, 9090],
1575     on_error => sub {
1576     $conn; # self-reference
1577    
1578     my ($hdl, $fatal, $msg) = @_;
1579    
1580     AE::log error => $msg;
1581    
1582     $hdl->destroy;
1583     },
1584     ;
1585    
1586     $conn->on_read (sub {
1587     warn $conn->{rbuf};
1588     });
1589    
1590     $conn->push_write (qq<{"jsonrpc":"2.0","method":"player.open", "params": {"item":{"file":"$KODIURL/$host.bin"}}}>);
1591     warn "$KODIURL/$host.bin";#d#
1592    
1593     if (my $curpos = $state->{curpos}) {
1594     Coro::AnyEvent::sleep 1;
1595    
1596     my $ms = int +($curpos - int $curpos) * 1000;
1597     my $s = int $curpos % 60;
1598     my $m = int $curpos / 60 % 60;
1599     my $h = int $curpos / 60 / 60 ;
1600    
1601     $conn->push_write (qq<{"jsonrpc":"2.0","method":"player.seek", "params": {"playerid":1, "value":{"hours":$h, "minutes":$m, "seconds":$s, "milliseconds":$ms}}}>);
1602     }
1603    
1604     $conn->push_shutdown;
1605     }
1606    
1607     sub mangle_edit($$) {
1608     my ($playlist, $path) = @_;
1609    
1610     my $base = basename $path;
1611    
1612     my ($uploader, $title) = split /-/, basename $base;
1613    
1614     my @pats;
1615    
1616     utf8::decode $title; # filename must be utf-8, now unicode
1617    
1618     while ($title =~ /(?:(\w+|\S+)|([[:space:]:!,‐]+))/mgs) {
1619     my ($w, $W) = ($1, $2);
1620     if (defined $w) {
1621     $w = quotemeta $w;
1622     $w =~ s/\d+/\\d+/g;
1623     push @pats, $w;
1624     } elsif ($W eq " ") {
1625     push @pats, " ";
1626     } else {
1627     push @pats, "\\W+?";
1628     }
1629     }
1630    
1631     #utf8::encode $_ for @pats;
1632    
1633     my ($o, $l) = (1, 0);
1634    
1635     my $patterns = $STATE{mangle_config}{$uploader};
1636    
1637     my $list_state = { curidx => 1 };
1638    
1639     my $rescan;
1640    
1641     while () {
1642     win_clear;
1643     win_set 1, "\e[33mmangle editor";
1644     win_set 3, dec $base;
1645     win_set 6, "keyboard: 4=left, 6=right, 8=extend, 2=shrink; remote: prev=left, next=right, instant=extend/shrink";
1646    
1647     $o = 0 if $o < 0;
1648     $o = $#pats if $o > $#pats;
1649     $l = 0 if $l < 0;
1650     $l = $#pats - $o if $l > $#pats - $o;
1651    
1652     my $edit = "";
1653     for my $i (0 .. $#pats) {
1654     $edit .= "<\e[30;43m" if $i == $o;
1655     $edit .= $pats[$i];
1656     $edit .= "\e[m>" if $i == $o + $l;
1657     }
1658    
1659     win_set 8, "\e[36mpattern edit ($o+$l):\e[0m $edit";
1660     win_set 10, "resulting pattern: <\e[33m" . (join "", @pats[$o .. $o+$l]) . "\e[m>";
1661    
1662     my @list = (
1663     ["return", sub { last }],
1664     ["add pattern", sub {
1665     push @$patterns, join "", @pats[$o .. $o+$l];
1666     $rescan = 1;
1667     last;
1668     }],
1669     ["use time for all (add empty pattern)", sub {
1670     push @$patterns, "";
1671     $rescan = 1;
1672     last;
1673     }],
1674     );
1675    
1676     for my $pattern (@$patterns) {
1677     push @list, ["remove: <$pattern>", sub {
1678     $patterns = [grep $_ ne $pattern, @$patterns];
1679     $list_state->{curidx} = 0; # return
1680     $rescan = 1;
1681     }];
1682     }
1683    
1684     my $menu = new list
1685     state => $list_state,
1686     y0 => 13,
1687     return => 0,
1688     left => 0,
1689     list => \@list,
1690     ;
1691    
1692     1 while $menu->handle_events;
1693    
1694     if ($INPUT eq "list/select") {
1695     $menu->selection->[1]();
1696     } elsif ($INPUT eq "4" or $INPUT eq "prev") {
1697     --$o;
1698     } elsif ($INPUT eq "6" or $INPUT eq "next") {
1699     ++$o;
1700     } elsif ($INPUT eq "8" or $INPUT eq "intfwd") {
1701     ++$l;
1702     } elsif ($INPUT eq "2" or $INPUT eq "intrev") {
1703     --$l;
1704     }
1705     }
1706    
1707     if ($rescan) {
1708     if (@$patterns) {
1709     $STATE{mangle_config}{$uploader} = $patterns;
1710     } else {
1711     delete $STATE{mangle_config}{$uploader};
1712     }
1713    
1714     state_save;
1715    
1716     sub dfe::mangle_reconfig ();
1717     dfe::mangle_reconfig;
1718    
1719     $playlist->{rescan} = 1;
1720     }
1721     }
1722    
1723     sub file_menu($$) {
1724     my ($playlist, $path) = @_;
1725    
1726     my $state = $STATE{filestate}{$path};
1727    
1728     my $menu = new list
1729     y0 => 10,
1730     return => 0,
1731     left => 0,
1732     list => [
1733     ["return", sub { last }],
1734     ["clear state", sub { %$state = (); last }],
1735     ["kodiplay mate10", sub { play_video_kodi "loki-mate10pro", $path, $state }],
1736     ["toggle watched", sub { $state->{watched} = !$state->{watched}; last }],
1737     ["toggle deleted", sub { $state->{deleted} = !$state->{deleted}; last }],
1738     ["toggle archive", sub { $state->{archive} = !$state->{archive}; last }],
1739     ["toggle tagged" , sub { $state->{tagged} = !$state->{tagged} ; last }],
1740     ["mangle editor" , sub { mangle_edit $playlist, $path; last }],
1741     ];
1742    
1743     win_clear;
1744     win_set 1, "\e[33mfile menu";
1745     win_set 3, dec $path;
1746    
1747     while () {
1748     win_set 4, sprintf "watched:%d deleted:%d", $state->{watched}, $state->{deleted};
1749    
1750     1 while $menu->handle_events;
1751    
1752     $menu->selection->[1]() if $INPUT eq "list/select";
1753     }
1754     }
1755    
1756     sub live_tv {
1757     win_nest {
1758     play_video {}, "dvb://", 0;
1759     };
1760     }
1761    
1762     sub dir_menu {
1763     my ($self) = @_;
1764    
1765     my $filter_update = sub {
1766     $self->{state}{list_menu}{curidx} = 0;
1767     $self->{rescan} = 1;
1768     };
1769    
1770     my $do_unlink = sub {
1771     my ($filter) = @_;
1772    
1773     my $filestate = $STATE{filestate};
1774    
1775     my $pathpfx = $self->{pathpfx};
1776     my $list = $self->{list};
1777    
1778     my $empty = 1;
1779    
1780     for (@$list) {
1781     if ($filter->($filestate->{"$pathpfx$_->[1]"})) {
1782     $self->{rescan} = 1;
1783     IO::AIO::aio_unlink "$pathpfx/$_->[1]";
1784     IO::AIO::aio_unlink "$pathpfx/$_->[1].chapters";
1785     } else {
1786     $empty = 0;
1787     }
1788     }
1789    
1790     if ($empty) {
1791     playlist_delete $self->{playlist};
1792     }
1793    
1794     IO::AIO::flush; #d# should do a group, but I am too lazy
1795     };
1796    
1797     my $do_archive = sub {
1798     my $filestate = $STATE{filestate};
1799    
1800     while (my ($path, $state) = each %$filestate) {
1801     if ($state->{archive}) {
1802     $self->{rescan} = 1;
1803     system "mv", "-v", "-b", $path, $ARCHIVE_DIR;
1804     }
1805     }
1806     };
1807    
1808     my $filter_uploader = sub {
1809     my @menu = (["\e[32mreturn"], ["\e[32mclear filter", undef]);
1810    
1811     my %uploader;
1812    
1813     for (@{ $self->{full_list} }) {
1814     ++$uploader{$1} if $_->[0] =~ /^([^-]+)/;
1815     }
1816    
1817     push @menu,
1818     map [(sprintf "[%4d] %s", $uploader{$_}, dec $_), $_],
1819     grep $uploader{$_} >= MAX_ISLANDS,
1820     sort { "\L$a" cmp "\L$b" } keys %uploader;
1821    
1822     my $menu = new list
1823     y0 => 3,
1824     return => 0,
1825     state => ($self->{state}{filter_uploader_menu} ||= {}),
1826     list => \@menu,
1827     ;
1828    
1829     while () {
1830     win_clear;
1831     win_set 1, "\e[33mselect uploader";
1832    
1833     1 while $menu->handle_events;
1834    
1835     if ($INPUT eq "list/select") {
1836     my $sel = $menu->selection;
1837    
1838     if (@$sel >= 2) {
1839     $self->{state}{filter_uploader} = $sel->[1];
1840     $filter_update->();
1841     }
1842    
1843     last;
1844     }
1845     }
1846     };
1847    
1848     my $chdir = sub {
1849     while () {
1850     my @menu = (["\e[32mreturn"]);
1851    
1852     push @menu, [$_, $_]
1853     for playlist_names;
1854    
1855     my $menu = new list
1856     y0 => 3,
1857     return => 0,
1858     list => \@menu,
1859     ;
1860    
1861     while () {
1862     win_clear;
1863     win_set 1, "\e[33mselect playlist";
1864    
1865     1 while $menu->handle_events;
1866    
1867     if ($INPUT eq "list/select") {
1868     my $sel = $menu->selection;
1869    
1870     if (@$sel >= 2) {
1871     external "--playlist=" . substr $sel->[1], 1;
1872     }
1873    
1874     return;
1875    
1876     } elsif ($INPUT eq "red") {
1877     my $sel = $menu->selection;
1878     delete $STATE{$sel->[1]};
1879     state_save;
1880     last;
1881     }
1882     }
1883     }
1884     };
1885    
1886     my $menu = new list
1887     y0 => 10,
1888     return => 0,
1889     list => [
1890     ["return", sub { last }],
1891     ["delete marked as Deleted or Watched", sub { $do_unlink->(sub { $_[0]{deleted} || $_[0]{watched} }); last }],
1892     ["filter uploader" , sub { win_nest { $filter_uploader->() }; last }],
1893     ["delete marked as Watched" , sub { $do_unlink->(sub { $_[0]{watched} }); last }],
1894     ["delete marked as Deleted" , sub { $do_unlink->(sub { $_[0]{deleted} }); last }],
1895     ["clear uploader filter" , sub { delete $self->{state}{filter_uploader}; $filter_update->(); last; }],
1896     ["clear regex filter" , sub { delete $self->{state}{filter_regex}; $filter_update->(); last; }],
1897     ["archive marked as Archive" , sub { $do_archive->(); last }],
1898     #["run xdfe" , sub { system "/fs/doom/root/xdfe"; last }],
1899     ["play live tv" , sub { live_tv; last; }],
1900     ["delete this playlist" , sub { playlist_delete $STATE{curdir}; last } ],
1901     ["rescan playlist" , sub { $self->{rescan} = 1; last }],
1902     ["change playlist" , sub { win_nest { $chdir->() }; last }],
1903     ["change to PLAYLIST" , sub { external "--playlist=playlist"; last }],
1904     ["change to VIDEO_DIR" , sub { external "--playlist=videos" ; last }],
1905     ];
1906    
1907     while () {
1908     win_clear;
1909     win_set 1, "\e[33mdirectory menu";
1910    
1911     1 while $menu->handle_events;
1912    
1913     win_nest { $menu->selection->[1]() } if $INPUT eq "list/select";
1914     }
1915     }
1916    
1917     sub menu_playlist {
1918     my @pl = playlist_names
1919     or return;
1920    
1921     #@pl = reverse @pl unless $INPUT =~ /^(?:prev|intrev|triangle)$/;
1922    
1923     my $cur = max 0, List::MoreUtils::firstidx { $_ eq $STATE{curdir} } @pl;
1924    
1925     win_clear;
1926     win_set 0, "\e[33mPLAYLIST SELECT";
1927    
1928     my $menu = new list
1929     y0 => 5,
1930     list => [map [$_], @pl],
1931     ;
1932    
1933     my $autoselect = 2; # initial delay longer
1934    
1935     while () {
1936     if ($INPUT =~ /^(?:next|intfwd|circle)$/) {
1937     ++$cur;
1938     } elsif ($INPUT =~ /^(?:prev|intrev|triangle)$/) {
1939     --$cur;
1940     } elsif ($INPUT eq "enter") {
1941     external "--playlist=" . substr $pl[$cur], 1;
1942     last;
1943     } elsif ($INPUT eq "return") {
1944     last;
1945     }
1946    
1947     $cur %= @pl;
1948     $menu->{cur} = $cur;
1949     $menu->changed;
1950     $menu->draw;
1951    
1952     my ($timer, $time);
1953     $time = AE::now;
1954     $timer = AE::timer 0, 1/30, sub {
1955     my $bar = int $WIN_W * min 1, (AE::now - $time) / $autoselect;
1956    
1957     win_set 2, "\e[43m" . (" " x ($WIN_W - $bar)) . "\e[m";
1958     _win_refresh;
1959     input_feed "enter" if $bar >= $WIN_W;
1960     };
1961    
1962     input_next "playlist";
1963    
1964     $autoselect = 0.66; # subsequent delay shorter
1965     }
1966     }
1967    
1968     sub view_playlist {
1969     my ($playlist) = @_;
1970    
1971     my $state = $STATE{$playlist} ||= {};
1972     my $filestate = $STATE{filestate} ||= {};
1973    
1974     my $conf = $CONF_PLAYLIST{$playlist};
1975    
1976     my $self = {
1977     playlist => $playlist,
1978     path => $state->{cwd} // $conf->{cwd},
1979     state => $state,
1980     pathpfx => "",
1981     };
1982    
1983     while () {
1984     win_clear;
1985     win_set 0, "\e[33m" . ($conf->{title} // uc $playlist);
1986     win_set 3, "preparing...";
1987     _win_refresh;
1988    
1989     # file scanning/selection
1990     my $pathpfx = "";
1991    
1992     my $mode;
1993    
1994     my $filter_status;
1995     my $list_state = $state->{list_menu} ||= {};
1996    
1997     if ($self->{state}{full_list}) {
1998     $mode = "full list";
1999    
2000     $self->{full_list} = $self->{state}{full_list};
2001    
2002     # remove missing files
2003     $self->{full_list} = [ grep -e $_->[1], @{ $self->{full_list} } ];
2004    
2005     } elsif ($conf->{glob}) {
2006     $mode = sprintf "glob %s", dec join ",", @{ $conf->{glob} };
2007    
2008     my @list;
2009    
2010     for (@{ $conf->{glob} }) {
2011     push @list,
2012     sort { "\L$a->[0]" cmp "\L$b->[0]" }
2013     map { stat_video $_ }
2014     File::Glob::bsd_glob
2015     $_ =~ /^\// ? $_ : "$self->{path}/$_",
2016     File::Glob::GLOB_MARK | File::Glob::GLOB_BRACE;
2017     }
2018    
2019     $self->{full_list} = \@list;
2020    
2021     } elsif ($conf->{scan}) {
2022     ($pathpfx, $self->{full_list}) = $conf->{scan}($self->{path}, $self);
2023     $mode = sprintf "confscan %s", dec $pathpfx;
2024    
2025     } elsif ($state->{scan}) {
2026     $mode = sprintf "$state->{scan} %s", dec $self->{path};
2027    
2028     #$pathpfx = "$self->{path}/";
2029     $self->{full_list} = eval { $state->{scan}($self->{path}, $self) };
2030    
2031     } else {
2032     $mode = "empty";
2033    
2034     $self->{full_list} = undef;
2035     }
2036    
2037     #$self->{full_list} ||= [["error", "error"]];
2038     $self->{full_list} ||= [];
2039     $self->{pathpfx} = $pathpfx;
2040    
2041     $self->{list} = $self->{full_list};
2042    
2043     if (defined $state->{filter_uploader}) {
2044     $filter_status .= " (uploader " . (enc $state->{filter_uploader}) . ")";
2045     $list_state = $state->{uploader_list_menu}{$state->{filter_uploader}} ||= {};
2046     my $re = qr/^\Q$state->{filter_uploader}\E-/;
2047     $self->{list} = [grep $_->[0] =~ $re, @{ $self->{list} }]
2048     }
2049    
2050     if (defined $state->{filter_regex}) {
2051     $filter_status .= " (regex $state->{filter_regex})";
2052     my $re = qr/$state->{filter_regex}/;
2053     $self->{list} = [grep $_->[1] =~ $re, @{ $self->{list} }]
2054     }
2055    
2056     my $DESC_H = 18;
2057    
2058     my $list = new list
2059     list => $self->{list},
2060     state => $list_state,
2061     y0 => 4,
2062     y1 => $WIN_H - $DESC_H - 1,
2063     display_cb => sub {
2064     my @flags = (" ") x 5;
2065    
2066     if (my $state = $filestate->{"$pathpfx$_[0][1]"}) {
2067     $flags[4] = "*" if $state->{started};
2068     $flags[3]= "\e[95mW\e[m" if $state->{watched};
2069     $flags[2]= "\e[31mD\e[m" if $state->{deleted};
2070     $flags[1]= "\e[94mA\e[m" if $state->{archive};
2071     $flags[0]= "\e[32mT\e[m" if $state->{tagged};
2072     }
2073    
2074     "[" . (join "", @flags) . "] $_[1]"
2075     },
2076     ;
2077    
2078     win_clear;
2079     win_set 0, "\e[33m" . ($conf->{title} // uc $playlist);
2080     win_set 1, "$playlist ($mode)";
2081     win_set 2, sprintf "%d entries overall, %d entries filtered%s",
2082     scalar @{ $self->{full_list} },
2083     scalar @{ $self->{list} },
2084     $filter_status,
2085     ;
2086    
2087     while () {
2088     if (delete $self->{rescan}) {
2089     #scan_video_dir_clear_cache;
2090     last;
2091     }
2092    
2093     return if @EXTERNAL;
2094    
2095     state $mediainfo_jobid;
2096     state $mediainfo_pid;
2097    
2098     while () {
2099     if ($DESC_H) {
2100     my $jobid = ++$mediainfo_jobid;
2101     if (my $entry = $list->selection) {
2102     my $name = $entry->[1];
2103    
2104     open my $old_stdout, ">&", \*STDOUT;
2105     pipe my ($r, $w);
2106     open STDOUT, ">&", $w;
2107     close $w;
2108    
2109     $mediainfo_pid = Proc::FastSpawn::spawn $::MEDIAINFO, ["mediainfo", "--Inform=General;%Description%", "--", "$pathpfx$name"];
2110    
2111     if ($mediainfo_pid) {
2112     win_set $WIN_H - $DESC_H + 1, "fetching media description...";
2113     _win_refresh;
2114    
2115     my $iow; $iow = EV::io $r, EV::READ, sub {
2116     $iow->stop;
2117    
2118     return if $mediainfo_jobid != $jobid;
2119    
2120     read $r, my $description, 8192;
2121     undef $mediainfo_pid;
2122     close $r;
2123    
2124     utf8::decode $description;
2125     $description = "<no description>" unless $description =~ /\S/;
2126    
2127     $description =~ s/ \/ /\n/g; # youtube-dl uses " / " or so to separate lines
2128    
2129     if (stat "$pathpfx$name") {
2130     $description = sprintf "%s %s\n%s",
2131     (POSIX::strftime "%Y-%m-%d %H:%M:%S", localtime +(stat _)[9]),
2132     (Format::Human::Bytes::base10 +(stat _)[7]),
2133     $description;
2134     }
2135    
2136     local $Text::Wrap::columns = $WIN_W;
2137     my @description = grep /\S/, split /\n/, Text::Wrap::wrap "", "", $description;
2138    
2139     for (0 .. $DESC_H - 1) {
2140     win_set $WIN_H - $DESC_H + 1 + $_, $description[$_];
2141     }
2142     _win_refresh;
2143     };
2144     }
2145    
2146     open STDOUT, ">&", $old_stdout;
2147     }
2148     };
2149    
2150     my $handled = $list->handle_events;
2151    
2152     if ($DESC_H) {
2153     ++$mediainfo_jobid;
2154     kill 9, $mediainfo_pid if $mediainfo_pid;
2155     for ($WIN_H - $DESC_H .. $WIN_H - 1) {
2156     win_set $_, "";
2157     }
2158     win_refresh;
2159     }
2160    
2161     last unless $handled;
2162     }
2163    
2164     input_context "view";
2165    
2166     my $entry = $list->selection;
2167     my $name = $entry->[1];
2168     my $filestate = $filestate->{"$pathpfx$name"} ||= {};
2169    
2170     if ($INPUT eq "list/select" or $INPUT eq "play" or $INPUT eq "pause") {
2171     $filestate->{started} = int AE::now;
2172     my $uploader = "$pathpfx$name" =~ /00_distant_worlds/ && $name =~ /^([^-]+)-/ ? $1 : undef;
2173    
2174     my @uploader_props = qw(mpv_sid speed);
2175    
2176     if ($uploader) {
2177     for (@uploader_props) {
2178     $filestate->{$_} //= $STATE{"uploader_$_"}{$uploader};
2179     }
2180     }
2181    
2182     ::state_save;
2183     win_nest {
2184     play_video $filestate, "$pathpfx/$name", $INPUT ne "play";
2185     };
2186    
2187     if ($uploader) {
2188     for (@uploader_props) {
2189     if ($filestate->{$_} != $STATE{"uploader_$_"}{$uploader}) {
2190     $STATE{"uploader_$_"}{$uploader} = $filestate->{$_};
2191     ::state_save;
2192     }
2193     }
2194     }
2195    
2196     ++$list->{cur} if $filestate->{watched};
2197     $list->changed;
2198    
2199     } else {
2200     if ($INPUT eq "esc") {
2201     EV::unloop;
2202    
2203     } elsif ($INPUT eq "return") {
2204     prepare_exit;
2205     exec $0, "--restart";
2206    
2207     } elsif ($INPUT =~ /^(?:next|prev|intfwd|intrev|triangle|circle)$/) {
2208     win_nest {
2209     menu_playlist;
2210     };
2211    
2212     } elsif ($INPUT eq "red") {
2213     $filestate->{deleted} ? delete $filestate->{deleted} : ($filestate->{deleted} = 1);
2214     ::state_save;
2215     ++$list->{cur}; $list->changed;
2216    
2217     } elsif ($INPUT eq "green") {
2218     $filestate->{watched} ? delete $filestate->{watched} : ($filestate->{watched} = 1);
2219     ::state_save;
2220     ++$list->{cur}; $list->changed;
2221    
2222     } elsif ($INPUT eq "yellow") {
2223     $filestate->{started} ? delete $filestate->{started} : ($filestate->{started} = 1);
2224     ::state_save;
2225     ++$list->{cur}; $list->changed;
2226    
2227     } elsif ($INPUT eq "blue") {
2228     $filestate->{archive} ? delete $filestate->{archive} : ($filestate->{archive} = 1);
2229     ::state_save;
2230     ++$list->{cur}; $list->changed;
2231    
2232     } elsif ($INPUT eq "popup") {
2233     win_nest {
2234     dir_menu $self;
2235     };
2236    
2237     } elsif ($INPUT eq "right") {
2238     win_nest {
2239     file_menu $self, "$pathpfx$name";
2240     };
2241     }
2242     }
2243     }
2244     }
2245     }
2246    
2247     sub main {
2248     while () {
2249     if (my $args = shift @EXTERNAL) {
2250     state_save; # proactively request a state save since we are almost certain to change something
2251    
2252     my $state = $STATE{ $STATE{curdir} // "/videos" } ||= {};
2253    
2254     if ($args->[0] =~ /^--regex=(.*)/) {
2255     $state->{filter_regex} = dec $1;
2256     next;
2257     } elsif ($args->[0] =~ /^--uploader=(.*)/) {
2258     $STATE{"/videos"}{filter_uploader} = dec $1;
2259     next;
2260     } elsif ($args->[0] =~ /^--playlist=\/*(.*)/) {
2261     $STATE{curdir} = dec "/$1";
2262     next;
2263     } elsif ($args->[0] =~ /^--rescan$/) {
2264     next;
2265     }
2266    
2267     my $playlist = @$args > 1 ? "/playlist" : "/playlist1";
2268    
2269     if ($args->[0] =~ /--list=\/*(.*)/) {
2270     shift @$args;
2271     $playlist = dec "/$1";
2272     }
2273    
2274     if ($args->[0] =~ /^--/) {
2275     next; # error case
2276     }
2277    
2278     # playlist / directory
2279    
2280     $STATE{curdir} = $playlist;
2281    
2282     my $pl = $STATE{$playlist} ||= {};
2283    
2284     delete $pl->{full_list};
2285     delete $pl->{cwd};
2286    
2287     if ($args->[0] eq "-r") {
2288     $pl->{cwd} = canonpath $args->[1];
2289     $pl->{scan} = "state_scan_recursive";
2290    
2291     } elsif (@$args == 1 && -d $args->[0]) {
2292     # single directory given, play directory
2293     $pl->{cwd} = canonpath $args->[0];
2294    
2295     } else {
2296     # playlist, must be all files => create playlist with files
2297    
2298 root 1.2 $pl->{full_list} = [map { ref ? $_ : stat_video canonpath $_ } @$args];
2299 root 1.1
2300     ::input_feed "enter" if @$args == 1; #d# hack: auto-play when single video
2301     }
2302     }
2303    
2304     wakeup;
2305     view_playlist $STATE{curdir} // "/videos";
2306     }
2307     }
2308    
2309     $WIN_READY->recv;
2310    
2311     our $MAIN_CORO;
2312    
2313     sub state_expire {
2314     my $filestate = $STATE{filestate};
2315    
2316     if ($DOOM) { # only do it on doom
2317     # filter out old/empty state
2318    
2319     while (my ($k, $v) = each %$filestate) {
2320     unless (%$v and -e $k) {
2321     delete $filestate->{$k};
2322     }
2323     }
2324     }
2325    
2326     if (0) {
2327     for my $k (keys %$filestate) {
2328     my $k2 = $k =~ s%//+%/%gr;
2329     $k2 =~ s%^/fs/fuji/fs/doom/%/fs/doom/%;
2330     $k2 =~ s%^/fs/doom/fs/doom/%/fs/doom/%; # / <- vio fix
2331     if ($k2 ne $k) {
2332     $filestate->{$k2} = delete $filestate->{$k};
2333     }
2334     }
2335     }
2336     }
2337    
2338     sub main_start {
2339     $MAIN_CORO ||= async {
2340     mpv_init;
2341     $mpv->cmd ("script-message", "osc-visibility", "never", "dummy");
2342    
2343     if ($ARGV[0] eq "--state-reload") {
2344     win_progress "\e[31mstate was externally modified, press enter to reload and proceed";
2345    
2346     while () {
2347     input_next "reload";
2348     last if $INPUT eq "enter" or $INPUT eq "return";
2349     }
2350    
2351     win_clear;
2352     }
2353    
2354     state_init;
2355     #use Data::Dump; ddx \%STATE;#d#
2356    
2357     conf_check;
2358     state_expire;
2359    
2360     main;
2361     EV::unloop;
2362     };
2363     }
2364    
2365     sub state_file_check {
2366     if ($STATE_MTIME != (stat $STATE_FILE)[9]) {
2367     return if $TESTING;
2368    
2369     $MAIN_CORO->safe_cancel;
2370     unlink $STATE_SHM;
2371     $mpv->stop;
2372     exec $0, "--state-reload";
2373     die "state changed, aborting to reload hack\n";
2374     async {
2375     win_clear;
2376     };
2377     }
2378     }
2379    
2380     main_start;
2381     EV::loop;
2382     prepare_exit;
2383