#!/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; $title .= " Reverse" if (defined($query{'revsort'})); $title .= " Sorted by Col. $query{'sort'}" if (defined($query{'sort'})); # 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; my $multi = 0; for $iso (split /\//, $short) { my $addon = ''; $addon = $1 if ($iso=~s/( ?\(.*\))//); $lang = $lang{$iso}; $lang = ''.$iso.'' unless $lang ne ''; $lang .= $addon; if ($first) { $first = 0; } else { #$long .= ','; #$long .= ',
'; #$long .= ', '; $long .= '