#!/usr/bin/perl
#
# Server to take snapshots with a Reolink IP camera every so often.
#
# Includes client that interacts with the server.

use strict;
use warnings;
use Scalar::Util qw/looks_like_number/;

my %default_config = (
                      socket    => '/var/run/reolink.sock',
                      config    => '/etc/reolink.conf',
                      spool_dir => '/var/spool/reolink'
                     );
my %debug_config   = (
                      socket    => "$ENV{HOME}/reolink.sock",
                      config    => "$ENV{HOME}/reolink.conf",
                      spool_dir => "$ENV{HOME}/spool"
                     );
my $global_config = \%default_config;

# 30s is 1920 shots over 16 hours. At 24fps, this makes a 1:20 video.
my ($min_interval, $interval, $max_interval) = (10, 30, 600);
# Retain images in the spool 72 hours by default
my $spool_retention_time = 72;
my $default_video_range = '0530-2130';
my ($video_format, $video_extension) = ('h264', 'mp4'); # ('vp9', 'webm') also supported
my @video_extensions = qw(mp4 webm); # enumeration of all supported types - used to generate HTML

my %commands = (
                interval  => {
                              args     => 1,
                              server   => \&Server::set_interval,
                              validate => sub { looks_like_number($_[0]) && $_[0] >= $min_interval && $_[0] <= $max_interval },
                              help     => 'Set snapshot interval'
                             },
                snapshot  => {
                              args     => 0,
                              server   => \&Server::snapshot,
                              help     => 'Take a snapshot now'
                             },
                spooltime => {
                              args     => 1,
                              server   => \&Server::set_spooltime,
                              validate => sub { looks_like_number ($_[0]) && $_[0] > 0 && int($_[0]) == $_[0] },
                              help     => 'Set spool retention time (in hours)'
                             },
                status    => {
                              args     => 0,
                              server   => \&Server::server_status,
                              help     => 'Send status of the server'
                             },
                ping      => {alias    => 'status'},
                pid       => {
                              args     => 0,
                              server   => \&Server::server_pid,
                              help     => 'Send the pid of the server'
                             },
                video     => {
                              args     => 1,
                              server   => \&Server::video,
                              validate => \&Process::validate_video_times,
                              help     => 'Time range for daily time-lapse video'
                             },
                timelapse => {
                              args     => 1,
                              server   => \&Server::timelapse,
                              validate => sub { $_[-1] =~ m/^\d{8}$/ },
                              help     => 'Generate a timelapse for YYYYMMDD'
                             },
                exit      => {
                              args     => 0,
                              server   => \&Server::server_terminate,
                              help     => 'Stop the server'
                             },
                quit      => {alias    => 'exit'},
                terminate => {alias    => 'exit'},
                term      => {alias    => 'exit'},
                die       => {alias    => 'exit'}
               );

# Load parameters from the config file
sub load_params {
  my $params = $_[0];

  $params->{spool_dir} = $global_config->{spool_dir} if not defined $params->{spool_dir};

  open (my $fh, '<', $global_config->{config}) or return;

  foreach my $line (<$fh>) {
    chomp $line;
    $line =~ s/^\s*#.*//;
    if ($line =~ m/^\s*(\S+)\s*[=:]\s*(\S+)/) {
      my ($key, $value) = ($1, $2);
      if ($key eq 'interval' and $commands{interval}->{validate} ($value)) {
        $params->{interval} = $value;
      } elsif ($key =~ m/^spool(?:_dir)?$/) {
        $params->{spool_dir} = $value;
      } elsif ($key =~ m/^spool[-_]time$/ and $commands{spooltime}->{validate} ($value)) {
        $params->{spooltime} = $value;
      } elsif ($key =~ m/^ntp(?:_ip)?$/) {
        $params->{ntp_ip} = $value;
      } elsif ($key =~ m/^video(?:[-_]?times?)?$/ and $commands{video}->{validate} ($value)) {
        $params->{video} = $value;
      }
    }
  }

  close ($fh);
}

package Server;

use Errno qw/EINTR/;
use File::Basename;
use File::Path 'make_path';
use File::Spec;
use Getopt::Long;
use Image::Magick;
use IO::Select;
use OpenBSD::Pledge;
use OpenBSD::Unveil;
use POSIX qw(mktime setsid :signal_h :sys_wait_h);
use Socket;
use Sys::Syslog qw/:standard :macros/;

