#! /usr/bin/perl -w use autodie qw{:all}; use open ":utf8"; use strict; use DBI; use Encode qw{encode_utf8 decode_utf8}; use Getopt::Std; BEGIN { binmode STDIN, ":utf8"; binmode STDOUT, ":utf8"; binmode STDERR, ":utf8"; } (my $prog = $0) =~ s:^.*/::; sub HELP_MESSAGE ($;@) { my ($fh) = @_; print $fh "usage: $prog FILE ...\n"; } my $bogusp = 0; my %opt; getopts("h", \%opt) or $bogusp = 1; if ($opt{"h"}) { HELP_MESSAGE \*STDOUT; exit 0; } @ARGV >= 1 or $bogusp = 1; if ($bogusp) { HELP_MESSAGE \*STDERR; exit 2; } my $DB = DBI->connect("dbi:Pg:host=roadstar", "", "", { AutoCommit => 0, RaiseError => 1 }); my $R_STR = qr/ " (?: [^"\\]++ | \\ .)++ " /x; my $R_INT = qr/ -?+ \d++ /x; my $R_REAL = qr/ -?+ \d++ (?: \. \d++)?+ (?: [eE] [-+]?+ \d++)?+ /x; sub unquote ($) { my ($s) = @_; if ($s eq "-") { return undef; } else { $s =~ s/^"(.*)"$/$1/; $s =~ s/\\(.)/$1/; return $s; } } my $st_def_playlist = $DB->prepare ("INSERT INTO playlist AS pl (name, n_entry) VALUES (?, 0) ON CONFLICT (name) DO UPDATE SET name = pl.name WHERE pl.name = ?"); my $st_finish_playlist = $DB->prepare ("UPDATE playlist SET n_entry = ? WHERE name = ?"); my $st_def_series = $DB->prepare ("INSERT INTO series AS s (name, title) VALUES (?, ?) ON CONFLICT (name) DO UPDATE SET title = ? WHERE s.name = ?"); my $st_def_media = $DB->prepare ("INSERT INTO media AS m (path, title_number, start_chapter, end_chapter, title, series_name, duration) VALUES (?, ?, ?, ?, ?, ?, ?) ON CONFLICT (path, title_number, start_chapter, end_chapter) DO UPDATE SET title = ?, series_name = ?, duration = ? WHERE m.path = ? AND m.title_number = ? AND m.start_chapter = ? AND m.end_chapter = ? RETURNING m.id"); my $st_def_entry = $DB->prepare ("INSERT INTO playlist_entry AS e (list_name, entry, media_id) VALUES (?, ?, ?) ON CONFLICT (list_name, entry) DO UPDATE SET media_id = ? WHERE e.list_name = ? AND e.entry = ?"); my $st_clear_entries = $DB->prepare ("DELETE FROM playlist_entry WHERE list_name = ? AND entry >= ?"); my $playlist = undef; my $index = 0; sub wrap () { defined $playlist or return; $index or die "empty playlist"; $st_finish_playlist->execute($index, $playlist); $st_clear_entries->execute($playlist, $index); $playlist = undef; $index = 0; } LINE: while (<>) { chomp; if (/^ \s* (?: ; | $) /x) { next LINE; } elsif (/^ \s* LIST \s+ (\S+) \s* $/x) { wrap; $playlist = $1; $st_def_playlist->execute($playlist, $playlist); } elsif (!defined $playlist) { die "no playlist name"; } elsif (/^ \s* SERIES \s+ (\S+) \s+ ($R_STR) \s* $/x) { my ($stag, $title) = ($1, unquote($2)); my $sname = $stag eq "-" ? $playlist : "$playlist/$stag"; $st_def_series->execute($sname, $title, $title, $sname); } elsif (/^ \s* ENTRY \s+ (\S+) \s+ ($R_STR) \s+ ($R_STR) \s+ ($R_INT) \s+ ($R_INT) \s+ ($R_INT) \s+ ($R_REAL) \s* $/x) { my ($stag, $title, $path, $ttn, $loch, $hich, $dur) = ($1, unquote($2), unquote($3), $4, $5, $6, $7); my $sname = $stag eq "-" ? $playlist : "$playlist/$stag"; $st_def_media->execute($path, $ttn, $loch, $hich, $title, $sname, $dur, $title, $sname, $dur, $path, $ttn, $loch, $hich); my ($mid) = $st_def_media->fetchrow_array; $st_def_media->finish; $st_def_entry->execute($playlist, $index, $mid, $mid, $playlist, $index); $index++; } else { die "bad line $_"; } } wrap; $DB->commit; $DB->disconnect;