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