BEGIN {
  # If we're running out of the dev tree (or otherwise have the module
  # installed with the executable), prefer the local version.
  my $wd = File::Spec->rel2abs ($0);
  $wd =~ s|/[^/]+$||;
  if (-f "$wd/Reolink.pm") {
    unshift @INC, $wd;
  }
  require Reolink;
  Reolink->import();
}

my %server_params = (interval   => $interval,
                     ntp_ip     => '192.168.127.1',
                     spooltime  => $spool_retention_time,
                     video      => $default_video_range);
# See dhcpd.conf for IP assignments
my %cameras = ('camera1' => {display => 'Camera 1',
                             spool   => 'camera_1',
                             ip      => '192.168.127.10',
                             args    => {}},
               'camera2' => {display => 'Camera 2',
                             spool   => 'camera_2',
                             ip      => '192.168.127.11',
                             args    => {image_quality_workaround => 1}});

my ($debug, $local) = (0, 0);

sub message {
  my $priority = @_ > 1 ? shift : LOG_INFO;
  my $msg = join ('', @_);
  if ($debug) {
    print "$msg\n";
  } else {
    syslog ($priority, $msg);
  }
}

sub error {
  my $line = (caller (1))[3];
  message (LOG_ERR, "error: @_ at $line");
}

sub debug {
  message (@_) if $debug;
}

sub save_params {
  my $fh;
  unless (open ($fh, '>', $global_config->{config})) {
    error ("failed to open $global_config->{config}: $!");
    return;
  }

  print $fh "# Autogenerated ".localtime.".\n";
  print $fh "interval: $server_params{interval}\n";
  print $fh "spool_dir: $server_params{spool_dir}\n";
  print $fh "spool_time: $server_params{spooltime}\n";
  print $fh "ntp_ip: $server_params{ntp_ip}\n";
  print $fh "video: $server_params{video}\n";

  close ($fh);

  message ("saved $global_config->{config}");
}

sub daemonize {
  chdir ('/') or die "failed to chdir(/): $!";

  open (STDIN,  '</dev/null') or die "failed to reopen stdin as /dev/null: $!";
  open (STDOUT, '>/dev/null') or die "failed to reopen stdout as /dev/null: $!";

  my $pid = fork();
  die "fork error: $!" unless defined $pid;

  exit if $pid; # parent

  die "setsid failed: $!" if setsid () == -1;

  open (STDERR, '>&', STDOUT) or die "failed to dup stdout: $!";
}

sub open_socket {
  socket (my $server_socket, PF_UNIX, SOCK_STREAM, 0) || die "socket error: $!";
  debug ("open($global_config->{socket})");
  unlink $global_config->{socket};
  my $umask = umask 0117; # rw-rw----
  bind ($server_socket, sockaddr_un ($global_config->{socket})) || die "bind error($global_config->{socket}): $!";
  umask $umask;
  listen ($server_socket, SOMAXCONN) || die "listen error: $!";
  $server_socket;
}

sub spool {
  File::Spec->catdir ($server_params{spool_dir}, $cameras{$_[0]}->{spool});
}

sub host {
  $cameras{$_[0]}->{ip};
}

sub setup_reolink {
  my $camera = $_[0];
  my ($resp, $code);

  my $r = Reolink->new (host => host ($camera), %{ $cameras{$camera}->{args} });
  unless ($r->Login) {
    error ("Failed to login to $camera");
    return;
  }
  $r->Errors (1);

  $code = $r->SetNtp (1, $server_params{ntp_ip});
  $code = $r->SetTime; # just enable DST
  $code = $r->SetOsd (0, 0, "AySpy", "Upper Left", 0, "Upper Right");

  $r->Logout;
}

my $keep_going = 1;

sub server_terminate {
  $keep_going = 0;
  'bye';
}

sub set_interval {
  $server_params{interval} = $_[1];
  save_params;
  "ok";
}

sub set_spooltime {
  $server_params{spooltime} = $_[1];
  save_params;
  "ok";
}

sub video {
  $server_params{video} = $_[1];
  save_params;
  "ok";
}

