#!/usr/bin/perl -w
# dvdlist.pl, a perl CGI script to display a list of DVDs on a web page
# Copyright (C) 2005-2023 Christian Wolff
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# Or, download it from http://www.gnu.org/copyleft/gpl.html
#
# You can reach the author via email: sub-gpl
\n";
if ($header) {
$header = 0; # Skip header line
} else {
$line[6] =~ s/\s*\(.*\)//;
$lang{$line[3]} = $line[6] if $line[3] ne '';
$lang{$line[2]} = $line[6] if $line[2] ne '';
$lang{$line[1]} = $line[6] if $line[1] ne '';
$lang{$line[0]} = $line[6];
}
}
close LANG;
$lang{'cmn'} = 'Mandarin'; # replace 'Mandarin Chinese'
$lang{'yue'} = 'Yue Cantonese'; # Cantonese (Hong-Kong), replace 'Yue Chinese'
}
$lang{'-'} = 'none';
# Expansion pattern for countries through ISO-3166 Country Codes (2 letters)
# -- How to get latest ISO-3166 country code data set --
# 1. Browse w/ Firefox to 'https://www.iso.org/obp/ui/#search/code/'
# 2. Select menu: "Tools" --> "Web Developer" --> "Network", developer tools window will open at bottom of page
# 3. On page, top right, select "Results per page": 300
# 4. In developer tools window at bottom, right-click on last "POST" entry (Type "json", about 120 kByte)
# 5. Select "Copy" --> "Copy Response"
# 6. Paste into text file and save as 'iso-3166-1.json' into cgi-bin directory
# 7. Run 'iso-3166-1_parse.pl' in cgi-bin directory to create .tab files
#my $iso3166_table = 'iso-3166-1_full.tab'; # tab-separated values, complete, see instructions above
my $iso3166_table = 'iso-3166-1.tab'; # tab-separated values, abridged (columns #4 and #6), see instructions above
my $iso3166_url = 'https://scarabaeus.org/' . $iso3166_table;
# tab-delimited:
# ID char(2) -- The two-letter 3166 identifier
# Name varchar(150) -- Reference country name
# Parse file of ISO-3166 codes into hash table
my %country = ();
if (open CTRY, "<${iso3166_table}") {
my $header = 1;
while (
\n";
if ($header) {
$header = 0; # Skip header line
} else {
$country{uc($line[0])} = $line[1] if ($line[0]);
}
}
close CTRY;
}
# Expansion pattern for audio codec. Short tag has to appear at the start of the description, followed by an optional space.
my %audio_codec = (
'PC', 'PCM',
'DD', 'Dolby Digital',
'DP', 'Dolby Digital Plus',
'AD', 'Dolby Digital Plus / Atmos',
'TH', 'Dolby TrueHD',
'AT', 'Dolby TrueHD / Atmos',
'DT', 'DTS',
'HR', 'DTS-HD High Resolution',
'MA', 'DTS-HD Master Audio',
'DX', 'DTS:X MA',
'HX', 'DTS:X HR',
'DH', 'DTS Headphone:X',
'AU', 'Auro3D',
'MH', 'MPEG-H 3D Audio',
'AA', 'AAC');
my %video_format = (
'', '4:3',
's', '4:3',
'a', '16:9',
'p', '16:9,720p',
'i', '16:9,1080i',
'h', '16:9,1080p',
'w', '21:9,1080p',
'u', '16:9,2160p');
my %hdr_format = (
'', ',SDR',
's', ',SDR',
'h', ',HDR10',
'd', ',Dolby Vision',
'p', ',HDR10+',
't', ',Technicolor HDR',
'g', ',HLG');
my %media_type = (
'c', 'CD',
's', 'SACD',
'b', 'Blu-ray',
't', 'Blu-ray 3D',
'w', 'Blu-ray MoD',
'u', 'UltraHD Blu-ray',
'h', 'HD-DVD',
'hd', 'HD-DVD/DVD',
'l', 'Laser Disc',
'm', 'VideoCD',
'v', 'VHS',
'x', 'CD/DVD-ROM',
'a', 'UV/MA',
'i', 'iTunes',
'y', 'DigCopy',
'o', 'DVD Audio',
'r', 'DVD-R',
'd', 'DVD');
#
# Helper Functions
#
# Expansion function for audio and subtitle track descriptions
sub expand_lang
{
my ($value) = @_;
my $lang = ''; # Language(s) of audio or subtitle tracks
my ($tracks, $track, $language);
my $count = 0;
for $tracks (split /\//, $value) { # separate language tracks by '/'
my $descr = '';
$descr = $1 if ($tracks=~s/ ?\((.*)\)//); # extract description, appended in '()'
# expand audio coding type at beginning of description
foreach $codec (keys %audio_codec) {
last if $descr=~s/^${codec} ?/$audio_codec{$codec} /i;
}
for $track (split /,/, $tracks) { # separate tracks that share an add-on by ','
my $multilang = ''; # one or more language in the track
my $separator = '';
for $language (split /\+/, $track) { # separate multi-language track by '+' into ISO language codes
my $region = '';
if ($language eq '-') {
$language = 'none';
} else {
if ($language=~/^(.*)-(.*)$/) { # separate region, if appended to language, with '-' as separator
$language = $1;
$region = $2;
}
if ($language=~/^[a-zA-Z]{2}[a-zA-Z]?$/) {
my $iso = lc($language);
$language = $lang{$iso}; # expand 2 or 3 letter ISO 639 code to language name
$language = '' . $iso . '' unless (defined($language) && ($language ne '')); # mark unknown language tag in bold red
}
$language .= "($country{uc($region)})" if ($region); # expand 2 letter ISO 3166 code to country name
}
$multilang .= $separator . $language;
$separator = '+';
}
$descr=~s/\s*$//;
$multilang .= ' (' . $descr . ')' if $descr; # attach description
$lang .= (($count > 0) ? '
' : '') . $multilang; # gather list of tracks
$count++;
}
}
if (($count > 3) && ! defined($query{'raw'})) { # in excess of 3 tracks, make it a size 3 overflow box
$lang = '
\n";
}
}
#
# Start of HTML
#
# get CGI parameter
%query = ();
$query{'file'} = 'dvd_list.txt';
$query = $ENV{'QUERY_STRING'};
chomp $query;
for (split (/&/, $query)) {
if (/=/) {
my ($param,$content) = split(/=/, $_, 2);
$content =~ tr/+/ /;
$content =~ s/%([0-9a-fA-F]{2})/pack('c',hex($1))/ge;
$query{$param} = $content;
} elsif ($_) {
$query{'file'} = $_;
}
}
$limit = defined($query{'limit'}) ? $query{'limit'} : 0;
$filter = defined($query{'filter'}) ? $query{'filter'} : '';
$dbfile = $query{'file'};
$dbfile=~s/^.*\///; # Delete everything up to and including the last slash
$dbfile=~s/\/.*$//;
$dbfile = $dbpath . $dbfile;
$title .= " Reverse" if (defined($query{'revsort'}));
$title .= " Sorted by Col. $query{'sort'}" if (defined($query{'sort'}));
# print HTTP header
print "MIME-Version: 1.0\nContent-Type: text/html\n\n";
my $title = 'Media List';
# print HTML header
# background colors:
# light dark
# dark line #F0F0F0 #505050 (grey)
# title line #B0B0D0 #606080 (blue-grey)
# section summary #E0FFE0 #809F80 (lime green)
# total summary #D0E0D0 #709070 (green-grey)
#
print <\n";
print " ";
print " \n";
print " ";
print "
\n";
#}
search();
my (
$items, $total_items,
$items_dvd, $total_items_dvd,
$items_cd, $total_items_cd,
$items_bd, $total_items_bd,
$items_3d, $total_items_3d,
$items_uhd, $total_items_uhd,
$items_hd, $total_items_hd,
$items_ld, $total_items_ld,
$items_vcd, $total_items_vcd,
$items_vhs, $total_items_vhs,
$items_dig, $total_items_dig,
$discs, $total_discs,
$discs_dvd, $total_discs_dvd,
$discs_cd, $total_discs_cd,
$discs_bd, $total_discs_bd,
$discs_3d, $total_discs_3d,
$discs_uhd, $total_discs_uhd,
$discs_hd, $total_discs_hd,
$discs_ld, $total_discs_ld,
$discs_vcd, $total_discs_vcd,
$discs_vhs, $total_discs_vhs,
$discs_dig, $total_discs_dig,
$times, $total_times
) = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my ($dollars, $total_dollars) = (0.00, 0.00);
my @lines = ();
my @sections = ();
my ($cur_line, $cur_section, $sections) = (0, 0, 0);
my $selected_section = 1;
my $td_tag = 'th';
my $td = $td_tag . ' valign="baseline" align="left" class="alt_row"';
my $firstheader = 1;
my $firstseg = 1;
open LIST, "<${dbfile}" or die "list file '${dbfile}' not found!";
print "\n";
while (
\n";
search();
print <) {
chomp;
s/^\#\#\#\s?/[XXX] / if $query{'xxx'};
s/^\#.*$//;
next if /^\s*$/;
next if ($td!~/^th/) && $query{'search'} && !/$query{'search'}/i && !/^--/;
my @line = split "\t";
if ($#line < 7) { # Convert legacy file format
for (my $i = 12; $i > 0; $i--) {
$line[$i] = ($i < 4) ? '' : ($line[$i - 3] ? $line[$i - 3] : '') ;
}
}
while ($#line < 12) {
push @line, '';
}
next if ((! $query{'all'}) && defined($line[5]) && ($line[5] =~ /-/));
my $line = "\t
\n\n";
$firstheader = 0;
}
if (($td!~/^th/) && defined($query{'sort'})) {
unless (/^--/ || /^\*\*\*/) {
my $sort_key = '';
$sort_key = $key[$query{'sort'}] if defined($key[$query{'sort'}]);
push @lines, $key[0] . "\t" . $sort_key . $line; # Always sort by Title in second order
}
} else {
push @lines, $line;
}
$td_tag = 'td';
$td = $td_tag . (($td eq $td_tag) ? " class=\"alt_row\"" : '');
}
close LIST;
sub bykeys {
my ($a0, $a1, $b0, $b1) = ('', '', '', '');
($a0, $a1) = ($1, $2) if ($a =~ /^(.*?)\t(.*?)\t/);
($b0, $b1) = ($1, $2) if ($b =~ /^(.*?)\t(.*?)\t/);
(lc($a1) cmp lc($b1)) || (lc($a0) cmp lc($b0));
}
sub bykeysnum {
my ($a0, $a1, $b0, $b1) = ('', '', '', '');
($a0, $a1) = ($1, $2) if ($a =~ /^(.*?)\t(.*?)\t/);
($b0, $b1) = ($1, $2) if ($b =~ /^(.*?)\t(.*?)\t/);
$a1 = 0 unless $a1;
$b1 = 0 unless $b1;
($a1 <=> $b1) || (lc($a0) cmp lc($b0));
}
if (defined($query{'sort'})) { # Print sorted results
my @sorted;
# By Duration, Disc count, or Price: Numerical sort, otherwise alphabetical
if (($query{'sort'} == 3) || ($query{'sort'} == 4) || ($query{'sort'} == 10)) {
if (defined($query{'revsort'})) {
@sorted = reverse sort bykeysnum @lines;
} else {
@sorted = sort bykeysnum @lines;
}
} else {
if (defined($query{'revsort'})) {
@sorted = reverse sort bykeys @lines;
} else {
@sorted = sort bykeys @lines;
}
}
if (defined($query{'revsort'})) {
my $header = pop @sorted;
unshift @sorted, $header;
}
$td_tag = 'td';
$td = $td_tag;
for (@sorted) {
s/^.*?\t.*?\t/\t/;
$td = $td_tag . (($td eq $td_tag) ? " class=\"alt_row\"" : '');
s/td class=\"alt_row\"/td/g;
s/";
my $dollar = 0.00;
my @key = ();
my $imdbsearch = $line[0];
$imdbsearch =~ s/ - .*$//;
$imdbsearch =~ s/^\[XXX\] //;
$imdbsearch =~ s/^P: //;
$imdbsearch = decode_entities($imdbsearch);
#$imdbsearch =~ s/\&(\d+);/chr($1)/eg;
$imdbsearch = uri_escape($imdbsearch, "^A-Za-z0-9\-\._~");
#$imdbsearch =~ s/([^A-Za-z0-9\-\._~ ])/sprintf("%%%02X",ord($1))/eg;
#$imdbsearch =~ s/ /+/g;
my $fps = 0;
if (defined($query{'sort'})) {
@key = @line;
$key[0] =~ s/^\[XXX\] //;
$key[0] =~ s/^P: //;
# Remove article from title
$key[0] =~ s/^\s*a\s+//i;
$key[0] =~ s/^\s*an\s+//i;
$key[0] =~ s/^\s*the\s+//i;
$key[0] =~ s/^\s*der\s+//i;
$key[0] =~ s/^\s*die\s+//i;
$key[0] =~ s/^\s*das\s+//i;
# Expand numbers in Title and Release to 8 digits
$key[0] =~ s/(\d+)/sprintf "%08d", $1/eg;
$key[1] =~ s/(\d+)/sprintf "%08d", $1/eg if defined($key[1]);
# Remove anything besides letters, digits and white space from title and release
$key[0] =~ s/[^\w\d\s]//;
$key[1] =~ s/[^\w\d\s]// if defined($key[1]);
# Simplify URLs
$key[8] =~ s/(https?\:\/\/)(www\.)?// if defined($key[8]);
$key[12] =~ s/(https?\:\/\/)(www\.)?// if defined($key[12]);
}
unless (/^--/) { # Regular entry
next unless ($selected_section);
push @line, '' while ($#line < 7);
$line[0] =~s/^\*{3}\s+(.*)$/$1<\/b>/;
if ($td!~/^th/) {
$line[0] = "$line[0]";
$line[0] =~ s/^(\[XXX\] )?P: /Preorder:<\/i> $1/g;
if ($line[3]) {
# Aspect Ratio (x.xx --> x.xx:1) and video format
my @video_format = ();
for $vf (split /\//, $line[3]) {
my ($format, $rate) = expand_vf($vf);
push @video_format, $format;
$fps = 24 if ($rate == 24); # cumulative, any 24 fps or none
}
$line[3] = join(' \n";
$line .= "\t
', @video_format);
}
if (defined($line[5])) {
$line[5] =~ s/^p/PAL<\/font>/i;
$line[5] =~ s/^n/NTSC<\/font>/i;
$line[5] =~ s/([\d\-A-F\?]+\??)$/\/Reg.$1/;
}
#$line[6] = break($line[6]);
#$line[7] = break($line[7]);
$line[6] = expand_lang($line[6]) if defined($line[6]);
$line[7] = expand_lang($line[7]) if defined($line[7]);
}
} else { # start of new segment == end of previous segment, print summary
my $section = $line[0];
$section =~s/^--\s*(.*)\s*/$1/; # section tag
push @sections, $section;
$sections++;
my $tag = $section;
$tag =~ s/[^a-zA-Z0-9_]//g;
if (defined($query{'section'})) {
$selected_section = ($query{'section'} eq $tag);
next unless ($selected_section);
}
$line[0] = "-- " . $section . "";
$td_tag = 'td';
if (defined($query{'raw'})) {
$td = $td_tag . (($td eq $td_tag) ? " class=\"alt_row\"" : '');
} else {
$td = $td_tag . " class=\"summary_row\"";
}
unless (defined($query{'sort'}) || defined($query{'raw'}) || defined($query{'section'}) || $firstseg) {
$line .= " <${td} colspan=3>${items} (${items_dvd} DVD, ${items_cd} CD, ${items_bd} Blu-ray (${items_3d} 3D), ${items_uhd} UltraHD Blu-ray, ${items_hd} HD-DVD, ${items_ld} Laser Disc, ${items_vcd} VideoCD, ${items_vhs} VHS, ${items_dig} DigCopy)${td_tag}> ";
if ($times) {
$times = sprintf("%d day%s, %d:%02d (%d min.)", $times / 1440, (int($times / 1440) == 1) ? '' : 's', ($times / 60) % 24, $times % 60, $times);
$line .= "<${td}>${times}${td_tag}> ";
} else {
$line .= "<${td}> ";
}
$dollars = sprintf("%0.2f", $dollars);
$line .= "<${td} colspan=4>${discs} (${discs_dvd} DVD, ${discs_cd} CD, ${discs_bd} Blu-ray (${discs_3d} 3D), ${discs_uhd} UltraHD Blu-ray, ${discs_hd} HD-DVD, ${discs_ld} Laser Disc, ${discs_vcd} VideoCD, ${discs_vhs} VHS, ${discs_dig} DigCopy, )${td_tag}> <${td} colspan=1> " . (defined($query{'cost'}) ? "<${td}>\$${dollars} " : '') . "<${td} colspan=1> \n\n\t ";
}
# Add segment counts to totals
$total_discs_dvd += $discs_dvd;
$total_discs_cd += $discs_cd;
$total_discs_bd += $discs_bd;
$total_discs_3d += $discs_3d;
$total_discs_uhd += $discs_uhd;
$total_discs_hd += $discs_hd;
$total_discs_ld += $discs_ld;
$total_discs_vcd += $discs_vcd;
$total_discs_vhs += $discs_vhs;
$total_discs_dig += $discs_dig;
# Reset counts for next segment
$items = 0;
$items_dvd = 0;
$items_cd = 0;
$items_bd = 0;
$items_3d = 0;
$items_uhd = 0;
$items_hd = 0;
$items_ld = 0;
$items_vcd = 0;
$items_vhs = 0;
$items_dig = 0;
$discs = 0;
$discs_dvd = 0;
$discs_cd = 0;
$discs_bd = 0;
$discs_3d = 0;
$discs_uhd = 0;
$discs_hd = 0;
$discs_ld = 0;
$discs_vcd = 0;
$discs_vhs = 0;
$discs_dig = 0;
$times = 0;
$dollars = 0.00;
$firstseg = 0;
next if defined($query{'raw'});
}
if ($td=~/^th/) {
my $q = '&' . $ENV{'QUERY_STRING'};
# next if defined($query{'raw'});
$q =~ s/\&revsort=\d+//;
$q =~ s/\&sort=\d+//;
$q =~ s/^\&//;
for (my $i = 0; $i < 12; $i ++) {
if (defined($query{'sort'}) && ($query{'sort'} == $i)) {
if (defined($query{'revsort'})) {
$line[$i] = "$line[$i]";
} else {
$line[$i] = "$line[$i]";
}
} else {
$line[$i] = "$line[$i]";
}
}
$line[6] .= "language";
$line[7] .= "country";
} else {
# Media type (Disc type, digital format)
$key[4] = 0;
if (defined($line[4]) && ($line[4] ne '')) {
my $first = 1;
my $first_3d = 1;
my $first_dig = 1;
my $got_bd = 0;
my $skip = 0;
$skip = 1 if ($filter ne '');
if ($line[4] =~ /\D/) { # number(s) with qualifier(s)
my $num = $line[4];
my ($t, $n);
$line[4] = '';
while ($num =~ /(\d+)([^0123456789(]*)(\([^()]+?\))?(.*)$/) { # 1+ digits, followed by 0+ non-digits/open paren, followed by a portion in parens (if any), followed by 0+ any. 3rd match group will start with digit, if any.
$line[4] .= ", " if ($line[4]);
($n, $t, $s, $num) = ($1, $2, $3, $4);
if ($t =~ /^c/i) {
$skip = 0 if ($filter =~ /c/i);
$t = $media_type{'c'};
$discs_cd += $n;
$items_cd ++ if $first;
$total_items_cd ++ if $first;
} elsif ($t =~ /^s/i) {
$skip = 0 if ($filter =~ /s/i);
$t = $media_type{'s'};
$discs_cd += $n;
$items_cd ++ if $first;
$total_items_cd ++ if $first;
} elsif ($t =~ /^b/i) {
$skip = 0 if ($filter =~ /b/i);
$t = $media_type{'b'};
$discs_bd += $n;
$items_bd ++ if $first;
$total_items_bd ++ if $first;
$got_bd = 1;
} elsif ($t =~ /^t/i) { # Count Blu-Ray 3D items as both Blu-Ray and Blu-Ray 3D
$skip = 0 if ($filter =~ /t/i);
$t = $media_type{'t'};
$discs_3d += $n;
$items_3d ++ if ($first || $first_3d);
$total_items_3d ++ if ($first || $first_3d);
$items_bd ++ if ($first || ($first_3d && (! $got_bd)));
$total_items_bd ++ if ($first || ($first_3d && (! $got_bd)));
$first_3d = 0;
} elsif ($t =~ /^w/i) {
$skip = 0 if ($filter =~ /w/i);
$t = $media_type{'w'};
$discs_bd += $n;
$items_bd ++ if $first;
$total_items_bd ++ if $first;
$got_bd = 1;
} elsif ($t =~ /^u/i) {
$skip = 0 if ($filter =~ /u/i);
$t = $media_type{'u'};
$discs_uhd += $n;
$items_uhd ++ if $first;
$total_items_uhd ++ if $first;
} elsif ($t =~ /^hd/i) {
$skip = 0 if ($filter =~ /hd/i);
$t = $media_type{'hd'};
$discs_hd += $n;
$items_hd ++ if $first;
$total_items_hd ++ if $first;
} elsif ($t =~ /^h/i) {
$skip = 0 if ($filter =~ /h/i);
$t = $media_type{'h'};
$discs_hd += $n;
$items_hd ++ if $first;
$total_items_hd ++ if $first;
} elsif ($t =~ /^l/i) {
$skip = 0 if ($filter =~ /l/i);
$t = $media_type{'l'};
$discs_ld += $n;
$items_ld ++ if $first;
$total_items_ld ++ if $first;
} elsif ($t =~ /^m/i) {
$skip = 0 if ($filter =~ /m/i);
$t = $media_type{'m'};
$discs_vcd += $n;
$items_vcd ++ if $first;
$total_items_vcd ++ if $first;
} elsif ($t =~ /^v/i) {
$skip = 0 if ($filter =~ /v/i);
$t = $media_type{'v'};
$discs_vhs += $n;
$items_vhs ++ if $first;
$total_items_vhs ++ if $first;
} elsif ($t =~ /^x/i) {
$skip = 0 if ($filter =~ /x/i);
$t = $media_type{'x'};
} elsif ($t =~ /^a/i) {
$skip = 0 if ($filter =~ /a/i);
$t = $media_type{'a'};
$discs_dig += $n;
$items_dig ++ if $first_dig;
$total_items_dig ++ if $first_dig;
$first_dig = 0;
} elsif ($t =~ /^i/i) {
$skip = 0 if ($filter =~ /i/i);
$t = $media_type{'i'};
$discs_dig += $n;
$items_dig ++ if $first_dig;
$total_items_dig ++ if $first_dig;
$first_dig = 0;
} elsif ($t =~ /^y/i) {
$skip = 0 if ($filter =~ /y/i);
$t = $media_type{'y'};
$discs_dig += $n;
$items_dig ++ if $first_dig;
$total_items_dig ++ if $first_dig;
$first_dig = 0;
} elsif ($t =~ /^o/i) {
$skip = 0 if ($filter =~ /o/i);
$t = $media_type{'o'};
$discs_dvd += $n;
$items_dvd ++ if $first;
$total_items_dvd ++ if $first;
} elsif ($t =~ /^r/i) {
$skip = 0 if ($filter =~ /r/i);
$t = $media_type{'r'};
$discs_dvd += $n;
$items_dvd ++ if $first;
$total_items_dvd ++ if $first;
} else { # 'd' or unknown designator, default to DVD
$skip = 0 if ($filter =~ /d/i);
$t = $media_type{'d'};
$discs_dvd += $n;
$items_dvd ++ if $first;
$total_items_dvd ++ if $first;
}
$key[4] += $n;
$discs += $n;
$total_discs += $n;
$line[4] .= ' \n";
if ($firstheader) {
$line .= "
' if ($line[4]);
$line[4] .= $n . ' ' . $t . (($n == 1) ? '' : 's');
$line[4] .= ' ' . $s if ($s);
$first = 0;
}
next if $skip;
} else { # just a number, assume DVD
$skip = 0 if ($filter =~ /d/i);
next if $skip;
my $dvd_count = 1;
$dvd_count = $line[4] if defined($line[4]) && ($line[4] > 0);
$key[4] += $dvd_count;
$discs += $dvd_count;
$discs_dvd += $dvd_count;
$items_dvd ++;
$total_discs += $dvd_count;
$total_items_dvd ++;
$line[4] .= ' DVD' . (($dvd_count == 1) ? '' : 's');
}
$items ++;
$total_items ++;
} else { # No info, assume DVD without specific number of discs
next if (($filter ne '') && ($filter =~ /d/i));
next if (defined($query{'raw'}));
}
# Running time (PAL 2:2 pulldown adjustment)
if ($line[2] =~/\d/) {
my $time_line = '';
$key[2] = 0;
for $rt (split /\//, $line[2]) {
my $runtime = defined($rt) ? $rt : 0;
if ($runtime =~/(\d+)\:(\d+)/) {
$runtime = $1 * 60 + $2;
} elsif ($runtime =~/\D/) {
$runtime = 0;
}
my $time_entry = sprintf("%d:%02d ", $runtime / 60, $runtime % 60);
if (($line[5]=~/P/) && ($fps != 24)) {
$time_entry .= sprintf("(%d[%d] min.)", $runtime, $runtime * 25 / 24);
} else {
$time_entry .= sprintf("(%d min.)", $runtime);
}
$time_line .= '
' if ($time_line);
$time_line .= $time_entry;
$key[2] = $runtime if (defined($query{'sort'}) && ! $key[2]);
$times += $runtime;
$total_times += $runtime;
}
$line[2] = $time_line;
}
# Cost (currency conversion, 2018)
if (defined($query{'cost'}) && defined($line[10])) {
my ($currency, $amount) = ('D', 0);
if ($line[10] =~ /^([A-Z\$€£]?)(.*)$/) {
$currency = $1 if defined($1);
$amount = $2 if defined($2);
$amount = 0 unless ($amount =~ /\d+\.\d{2}/);
}
if ($currency =~ /^[E€]/) {
$dollar = ($amount * 1.1);
$line[10] =~ s/^E/€/;
$line[10] .= sprintf(" (~\$%0.2f)", $dollar);
} elsif ($currency =~ /^[P£]/) {
$dollar = ($amount * 1.3);
$line[10] =~ s/^P/£/;
$line[10] .= sprintf(" (~\$%0.2f)", $dollar);
} elsif ($amount) {
$dollar = $amount;
$line[10] = sprintf("\$%0.2f", $dollar);
}
$key[10] = $dollar;
$dollars += $dollar;
$total_dollars += $dollar;
} else {
$key[10] = 0;
}
# ASIN
if (defined($line[11]) && ($line[11] ne "") && (! defined($query{'raw'}))) {
my ($country, $asin) = ('us', $line[11]);
if ($asin =~ /\//) { # Optional: prefix with Amazon country (e.g. "de/" for amazon.de)
($country, $asin) = split('/', $asin);
}
if ($asin=~/^B0/ || $asin=~/^63/ || $asin=~/^07/ || $asin=~/^18/ || $asin=~/^38/ || $asin=~/^39/) {
if ($country eq 'de') { # Germany
$line[11] = "${asin}";
} elsif ($country eq 'jp') { # Japan
$line[11] = "${asin}";
} elsif ($country eq 'uk') { # UK
$line[11] = "${asin}";
} elsif ($country eq 'fr') { # France
$line[11] = "${asin}";
} elsif ($country eq 'it') { # Italy
$line[11] = "${asin}";
} elsif ($country eq 'ca') { # Canada
$line[11] = "${asin}";
} elsif ($country eq 'us') { # USA
#$line[11] = "${asin}";
$line[11] = "${asin}*";
# http://www.amazon.com/gp/offer-listing/${asin}/?condition=new
# http://www.amazon.com/gp/offer-listing/${asin}/?condition=used
# https://catalog-retail.amazon.com/abis/syh/DisplayCondition/?asin=${asin}
} else {
$line[11] = "${asin}";
}
}
}
}
if ($line[0]=~/^--/) {
next if defined($query{'raw'});
$td_tag = 'td';
$td = $td_tag . " class=\"title_row\"";
$line .= " <${td}>$line[0]${td_tag}> =====";
} else {
if ($td!~/^th/) {
# Forced line breaks in Title and Release
$line[0] =~ s/( [-\/] )/$1\
/g;
#$line[0] =~ s/: /:\
/g;
$line[0] =~ s/ / \
/g;
$line[1] =~ s/( [-\/] )/$1\
/g;
#$line[1] =~ s/: /:\
/g;
# Expand IMDB title, character, or company tags ('tt', 'ch', or 'co', followed by 7 digits)
$line[8] =~s/^(tt\d{7,8})$/https:\/\/www.imdb.com\/title\/${1}\//;
$line[8] =~s/^(ch\d{7,8})$/https:\/\/www.imdb.com\/character\/${1}\//;
$line[8] =~s/^(co\d{7,8})$/https:\/\/www.imdb.com\/company\/${1}\//;
# Add link to Title
if ((! defined($query{'raw'})) && defined($line[8]) && ($line[8] =~ /(https?\:\/\/)(www\.)?(\S*?)(\/?)(\s*)$/)) {
my $url = '';
my $link = '';
my $spacing = '';
$url = $1 if defined($1);
$url .= $2 if defined($2);
$url .= $3 if defined($3);
$url .= $4 if defined($4);
$link .= $3 if defined($3);
$spacing = $5 if defined($5);
$line[8] =~ s/https?\:\/\/(www\.)?\S*?\/?\s*$/"" . break(${link}) . "<\/a>${spacing}"/ge;
$line[0] = "" . $line[0]. "<\/a>";
} elsif (! defined($query{'raw'})) {
# Create link to IMDB search for title
$line[0] = "" . $line[0]. "<\/a>";
}
# Add link to Release
if (! defined($query{'raw'})) {
if (defined($line[12]) && ($line[12] =~ s/(https?\:\/\/)(www\.)?(\S*?)(\/?)(\s*)$/"" . break($3) . "<\/a>$5"/ge)) {
$line[1] = "" . $line[1]. "<\/a>";
} elsif ($line[1]=~/criterion\s(\d+)/) {
$line[1] = "" . $line[1]. "<\/a>";
} elsif ($line[1]=~/Vinegar Syndrome\s([A-Z0-9\-]+ ?[A-Z]?[A-Z]?[A-Z]?[A-Z]?)(\s-)?/) {
my $sku = $1;
$sku=~s/ /+/g;
$line[1] = "" . $line[1]. "<\/a>";
} else {
$line[1] = "" . $line[1]. "<\/a>";
}
}
}
#my $w = ' width="25%"';
my $w = ' nowrap="nowrap"';
#my $w = ' style="width:25%"';
for (my $i = 0; $i < 12; $i ++) {
#if ($i >= 2) {
# #$w = ' nowrap="nowrap"';
# $w = '';
#}
if (($i != 10) || defined($query{'cost'})) {
$line .= defined($line[$i]) ? " <${td}${w}>$line[$i]${td_tag}>" : " <${td}>${td_tag}>" if ($query{'url'} || ($i != 8));
#$w = ' nowrap="nowrap"';
#$w = '';
}
}
}
$line .= " $limit)) {
my $remaining = scalar(@lines) - $cur_line;
print "\t \n";
last;
}
}
} elsif (defined($query{'raw'})) { # Print raw dataset
for (@lines) {
print;
}
} else { # Print in original order from file, in sections
my $jump = "... skipping ${remaining} entries [";
if ($limit) {
my $q = '&' . $ENV{'QUERY_STRING'};
$q =~ s/\§ion=.+\&/\&/;
$q =~ s/\§ion=.*$//;
$q =~ s/^\&/?/;
$jump .= "All]";
for (@sections) {
my $tag = $_;
$tag =~ s/[^a-zA-Z0-9_]//g;
$jump .= " -- $_";
}
} else {
$jump .= "Top]";
for (@sections) {
my $tag = $_;
$tag =~ s/[^a-zA-Z0-9_]//g;
$jump .= " -- $_";
}
}
$jump .= " -- [Search]";
$jump .= " -- [New Entry]";
$jump .= " ";
for (@lines) {
if (s/=====/$jump/) {
$cur_section++;
} else {
$cur_line++;
}
print;
if ($limit && ($cur_line > $limit)) {
my $remaining = scalar(@lines) - $cur_line - $sections + $cur_section;
print "\t \n";
last;
}
}
# print last segment summary
unless (defined($query{'section'})) {
$td_tag = 'td';
$td = $td_tag . " class=\"summary_row\"";
print "\t... skipping ${remaining} entries <${td} colspan=3>${items} (${items_dvd} DVD, ${items_cd} CD, ${items_bd} Blu-ray (${items_3d} 3D), ${items_uhd} UltraHD Blu-ray, ${items_hd} HD-DVD, ${items_ld} Laser Disc, ${items_vcd} VideoCD, ${items_vhs} VHS, ${items_dig} DigCopy)${td_tag}> ";
if ($times) {
$times = sprintf("%d day%s, %d:%02d (%d min.)", $times / 1440, (int($times / 1440) == 1) ? '' : 's', ($times / 60) % 24, $times % 60, $times);
print "<${td}>${times}${td_tag}> ";
} else {
print "<${td}> ";
}
$dollars = sprintf("%0.2f", $dollars);
print "<${td} colspan=4>${discs} (${discs_dvd} DVD, ${discs_cd} CD, ${discs_bd} Blu-ray (${discs_3d} 3D), ${discs_uhd} UltraHD Blu-ray, ${discs_hd} HD-DVD, ${discs_ld} Laser Disc, ${discs_vcd} VideoCD, ${discs_vhs} VHS, ${discs_dig} DigCopy)${td_tag}> <${td} colspan=1> " . (defined($query{'cost'}) ? "<${td}>\$${dollars} " : '') . "<${td} colspan=1> \n\t";
}
}
# Add last segment counts to totals
$total_discs_dvd += $discs_dvd;
$total_discs_cd += $discs_cd;
$total_discs_bd += $discs_bd;
$total_discs_3d += $discs_3d;
$total_discs_uhd += $discs_uhd;
$total_discs_hd += $discs_hd;
$total_discs_ld += $discs_ld;
$total_discs_vcd += $discs_vcd;
$total_discs_vhs += $discs_vhs;
$total_discs_dig += $discs_dig;
# print file summary
$td_tag = 'td';
$td = $td_tag . " class=\"total_row\"";
print " <${td} colspan=3>${total_items} (${total_items_dvd} DVD, ${total_items_cd} CD, ${total_items_bd} Blu-ray (${total_items_3d} 3D), ${total_items_uhd} UltraHD Blu-ray, ${total_items_hd} HD-DVD, ${total_items_ld} Laser Disc, ${total_items_vcd} VideoCD, ${total_items_vhs} VHS, ${total_items_dig} DigCopy)${td_tag}> ";
if ($total_times) {
$total_times = sprintf("%d day%s, %d:%02d (%d min.)", $total_times / 1440, (int($total_times / 1440) == 1) ? '' : 's', ($total_times / 60) % 24, $total_times % 60, $total_times);
print "<${td}>${total_times}${td_tag}> ";
} else {
print "<${td}> ";
}
$total_dollars = sprintf("%0.2f", $total_dollars);
print "<${td} colspan=4>${total_discs} (${total_discs_dvd} DVD, ${total_discs_cd} CD, ${total_discs_bd} Blu-ray (${total_discs_3d} 3D), ${total_discs_uhd} UltraHD Blu-ray, ${total_discs_hd} HD-DVD, ${total_discs_ld} Laser Disc, ${total_discs_vcd} VideoCD, ${total_discs_vhs} VHS, ${total_discs_dig} DigCopy)${td_tag}> <${td} colspan=1>${td_tag}> " . (defined($query{'cost'}) ? "<${td}>\$${total_dollars} " : '') . "<${td} colspan=1> \n";
print "
The running time of PAL encoded movies is often shortened due to the fact that the 24 fps film is encoded without frame rate adaption on the 25 fps video system (2:2 pulldown). The duration time for PAL states the assumed film length in square brackets after the video running time.
EXPL my $new_url_title_default = 'https://imdb.com/title//'; my $new_url_release_default = 'http://blu-ray.com/movies//'; my @new_fields = ( 'new_section', 'new_title', 'new_release', 'new_aspect_ratio', 'new_time', 'new_discs', 'new_std', 'new_lang', 'new_sub', 'new_url_title', 'new_date', 'new_cost', 'new_asin', 'new_url_release', 'new_timestamp', ); my %new_default = ( # 'new_time' => 'mmm or h:mm', 'new_url_title' => 'https://imdb.com/title//', 'new_url_release' => 'http://blu-ray.com/movies//', 'new_asin' => 'us/B000000000', ); foreach $name (@new_fields) { $new_default{$name} = '' unless defined($new_default{$name}); } my $now = time(); my ($sec, $min, $hour, $day, $month, $year, $wday, $yday, $isdst) = gmtime($now); $year += 1900; $month++; my $timestamp = sprintf("%04d%02d%02d%02d%02d%02d", $year, $month, $day, $hour, $min, $sec); $new_default{'new_timestamp'} = $timestamp; $new_default{'new_date'} = sprintf("%04d-%02d-%02d", $year, $month, $day); my %new_entry = (); my ($buffer, @pairs, $pair, $name, $value); $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/; if ($ENV{'REQUEST_METHOD'} eq "POST") { print "New entries: