report: Sort more sensibly.

[dvddb] / report

#! /usr/bin/perl -w

use open ":utf8";
use strict;

use DBI;
use Encode qw{encode_utf8 decode_utf8};
use File::Find;

BEGIN { binmode STDOUT, ":utf8"; }

my $ROOT = "/mnt/dvd/archive";
my $DB = DBI->connect("dbi:Pg:host=roadstar", "", "",
		      { AutoCommit => 0,
			RaiseError => 1,
			ReadOnly => 1 });

my %iso = ();
find(sub {
       if (/\.iso$/ && ! -l && -f) {
	 my $fn = decode_utf8 $File::Find::name;
	 $fn =~ s:^$ROOT/::;
	 $iso{$fn} = 1;
       }
     }, $ROOT);

my %set_path;
my %set_id;
my %box;
my $st_set = $DB->prepare("SELECT id, name, n_disc FROM dvd_set");
my $st_disc = $DB->prepare
  ("SELECT disc, path, box FROM dvd_disc WHERE set_id = ? ORDER BY disc");
$st_set->execute;

while (my @r = $st_set->fetchrow_array) {
  my ($id, $name, $ndisc) = @r;
  my @path;

  $st_disc->execute($id);
  while (my @r = $st_disc->fetchrow_array) {
    my ($disc, $path, $box) = @r;
    $disc == @path or die "bad disc sequence for `$name'";
    $box{$path} = $box if defined $box;
    push @path, $path;
  }
  @path == $ndisc or die "wrong number of discs for `$name'";
  $set_path{$name} = \@path; $set_id{$name} = $id;
}

for my $name (keys %set_path) {
  my $allp = 1;
  for my $path (@{$set_path{$name}}) {
    if (defined $path && exists $iso{$path}) { delete $iso{$path}; }
    else { $allp = 0; }
  }
  ##if ($allp) { delete $set_path{$name}; }
}

my @iso = sort keys %iso;
my $lastbox = "#nil";
sub set_box ($) {
  my ($box) = @_;
  $box //= "#nil";
  if ($box ne $lastbox) { print "!box $box\n"; $lastbox = $box; }
}

sub path_key ($) {
  my ($p) = @_;
  if ($p =~ m{^ ([a-z]) / ([^/]+) ((?: / .*)?) $}ix) {
    my $init = $1;
    my $focus = $2;
    my $tail = $3;
    my $head = undef;
    if ($focus =~ /^ (the | a ) \s+ (\S .*) $/x)
      { $head = $1; $focus = $2; }
    if (lc $init ne lc substr($focus, 0, 1) &&
	$focus =~ /^ (.*) \s+ ($init .*) $/x)
      { $head .= (defined $head && " ") . $1; $focus = $2; }
    if (defined $head) { return "$init/$focus, $head$tail"; }
  }
  return $p;
}

for my $name (sort { my $pa = $set_path{$a}[0]; my $ba = $box{$pa} // "~~~";
		     my $pb = $set_path{$b}[0]; my $bb = $box{$pb} // "~~~";
		     $ba cmp $bb || path_key $pa cmp path_key $pb }
		keys %set_path) {
  my $paths = $set_path{$name};
  my @unk;
  set_box $box{$paths->[0]};
  while (@iso && $iso[0] lt $paths->[0]) { push @unk, shift @iso; }
  if (@unk) {
    print "[#UNK: *]\n";
    for my $path (@unk) { print "\t", $path, "\n"; }
  }
  printf "[#%d: %d] %s\n", $set_id{$name}, scalar @$paths, $name;
  my $i = 0;
  for my $path (@$paths) {
    $i++;
    if (!defined $path) {
      printf "\t!! (disc %d)\n", $i;
    } else {
      my $fn = "$ROOT/$path";
      set_box $box{$path};
      if (-f $fn && ! -l $fn) { print "\t" . $path . "\n"; }
      else { print "\t!! ". $path . "\n"; }
    }
  }
}

if (@iso) {
  print "[#UNK: *]\n";
  for my $path (@iso) { print "\t", $path, "\n"; }
}

$DB->disconnect;