sub snapshot {
  my @cameras = @_ ? @_ : keys (%cameras);

  foreach my $camera (@cameras) {
    my $r = Reolink->new (host => host ($camera), %{ $cameras{$camera}->{args} });
    unless ($r->Login) {
      error ("Failed to login to $camera");
      next;
    }
    $r->Errors (1);

    my @t = localtime;
    my $fn = File::Spec->catfile (spool ($camera), sprintf ("%04d%02d%02d-%02d%02d%02d.jpg",
                                                            $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]));
    my $sn = $fn;
    $sn =~ s|/([^/]+)$|/sm-$1|;

    # Could have changed since last time through
    make_path (spool ($camera), { mode => 0755 }) unless -d spool ($camera);

    debug ("snapshot => $fn");

    # take snapshot
    if ($r->Snap ($fn)) {
      warn "Error creating snapshot\n";
    } else {
      my $image = Image::Magick->new ();
      $image->Read ($fn);
      $image->Resize ('1024x768'); # 4:3 - use 1280x960 if this is too small
      $image->Write (filename => $sn);
    }

    $r->Logout;
  }

  "snap";
}

my @saved_argv;

sub server_reload {
  exec @saved_argv or die "exec for reload failed: $!";
}

sub server_status {
  'alive';
}

sub server_pid {
  "$$";
}

sub process_command {
  accept (my $s, $_[0]) || die "accept error: $!";
  $s->autoflush;
  my $command = <$s>;
  my $resp = 'error';

  my @command = split ' ', $command;
  my $cmd = shift @command;
  unless (defined $commands{$cmd}) {
    error ("unknown command from client '$cmd'\n");
    goto out;
  }
  if (@command < $commands{$cmd}->{args}) {
    error ("insufficient args from client for '$cmd' (expect $commands{$cmd}->{args}, have ".@command.")");
    goto out;
  }
  if (@command && $commands{$cmd}->{validate} && ! $commands{$cmd}->{validate} (@command)) {
    error ("invalid args from client for '$cmd'");
    goto out;
  }

  $resp = $commands{$cmd}->{server} ($s, @command);

 out:
  print $s "$resp\n";
  close $s;
}


my %process_children;

sub maybe_generate_video {
  # [camera list] [time]
  my @cameras;
  foreach my $a (0..$#_) {
    if (defined $cameras{$_[$a]}) {
      push @cameras, $_[$a];
      delete $_[$a];
    }
  }
  @cameras = keys (%cameras) unless @cameras;

  my $date = $_[0] if $_[0] && $_[0] =~ m/^\d{8}$/;

  # if current time has passed $end_time and no video exists for this date and there is no pending video process

 CAMERA:
  foreach my $camera (@cameras) {

    foreach my $pid (keys %process_children) {
      my $res = waitpid ($pid, WNOHANG);
      debug ("$pid -> $process_children{$pid}: $res");
      if ($res == 0) {
        debug ("child process $pid ($process_children{$pid}) running...");
        next CAMERA;
      } else {
        debug ("child process $pid ($process_children{$pid}) complete");
        delete $process_children{$pid};
      }
    }

    my ($start_time, $end_time) = $commands{video}->{validate} ($server_params{video});

    my @t = localtime;
    my $time = sprintf ('%d%02d', $t[2], $t[1]);
    if ($time < $end_time && @_ == 0) { # an arg means we have a particular date in mind so skip this check
      debug ("too early to generate video ($time < $end_time)");
      return;
    }

    my $video_prefix = $date // sprintf ('%04d%02d%02d', $t[5]+1900, $t[4]+1, $t[3]);

    foreach my $ext (@video_extensions) {
      my $out = File::Spec->catfile (spool ($camera), "$video_prefix.$ext");
      if (-f $out && -s $out) {
        debug ("already generated for $camera $out");
        next CAMERA;
      }
    }

    message ("generating video for $camera $video_prefix");

    # extract program name and any "--debug" from @saved_argv
    my @process_args;
    foreach (@saved_argv) {
      next if m/server/;
      push @process_args, $_;
    }
    push @process_args, ('--process' => $video_prefix, '--range' => $server_params{video}, '--spool', spool ($camera));

    my $process_child = fork ();
    unless (defined ($process_child)) {
      error ("failed to fork video process for $camera");
      next;
    }

    if ($process_child == 0) {
      exec @process_args or die "failed to launch child for $camera: @process_args: $!";
    }

    $process_children{$process_child} = $camera;

    debug ("launched video process for $camera as pid $process_child");
  }
}

