| 1 | #! /usr/bin/perl |
| 2 | |
| 3 | use open ":utf8"; |
| 4 | use strict; |
| 5 | |
| 6 | use DBI; |
| 7 | use Getopt::Std; |
| 8 | |
| 9 | BEGIN { binmode STDOUT, ":utf8"; } |
| 10 | |
| 11 | (my $prog = $0) =~ s:^.*/::; |
| 12 | sub HELP_MESSAGE ($;@) { |
| 13 | my ($fh) = @_; |
| 14 | print $fh "usage: $prog [-ps] DISC-ID ...\n"; |
| 15 | } |
| 16 | my $ROOT = "/mnt/dvd/archive"; |
| 17 | |
| 18 | my $bogusp = 0; |
| 19 | my %opt; |
| 20 | getopts("hps", \%opt) or $bogusp = 1; |
| 21 | if ($opt{"h"}) { HELP_MESSAGE \*STDOUT; exit 0; } |
| 22 | @ARGV or $bogusp = 1; |
| 23 | if ($bogusp) { HELP_MESSAGE \*STDERR; exit 2; } |
| 24 | $opt{"p"} || $opt{"s"} or $opt{"p"} = 1; |
| 25 | |
| 26 | my $DB = DBI->connect("dbi:Pg:host=roadstar", "", "", |
| 27 | { AutoCommit => 0, |
| 28 | RaiseError => 1, |
| 29 | ReadOnly => 1 }); |
| 30 | |
| 31 | my $st = $DB->prepare |
| 32 | ("SELECT s.name, d.disc, d.path |
| 33 | FROM dvd_disc AS d JOIN dvd_set AS s ON d.set_id = s.id |
| 34 | WHERE d.disc_id = ?"); |
| 35 | |
| 36 | my $rc = 0; |
| 37 | for my $id (@ARGV) { |
| 38 | $st->execute($id); |
| 39 | my @r = $st->fetchrow_array; $st->finish; |
| 40 | if (!@r) { print STDERR "$prog: unknown id `$id'\n"; $rc = 1; } |
| 41 | else { |
| 42 | my ($name, $disc, $path) = @r; |
| 43 | @ARGV > 1 and print "$id: "; |
| 44 | if ($opt{"s"}) { print "$name (#$disc)"; } |
| 45 | if ($opt{"p"} && $opt{"s"}) { print " ["; } |
| 46 | if ($opt{"p"}) { print $path; } |
| 47 | if ($opt{"p"} && $opt{"s"}) { print "]"; } |
| 48 | print "\n"; |
| 49 | } |
| 50 | } |
| 51 | |
| 52 | $DB->disconnect; |
| 53 | exit $rc; |