#!/opt/bin/perl # todo hi cpu tie on fuji due to mpv runtime config # mpv over ass-events # {\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} # {\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} # {\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 # {\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} BEGIN { if ($ARGV[0] eq "-=reloaded=-") { shift; } elsif (-e "/root/mlockall.so") { $ENV{LD_PRELOAD} = "/root/mlockall.so:/root/libmimalloc.so.1.7"; $ENV{MIMALLOC_LARGE_OS_PAGES} = 1; system "echo always >/sys/kernel/mm/transparent_hugepage/defrag"; system "echo 3 > /proc/sys/vm/drop_caches"; system "echo 1 > /proc/sys/vm/compact_memory"; exec "taskset", "-c", "12-15", "nice", "-n-20", "ionice", "-c1", $0, "-=reloaded=-", @ARGV; exit 255; } } use common::sense; use EV; use Fcntl (); use Socket (); use POSIX (); use Cwd (); use File::Glob (); use Coro; use File::Basename; use AE (); use CBOR::XS (); use Compress::Zstd (); use AnyEvent::AIO (); use Coro::AIO; use Coro::AnyEvent; use JSON::XS (); use AnyEvent::Handle (); use AnyEvent::Socket (); use Proc::FastSpawn (); use PApp::SQL (); use List::MoreUtils (); use List::Util qw(min max); use Text::Wrap (); use Format::Human::Bytes (); use AnyEvent::MPV (); IO::AIO::min_parallel 16; sub MAX_ISLANDS () { 5 } sub enc($) { my $s = shift; utf8::encode $s; $s } sub dec($) { my $s = shift; utf8::decode $s; $s } our $NODENAME = (POSIX::uname)[1]; our $DOOM = $NODENAME eq "doom"; our $TESTING = $ARGV[0] eq "--testing"; #our $DPMS_DISABLE = $DOOM; our ($SW, $SH) = (3840, 2160); our $FONTSIZE = $NODENAME eq "doom" ? 32 : 18; our $FONT = "xft:inputmonocondensed:minspace:medium:hintstyle=hintfull:matrix=1 0 0 0.95:size=$FONTSIZE"; # MUST be canonical, same as dfe our $STATE_FILE = "/fs/doom/db/doomfrontend.state"; our $STATE_SHM = "/dev/shm/doomfrontend.state"; our @LIRC = ("unix/", "/run/lirc/lircd"); our $CONF_FILE = "/fs/doom/root/dfe.conf"; our $VIDEO_DIR = "/fs/doom/root/00_distant_worlds"; our $ARCHIVE_DIR = "/fs/doom/root/00_distant_worlds/00_archive"; # was /fs/doom/var/lib/mythvideo/02_ytd/00_distant_worlds/00_archive our $MYTHTV_DIR = "/fs/doom/var/lib/mythtv"; our $MEDIAINFO = "/usr/bin/mediainfo"; our $MPV = "mpv"; our @MPV_ARGS = qw( --audio-client-name=doomfrontend --osd-on-seek=msg-bar --osd-bar-align-y=-0.85 --osd-bar-w=95 --screenshot-directory=/fs/doom/root --screenshot-template=screenshot-%F-%P --sub-auto=exact --audio-file-auto=exact ); our %SPONSOR_SKIP = ( "Sponsor" => 1, "Intermission/Intro Animation" => 1, "Interaction Reminder" => 1, "Endcards/Credits" => 1, "Unpaid/Self Promotion" => 1, "Highlight" => 0, "Preview/Recap" => 0, "Non-Music Section" => 0, "Filler Tangent" => 0, "UNKNOWN" => 0, ); our $KODIPATH = "/fs/doom/var/www/html/doomfrontend"; our $KODIURL = "http://10.0.0.5/doomfrontend/"; our $XRANDR_OUTPUT = "HDMI-0"; our $XRANDR_MODE = "3840x2160"; our $XRANDR_FPS = 60; #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 our @XRANDR_RATES = ([60, 60], [59.94, 59.94], [50, 50]); our @EXTERNAL; # current external events, if any our %STATE; our $SS_LENGTH = 300; ############################################################################# # prevent xscreensaver from doing something stupid, such as starting dbus $ENV{DBUS_SESSION_BUS_ADDRESS} = "/"; # prevent dbus autostart for sure $ENV{XDG_CURRENT_DESKTOP} = "generic"; if ($DOOM) { unless (exists $ENV{XDG_RUNTIME_DIR}) { $ENV{XDG_RUNTIME_DIR} = "/run/user/0"; mkdir $ENV{XDG_RUNTIME_DIR}, 0700; } } ############################################################################# our $STATE_MTIME_TIMER; our $STATE_MTIME; our $STATE_FILE_TIMER; our $STATE_SHM_TIMER; our $STATE_DIRTY; our $STATE_SAVER; sub state_file_check; sub state_init { my $state_load = sub { open my $fh, "<", $_[0] or die "$_[0]: $@\n"; sysread $fh, my $buf, -s $fh; *STATE = CBOR::XS::decode_cbor Compress::Zstd::decompress $buf; }; eval { $state_load->($STATE_SHM); 1 } or eval { $state_load->($STATE_FILE); 1} or %STATE = (); $STATE_MTIME = (stat $STATE_FILE)[9]; $STATE_MTIME_TIMER = AE::timer 15, 15, sub { async { state_file_check; }; }; } sub _state_save_shm { undef $STATE_SHM_TIMER; return; #d# must check which file is newer return unless $DOOM; if (open my $fh, ">", $STATE_SHM) { syswrite $fh, $_[0]; } } sub _state_save { return if $TESTING; while ($STATE_DIRTY) { undef $STATE_SHM_TIMER; my $fh = aio_open "$STATE_FILE~", IO::AIO::O_CREAT | IO::AIO::O_WRONLY, 0600 or last; undef $STATE_DIRTY; last unless %STATE; # state not loaded - do not save $STATE{last_save} = time; my $data = Compress::Zstd::compress +(CBOR::XS::encode_cbor \%STATE), 3; _state_save_shm $data; aio_write $fh, undef, undef, $data, 0; aio_fsync $fh; my $new_mtime = (stat $fh)[9]; aio_close $fh; state_file_check; aio_rename "$STATE_FILE~", $STATE_FILE; $STATE_MTIME = $new_mtime; } } sub _state_saver { $STATE_SAVER ||= async { _state_save; undef $STATE_SAVER; undef $STATE_FILE_TIMER; }; } sub state_save { $STATE_DIRTY = 1; $STATE_FILE_TIMER ||= AE::timer 15, 0, sub { _state_saver; }; $STATE_SHM_TIMER ||= AE::timer 0.5, 0, sub { _state_save_shm CBOR::XS::encode_cbor \%STATE; }; } sub state_cleanup { _state_saver; $STATE_SAVER->join; } our $SIGINT = AE::signal INT => sub { EV::unloop }; our $SIGTERM = AE::signal TERM => sub { EV::unloop }; ############################################################################# # screensaver reset management system "xset", "s", $SS_LENGTH if $DOOM; our $WAKEUP_TIMER; our $WAKEUP_WANT; sub wakeup { if ($WAKEUP_TIMER) { $WAKEUP_WANT = 1; } else { $WAKEUP_WANT = 0; Proc::FastSpawn::spawn "/usr/bin/xset", ["xset", "s", "reset"]; $WAKEUP_TIMER = AE::timer $SS_LENGTH - 5, 0, sub { undef $WAKEUP_TIMER; wakeup () if $WAKEUP_WANT; }; } } ############################################################################# # input queue my $input_queue = new Coro::Channel; our ($INPUT, $INPUTS, $INPUT_DATA); sub input_context($) { $INPUT = undef; for (split /,/, $INPUTS) { if (/(.*):(.*)/) { $INPUT = $2 if $1 eq $_[0]; } else { $INPUT = $_; } } #warn "interpret<$INPUTS> as $_[0] gives <$INPUT>\n"; } sub input_set($$) { $INPUT = undef; $INPUTS = $_[0]; $INPUT_DATA = $_[1]; input_context undef; } sub input_next(;$) { _win_refresh (); &input_set (@{ $input_queue->get }); input_context $_[0] if @_; } sub input_feed($;$) { #use Data::Dump; ddx [input_feed => @_];#d# $input_queue->put ([@_]) if defined $_[0]; } my %input_feed_key_map = ( "\e" => "esc", "\e[A" => "up", "\e[B" => "down", "\e[C" => "right", "\e[D" => "left", "\e[5~" => "pgup", "\e[6~" => "pgdown", "\r" => "enter", "<" => "prev", ">" => "next", "d" => "red", "i" => "green", "r" => "return", "m" => "popup", (map { ($_, $_) } 0..9), "." => "clear", "]" => "stepfwd", "[" => "steprev", "p" => "play", " " => "pause", ); sub input_feed_key($) { input_feed $input_feed_key_map{$_[0]}; } sub external(@) { push @EXTERNAL, [@_]; input_feed "external"; # sucks } ############################################################################# # lirc async { while () { my $hdl = new AnyEvent::Handle connect => \@LIRC, on_error => Coro::rouse_cb, on_read => sub { $_[0]->push_read (line => sub { $_[1] =~ /\S+ \S+ (\S+) \S+/ or return; ::input_feed $1; wakeup; }); }, ; my (undef, $fatal, $msg) = Coro::rouse_wait; $hdl->destroy; #warn $msg; } continue { Coro::AnyEvent::sleep 10; } }; ############################################################################# # mythmote our %MYTHREMOTE = ( "play speed pause" => "pause", "play speed normal" => "pause", "play stop" => "stop", "key i" => "green", "key up" => "up", "key down" => "down", "key left" => "left", "key right" => "right", "key enter" => "enter", "key escape" => "return", "key m" => "popup", "key r" => "red", "key home" => "down", "play seek backward" => "steprev", "play seek forward" => "stepfwd", "key end" => "up", "key f2" => "red", "key f3" => "green", "key f4" => "yellow", "key f5" => "blue", #"key s" => up right "play channel up" => "next", "play channel down" => "prev", "key h" => "play", # circle clock "key ]" => "vol+", "key |" => "mute", "key [" => "vol-", "key backspace" => "red", (map { ("key $_" => "num$_") } 0..9), ); our $mythremote = AnyEvent::Socket::tcp_server undef, 6546, sub { my ($fh) = @_; my $hdl; $hdl = new AnyEvent::Handle fh => $fh, on_error => sub { #warn "mythremote error: $_[2]\n"; undef $hdl; }, on_read => sub { $_[0]->push_read (line => sub { if (my $input = $MYTHREMOTE{$_[1]}) { if ($input eq "vol+") { Proc::FastSpawn::spawnp "/usr/bin/amixer", ["amixer", "sset", "Master", "1+"]; } elsif ($input eq "vol-") { Proc::FastSpawn::spawnp "/usr/bin/amixer", ["amixer", "sset", "Master", "1-"]; } elsif ($input eq "mute") { Proc::FastSpawn::spawnp "/usr/bin/amixer", ["amixer", "sset", "Master", "toggle"]; } ::input_feed $input; } elsif ($_[1] =~ /external/) { if (open my $fh, "<", "/root/doomfrontend.external") { unlink "/root/doomfrontend.external"; sysread $fh, my $buf, -s $fh; external @{ JSON::XS::decode_json $buf }; } } else { warn "unknown mythremote command: <$_[1]>\n"; } ::wakeup; }); }, ; }; ############################################################################# my $mpv = AnyEvent::MPV->new ( mpv => $MPV, args => \@MPV_ARGS, trace => 1, on_event => sub { input_feed "mpv/$_[1]", $_[2]; }, on_key => sub { input_feed $_[1]; }, on_eof => sub { input_feed "mpv/quit"; }, ); ############################################################################# # rxvt qx =~ / connected primary (\d+)x(\d+)\+/a or qx =~ / connected (\d+)x(\d+)\+/a or "3840x2160" =~ /^(\d+)x(\d+)\z/a; # rather than crash ($SW, $SH) = ($1, $2); our $WIN_BORDER = 0; # > 0 not works our ($WIN_FW, $WIN_FH) = (60, 60); our ($WIN, $WIN_SHOW, $WIN_W, $WIN_H, $WIN_TEXT); our $WIN_TOW; our $WIN_RW; { if (0) { my $prop = qx; $WIN_FW = $prop =~ /^AVERAGE_WIDTH = (\d+)0$/am ? $1 : die; $WIN_FH = $prop =~ /^PIXEL_SIZE = (\d+)$/am ? $1 : die; } } our @DISPLAY; our @DISPLAYED; our $WIN_DISPLAY_PREFIX; our $WIN_READY = AE::cv; sub __win_reset { undef $WIN; undef $WIN_RW; @DISPLAYED = (); undef $WIN_DISPLAY_PREFIX; } sub _win_refresh { undef $WIN_TOW; my $msg; unless ($WIN) { socketpair $WIN, my $slave, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC; fcntl $slave, Fcntl::F_SETFD, 0; system "exec rxvt -bg black -fg gray -perl-ext '' -perl-ext-common '' -sl 0 +sb" . " -fn \Q$FONT\E -b $WIN_BORDER -name doomfrontend" . " --pointerBlank --pointerBlankDelay 1" . " -geometry 1x1-0-0 -bl -pty-fd " . (fileno $slave) . " &"; close $slave; binmode $WIN, ":utf8"; $WIN->autoflush; $WIN_RW = AE::io $WIN, 0, sub { sysread $WIN, my $buf, 64 or exit 1; # hacky parsing, but we expect only one reply if ($buf =~ /^\x1b]776;([^\007]+)\007/) { my @info = split /;/, $1; $WIN_FW = $info[0]; $WIN_FH = $info[1]; $WIN_W = int $SW / $WIN_FW; $WIN_H = int $SH / $WIN_FH; my ($x, $y) = $WIN_SHOW ? (($SW - $WIN_FW * $WIN_W) * 0.5, $WIN_BORDER * 2) # top : ($SW + $WIN_BORDER, $SH - $WIN_BORDER); # do resize first, to avoid resize followed by Xserver moving, and another resize my $init = sprintf "\e[8;%d;%dt", $WIN_H, $WIN_W; #$init .= sprintf "\e[3;%d;%dt", $x - $WIN_BORDER, $y - $WIN_BORDER * 2; $init .= sprintf "\e[3;%d;%dt", 0, 0; syswrite $WIN, $init; select undef, undef, undef, 0.1; @DISPLAYED = (); goto &_win_refresh; } input_feed_key $buf; }; undef $WIN_FH; $msg = "\e]776;?\007" # cellinfo request . "\e[?25l" # hide cursor . "\e[?7l" # no wraparound . "\e[H"; # clreos } $msg .= $WIN_DISPLAY_PREFIX; undef $WIN_DISPLAY_PREFIX; for my $y (0 .. $WIN_H - 1) { if ($DISPLAY[$y] ne $DISPLAYED[$y]) { $msg .= "\e[" . ($y + 1) . "H$DISPLAY[$y]\e[3K\e[m"; $DISPLAYED[$y] = $DISPLAY[$y]; } } # my $txt = substr $WIN_TEXT, 0, $WIN_W; # $msg .= " " x ($WIN_W - 1 - length $txt); # $msg .= $txt; # $msg .= "\e[J"; # clreos $msg .= $WIN_TEXT; #utf8::encode $msg; print $WIN $msg; if (0) {#d# for (my $ofs = 0; $ofs < length $msg; ) { my $len = syswrite $WIN, $msg, (length $msg) - $ofs, $ofs; if ($len > 0) { $ofs += $len; } else { __win_reset; sleep 1; goto &__win; } } } $WIN_READY->() if $WIN_H; } sub win_refresh { $WIN_TOW ||= AE::timer 1/60, 0, \&_win_refresh; } sub win_show { return if $WIN_SHOW; $WIN_SHOW = 1; win_refresh; } sub win_hide { return unless $WIN_SHOW; $WIN_SHOW = 0; win_refresh; } sub win_scroll($$;$) { my ($y0, $y1, $up) = @_; $WIN_DISPLAY_PREFIX = sprintf "\e[%d;%dr\e[%dH", $y0 + 1, $y1 + 1, $y0 + 1; $WIN_DISPLAY_PREFIX .= $up ? "\e[M" : "\e[L"; $WIN_DISPLAY_PREFIX .= "\e[r"; for (\@DISPLAY, \@DISPLAYED) { if ($up) { splice @$_, $y1, 0, ""; splice @$_, $y0, 1; } else { splice @$_, $y1, 1; splice @$_, $y0, 0, ""; } } } # expects unicode sub win_set($$) { $DISPLAY[$_[0]] = $_[1]; } sub win_clear { @DISPLAY = (); # immediatelly clear, if possible if ($WIN) { syswrite $WIN, "\e[H\e[2J"; @DISPLAYED = (); } win_show; } sub win_nest(&) { my @old_display = @DISPLAY; win_clear; win_refresh; $_[0](); @DISPLAY = @old_display; win_refresh; } __win_reset; _win_refresh; win_show; sub win_progress($) { win_clear; win_set 10, " $_[0]"; _win_refresh; } sub win_progress_init { my (@lines) = @_; my $msg; for my $y (0 .. $#lines) { $msg .= "\e[" . ($y + 1) . "H$lines[$y]\e[3K\e[m"; } $msg .= "\e[J"; print $WIN $msg; } sub win_progress_update { my ($y, $text) = @_; print $WIN "\e[" . ($y + 1) . "H$text\e[3K"; } sub win_progress_done { win_refresh; } ############################################################################# package list { sub new { my $class = shift; my $self = bless { list => [], # format: [display-string, id, extra-unused] state => {}, y0 => 0, y1 => $WIN_H - 1, ref => -2, return => undef, left => undef, display_cb => sub { }, @_, cur => 0, }, $class; $self->{cur} = $self->{state}{curidx}*1; if (defined (my $curname = $self->{state}{curname})) { my $list = $self->{list}; for (0 .. $#$list) { if ($list->[$_][1] eq $curname) { $self->{cur} = $_; last; } } } $self->reify; $self } sub set { $_[0]{list} = $_[1]; } sub reify { my ($self) = @_; my $list = $self->{list}; my $cur = $self->{cur}; $cur = List::Util::max $cur, 0; $cur = List::Util::min $cur, $#$list; $self->{cur} = $cur; } sub draw { my ($self) = @_; $self->reify; my $list = $self->{list}; my $cur = $self->{cur}; my $lines = $self->{y1} - $self->{y0} + 1; my $beg = List::Util::max 0, List::Util::min $cur - int $lines / 2, @$list - $lines; # scroll optimization if ($self->{ref} + 1 == $beg) { ::win_scroll $self->{y0}, $self->{y1}, 1; } elsif ($self->{ref} - 1 == $beg) { ::win_scroll $self->{y0}, $self->{y1}, 0; } { my $cb = $self->{display_cb}; my ($entry, $line); # speed my $y0 = $self->{y0}; my $yb = List::Util::min @$list - $beg, $lines; for (0 .. $yb - 1) { $entry = $list->[$beg + $_]; $line = $entry->[0]; $line = "\e[30;43m$line" if $_ == $cur - $beg; # hilight selection $line = $cb->($entry, $line) // $line; $DISPLAY[$_ + $y0] = $line; } if (0) { # random pattern for my $line (@DISPLAY[$y0 + $yb .. $y0 + $lines - 1]) { $line = " " x $WIN_W; substr $line, (rand $WIN_W - 1), 1, "." for 1 .. rand $WIN_W / $WIN_H; $line =~ s/ +$//; } } $DISPLAY[$y0] = sprintf "%d more", $beg + 1 if $cur > $beg && $beg; if ($cur < $beg + $lines && @$list - $beg - $lines > 0) { $DISPLAY[$y0 + $yb - 1] = sprintf "%d more", @$list - $beg - $lines + 1; } } $self->{cur} = $cur; $self->{ref} = $beg; } sub changed { my ($self) = @_; $self->reify; $self->{state}{curidx} = $self->{cur}; $self->{state}{curname} = $self->{list}[$self->{cur}][1]; ::state_save; } sub handle_event { my ($self) = @_; return unless @{ $self->{list} }; if ($::INPUT eq "up") { $self->{cur} = ($self->{cur} - 1) % @{ $self->{list} }; $self->changed; } elsif ($::INPUT eq "down") { $self->{cur} = ($self->{cur} + 1) % @{ $self->{list} }; $self->changed; } elsif ($::INPUT eq "pgup" or $::INPUT eq "num2") { $self->{cur} -= ($self->{y1} - $self-> {y0} + 1) >> 1; $self->changed; } elsif ($::INPUT eq "pgdown" or $::INPUT eq "num8") { $self->{cur} += ($self->{y1} - $self-> {y0} + 1) >> 1; $self->changed; } elsif ($::INPUT eq "num1") { $self->{cur} = 0; $self->changed; } elsif ($::INPUT eq "num9") { $self->{cur} = $#{ $self->{list} }; $self->changed; } else { return; } 1 # event consumed } # handle events until selection was made (return it) # or an unknown input was received (return nothing) sub handle_events { my ($self) = @_; while () { $self->draw; ::input_next "list"; $self->handle_event and return 1; my $nonempty = @{ $self->{list} }; if ($::INPUT eq "enter") { ::input_set "list/select", $self->{cur}; return if $nonempty; } elsif (($::INPUT eq "return" || $::INPUT eq "esc") && defined $self->{return}) { $self->{cur} = $self->{return}; ::input_set "list/select", $self->{cur}; return if $nonempty; } elsif ($::INPUT eq "left" && defined $self->{left}) { $self->{cur} = $self->{left}; ::input_set "list/select", $self->{cur}; return if $nonempty; } else { return; } } } sub selection { $_[0]{list}[$_[0]{cur}] } } ############################################################################# sub prepare_exit() { state_cleanup; $mpv->stop; } ############################################################################# sub menu_choice($%) { my (%arg) = @_; my $list = new list cur => 0, y0 => 5, %arg, ; while () { $list->handle_events and next; if ($INPUT eq "list/select") { return $list->selection; } #TODO: return more? } } ############################################################################# sub _canonpath { my $path = $_[0]; my $file; unless (-d $path) { $path =~ s/((?:^|\/)[^\/]+\z)//; $file = $1; } $path = Cwd::realpath $path; $path = "/fs/$NODENAME$path" unless $path =~ /^\/fs\//; "$path$file" } our $VIDEO_DIR_CANON = _canonpath $VIDEO_DIR; sub canonpath { my $path = _canonpath $_[0]; $path =~ s/^\Q$VIDEO_DIR_CANON\E(\z|\/)/$VIDEO_DIR$1/; $path } # check path for mythtv sub is_myth($) { my $a = canonpath $_[0]; my $b = canonpath $MYTHTV_DIR; $a =~ /^\Q$b\E/ } our $CONF_MTIME; our $CONF; our %CONF_PLAYLIST; our @CONF_PLAYLIST_ORDER; sub conf_postload { %CONF_PLAYLIST = (); @CONF_PLAYLIST_ORDER = (); my @pl = @{ $CONF->{playlists} }; while (@pl) { my ($k, $v) = splice @pl, 0, 2; $k = "/$k"; push @CONF_PLAYLIST_ORDER, $k unless $v->{hide}; $v->{cwd} = $v->{cwd} ? canonpath $v->{cwd} : $VIDEO_DIR; my $state = $STATE{$k} //= {}; $CONF_PLAYLIST{$k} = $v; $state->{from_conf} = 1; } } sub conf_check { if ((stat $CONF_FILE)[9] != $CONF_MTIME) { warn "reloading $CONF_FILE...\n"; $CONF_MTIME = (stat _)[9]; $CONF = do $CONF_FILE; warn $@ if $@; conf_postload; } } ############################################################################# sub playlist_names { ( @CONF_PLAYLIST_ORDER, grep /^\// && !exists $CONF_PLAYLIST{$_}, sort keys %STATE ) } sub stat_video($;$) { my ($path, $prefix) = @_; my $display = $path =~ s%^.*/%%r; $display =~ /^\./ and return; $display =~ /\..{2,5}$/ or return; #next unless $name =~ /\.(mp4|mkv|webm|flv|ogg|mp3|m4a|mov|mpg|avi|ogv)$/i; utf8::downgrade $path; stat "$prefix$path" or return; -f _ or return; utf8::decode $display; for ($display) { #s%\.[A-Za-z0-9]{3,4}$%%; # .mp4 #s%-[A-Za-z0-9\-_]{11}$%%; # youtube-id s%-[A-Za-z0-9\-_]{11}.(mkv|webm|mp4|mov)$%.$1%; # youtube-id sub dfe::mangle_name (); dfe::mangle_name; # "improve" some filenames/episode numbers, mostly for sorting s{(?:\bpart|\bep\.?|episode|Ch\.|Chapter|\bE)\s*#?(\d+)\b}{sprintf "Ep.%03d", $1}geia; #s{(-\s*)(\d{1,4})(\s*-)}{sprintf "%s#%03d%s", $1, $2, $3}geia; s{\s+#(\d+)}{sprintf " #%03d", $1}geia; s{\[#?(\d+)\]}{sprintf "#%03d", $1}geia; s{\bs(\d+)e(\d+)\b}{sprintf "S%02dE%02d", $1, $2}geia; s{-20(\d\d)(\d\d)(\d\d)\.([^.]+)\z}{-20$1.$2.$3.$4}a; s/\s+/ /g; } $display = sprintf "%s [%dMB]", $display, (-s _) * 1e-6; [$display, $path] } sub video_sort { # schwartzian version sort on filename map $_->[0], sort { $a->[1] cmp $b->[1] } map [$_, lc $_->[0] =~ s/([0-9]+)/sprintf "%19d", $1/ger], @_ } my $video_dir_cache; sub scan_video_dir($) { my ($path) = @_; my $cache = $video_dir_cache->{$path}; opendir my $dir, $path or return []; #die "$path: $!\n"; my $mtime = (stat $dir)[9]; if ($mtime != $cache->[0]) { # hack to preload cache a bit $cache = $cache->[1]; my @files = grep !/(?:\.(?:json|srt|vtt|part|ytdl|chapters|f\d\d\d\.[^.]+)$)/a, readdir $dir; win_progress_init "scan_video_dir", $path; # pre-cache files for my $file (@files) { IO::AIO::aio_stat "$path/$file" unless exists $cache->{$file}; } my %new_cache; my $progress = 0; for my $file (@files) { $new_cache{$file} = (delete $cache->{$file}) || (stat_video "$path/$file") || next; win_progress_update 2, "$progress/" . @files unless ++$progress & 15; } $cache = $video_dir_cache->{$path} = [$mtime, \%new_cache]; win_progress_done; } [ video_sort values %{$cache->[1]} ] } sub scan_video_dir_clear_cache() { $video_dir_cache = undef; } sub scan_00_distant_worlds { ( "", [ video_sort #d# @{ scan_video_dir $VIDEO_DIR }, @{ scan_video_dir "/fs/doom/root/ytnew" }, @{ scan_video_dir "/seagate2tb/sinatar" }, ] ) } sub scan_islands($) { my ($path) = @_; my $list = scan_video_dir $path; my %byuploader; for (@$list) { push @{ $byuploader{$1} }, $_ if $_->[1] =~ /^([^-]+)-/; } ( "", [ sort { "\L$a->[0]" cmp "\L$b->[0]" } map @$_, grep @$_ <= MAX_ISLANDS, values %byuploader ] ) } sub state_scan_recursive($) { my ($path) = @_; my @list; my $scan = sub { my ($path, $display) = @_; my @dirs; $path = canonpath $path; opendir my $fh, $path or return; for (sort readdir $fh) { next if /^\.\.?$/; stat "$path/$_" or next; if (-d _) { my $dis = dec $_; $dis = length $dis > 25 ? (substr $dis, 0, 24) . "…" : $dis; push @dirs, ["$path/$_", "$display/$dis"]; } elsif (-f _) { my $dis = dec $_; push @list, [(substr "$display/$dis", 1), "$path/$_"]; } } __SUB__->(@$_) for @dirs; }; $scan->($path, ""); utf8::decode $_->[0] for @list; \@list } sub mythtv_dbh() { DBI->connect ("DBI:mysql:database=mythconverg;mysql_read_default_file=/root/.my.cnf;host=doom;user=root") or die "unable to connect to mythtv database" } sub scan_mythtv($) { my $dbh = mythtv_dbh; my $rv = $dbh->selectall_arrayref ( "select basename, convert_tz(starttime, 'UTC', 'Europe/Berlin'), title, subtitle from recorded where recgroup not in ('Deleted', 'LiveTV') order by starttime asc "); for (@$rv) { utf8::decode $_->[2]; utf8::decode $_->[3]; } ( "$MYTHTV_DIR/", [ map ["$_->[1] " . (dec $_->[2]) . " (" . (dec $_->[3]) . ")", $_->[0]], @$rv ] ) } # delete /playlist, maybe switch away if current playlist sub playlist_delete { my ($playlist) = @_; delete $STATE{$playlist}; if ($STATE{curdir} eq $playlist) { $STATE{curdir} = "/playlist"; ::state_save; external "--playlist=playlist"; } } our ($PLAYING_STATE, $PLAYING_PATH); sub play_video_speed_mult { sprintf "%.2f", 1.032 ** $PLAYING_STATE->{speed} } sub play_video_set_speed { my $speed = play_video_speed_mult; delete $PLAYING_STATE->{speed} unless $PLAYING_STATE->{speed}; $mpv->cmd ("set", "speed", "$speed"); $mpv->cmd ("show-text", "playback speed $speed"); } our $OSD_LEVEL = $DOOM ? 3 : 3; # was 1 on doom sub sprintf_time($$) { sprintf $_[0], sprintf "%02d:%02d:%02d.%03d", $_[1] / 60 / 60 % 60, $_[1] / 60 % 60, $_[1] % 60, $_[1] * 1000 % 1000; } my $curfps; sub set_fps { return unless $DOOM; my ($target) = @_; my $new = $XRANDR_FPS; if (defined $target) { my $maxerr = 0.02; # max. 2% off allowed for (@XRANDR_RATES) { for my $div (1..10) { my $err = abs ($target * $div / $_->[0] - 1); if ($err < $maxerr) { $maxerr = $err; $new = $_->[0]; } } } } if ($curfps != $new && defined $new) { warn "REFRESHRATE CHANGE current=$curfps, target=$target, selected=$new\n"; system "xrandr", "--output", $XRANDR_OUTPUT, "--mode", $XRANDR_MODE, "--rate", $new; $curfps = $new; } } # does not work: deinterlace, because it returns a boolean and expects i have no clue our %SAVE_PROPERTY = (aid => 1, sid => 1, "audio-delay" => 1); sub mpv_init { if ($mpv->start ("--idle=yes", "--pause", "--force-window=no")) { # "--start=$playback_start", "--", $mpv_path) $mpv->{info_page} = 0; } for ( List::Util::pairs qw( ESC return q return ENTER enter SPACE pause [ steprev ] stepfwd j subtitle BS red i green o yellow b blue D triangle UP up DOWN down RIGHT right LEFT left ), (map { ("KP$_" => "num$_") } 0..9), KP_INS => 0, # KP0, but different ) { $mpv->bind_key ($_->[0] => $_->[1]); } $mpv->cmd (observe_property => 1, "chapter-metadata"); eval { # the profile is optional $mpv->cmd ("apply-profile" => "doomfrontend"); }; } sub play_video { ($PLAYING_STATE, $PLAYING_PATH, my $continue) = @_; my $playback_start = 0; if ($continue) { $playback_start = $PLAYING_STATE->{curpos} // 0; } else { my @menu = ([beginning => 0], [cancel => undef]); for my $idx (reverse 0..9) { if (my $pos = $PLAYING_STATE->{"bookmark$idx"}) { unshift @menu, [(sprintf_time "bookmark $idx (%s)", $pos) => $pos]; } } if (my $pos = $PLAYING_STATE->{curpos}) { unshift @menu, [(sprintf_time "current (%s)", $pos) => $pos]; } if (@menu > 2) { win_clear; win_set 3, "\e[33mmultiple start locations available:"; my $selection = menu_choice list => \@menu, y0 => 5, return => $#menu, left => $#menu, ; $playback_start = $selection->[1]; defined $playback_start or return; } else { $playback_start = 0; } } win_clear; win_set 0, "starting video..."; _win_refresh; my $mpv_path = $PLAYING_PATH; my $initial_deinterlace; if (is_myth $mpv_path) { $mpv_path = "appending://$mpv_path"; $initial_deinterlace = 1; } $mpv->cmd ("script-message", "osc-visibility", "never", "dummy"); $mpv->cmd ("set", "vid", "auto"); $mpv->cmd ("set", "aid", "auto"); $mpv->cmd ("set", "sid", "no"); #$mpv->cmd ("set", "sub-delay", "-19.100"); #$mpv->cmd ("set", "sub-codepage", "UTF-8-BROKEN"); $mpv->cmd ("set", "file-local-options/chapters-file", $mpv->escape_binary ("$mpv_path.chapters")); $mpv->cmd ("set", "options/start" => "$playback_start"); # file-local-options, or just start do not work $mpv->cmd ("loadfile", $mpv->escape_binary ($mpv_path)); $mpv->cmd ("script-message", "osc-visibility", "auto", "dummy"); #$mpv->cmd ("playlist-clear"); my $oid = 100; #$mpv->cmd ("observe_property", ++$oid, "shared-script-properties"); #$mpv->cmd ("get_property", "playback-time"); #$mpv->cmd ("get_time_us"); my $playback_time; my $status = 0; my $arg; my $fps; my $skip_delay; while () { input_next "play"; if ($INPUT =~ /^num([0-9])$/ or $INPUT eq "red") { $INPUT eq "red" ? substr $arg, -1, 1, "" : ($arg .= $1); $mpv->cmd ("osd-msg", "show-text", "argument: ${arg}_", 600000); $mpv->cmd ("osd-msg", "show-text", "") unless length $arg; next; } if ($INPUT eq "mpv/quit") { # should not happen, but allows user to kill etc. without consequence $status = 1; mpv_init; # try reinit last; } elsif ($INPUT eq "mpv/idle") { # normal end-of-file last; } elsif ($INPUT eq "return") { $status = 1; last; } elsif ($INPUT eq "mpv/file-loaded") { # start playing, configure video #$mpv->cmd ("seek", $playback_start, "absolute+exact") if $playback_start > 0; my $target_fps = eval { $mpv->cmd_recv ("get_property", "container-fps") } || 60; $target_fps *= play_video_speed_mult; set_fps $target_fps; unless (eval { $mpv->cmd_recv ("get_property", "video-format") }) { # assume audio-only TODO: better test $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]"); }; for my $prop (keys %SAVE_PROPERTY) { if (exists $PLAYING_STATE->{"mpv_$prop"}) { $mpv->cmd ("set", "$prop", $PLAYING_STATE->{"mpv_$prop"} . ""); } $mpv->cmd ("observe_property", ++$oid, $prop); } play_video_set_speed; $mpv->cmd ("set", "osd-level", "$OSD_LEVEL"); $mpv->cmd ("observe_property", ++$oid, "osd-level"); $mpv->cmd ("set", "pause", "no"); $mpv->cmd ("set_property", "deinterlace", "yes") if $initial_deinterlace; $mpv->cmd ("show-text", "FPS: target $target_fps, current $curfps", 2000) if $curfps != $fps;#d# win_clear; } elsif ($INPUT eq "stepfwd") { ++$PLAYING_STATE->{speed}; play_video_set_speed; ::state_save; } elsif ($INPUT eq "steprev") { --$PLAYING_STATE->{speed}; play_video_set_speed; ::state_save; } elsif ($INPUT eq "pause") { $mpv->cmd ("cycle", "pause"); $PLAYING_STATE->{curpos} = $mpv->cmd_recv ("get_property", "playback-time"); ::state_save; } elsif ($INPUT eq "green") { if (length $arg) { # seek-to if ($arg <= 99) { # MM $arg = sprintf "%02d:00", $arg; } elsif ($arg <= 9999) { # HHMM $arg = sprintf "%02d:%02d:00", $arg / 100, $arg % 100; } else { # HHMMSS $arg = sprintf "%02d:%02d:%02d", $arg / 100 / 100, $arg / 100 % 100, $arg % 100; } $mpv->cmd ("osd-msg", "seek", $arg, "absolute+exact"); } else { #$mpv->cmd ("osd-msg-bar", "show-progress"); my $info_page = $mpv->{info_page}; if (!$info_page) { $mpv->cmd ("script-binding", "stats/display-stats-toggle"); } ++$info_page; if ($info_page == 4) { $info_page = 0; $mpv->cmd ("script-binding", "stats/display-page-1"); $mpv->cmd ("script-binding", "stats/display-stats-toggle"); } else { $mpv->cmd ("script-binding", "stats/display-page-$info_page"); } $mpv->{info_page} = $info_page; } } elsif ($INPUT eq "yellow") { $mpv->cmd ("osd-auto", "cycle-values", "osd-level", "2", "3", "0", "1"); } elsif ($INPUT eq "right") { $mpv->cmd ("osd-msg-bar", "seek", $arg * 60 || 30, "relative+exact"); } elsif ($INPUT eq "left") { $mpv->cmd ("osd-msg-bar", "seek", -$arg * 60 || -5, "relative+exact"); } elsif ($INPUT eq "up") { $mpv->cmd ("osd-msg-bar", "seek", +600, "relative+exact"); } elsif ($INPUT eq "down") { $mpv->cmd ("osd-msg-bar", "seek", -600, "relative+exact"); } elsif ($INPUT eq "select") { $mpv->cmd ("osd-msg-bar", "add", "audio-delay", "-0.100"); } elsif ($INPUT eq "start") { $mpv->cmd ("osd-msg-bar", "add", "audio-delay", "0.100"); } elsif ($INPUT eq "intfwd") { $mpv->cmd ("no-osd", "frame-step"); } elsif ($INPUT eq "intrev") { $mpv->cmd ("no-osd", "frame-back-step"); } elsif ($INPUT eq "enter") { eval { my $pos = $mpv->cmd_recv ("get_property", "playback-time"); $mpv->cmd ("show-text", "saving bookmark $arg position at $pos"); $PLAYING_STATE->{"bookmark$arg"} = $pos; ::state_save; }; } elsif ($INPUT eq "blue") { # recall bookmark my $pos = $mpv->cmd_recv ("get_property", "playback-time"); $mpv->cmd ("no-osd", "seek", $PLAYING_STATE->{"bookmark$arg"}, "absolute+exact"); $PLAYING_STATE->{"bookmark9"} = $pos; $mpv->cmd ("expand-properties", "show-text", "recalling bookmark $arg position \${playback-time}, recall bookmark 9 to return", 5000); ::state_save; } elsif ($INPUT eq "square") { $mpv->cmd ("osd-auto", "screenshot", "video"); } elsif ($INPUT eq "audio") { $mpv->cmd ("osd-auto", "cycle", "audio"); } elsif ($INPUT eq "subtitle") { $mpv->cmd ("osd-auto", "cycle", "sub"); } elsif ($INPUT eq "triangle") { $mpv->cmd ("osd-auto", "cycle", "deinterlace"); } elsif ($INPUT eq "mpv/property-change") { my $prop = $INPUT_DATA->{name}; if ($prop eq "osd-level") { $OSD_LEVEL = $INPUT_DATA->{data}; #win_set 0, "playback position $playback_time"; #warn "$playback_time\n";#d# #$mpv->cmd ("expand-properties", "show-text", '${time-pos}', "1500"); } elsif ($prop eq "chapter-metadata") { if ($INPUT_DATA->{data}{TITLE} =~ /^\[SponsorBlock\]: (.*)/) { my $section = $1; my $skip; $skip ||= $SPONSOR_SKIP{$_} for split /\s*,\s*/, $section; if (defined $skip) { if ($skip) { # delay a bit, in case we get two metadata changes in quick succession, e.g. # because we have a skip at file load time. $skip_delay = AE::timer 2/50, 0, sub { $mpv->cmd ("no-osd", "add", "chapter", 1); $mpv->cmd ("show-text", "skipped sponsorblock section \"$section\"", 3000); }; } else { undef $skip_delay; $mpv->cmd ("show-text", "NOT skipping sponsorblock section \"$section\"", 3000); } } else { $mpv->cmd ("show-text", "UNRECOGNIZED sponsorblock section \"$section\"", 60000); } } else { # cancel a queued skip undef $skip_delay; } } elsif (exists $SAVE_PROPERTY{$prop}) { $PLAYING_STATE->{"mpv_$prop"} = $INPUT_DATA->{data}; ::state_save; } } undef $arg; } $mpv->cmd ("set", "pause", "yes"); while ($oid > 100) { $mpv->cmd ("unobserve_property", $oid--); } if ($status) { eval { $PLAYING_STATE->{curpos} = $mpv->cmd_recv ("get_property", "playback-time"); ::state_save; }; warn $@ if $@;#d# } else { $PLAYING_STATE->{watched} = int AE::now; ::state_save; } $mpv->cmd_recv ("stop"); # make sure state is clean, even if its slower #$mpv->stop; #mpv_init; #if ($DPMS_DISABLE) { # system "xse", "-dpms"; #} } sub play_video_kodi($$$) { my ($host, $path, $state) = @_; unlink "$KODIPATH/$host.bin"; symlink $path, "$KODIPATH/$host.bin"; system "chmod", "o+r", "--", "$KODIPATH/$host.bin"; my $conn; $conn = new AnyEvent::Handle connect => [$host, 9090], on_error => sub { $conn; # self-reference my ($hdl, $fatal, $msg) = @_; AE::log error => $msg; $hdl->destroy; }, ; $conn->on_read (sub { warn $conn->{rbuf}; }); $conn->push_write (qq<{"jsonrpc":"2.0","method":"player.open", "params": {"item":{"file":"$KODIURL/$host.bin"}}}>); warn "$KODIURL/$host.bin";#d# if (my $curpos = $state->{curpos}) { Coro::AnyEvent::sleep 1; my $ms = int +($curpos - int $curpos) * 1000; my $s = int $curpos % 60; my $m = int $curpos / 60 % 60; my $h = int $curpos / 60 / 60 ; $conn->push_write (qq<{"jsonrpc":"2.0","method":"player.seek", "params": {"playerid":1, "value":{"hours":$h, "minutes":$m, "seconds":$s, "milliseconds":$ms}}}>); } $conn->push_shutdown; } sub mangle_edit($$) { my ($playlist, $path) = @_; my $base = basename $path; my ($uploader, $title) = split /-/, basename $base; my @pats; utf8::decode $title; # filename must be utf-8, now unicode while ($title =~ /(?:(\w+|\S+)|([[:space:]:!,‐]+))/mgs) { my ($w, $W) = ($1, $2); if (defined $w) { $w = quotemeta $w; $w =~ s/\d+/\\d+/g; push @pats, $w; } elsif ($W eq " ") { push @pats, " "; } else { push @pats, "\\W+?"; } } #utf8::encode $_ for @pats; my ($o, $l) = (1, 0); my $patterns = $STATE{mangle_config}{$uploader}; my $list_state = { curidx => 1 }; my $rescan; while () { win_clear; win_set 1, "\e[33mmangle editor"; win_set 3, dec $base; win_set 6, "keyboard: 4=left, 6=right, 8=extend, 2=shrink; remote: prev=left, next=right, instant=extend/shrink"; $o = 0 if $o < 0; $o = $#pats if $o > $#pats; $l = 0 if $l < 0; $l = $#pats - $o if $l > $#pats - $o; my $edit = ""; for my $i (0 .. $#pats) { $edit .= "<\e[30;43m" if $i == $o; $edit .= $pats[$i]; $edit .= "\e[m>" if $i == $o + $l; } win_set 8, "\e[36mpattern edit ($o+$l):\e[0m $edit"; win_set 10, "resulting pattern: <\e[33m" . (join "", @pats[$o .. $o+$l]) . "\e[m>"; my @list = ( ["return", sub { last }], ["add pattern", sub { push @$patterns, join "", @pats[$o .. $o+$l]; $rescan = 1; last; }], ["use time for all (add empty pattern)", sub { push @$patterns, ""; $rescan = 1; last; }], ); for my $pattern (@$patterns) { push @list, ["remove: <$pattern>", sub { $patterns = [grep $_ ne $pattern, @$patterns]; $list_state->{curidx} = 0; # return $rescan = 1; }]; } my $menu = new list state => $list_state, y0 => 13, return => 0, left => 0, list => \@list, ; 1 while $menu->handle_events; if ($INPUT eq "list/select") { $menu->selection->[1](); } elsif ($INPUT eq "4" or $INPUT eq "prev") { --$o; } elsif ($INPUT eq "6" or $INPUT eq "next") { ++$o; } elsif ($INPUT eq "8" or $INPUT eq "intfwd") { ++$l; } elsif ($INPUT eq "2" or $INPUT eq "intrev") { --$l; } } if ($rescan) { if (@$patterns) { $STATE{mangle_config}{$uploader} = $patterns; } else { delete $STATE{mangle_config}{$uploader}; } state_save; sub dfe::mangle_reconfig (); dfe::mangle_reconfig; $playlist->{rescan} = 1; } } sub file_menu($$) { my ($playlist, $path) = @_; my $state = $STATE{filestate}{$path}; my $menu = new list y0 => 10, return => 0, left => 0, list => [ ["return", sub { last }], ["clear state", sub { %$state = (); last }], ["kodiplay mate10", sub { play_video_kodi "loki-mate10pro", $path, $state }], ["toggle watched", sub { $state->{watched} = !$state->{watched}; last }], ["toggle deleted", sub { $state->{deleted} = !$state->{deleted}; last }], ["toggle archive", sub { $state->{archive} = !$state->{archive}; last }], ["toggle tagged" , sub { $state->{tagged} = !$state->{tagged} ; last }], ["mangle editor" , sub { mangle_edit $playlist, $path; last }], ]; win_clear; win_set 1, "\e[33mfile menu"; win_set 3, dec $path; while () { win_set 4, sprintf "watched:%d deleted:%d", $state->{watched}, $state->{deleted}; 1 while $menu->handle_events; $menu->selection->[1]() if $INPUT eq "list/select"; } } sub live_tv { win_nest { play_video {}, "dvb://", 0; }; } sub dir_menu { my ($self) = @_; my $filter_update = sub { $self->{state}{list_menu}{curidx} = 0; $self->{rescan} = 1; }; my $do_unlink = sub { my ($filter) = @_; my $filestate = $STATE{filestate}; my $pathpfx = $self->{pathpfx}; my $list = $self->{list}; my $empty = 1; for (@$list) { if ($filter->($filestate->{"$pathpfx$_->[1]"})) { $self->{rescan} = 1; IO::AIO::aio_unlink "$pathpfx/$_->[1]"; IO::AIO::aio_unlink "$pathpfx/$_->[1].chapters"; } else { $empty = 0; } } if ($empty) { playlist_delete $self->{playlist}; } IO::AIO::flush; #d# should do a group, but I am too lazy }; my $do_archive = sub { my $filestate = $STATE{filestate}; while (my ($path, $state) = each %$filestate) { if ($state->{archive}) { $self->{rescan} = 1; system "mv", "-v", "-b", $path, $ARCHIVE_DIR; } } }; my $filter_uploader = sub { my @menu = (["\e[32mreturn"], ["\e[32mclear filter", undef]); my %uploader; for (@{ $self->{full_list} }) { ++$uploader{$1} if $_->[0] =~ /^([^-]+)/; } push @menu, map [(sprintf "[%4d] %s", $uploader{$_}, dec $_), $_], grep $uploader{$_} >= MAX_ISLANDS, sort { "\L$a" cmp "\L$b" } keys %uploader; my $menu = new list y0 => 3, return => 0, state => ($self->{state}{filter_uploader_menu} ||= {}), list => \@menu, ; while () { win_clear; win_set 1, "\e[33mselect uploader"; 1 while $menu->handle_events; if ($INPUT eq "list/select") { my $sel = $menu->selection; if (@$sel >= 2) { $self->{state}{filter_uploader} = $sel->[1]; $filter_update->(); } last; } } }; my $chdir = sub { while () { my @menu = (["\e[32mreturn"]); push @menu, [$_, $_] for playlist_names; my $menu = new list y0 => 3, return => 0, list => \@menu, ; while () { win_clear; win_set 1, "\e[33mselect playlist"; 1 while $menu->handle_events; if ($INPUT eq "list/select") { my $sel = $menu->selection; if (@$sel >= 2) { external "--playlist=" . substr $sel->[1], 1; } return; } elsif ($INPUT eq "red") { my $sel = $menu->selection; delete $STATE{$sel->[1]}; state_save; last; } } } }; my $menu = new list y0 => 10, return => 0, list => [ ["return", sub { last }], ["delete marked as Deleted or Watched", sub { $do_unlink->(sub { $_[0]{deleted} || $_[0]{watched} }); last }], ["filter uploader" , sub { win_nest { $filter_uploader->() }; last }], ["delete marked as Watched" , sub { $do_unlink->(sub { $_[0]{watched} }); last }], ["delete marked as Deleted" , sub { $do_unlink->(sub { $_[0]{deleted} }); last }], ["clear uploader filter" , sub { delete $self->{state}{filter_uploader}; $filter_update->(); last; }], ["clear regex filter" , sub { delete $self->{state}{filter_regex}; $filter_update->(); last; }], ["archive marked as Archive" , sub { $do_archive->(); last }], #["run xdfe" , sub { system "/fs/doom/root/xdfe"; last }], ["play live tv" , sub { live_tv; last; }], ["delete this playlist" , sub { playlist_delete $STATE{curdir}; last } ], ["rescan playlist" , sub { $self->{rescan} = 1; last }], ["change playlist" , sub { win_nest { $chdir->() }; last }], ["change to PLAYLIST" , sub { external "--playlist=playlist"; last }], ["change to VIDEO_DIR" , sub { external "--playlist=videos" ; last }], ]; while () { win_clear; win_set 1, "\e[33mdirectory menu"; 1 while $menu->handle_events; win_nest { $menu->selection->[1]() } if $INPUT eq "list/select"; } } sub menu_playlist { my @pl = playlist_names or return; #@pl = reverse @pl unless $INPUT =~ /^(?:prev|intrev|triangle)$/; my $cur = max 0, List::MoreUtils::firstidx { $_ eq $STATE{curdir} } @pl; win_clear; win_set 0, "\e[33mPLAYLIST SELECT"; my $menu = new list y0 => 5, list => [map [$_], @pl], ; my $autoselect = 2; # initial delay longer while () { if ($INPUT =~ /^(?:next|intfwd|circle)$/) { ++$cur; } elsif ($INPUT =~ /^(?:prev|intrev|triangle)$/) { --$cur; } elsif ($INPUT eq "enter") { external "--playlist=" . substr $pl[$cur], 1; last; } elsif ($INPUT eq "return") { last; } $cur %= @pl; $menu->{cur} = $cur; $menu->changed; $menu->draw; my ($timer, $time); $time = AE::now; $timer = AE::timer 0, 1/30, sub { my $bar = int $WIN_W * min 1, (AE::now - $time) / $autoselect; win_set 2, "\e[43m" . (" " x ($WIN_W - $bar)) . "\e[m"; _win_refresh; input_feed "enter" if $bar >= $WIN_W; }; input_next "playlist"; $autoselect = 0.66; # subsequent delay shorter } } sub view_playlist { my ($playlist) = @_; my $state = $STATE{$playlist} ||= {}; my $filestate = $STATE{filestate} ||= {}; my $conf = $CONF_PLAYLIST{$playlist}; my $self = { playlist => $playlist, path => $state->{cwd} // $conf->{cwd}, state => $state, pathpfx => "", }; while () { win_clear; win_set 0, "\e[33m" . ($conf->{title} // uc $playlist); win_set 3, "preparing..."; _win_refresh; # file scanning/selection my $pathpfx = ""; my $mode; my $filter_status; my $list_state = $state->{list_menu} ||= {}; if ($self->{state}{full_list}) { $mode = "full list"; $self->{full_list} = $self->{state}{full_list}; # remove missing files $self->{full_list} = [ grep -e $_->[1], @{ $self->{full_list} } ]; } elsif ($conf->{glob}) { $mode = sprintf "glob %s", dec join ",", @{ $conf->{glob} }; my @list; for (@{ $conf->{glob} }) { push @list, sort { "\L$a->[0]" cmp "\L$b->[0]" } map { stat_video $_ } File::Glob::bsd_glob $_ =~ /^\// ? $_ : "$self->{path}/$_", File::Glob::GLOB_MARK | File::Glob::GLOB_BRACE; } $self->{full_list} = \@list; } elsif ($conf->{scan}) { ($pathpfx, $self->{full_list}) = $conf->{scan}($self->{path}, $self); $mode = sprintf "confscan %s", dec $pathpfx; } elsif ($state->{scan}) { $mode = sprintf "$state->{scan} %s", dec $self->{path}; #$pathpfx = "$self->{path}/"; $self->{full_list} = eval { $state->{scan}($self->{path}, $self) }; } else { $mode = "empty"; $self->{full_list} = undef; } #$self->{full_list} ||= [["error", "error"]]; $self->{full_list} ||= []; $self->{pathpfx} = $pathpfx; $self->{list} = $self->{full_list}; if (defined $state->{filter_uploader}) { $filter_status .= " (uploader " . (enc $state->{filter_uploader}) . ")"; $list_state = $state->{uploader_list_menu}{$state->{filter_uploader}} ||= {}; my $re = qr/^\Q$state->{filter_uploader}\E-/; $self->{list} = [grep $_->[0] =~ $re, @{ $self->{list} }] } if (defined $state->{filter_regex}) { $filter_status .= " (regex $state->{filter_regex})"; my $re = qr/$state->{filter_regex}/; $self->{list} = [grep $_->[1] =~ $re, @{ $self->{list} }] } my $DESC_H = 18; my $list = new list list => $self->{list}, state => $list_state, y0 => 4, y1 => $WIN_H - $DESC_H - 1, display_cb => sub { my @flags = (" ") x 5; if (my $state = $filestate->{"$pathpfx$_[0][1]"}) { $flags[4] = "*" if $state->{started}; $flags[3]= "\e[95mW\e[m" if $state->{watched}; $flags[2]= "\e[31mD\e[m" if $state->{deleted}; $flags[1]= "\e[94mA\e[m" if $state->{archive}; $flags[0]= "\e[32mT\e[m" if $state->{tagged}; } "[" . (join "", @flags) . "] $_[1]" }, ; win_clear; win_set 0, "\e[33m" . ($conf->{title} // uc $playlist); win_set 1, "$playlist ($mode)"; win_set 2, sprintf "%d entries overall, %d entries filtered%s", scalar @{ $self->{full_list} }, scalar @{ $self->{list} }, $filter_status, ; while () { if (delete $self->{rescan}) { #scan_video_dir_clear_cache; last; } return if @EXTERNAL; state $mediainfo_jobid; state $mediainfo_pid; while () { if ($DESC_H) { my $jobid = ++$mediainfo_jobid; if (my $entry = $list->selection) { my $name = $entry->[1]; open my $old_stdout, ">&", \*STDOUT; pipe my ($r, $w); open STDOUT, ">&", $w; close $w; $mediainfo_pid = Proc::FastSpawn::spawn $::MEDIAINFO, ["mediainfo", "--Inform=General;%Description%", "--", "$pathpfx$name"]; if ($mediainfo_pid) { win_set $WIN_H - $DESC_H + 1, "fetching media description..."; _win_refresh; my $iow; $iow = EV::io $r, EV::READ, sub { $iow->stop; return if $mediainfo_jobid != $jobid; read $r, my $description, 8192; undef $mediainfo_pid; close $r; utf8::decode $description; $description = "" unless $description =~ /\S/; $description =~ s/ \/ /\n/g; # youtube-dl uses " / " or so to separate lines if (stat "$pathpfx$name") { $description = sprintf "%s %s\n%s", (POSIX::strftime "%Y-%m-%d %H:%M:%S", localtime +(stat _)[9]), (Format::Human::Bytes::base10 +(stat _)[7]), $description; } local $Text::Wrap::columns = $WIN_W; my @description = grep /\S/, split /\n/, Text::Wrap::wrap "", "", $description; for (0 .. $DESC_H - 1) { win_set $WIN_H - $DESC_H + 1 + $_, $description[$_]; } _win_refresh; }; } open STDOUT, ">&", $old_stdout; } }; my $handled = $list->handle_events; if ($DESC_H) { ++$mediainfo_jobid; kill 9, $mediainfo_pid if $mediainfo_pid; for ($WIN_H - $DESC_H .. $WIN_H - 1) { win_set $_, ""; } win_refresh; } last unless $handled; } input_context "view"; my $entry = $list->selection; my $name = $entry->[1]; my $filestate = $filestate->{"$pathpfx$name"} ||= {}; if ($INPUT eq "list/select" or $INPUT eq "play" or $INPUT eq "pause") { $filestate->{started} = int AE::now; my $uploader = "$pathpfx$name" =~ /00_distant_worlds/ && $name =~ /^([^-]+)-/ ? $1 : undef; my @uploader_props = qw(mpv_sid speed); if ($uploader) { for (@uploader_props) { $filestate->{$_} //= $STATE{"uploader_$_"}{$uploader}; } } ::state_save; win_nest { play_video $filestate, "$pathpfx/$name", $INPUT ne "play"; }; if ($uploader) { for (@uploader_props) { if ($filestate->{$_} != $STATE{"uploader_$_"}{$uploader}) { $STATE{"uploader_$_"}{$uploader} = $filestate->{$_}; ::state_save; } } } ++$list->{cur} if $filestate->{watched}; $list->changed; } else { if ($INPUT eq "esc") { EV::unloop; } elsif ($INPUT eq "return") { prepare_exit; exec $0, "--restart"; } elsif ($INPUT =~ /^(?:next|prev|intfwd|intrev|triangle|circle)$/) { win_nest { menu_playlist; }; } elsif ($INPUT eq "red") { $filestate->{deleted} ? delete $filestate->{deleted} : ($filestate->{deleted} = 1); ::state_save; ++$list->{cur}; $list->changed; } elsif ($INPUT eq "green") { $filestate->{watched} ? delete $filestate->{watched} : ($filestate->{watched} = 1); ::state_save; ++$list->{cur}; $list->changed; } elsif ($INPUT eq "yellow") { $filestate->{started} ? delete $filestate->{started} : ($filestate->{started} = 1); ::state_save; ++$list->{cur}; $list->changed; } elsif ($INPUT eq "blue") { $filestate->{archive} ? delete $filestate->{archive} : ($filestate->{archive} = 1); ::state_save; ++$list->{cur}; $list->changed; } elsif ($INPUT eq "popup") { win_nest { dir_menu $self; }; } elsif ($INPUT eq "right") { win_nest { file_menu $self, "$pathpfx$name"; }; } } } } } sub main { while () { if (my $args = shift @EXTERNAL) { state_save; # proactively request a state save since we are almost certain to change something my $state = $STATE{ $STATE{curdir} // "/videos" } ||= {}; if ($args->[0] =~ /^--regex=(.*)/) { $state->{filter_regex} = dec $1; next; } elsif ($args->[0] =~ /^--uploader=(.*)/) { $STATE{"/videos"}{filter_uploader} = dec $1; next; } elsif ($args->[0] =~ /^--playlist=\/*(.*)/) { $STATE{curdir} = dec "/$1"; next; } elsif ($args->[0] =~ /^--rescan$/) { next; } my $playlist = @$args > 1 ? "/playlist" : "/playlist1"; if ($args->[0] =~ /--list=\/*(.*)/) { shift @$args; $playlist = dec "/$1"; } if ($args->[0] =~ /^--/) { next; # error case } # playlist / directory $STATE{curdir} = $playlist; my $pl = $STATE{$playlist} ||= {}; delete $pl->{full_list}; delete $pl->{cwd}; if ($args->[0] eq "-r") { $pl->{cwd} = canonpath $args->[1]; $pl->{scan} = "state_scan_recursive"; } elsif (@$args == 1 && -d $args->[0]) { # single directory given, play directory $pl->{cwd} = canonpath $args->[0]; } else { # playlist, must be all files => create playlist with files $pl->{full_list} = [map { ref ? $_ : stat_video canonpath $_ } @$args]; ::input_feed "enter" if @$args == 1; #d# hack: auto-play when single video } } wakeup; view_playlist $STATE{curdir} // "/videos"; } } $WIN_READY->recv; our $MAIN_CORO; sub state_expire { my $filestate = $STATE{filestate}; if ($DOOM) { # only do it on doom # filter out old/empty state while (my ($k, $v) = each %$filestate) { unless (%$v and -e $k) { delete $filestate->{$k}; } } } if (0) { for my $k (keys %$filestate) { my $k2 = $k =~ s%//+%/%gr; $k2 =~ s%^/fs/fuji/fs/doom/%/fs/doom/%; $k2 =~ s%^/fs/doom/fs/doom/%/fs/doom/%; # / <- vio fix if ($k2 ne $k) { $filestate->{$k2} = delete $filestate->{$k}; } } } } sub main_start { $MAIN_CORO ||= async { mpv_init; $mpv->cmd ("script-message", "osc-visibility", "never", "dummy"); if ($ARGV[0] eq "--state-reload") { win_progress "\e[31mstate was externally modified, press enter to reload and proceed"; while () { input_next "reload"; last if $INPUT eq "enter" or $INPUT eq "return"; } win_clear; } state_init; #use Data::Dump; ddx \%STATE;#d# conf_check; state_expire; main; EV::unloop; }; } sub state_file_check { if ($STATE_MTIME != (stat $STATE_FILE)[9]) { return if $TESTING; $MAIN_CORO->safe_cancel; unlink $STATE_SHM; $mpv->stop; exec $0, "--state-reload"; die "state changed, aborting to reload hack\n"; async { win_clear; }; } } main_start; EV::loop; prepare_exit;