#!/usr/bin/perl -w # dvdlist.pl, a perl CGI script to display a list of DVDs on a web page # Copyright (C) 2005 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 scara.com # # path to the DB file, if not in same directory as script my $dbpath = ''; # Format of the DB file: # - One line per movie # - Entries separated by Tabs: # - Title # - Release details (such as Distributor, Special Edition, etc.) # - Aspect Ratio(s) (1.33, 1.78, 1.37, 1.66, 1.85, 2.35 followed by 'a' if anamorphic widescreen or 'h' if HighDefinition 1080p, separated by '/') # - Running Time (H:MM or minutes) # - Number of Discs (followed by 'D' for DVD, 'C' for CD, 'B' for Blu-ray or 'H' for HD-DVD, optional) # - Standard/Region (N or P for NTSC or PAL, followed by list of regions, '?' if unknown, or '-' if copy) # - Language(s) (ISO 639-1 or ISO 639-3, separated by '/') # - Subtitle(s) (ISO 639-1 or ISO 639-3, separated by '/') # - Info URL # - date (ISO 8601 format, for sorting, e.g. aquisition date) # - cost (i.e. how much was spent to acquire this item) # back ground colors: my @bgcolor = ( '#F0F0F0', # dark line '#B0B0D0', # title line (blue-grey) '#E0FFE0', # section summary (lime green) '#D0E0D0'); # total summary (green-grey) my $isotable = 'iso-639-3_Latin1.tab'; my $isourl = 'http://scarabaeus.org/' . $isotable; #my $isourl = 'http://ftp.ics.uci.edu/pub/ietf/http/related/iso639.txt'; # allow flexible line break at occurrences of '/' sub break { my ($link) = @_; $link=~s/\//\//g if $link=~/[^\s]{10,}/; return $link; } # print HTTP header print "MIME-Version: 1.0\nContent-Type: text/html\n\n"; my $title = 'DVD List'; # get CGI parameter my %query = (); $query{'cpy'} = 1; $query{'file'} = 'dvd_list.txt'; my $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'} = $_; } } $dbfile = $query{'file'}; $dbfile=~s/^.*\///; $dbfile=~s/\/.*$//; $dbfile = $dbpath . $dbfile; # print HTML header print < ${title} END my %lang = {}; my $header = 1; if (open LANG, "<${isotable}") { while () { chomp; my @line = split "\t"; #print "ID:$line[0], 2B:$line[1], 2T:$line[2], 1:$line[3], Scope:$line[4], Type:$line[5], Name:$line[6], Comment:$line[7]
\n"; if ($header) { $header = 0; } else { $line[6] =~ s/\s*\(.*\)//; $lang{$line[3]} = $line[6] if $line[3] ne ''; $lang{$line[0]} = $line[6] if $line[0]=~/cmn/; # Mandarin $lang{$line[0]} = $line[6] if $line[0]=~/yue/; # Cantonese (Hong-Kong) } } close LANG; } $lang{'-'} = 'none'; sub expand_lang { my ($short) = @_; my $long = ''; my $lang; my $first = 1; for $iso (split /\//, $short) { $lang = $lang{$iso}; $lang = ''.$iso.'' unless $lang ne ''; if ($first) { $first = 0; } else { #$long .= ','; #$long .= ',
'; $long .= ', '; } $long .= $lang; } return $long; } my ( $items, $total_items, $items_dvd, $total_items_dvd, $items_cd, $total_items_cd, $items_bd, $total_items_bd, $items_hd, $total_items_hd, $discs, $total_discs, $discs_dvd, $total_discs_dvd, $discs_cd, $total_discs_cd, $discs_bd, $total_discs_bd, $discs_hd, $total_discs_hd, $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); my ($dollars, $total_dollars) = (0.00, 0.00); my @lines = (); my @sections = (); my $td = 'th valign="baseline" align="left"'; my $firstseg = 1; open LIST, "<${dbfile}" or die "list file '${dbfile}' not found!"; print "\n"; while () { chomp; 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 = 11; $i > 0; $i--) { $line[$i] = ($i < 4) ? '' : $line[$i - 3]; } } while ($#line < 11) { push @line, ''; } next if ((! defined($query{'all'})) && defined($line[5]) && ($line[5] =~ /-/)); my $line = "\t"; my $dollar = 0.00; my @key = (); if (defined($query{'sort'})) { @key = @line; $key[0] =~ s/^\s*a\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; $key[0] =~ s/[^\w\d\s]//; $key[1] =~ s/[^\w\d\s]//; $key[8] =~ s/(http\:\/\/)(www\.)?//; } unless (/^--/) { push @line, '' while ($#line < ($wide ? 9 : 7)); $line[0] =~s/^\*{3}\s+(.*)$/$1<\/b>/; if ($line[2] && $td!~/^th/) { $line[2] =~s/\//
/g; # break($line[2]); # 1.xx:1 $line[2] =~s/(\d+\.\d+)h/$1:1[16:9,1080p]<\/font>/ig; $line[2] =~s/(\d+\.\d+)a/$1:1[16:9]<\/font>/ig; $line[2] =~s/(\d+\.\d+)([^:\d])/$1:1[4:3]<\/font>$2/g; $line[2] =~s/(\d+\.\d+)$/$1:1[4:3]<\/font>/g; # 1:1.xx #$line[2] =~s/(\d+\.\d+)a/1:$1[16:9]<\/font>/ig; #$line[2] =~s/^(\d+\.\d+)/1:$1[4:3]<\/font>/g; #$line[2] =~s/([^:])(\d+\.\d+)/${1}1:$2[4:3]<\/font>/g; } $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]); $line[7] = expand_lang($line[7]); } else { # end of segment, print summary my $section = $line[0]; $section =~s/^--\s*(.*)\s*/$1/; push @sections, $section; $line[0] = "-- " . $section . ""; if (defined($query{'raw'})) { $td = ($td eq 'td') ? 'td' : "td bgcolor=\"$bgcolor[0]\""; } else { $td = "td bgcolor=\"$bgcolor[2]\""; # unless defined($query{'raw'}); } unless (defined($query{'sort'}) || defined($query{'raw'}) || $firstseg) { $line .= " <${td} colspan=3>${items} (${items_dvd} DVD, ${items_cd} CD, ${items_bd} Blu-ray, ${items_hd} HD-DVD) "; 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} "; } else { $line .= "<${td}> "; } $dollars = sprintf("%0.2f", $dollars); $line .= "<${td} colspan=4>${discs} (${discs_dvd} DVD, ${discs_cd} CD, ${discs_bd} Blu-ray, ${discs_hd} HD-DVD) <${td} colspan=1> <${td}>\$${dollars}
\n"; $line .= "\t\n\n\t"; } $total_discs_dvd += $discs_dvd; $total_discs_cd += $discs_cd; $total_discs_bd += $discs_bd; $total_discs_hd += $discs_hd; $items = 0; $items_dvd = 0; $items_cd = 0; $items_bd = 0; $items_hd = 0; $discs = 0; $discs_dvd = 0; $discs_cd = 0; $discs_bd = 0; $discs_hd = 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/\&sort=\d+//; $q =~ s/^\&//; for (my $i = 0; $i < 11; $i ++) { if (defined($query{'sort'}) && ($query{'sort'} == $i)) { $line[$i] = "$line[$i]"; } else { $line[$i] = "$line[$i]"; } } $line[6] .= "1"; $line[7] .= "1"; } else { # Disc type (DVD, Blu-ray, HD-DVD or CD) if (defined($line[4]) && ($line[4] ne '')) { my $first = 1; my $skip = 0; $skip = 1 if defined($query{'filter'}); $items ++; $total_items ++; if ($line[4] =~ /\D/) { # number(s) with qualifier(s) my $num = $line[4]; my $t, $n; $line[4] = ''; while ($num =~ /(\d+)(\D*)(.*)$/) { $line[4] .= ", " if ($line[4]); ($n, $t, $num) = ($1, $2, $3); if ($t =~ /^c/i) { $skip = 0 if (defined($query{'filter'}) && ($query{'filter'} =~ /c/i)); $t = 'CD'; $discs_cd += $n; $items_cd ++ if $first; $total_items_cd ++ if $first; } elsif ($t =~ /^b/i) { $skip = 0 if (defined($query{'filter'}) && ($query{'filter'} =~ /b/i)); $t = 'Blu-ray'; $discs_bd += $n; $items_bd ++ if $first; $total_items_bd ++ if $first; } elsif ($t =~ /^h/i) { $skip = 0 if (defined($query{'filter'}) && ($query{'filter'} =~ /h/i)); if ($t =~ /d/i) { $t = 'HD-DVD/DVD'; } else { $t = 'HD-DVD'; } $discs_hd += $n; $items_hd ++ if $first; $total_items_hd ++ if $first; } else { $skip = 0 if (defined($query{'filter'}) && ($query{'filter'} =~ /d/i)); $t = 'DVD'; $discs_dvd += $n; $items_dvd ++ if $first; $total_items_dvd ++ if $first; } $discs += $n; $total_discs += $n; $line[4] .= $n . ' ' . $t . (($n == 1) ? '' : 's'); $first = 0; } } else { # just a number, assume DVD $skip = 0 if (defined($query{'filter'}) && ($query{'filter'} =~ /d/i)); $discs += $line[4]; $discs_dvd += $line[4]; $items_dvd ++; $total_discs += $line[4]; $total_items_dvd ++; $line[4] .= ' DVD' . (($line[4] == 1) ? '' : 's'); } next if $skip; } else { next if (defined($query{'raw'})); } # Running time (2:2 pulldown adjustment) if ($line[3] =~/\d/) { my $time = defined($line[3]) ? $line[3] : 0; if ($time =~/(\d+)\:(\d+)/) { $time = $1 * 60 + $2; } $line[3] = sprintf("%d:%02d ", $time / 60, $time % 60); if ($line[5]=~/P/) { $line[3] .= sprintf("(%d[%d] min.)", $time, $time * 25 / 24); } else { $line[3] .= sprintf("(%d min.)", $time); } $key[3] = $time if defined($query{'sort'}); $times += $time; $total_times += $time; } # Cost (currency conversion) if (defined($line[10])) { if ($line[10] =~ /^E/) { $line[10] =~ s/^E//; $dollar = ($line[10] * 1.47); $line[10] =~ s/^/€/; $line[10] .= sprintf(" (~\$%0.2f)", $dollar); } elsif ($line[10] =~ /^P/) { $line[10] =~ s/^P//; $dollar = ($line[10] * 1.98); $line[10] =~ s/^/£/; $line[10] .= sprintf(" (~\$%0.2f)", $dollar); } elsif ($line[10]) { $dollar = ($line[10] * 1.00); $line[10] =~ s/^/\$/; } $dollars += $dollar; $total_dollars += $dollar; } } if ((! defined($query{'raw'})) && defined($line[8]) && ($line[8] =~ s/(http\:\/\/)(www\.)?(\S*?)(\/?)(\s*)$/"" . break($3) . "<\/a>$5"/ge)) { $line[0] = "" . $line[0]. "<\/a>"; } if ($line[0]=~/^--/) { next if defined($query{'raw'}); $td = "td bgcolor=\"$bgcolor[1]\""; $line .= " <${td}>$line[0] ====="; } else { my $w = ' nowrap'; for (my $i = 0; $i < 11; $i ++) { $line .= defined($line[$i]) ? " <${td}${w}>$line[$i]" : " <${td}>" if ($query{'url'} || ($i != 8)); $w = ''; } } $line .= " \n"; if (($td!~/^th/) && defined($query{'sort'})) { unless (/^--/ || /^\*\*\*/) { push @lines, $key[0] . "\t" . $key[$query{'sort'}] . $line; } } else { push @lines, $line; } $td = ($td eq 'td') ? "td bgcolor=\"$bgcolor[0]\"" : 'td'; } 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 <=> $b1) || (lc($a0) cmp lc($b0)); } if (defined($query{'sort'})) { my @sorted; if (($query{'sort'} == 3) || ($query{'sort'} == 4)) { @sorted = sort bykeysnum @lines; } else { @sorted = sort bykeys @lines; } $td = 'td'; for (@sorted) { s/^.*?\t.*?\t/\t/; $td = ($td eq 'td') ? "td bgcolor=\"$bgcolor[0]\"" : 'td'; s/td bgcolor=\"$bgcolor[0]\"/td/g; s/"; for (@lines) { s/=====/$jump/; print; } # print last segment summary $td = "td bgcolor=\"$bgcolor[2]\""; print "\t <${td} colspan=3>${items} (${items_dvd} DVD, ${items_cd} CD, ${items_bd} Blu-ray, ${items_hd} HD-DVD) "; 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} "; } else { print "<${td}> "; } $dollars = sprintf("%0.2f", $dollars); print "<${td} colspan=4>${discs} (${discs_dvd} DVD, ${discs_cd} CD, ${discs_bd} Blu-ray, ${discs_hd} HD-DVD) <${td} colspan=1> <${td}>\$${dollars} \n\t"; } # print file summary $td = "td bgcolor=\"$bgcolor[3]\""; print " <${td} colspan=3>${total_items} (${total_items_dvd} DVD, ${total_items_cd} CD, ${total_items_bd} Blu-ray, ${total_items_hd} HD-DVD) "; 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} "; } 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_hd} HD-DVD) <${td} colspan=1> <${td}>\$${total_dollars} \n"; print "
[Top]"; for (@sections) { $jump .= " -- $_"; } $jump .= " -- [Search]
\n"; unless (defined($query{'raw'})) { my $q = '&' . $ENV{'QUERY_STRING'}; $q =~ s/\&search=[^&]*//; $q =~ s/^\&//; print "

\n"; my $search = ''; $search = $query{'search'} if defined ($query{'search'}); print "\tSearch: \n"; for my $key (keys %query) { print "\t\n" unless ($key=~/^search$/); } print "

\n"; } print < Common film aspect ratios are 1.35:1 (Full Frame), 1.66:1 (European and Disney productions), 1.85:1 (Matted Wide Screen) and 2.35:1 (Cinemascope, Techniscope, Anamorphic Widescreen). A DVD can encode pictures either "normal" with a 4:3 aspect ratio, or anamorphic ("Enhanced for widescreen TVs") with a 16:9 aspect ratio. Video productions therefore usually have those aspect ratios, 1.33:1 and 1.78:1. Movies with 1.85:1 and 2.35:1 aspect ratios should be encoded as anamorphic video pictures, this increases the number of lines containing actual picture information. Movies shot on "Super 35" (e.g. "Pirates of the Caribbean") are intended to be shown at 2.35:1 or 1.85:1, but have enough image material above and below the frame to allow a "fullscreen" 1.33:1 release as well.

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 print "\n";