sub timelapse {
  maybe_generate_video ($_[1]);
  "ok"
}

sub respool_and_generate_slideshow {
  my @cameras;
  foreach my $a (0..$#_) {
    if (defined $cameras{$_[$a]}) {
      push @cameras, $_[$a];
      delete $_[$a];
    }
  }
  @cameras = (sort { $cameras{$a}->{display} cmp $cameras{$b}->{display} } keys (%cameras)) unless @cameras;

  # Retain only past 24 hours of stills
  my $t = time - $server_params{spooltime} * 60 * 60;

  # Generate a slideshow web page
  my $fh;
  unless (open ($fh, '>', "$server_params{spool_dir}/index.html")) {
    error ("open(index.html): $!");
  }

  my $generated = localtime;

  if ($fh) {
    print $fh <<"SLIDESHOW";
<!DOCTYPE html>
<html>
  <head>
    <title>Slideshow [$generated]</title>
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>

    <script type="text/javascript">
     var cameras = {
SLIDESHOW

    print $fh '       ' . join (",\n       ", map { qq("$_" : { "name" : "$cameras{$_}->{display}", "spool" : "$cameras{$_}->{spool}" }) } @cameras) . "\n";

    print $fh <<"SLIDESHOW";
     };

     var images = {
SLIDESHOW

    foreach my $camera (@cameras) {
      my $spool = spool ($camera);

      print $fh qq(       "$camera" : [\n);

      foreach my $image (<$spool/2*.jpg>) {
        if ($image =~ m|/(\d{4})(\d{2})(\d{2})-(\d{2})(\d{2})(\d{2})\.jpg|) {
          my $file_time = mktime ($6, $5, $4, $3, $2 - 1, $1 - 1900);
          my $title = "$1-$2-$3 $4:$5:$6";
          my $small = $image;
          $small =~ s|/([^/]+)$|/sm-$1|;
          if ($file_time < $t) {
            debug ("delete $image ($file_time $t)");
            unlink $image;
            unlink $small if -f $small;
          } else {
            my $im = basename ($image);
            if (-f $small) {
              $small = basename ($small);
            } else {
              $small = "";
            }

            print $fh <<"IMAGE";
         { image: "$im", small: "$small", title: "$title" },
IMAGE
          }
        }
      }

      print $fh qq(       ],\n);
    }


    print $fh <<"SLIDESHOW";
     };
     var videos = {
SLIDESHOW

    foreach my $camera (@cameras) {
      my $spool = spool ($camera);

      print $fh qq(       "$camera" : [\n);

      my @video_list;
      my @videos;
      foreach my $ext (@video_extensions) {
        push @video_list, <$spool/*.$ext>;
      }

      foreach my $video (sort @video_list) {
        my $ext = join ('|', @video_extensions);
        if ($video =~ m,/(\d{4})(\d{2})(\d{2})\.($ext)$,) {
          push @videos, [$1, $2, $3, $4];
        }
      }

      # 0=Y  1=M  2=D  3=ext
      print $fh $_ foreach map { qq(         { "video" : "$_->[0]$_->[1]$_->[2].$_->[3]", "title" : "$_->[0]-$_->[1]-$_->[2]", "keyframe" : "$_->[0]$_->[1]$_->[2]_kf.jpg" },\n) } @videos;

      print $fh qq(       ],\n);
    }

    print $fh <<"SLIDESHOW";
     };
    </script>

    <style type="text/css">
     body {
       background-color: #008080;
       color: black;
     }
     div.tabbed-wrapper {
       margin: 1%;
     }
     div.tabs {
       display: flex;
     }
     div.camera-name {
       display: flex;
       flex-grow: 1;
       align-items: center;
       justify-content: center;
       font-size: 4em;
       font-weight: bold;
     }
     span.camera-name {
       display: flex;
       flex-grow: 1;
       font-size: 2em;
       font-weight: bold;
       text-align: center;
       border: 1px solid black;
       border-radius: 4px;
       margin-bottom: 2px;
     }
     span.tab {
       background-color: #004040;
       flex-grow: 1;
       font-size: 3em;
       text-align: center;
       border: 1px solid black;
       border-radius: 10px;
       margin-bottom: 2px;
     }
     span.tab-left { margin-right: 1px; }
     span.tab-right { margin-left: 1px; }
     div.video {
       background-color: #004040;
       border: 1px solid black;
       border-radius: 10px;
       padding: 10px;
       max-width: 100%;
     }
     select.video-menu {
       background-color: #004040;
       font-size: 1em;
       font-weight: bold;
       border: none;
     }
     div.slideshow {
       background-color: #004040;
       border: 1px solid black;
       border-radius: 10px;
       padding: 10px;
       max-width: 100%;
     }
     img {
       width: 100%;
       max-width: 100%;
     }
     video {
       max-width: 100%;
       display: flex;
       margin: auto;
     }
     div.caption {
       font-size: 2em;
       display: flex;
       font-weight: bold;
     }
     div.caption > span, select {
       margin: auto;
     }
     input {
       display: flex;
       width: 100%;
     }
    </style>

    <script type="text/javascript">
     function id (i, camera) {
       return i+'-'+camera;
     }

     function set_image (camera) {
       slider = document.getElementById (id ("image-slider", camera));
       current = slider.value;

       img = document.getElementById (id ("photo-display", camera));
       img_src = cameras[camera].spool + "/" + images[camera][current].image;
       if (images[camera][current].small) {
         img.src = cameras[camera].spool + "/" + images[camera][current].small;
       } else {
         img.src = img_src;
       }
       a = document.getElementById (id ("photo-link", camera));
       a.href = img_src;
       cap = document.getElementById (id ("photo-caption", camera));
       cap.innerHTML = images[camera][current].title;
     }

     function slideshow_tab (camera) {
       s = document.getElementById (id ("slideshow-tab", camera));
       v = document.getElementById (id ("video-tab", camera));
       ts = document.getElementById (id ("tab-slideshow", camera));
       tv = document.getElementById (id ("tab-video", camera));
       s.style.display = "";
       v.style.display = "none";
       ts.style.fontWeight = "bold";
       tv.style.fontWeight = "normal";
     }

     function video_select (camera) {
       op = document.getElementById (id ("video-menu", camera));
       if (op.options.length == 0) { return; }
       idx = op.options[op.selectedIndex].value;
       vb = document.getElementById (id ("videobox", camera));
       vb.src = cameras[camera].spool + '/' + videos[camera][idx].video;
       vb.poster = cameras[camera].spool + '/' + videos[camera][idx].keyframe;
     }

     function video_tab (camera) {
       s = document.getElementById (id ("slideshow-tab", camera));
       v = document.getElementById (id ("video-tab", camera));
       ts = document.getElementById (id ("tab-slideshow", camera));
       tv = document.getElementById (id ("tab-video", camera));
       s.style.display = "none";
       v.style.display = "";
       ts.style.fontWeight = "normal";
       tv.style.fontWeight = "bold";
     }

     function init_camera (camera) {
       slideshow_tab (camera);
       slider = document.getElementById (id ("image-slider", camera));
       slider.min = 0;
       slider.step = 1;
       slider.max = images[camera].length - 1;
       slider.value = slider.max;
       slider.addEventListener ("input", () => set_image (camera));
       set_image (camera);

       select = document.getElementById (id ("video-menu", camera));
       for (let idx = 0; idx < videos[camera].length; idx++) {
         opt = document.createElement ("option");
         opt.value = idx;
         opt.innerHTML = videos[camera][idx].title;
         select.appendChild (opt);
         select.selectedIndex = idx;
       }
       video_select (camera);
     }

     function onload() {
       for (const camera in cameras) {
         init_camera (camera);
       }
     }
    </script>
  </head>
  <body onload="onload();">

SLIDESHOW

    foreach my $camera (@cameras) {
      print $fh <<"SLIDESHOW";
    <!-- $cameras{$camera}->{display} -->
    <div id="$camera">
      <div class="camera-name">$cameras{$camera}->{display}</div>
      <div class="tabbed-wrapper">
        <div class="tabs">
          <span class="tab tab-left" id="tab-slideshow-$camera" onclick="slideshow_tab('$camera');">Slideshow</span>
          <span class="tab tab-right" id="tab-video-$camera" onclick="video_tab('$camera');">Video</span>
        </div>

        <div class="video" id="video-tab-$camera">
          <div class="caption">
            <select class="video-menu" id="video-menu-$camera" onchange="video_select('$camera');">
            </select>
          </div>
          <video id="videobox-$camera" controls>
            This could be a video instead.
          </video>
        </div>

        <div class="slideshow" id="slideshow-tab-$camera">
          <div class="caption">
            <span id="photo-caption-$camera"></span>
          </div>
          <div class="inner">
            <div class="slide"><a id="photo-link-$camera" href=""><img id="photo-display-$camera" src=""/></a></div>
          </div>
          <input class="slider" id="image-slider-$camera" type="range" min="0" max="146" step="1" value="0"/>
        </div>
      </div>
    </div>

SLIDESHOW
    }

    print $fh <<"SLIDESHOW";
  </body>
</html>
SLIDESHOW
  }
}

sub upload {
  # Send link to page and current IP to rockgeeks.net

}


sub run {
  @saved_argv = (File::Spec->rel2abs ($0), @_);

  GetOptions (debug => sub {
                $debug = 1;
                $global_config = \%debug_config;
              },
              server => sub {});

  main::load_params (\%server_params);

  unless ($debug) {
    pledge (qw/rpath wpath cpath inet exec proc prot_exec unix unveil/) or die "Failed to pledge: $!";
    openlog ('reolink', 'PID', LOG_DAEMON);
    message ('startup');
    $SIG{__DIE__} = sub { syslog (LOG_CRIT, "fatal: @_") };

    daemonize;

    unveil ($_, 'rx')                          || die "unveil($_): $!" foreach @INC;
    unveil ($server_params{spool_dir}, 'rwxc') || die "unveil($server_params{spool_dir}): $!";
    unveil ($global_config->{socket}, 'rwc')   || die "unveil($global_config->{socket}): $!";
    unveil ($global_config->{config}, 'rwc')   || die "unveil($global_config->{config}): $!";
    unveil ($saved_argv[0], 'rx')              || die "unveil($saved_argv[0]): $!";
    unveil ('/etc/protocols', 'r')             || die "unveil(/etc/protocols): $!"; # HTTP::Tiny
    unveil ('/etc/localtime', 'r')             || die "unveil(/etc/localtime): $!"; # localtime
    unveil ('/usr/share/zoneinfo', 'rx')       || die "unveil (/usr/share/zoneinfo): $!"; # localtime
    unveil ()                                  || die "failed to lock unveil: $!";
  }

  make_path ($server_params{spool_dir}, { mode => 0755 }) unless -d $server_params{spool_dir};
  chdir ($server_params{spool_dir}) || die "chdir($server_params{spool_dir}): $!";

  $SIG{HUP} = \&server_reload;
  $SIG{INT} = \&server_terminate;
  $SIG{TERM} = \&server_terminate;

  setup_reolink ($_) foreach keys %cameras;

  my $s = open_socket ();
  my $i = IO::Select->new ();

  $i->add ($s);

  do {
    snapshot ();
    maybe_generate_video ();
    respool_and_generate_slideshow ();

    for (my $remaining = $server_params{interval}, my $start_time = time; $remaining > 0 && $keep_going;) {
      $! = 0;
      my @ready = $i->can_read ($server_params{interval});
      if (@ready) {
        process_command (@ready);
      } else {
        die "select error: $!" if $! && !$!{EINTR};
      }

      $remaining = $server_params{interval} - (time - $start_time);
     }
  } while ($keep_going);

  close ($s);
  unlink $global_config->{socket};

  closelog unless $debug;

  return 0;
}

1;

package Client;

use Fcntl;
use Getopt::Long;
use Socket;

sub help {
  my $maxlen = 0;
  map { $maxlen = length $_ if length $_ > $maxlen } keys %commands;
  my %help = ();
  my %alias = ();

  my sub format_command { sprintf "%${maxlen}s  $commands{$_[0]}->{help}\n", $_[0]; };
  my sub format_alias   { sprintf "%${maxlen}s  Alias for $commands{$_[0]}->{alias}\n", $_[0]; };

  foreach my $cmd (sort keys %commands) {
    if (my $alias = $commands{$cmd}->{alias}) {
      my $str = format_alias ($cmd);

      if ($help{$alias}) {
        $help{$alias} .= $str;
      } elsif ($alias{$alias}) {
        $alias{$alias} .= $str;
      } else {
        $alias{$alias} = $str;
      }
    } else {
      $help{$cmd} = format_command ($cmd);
      if ($alias{$cmd}) {
        $help{$cmd} .= $alias{$cmd};
      }
    }
  }

  print "Commands:\n".join ('', map { $help{$_} } sort keys %help);
}

sub client_command {
  my @commands = ();
  while (@_) {
    my $cmd = shift;

    if ($cmd eq 'help') {
      shift @_;
      help ();
      next;
    }

    die "unknown command '$cmd'\n" unless defined $commands{$cmd};
    if (defined ($commands{$cmd}->{alias})) {
      $cmd = $commands{$cmd}->{alias};
    }
    die "insufficient args for '$cmd' (expect $commands{$cmd}->{args}, have ".@_.")" if @_ < $commands{$cmd}->{args};
    my @args = splice @_, 0, $commands{$cmd}->{args};
    if (@args && $commands{$cmd}->{validate}) {
      die "invalid args for '$cmd'" unless $commands{$cmd}->{validate} (@args);
    }
    push @commands, join (' ', ($cmd, @args)) . "\n";
  }
  @commands;
}

sub run {
  GetOptions (debug => sub {
                $global_config = \%debug_config;
              });

  my @commands = client_command (@ARGV);
  return 0 unless @commands;

  socket (my $sock, PF_UNIX, SOCK_STREAM, 0) || die "unable to connect to server socket: $!";
  connect ($sock, sockaddr_un ($global_config->{socket})) || die "connect error: $!";

  $sock->autoflush;

  foreach my $command (@commands) {
    print $sock "$command\n";
    my $response = <$sock>;
    print "$response";
  }

  close $sock;

  return 0;
}

1;

package Process;

use Getopt::Long;

my %process_params;

# 4:3 resolutions (native is 2560:1920)
# height:crf values are interpolated from https://developers.google.com/media/vp9/settings/vod/
my @video_params = ({size => '1024:768',  crf => 32},
                    {size => '1280:960',  crf => 32},
                    {size => '1400:1050', crf => 31},
                    {size => '1440:1080', crf => 31},
                    {size => '1600:1200', crf => 28},
                    {size => '1920:1440', crf => 24},
                    {size => '2560:1920', crf => 19});
# my @videos = ({index => 3, suffix => '_small'});
my @videos = ({index => 3, suffix => ''});

# Input format something like: '0530-2130'
# Return (start, end) with any leading '0' stripped if range validates, otherwise return empty list
sub validate_video_times {
  my $time_re = qr/(?:0?\d|1\d|2[0-3]):?[0-5]\d/;

  if ($_[0] =~ m/^($time_re)-($time_re)$/) {
    my ($start, $end) = ($1, $2);
    $start =~ s/^0//;
    $start =~ s/://g; $end =~ s/://g;
    if ($start < $end) {
      return ($start, $end);
    }
  }
  return ();
}

sub process_pass {
  my $quality = shift;
  my $size = shift;
  my $lib = shift;
  my $bitrate = shift;
  my $pass = shift;
  my $outfile = shift;
  my @files = @_;

  my $cmd = ("ffmpeg"
             ." -y"
             ." -framerate 24"
             ." -f image2pipe -i -"
             ." -vf scale=$size"
             ." -c:v $lib"
             ." -b:v $bitrate"
             ." -quality good"
             ." $quality"
             .($pass ? (" -pass $pass"." -speed ".($pass == 1 ? 4 : 2)) : '')
             ." -an"
             .' '.$outfile);

  open (my $ffmpeg, "|-", $cmd) or die "open: $!";

 outer:
  foreach my $file (@files) {
    open (my $fh, "<", "$file") or do { print "error opening $file: $!\n"; next };

    my $chunk = 65536;

    while (my $nbytes = sysread ($fh, my $bytes, $chunk)) {
    again:
      my $outbytes = syswrite ($ffmpeg, $bytes, $nbytes);
      unless (defined ($outbytes)) {
        print "write to ffmpeg error: $!\n";
        last outer;
      }
      if ($outbytes < $nbytes) {
        $nbytes -= $outbytes;
        goto again;
      }
    }

    close ($fh);
  }

  close ($ffmpeg);
}

# Two pass VP9 webm constant quality encoding
sub process_vp9 {
  my $v = shift;
  my $basefile = shift;
  my @files = @_;
  my $outfile = "$basefile.webm";

  process_pass ('-crf '.$video_params[$v->{index}]->{crf}, $video_params[$v->{index}]->{size}, 'libvpx-vp9', '0', $_, $outfile, @files) for (1..2);

  return $outfile;
}

# H.264
# This is nearly twice the size of VP9, but apple products don't support that or AV1, and firefox doesn't support MP4/HEVC. Lame.
sub process_h264 {
  my $v = shift;
  my $basefile = shift;
  my @files = @_;
  my $outfile = "$basefile.mp4";

  process_pass ('-preset veryslow', $video_params[$v->{index}]->{size}, 'libx264', 0, 0, $outfile, @files);

  return $outfile;
}


sub process {
  my $v = shift;
  my $spool = shift;
  my @files = @_;
  my $basefile = File::Spec->catfile ($process_params{spool_dir}, $ARGV[0].$v->{suffix});
  my $outfile;

  if ($video_format eq 'vp9') {
    $outfile = process_vp9 ($v, $basefile, @files);
  } elsif ($video_format eq 'h264') {
    $outfile = process_h264 ($v, $basefile, @files);
  } else {
    die "Video format '$video_format' not supported";
  }

  # "Key frame" is the still to show for the video.  Use the middle image.
  my ($keyframe_in, $keyframe) = ($files[int (@files / 2)], $outfile);
  my $ext = join ('|', @video_extensions);
  $keyframe =~ s/\.(?:$ext)$/_kf.jpg/;
  print ("generating keyframe $keyframe_in $keyframe\n");
  my $geometry = $video_params[$v->{index}]->{size};
  $geometry =~ s/:/x/g;
  if (system ("convert -resize $geometry $keyframe_in $keyframe")) {
    if ($? == -1) {
      print "error: failed to launch 'convert': $!\n";
    } elsif ($? & 127) {
      print "error: 'convert' died with signal ".($? & 127).": $!\n";
    } else {
      print "error: 'convert' exited with ".($? >> 8).": $!\n";
    }
  }
}

sub run {
  my ($start_time, $end_time);
  my $range = $default_video_range;
  my $spool;

  GetOptions (process   => sub {},
              'range=s' => \$range,
              'spool=s' => \$spool,
              debug     => sub {
                $global_config = \%debug_config;
              });

  die "Invalid range '$range'\n" unless (($start_time, $end_time) = validate_video_times ($range));
  die "Missing date arg\n" unless @ARGV;

  main::load_params (\%process_params);

  $process_params{spool_dir} = $spool if $spool;

  # Summer: 5:42AM / 8:08PM (DST)
  # Winter: 6:55AM / 4:48PM
  #
  # 05:30 - 21:30 (local) 16 hours
  #
  # 60s, 24fps -> 1440 frames (1/40s)
  # 40s, 24fps -> 960 frames (1/60s)

  my @filelist = map { /-(?|0?(\d{3})|(\d{4}))\d{2}\./ && $1 >= $start_time && $1 <= $end_time ? $_ : () } glob "$process_params{spool_dir}/$ARGV[0]-*";

  die "no files found with prefix $ARGV[0] in $process_params{spool_dir}\n" unless @filelist;
  print join("\n", @filelist)."\n";
  my @outfiles;
  my @times;
  my @fps;
  foreach my $v (@videos) {
    my $t1 = time;
    my $outfile = process ($v, @filelist);
    my $t2 = time;
    push @outfiles, $outfile;
    push @times, $t2 - $t1;
    push @fps, @filelist / $times[-1];
  }
  foreach my $i (0..$#outfiles) {
    printf "Generated $outfiles[$i] in $times[$i]s (%.1f FPS)\n", $fps[$i];
  }
}

1;

package main;

if (@ARGV == 0 or map { $_ =~ /^-{0,2}server$/ ? 1 : () } @ARGV) {
  exit Server::run (@ARGV);
} elsif (map { $_ =~ /^-{0,2}process$/ ? 1 : () } @ARGV) {
  exit Process::run (@ARGV);
}

exit Client::run (@ARGV);