[ViewVC] Annotation of: cvs/doomfrontend/doomfrontend

#!/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} !~ /libmimalloc/) {
      $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 "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<filler>"              => 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<xrandr --current> =~ / connected primary (\d+)x(\d+)\+/a
   or qx<xrandr --current> =~ / 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<xprop -font \Q$FONT>;
      $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 {
   $mpv->start ("--idle=yes", "--pause", "--force-window=no"); # "--start=$playback_start", "--", $mpv_path;

   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");
         }

      } 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 = "<no 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;

Revision:	1.2
Committed:	Wed Apr 5 22:12:20 2023 UTC (15 months, 3 weeks ago) by root
Branch:	MAIN
Changes since 1.1:	+31 -11 lines
Log Message:	* empty log message *