p5pRT
commented
25 years ago From lvirden@cas.org
----------------------------------------------------------------- I am getting a core dump today from perl. I'm uncertain what to send along. Right now\, my perl isn't compiled with -g - is there a way that I can recompile with -g without having to go thru all the Configure prompts?
$ gdb $(whence perl) core GDB is free software and you are welcome to distribute copies of it under certain conditions; type "show copying" to see the conditions. There is absolutely no warranty for GDB; type "show warranty" for details. GDB 4.16 (sparc-sun-solaris2.6)\, Copyright 1996 Free Software Foundation\, Inc...(no debugging symbols found)... Core was generated by `perl -w getdata.pl'. Program terminated with signal 11\, Segmentation fault. Reading symbols from /usr/lib/libsocket.so.1...(no debugging symbols found)... done. Reading symbols from /usr/lib/libnsl.so.1...(no debugging symbols found)... done. Reading symbols from /usr/lib/libdl.so.1...(no debugging symbols found)...done. Reading symbols from /usr/lib/libm.so.1...(no debugging symbols found)...done. Reading symbols from /usr/lib/libc.so.1...(no debugging symbols found)...done. Reading symbols from /usr/lib/libsec.so.1...(no debugging symbols found)... done. Reading symbols from /usr/lib/libmp.so.2...(no debugging symbols found)...done. Reading symbols from /usr/platform/SUNW\,Ultra-5_10/lib/libc_psr.so.1... (no debugging symbols found)...done. Reading symbols from /vol/lwv26ldatae/lib/perl5/5.006/sun4-solaris/auto/IO/IO.so...(no debugging symbols found)...done. Reading symbols from /vol/lwv26ldatae/lib/perl5/5.006/sun4-solaris/auto/Socket/Socket.so...(no debugging symbols found)...done. Reading symbols from /usr/lib/nss_nis.so.1...(no debugging symbols found)... done. #0 0x1397b0 in Perl_re_intuit_start () (gdb) where #0 0x1397b0 in Perl_re_intuit_start () #1 0x13b25c in Perl_regexec_flags () #2 0xb9608 in Perl_pp_subst () #3 0xaf938 in Perl_runops_debug () #4 0x2c67c in S_run_body () #5 0xf67b8 in Perl_vdefault_protect () #6 0xf6658 in Perl_default_protect () #7 0x2c068 in perl_run () #8 0x28054 in main () (gdb)
The script in question is:
#!/usr/bin/perl #****************************************************************************** # # Showtimes - Movie showtimes for the Palm Computing Platform # Copyright (C) 1999 J Robert Ray # # 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. # # --- # # $Source: /usr/local/src/CVS/showtimes/script/getdata.pl\,v $ # $Revision: 1.12 $ $Date: 1999/05/01 16:23:22 $ # Checked in by: $Author: robert $ # #******************************************************************************* use strict; use LWP::UserAgent; use Time::Local;
################################################################################# ## ## The configuration for this script has moved! ## ## Please refer to the file called getdata.cfg for all your customization needs ## #################################################################################
############################################################## ############### ################ ############### No user servicable parts below! ################ ############### ################ ##############################################################
my $Parser = "yahoo"; my @URLs = (); my $DestDir = "."; my $FlipReg = 0; my @UserNums = (); my $Proxy = ""; my $ProxyUsername = ""; my $ProxyPassword = ""; my $TheaterList = ""; my %TheaterIgnore = (); my $runtime = time (); my $ConfigPath = ".";
ParseParams ();
chdir ( $ConfigPath );
LoadConfig ();
if ( $FlipReg == 1 ) { $DestDir = "."; }
# # Do some sanity checking on the configuration # if ( !length ( $DestDir )) { errormsg ( "You have not set your DESTDIR in the configuration file. Please open the configuration file and follow the instructions therein to customize this script." );
pause (); exit 1; }
if ( ! -d $DestDir ) { errormsg ( "The path you have set DESTDIR to does not exist. It is possible you have not yet edited the configuration file to customize this script. Verify that the path is correct and try again." );
pause (); exit 1; }
if ( $#URLs == -1 ) { errormsg ( "You do not have any URLs configured in the configuration file. Please add a URL and try again." );
pause (); exit 1; }
if ( $TheaterList ne "" )
{
if ( open ( THEATERLIST\, "\<$TheaterList" ))
{
foreach my $line ( \
if ( $line =~ /^(.*\w)\s*ignore\s*$/i ) { $TheaterIgnore{ $1 } = 1; } elsif ( $line =~ /^(.*\w)\s*$/ ) { $TheaterIgnore{ $1 } = 0; } } close ( THEATERLIST ); } }
# # Set up the user agent object # my $ua = new LWP::UserAgent; $ua->agent ( 'Mozilla/5.0' );
# # See if we are using a proxy # Proxy support adapted from code by Xev Glitter (Xev.Glitter@gs.com) # if ( $Proxy ne "" ) { $ua->proxy ( ['http']\, $Proxy ); }
my $nURL = 0; my $nDate = 0; my $nTheater = 0; my $nMovie = 0; my $nShowtime = 0; my $nTimeString = 0;
my %hDates = (); my %hTempDates = (); my %hTheaters = (); my %hTempTheaters = (); my %hMovies = (); my %hTempMovies = (); my %hShowtimes = (); my %hTempShowtimes = (); my %hTimeStrings = (); my %hTempTimeStrings = ();
print "\n\n";
foreach my $URL ( @URLs ) { $nURL++;
# # Decide which parser to use # if ( $URL =~ /au\..*yahoo/ ) { $Parser = "au.yahoo"; } elsif ( $URL =~ /yahoo/ ) { $Parser = "yahoo"; } elsif ( $URL =~ /scoot/ ) { $Parser = "scoot"; } elsif ( $URL =~ /allocine/ ) { $Parser = "allocine"; }
print "Grabbing URL $nURL of " . ( $#URLs + 1 ) . " from $Parser..."; my $content = grabpage ($URL); print "Done!\n\n";
if ( $Parser eq "yahoo" ) { YahooParse ( $content ); } elsif ( $Parser eq "scoot" ) { ScootParse ( $content ); } elsif ( $Parser eq 'au.yahoo' ) { auYahooParse ($content \, $URL); } elsif ( $Parser eq 'allocine' ) { AlloCineParse ( $content \, $URL ); } else { errormsg ( "Unknown parser. How did this happen?" ); pause (); exit 1; } }
# # Write out the date database # if ( open ( PDB\, ">$DestDir/ST_Dates.pdb" )) { binmode ( PDB ); WritePDBHeader ( "ST_Dates"\, scalar keys %hDates ); WriteDatePDB (); close ( PDB ); } else { errormsg ( "Cannot open '$DestDir/ST_Dates.pdb' for writing.\nError message: ($!)" ); pause (); exit 1; }
# # Write out the theater database # if ( open ( PDB\, ">$DestDir/ST_Thtrs.pdb" )) { binmode ( PDB ); WritePDBHeader ( "ST_Theaters"\, scalar keys %hTheaters ); WriteTheaterPDB (); close ( PDB ); } else { errormsg ( "Cannot open '$DestDir/ST_Thtrs.pdb' for writing.\nError message: ($!)" ); pause (); exit 1; }
# # Write out the movie database # if ( open ( PDB\, ">$DestDir/ST_Mvies.pdb" )) { binmode ( PDB ); WritePDBHeader ( "ST_Movies"\, scalar keys %hMovies ); WriteMoviePDB (); close ( PDB ); } else { errormsg ( "Cannot open '$DestDir/ST_Mvies.pdb' for writing.\nError message: ($!)" ); pause (); exit 1; }
# # Write out the string database # if ( open ( PDB\, ">$DestDir/ST_Strgs.pdb" )) { binmode ( PDB ); WritePDBHeader ( "ST_Strings"\, scalar keys %hTimeStrings ); WriteStringPDB (); close ( PDB ); } else { errormsg ( "Cannot open '$DestDir/ST_Strgs.pdb' for writing.\nError message: ($!)" ); pause (); exit 1; }
# # Translate the showtime ID's # foreach my $showtime ( keys %hShowtimes ) { $hShowtimes{ $showtime }{ "MID" } = $hMovies{ $hShowtimes{ $showtime }{ "MID" }}{ "Index" }; $hShowtimes{ $showtime }{ "TID" } = $hTheaters{ $hShowtimes{ $showtime }{ "TID" }}{ "Index" }; $hShowtimes{ $showtime }{ "DID" } = $hDates{ $hShowtimes{ $showtime }{ "DID" }}{ "Index" }; }
# # Write out the showtime database # if ( open ( PDB\, ">$DestDir/ST_Times.pdb" )) { binmode ( PDB ); WritePDBHeader ( "ST_Times"\, scalar keys %hShowtimes ); WriteShowtimePDB (); close ( PDB ); } else { errormsg ( "Cannot open '$DestDir/ST_Times.pdb' for writing.\nError message: ($!)" ); pause (); exit 1; }
if ( $FlipReg ) { print "\nInstalling data files.\n\n"; foreach my $UserNum ( @UserNums ) { system ( "FlipReg2.exe \"$UserNum\"" ); } }
# # Write out the theater file\, if the user requests one # if ( $TheaterList ne "" ) { if ( open ( THEATERLIST\, ">$TheaterList" )) { foreach my $theater ( sort keys %TheaterIgnore ) { print THEATERLIST "$theater"; if ( $TheaterIgnore{ $theater }) { printspaces ( 50 - length ( $theater ) - 1 ); print THEATERLIST "ignore"; } print THEATERLIST "\n"; } close ( THEATERLIST ); } else { errormsg ( "Unable to create THEATERLIST file '$TheaterList' for writing!\nError message: ($!)" ); pause (); } }
print "\n\nScript Complete.\n\n";
#####################
# #
# subroutines below #
# #
#####################
sub LoadConfig
{
# Try to open the config file
unless ( open ( CONFIG\, "getdata.cfg" ))
{
errormsg ( "Unable to open the configuration file\, $ConfigPath/getdata.cfg. The script looks in the current directory for this file\, unless you specify a path with the command line option -d." );
pause ();
exit 1; }
foreach my $line ( \
chomp $line;
( my $key\, my $value ) = split ( /\s+/\, $line\, 2 );
SWITCH: { $key eq "URL" && do { push ( @URLs\, $value ); last SWITCH; }; $key eq "DESTDIR" && do { $DestDir = $value; last SWITCH; }; $key eq "FLIPREG" && do { $FlipReg = $value; last SWITCH; }; $key eq "USERNUM" && do { push ( @UserNums\, $value ); last SWITCH; }; $key eq "PROXY" && do { $Proxy = $value; last SWITCH; }; $key eq "PROXYUSERNAME" && do { $ProxyUsername = $value; last SWITCH; }; $key eq "PROXYPASSWORD" && do { $ProxyPassword = $value; last SWITCH; }; $key eq "THEATERLIST" && do { $TheaterList = $value; last SWITCH; }; } }
close ( CONFIG ); }
# # Get the web page #
sub grabpage {
my ($URL) = @_;
my $request = new HTTP::Request ( 'GET'\, $URL );
# # Set the proxy authentication stuff if need be # if (( $ProxyUsername ne "" ) && ( $ProxyPassword ne "" )) { $request->proxy_authorization_basic ( $ProxyUsername\, $ProxyPassword ); }
my $response = $ua->request ( $request );
my $content;
if ( $response->is_success )
{
$content = $response->content;
return $content;
}
else
{
my $errmsg = "Error retreiving web page!\nMake sure you are connected to the internet and that the \$URL variable contains a valid URL.";
if ( $Proxy ne "" )
{
$errmsg .= " Also make sure that your proxy settings are correct.";
}
else
{
$errmsg .= " If you are behind a firewall or are using a proxy\, please configure the proxy settings.";
}
print "\n\n\n";
errormsg ( $errmsg );
print "\n\nLWP returned:\n\n";
print $response->status_line;
pause ();
exit 1;
}
}
sub WritePDBHeader { my $DBName = $_[0]; my $nRecords = $_[1];
print "Writing pdb $DBName with $nRecords records.\n";
my $attributes = 0x8000; my $version = 1; if ( $Parser eq "scoot" ) { $version = 2; } elsif ( $Parser eq "allocine" ) { $version = 3; } elsif ( $Parser eq "au.yahoo" ) { $version = 4; }
my $now = time (); # # If we are running on a system where the epoch is 1 Jan\, 1970\, # add 2082844800 seconds to the result. (The number of seconds # between 1 Jan\, 1904 and 1 Jan\, 1970. # if ( timegm ( 0\, 0\, 0\, 1\, 0\, 1970 ) == 0 ) { $now += 2082844800; }
my $creationdate = $now;
my $modificationdate = $now;
my $lastbackupdate = $now;
my $modificationnumber = 1;
my $appinfoid = 0;
my $sortinfoid = 0;
my $uniqueidseed = 0;
my $nextrecordlistid = 0;
# Write out the main header
syswrite ( PDB\,
pack ( "a32nnNNNNNNa4a4NNn"\,
$DBName\,
$attributes\,
$version\,
$creationdate\,
$modificationdate\,
$lastbackupdate\,
$modificationnumber\,
$appinfoid\,
$sortinfoid\,
"Data"\,
"OCMv"\,
$uniqueidseed\,
$nextrecordlistid\,
$nRecords
)\,
78 );
}
sub WriteDatePDB { my $nOffset = 80 + 8 * scalar keys %hDates;
# Write out the headers my $index = 0; foreach my $date ( sort{ $hDates{ $a }{ "Date" } \<=> $hDates{ $b }{ "Date" }} keys %hDates ) { # Remember what order we wrote them out in $hDates{ $date }{ "Index" } = $index;
syswrite ( PDB\, pack ( "N"\, $nOffset )\, 4 ); # Offset syswrite ( PDB\, pack ( "x" )\, 1 ); # Attributes
syswrite ( PDB\, pack ( "xxx" )\, 3 ); # Unique ID\, leave zero
$nOffset += GetDateSize ( $date ); $index++; }
# Pad two bytes syswrite ( PDB\, pack ( "xx" )\, 2 );
# Write out the data foreach my $date ( sort{ $hDates{ $a }{ "Date" } \<=> $hDates{ $b }{ "Date" }} keys %hDates ) { # Write the date syswrite ( PDB\, pack ( "N"\, $hDates{ $date }{ "Date" })\, 4 ); } }
sub GetDateSize { my $key = $_[0];
my $size = 4; # one int
return $size; }
sub WriteTheaterPDB { my $nOffset = 80 + 8 * scalar keys %hTheaters;
# Write out the headers my $index = 0; foreach my $theater ( sort{ uc ( $hTheaters{ $a }{ "Name" }) cmp uc ( $hTheaters{ $b }{ "Name" })} keys %hTheaters ) { # Remember what order we wrote them out in $hTheaters{ $theater }{ "Index" } = $index;
syswrite ( PDB\, pack ( "N"\, $nOffset )\, 4 ); # Offset syswrite ( PDB\, pack ( "x" )\, 1 ); # Attributes
syswrite ( PDB\, pack ( "xxx" )\, 3 ); # Unique ID\, leave zero
$nOffset += GetTheaterSize ( $theater ); $index++; }
# Pad two bytes syswrite ( PDB\, pack ( "xx" )\, 2 );
# Write out the data
foreach my $theater ( sort{ uc ( $hTheaters{ $a }{ "Name" }) cmp uc ( $hTheaters{ $b }{ "Name" })} keys %hTheaters )
{
# Write the offset to the info
syswrite ( PDB\, pack ( "n"\, length ( $hTheaters{ $theater }{ "Name" }) + 1 )\, 2 );
# Write the name
syswritestr ( $hTheaters{ $theater }{ "Name" });
# Write the info syswritestr ( $hTheaters{ $theater }{ "Info" }); } }
sub GetTheaterSize { my $key = $_[0];
my $size = 4; # Two strings\, two nulls\, one offset $size += length ( $hTheaters{ $key }{ "Name" }); $size += length ( $hTheaters{ $key }{ "Info" });
return $size; }
sub WriteMoviePDB
{
my $nOffset = 80 + 8 * scalar keys %hMovies;
# Write out the headers
my $index = 0;
foreach my $movie ( sort{ uc ( $hMovies{ $a }{ "Name" }) cmp uc ( $hMovies{ $b }{ "Name" })} keys %hMovies )
{
# Remember what order we wrote them out in
$hMovies{ $movie }{ "Index" } = $index;
syswrite ( PDB\, pack ( "N"\, $nOffset )\, 4 ); # Offset syswrite ( PDB\, pack ( "x" )\, 1 ); # Attributes
syswrite ( PDB\, pack ( "xxx" )\, 3 ); # Unique ID\, leave zero
$nOffset += GetMovieSize ( $movie ); $index++; }
# Pad two bytes syswrite ( PDB\, pack ( "xx" )\, 2 );
# Write out the data
foreach my $movie ( sort{ uc ( $hMovies{ $a }{ "Name" }) cmp uc ( $hMovies{ $b }{ "Name" })} keys %hMovies )
{
# Write the offset to the info
my $ratingoffset = length ( $hMovies{ $movie }{ "Name" }) + 1;
my $lengthoffset = $ratingoffset + 1;
if ( defined( $hMovies{ $movie }{ "Rating" }))
{
$lengthoffset = $ratingoffset + length ( $hMovies{ $movie }{ "Rating" }) + 1;
}
syswrite ( PDB\, pack ( "nn"\, $ratingoffset\, $lengthoffset )\, 4 );
# Write the name
syswritestr ( $hMovies{ $movie }{ "Name" });
# Write the rating\, if it exists
if ( defined( $hMovies{ $movie }{ "Rating" }))
{
syswritestr( $hMovies{ $movie }{ "Rating" });
}
else
{
# write out a NULL
syswrite ( PDB\, pack ( "x" )\, 1 );
}
# Write out the length\, if it exists
if ( defined( $hMovies{ $movie }{ "Length" }))
{
syswritestr( $hMovies{ $movie }{ "Length" });
}
else
{
# write out a NULL
syswrite ( PDB\, pack ( "x" )\, 1 );
}
}
}
sub GetMovieSize { my $key = $_[0];
my $size = 7; # Three strings\, three nulls\, two offsets if ( defined( $hMovies{ $key }{ "Name" })) { $size += length ( $hMovies{ $key }{ "Name" }); } if ( defined( $hMovies{ $key }{ "Rating" })) { $size += length ( $hMovies{ $key }{ "Rating" }); } if ( defined( $hMovies{ $key }{ "Length" })) { $size += length ( $hMovies{ $key }{ "Length" }); }
return $size; }
sub WriteShowtimePDB
{
my $nOffset = 80 + 8 * scalar keys %hShowtimes;
# Write out the headers
my $index = 0;
foreach my $showtime ( sort{
$hShowtimes{ $a }{ "MID" } \<=> $hShowtimes{ $b }{ "MID" } ||
$hShowtimes{ $a }{ "TID" } \<=> $hShowtimes{ $b }{ "TID" } ||
$hShowtimes{ $a }{ "DID" } \<=> $hShowtimes{ $b }{ "DID" }
} keys %hShowtimes )
{
syswrite ( PDB\, pack ( "N"\, $nOffset )\, 4 ); # Offset
syswrite ( PDB\, pack ( "x" )\, 1 ); # Attributes
syswrite ( PDB\, pack ( "xxx" )\, 3 ); # Unique ID\, leave zero
$nOffset += GetShowtimeSize ( $showtime ); $index++; }
# Pad two bytes syswrite ( PDB\, pack ( "xx" )\, 2 );
# Write out the data foreach my $showtime ( sort{ $hShowtimes{ $a }{ "MID" } \<=> $hShowtimes{ $b }{ "MID" } || $hShowtimes{ $a }{ "TID" } \<=> $hShowtimes{ $b }{ "TID" } || $hShowtimes{ $a }{ "DID" } \<=> $hShowtimes{ $b }{ "DID" } } keys %hShowtimes ) { # Write the MID\, TID\, DID\, SID syswrite ( PDB\, pack ( "nnnn"\, $hShowtimes{ $showtime }{ "MID" }\, $hShowtimes{ $showtime }{ "TID" }\, $hShowtimes{ $showtime }{ "DID" }\, $hShowtimes{ $showtime }{ "SID" })\, 8 ); } }
sub GetShowtimeSize { my $key = $_[0];
my $size = 8; # four shorts
return $size; }
sub WriteStringPDB
{
my $nOffset = 80 + 8 * scalar keys %hTimeStrings;
# Write out the headers
my $index = 0;
foreach my $string ( sort{ $a \<=> $b } keys %hTimeStrings )
{
syswrite ( PDB\, pack ( "N"\, $nOffset )\, 4 ); # Offset
syswrite ( PDB\, pack ( "x" )\, 1 ); # Attributes
syswrite ( PDB\, pack ( "xxx" )\, 3 ); # Unique ID\, leave zero
$nOffset += GetStringSize ( $string ); $index++; }
# Pad two bytes syswrite ( PDB\, pack ( "xx" )\, 2 );
# Write out the data foreach my $string ( sort{ $a \<=> $b } keys %hTimeStrings ) { # Write the string syswritestr ( $hTimeStrings{ $string }{ "String" }); } }
sub GetStringSize { my $key = $_[0];
my $size = 1; # one string\, one null if ( defined( $hTimeStrings{ $key }{ "String" })) { $size += length ( $hTimeStrings{ $key }{ "String" }); }
return $size; }
sub syswritestr { syswrite ( PDB\, $_[0]\, length ( $_[0] )); syswrite ( PDB\, pack ( "x" )\, 1 ); }
sub errormsg { printmsg( "GETDATA.PL ERROR:"\, $_[0] ); }
sub printmsg { #Print a message\, with the given line leader\, and word wrap the message #so that each line of the message doesn't exceed 80 columns.
print "$_[0]\n"; print "$_[0]\n"; print "$_[0]\n"; print "$_[0]"; my $totlen = length( $_[0] ); my @themsg = split( /\s/\, $_[1] ); foreach my $token ( @themsg ) { $totlen += length( $token ) + 1; if ( $totlen \< 80 ) { print " $token"; } else { $totlen = length( $_[0] ) + 1 + length( $token ) + 1; print "\n$_[0] $token"; } } print "\n$_[0]\n"; print "$_[0]\n"; print "$_[0]\n"; }
sub pause
{
print "\n\nPress return to continue...";
my $bogus = \
sub ucwords { my $result=lc shift; $result =~ s/^(\w)/uc($1)/e; $result =~ s/([ .\,;:+!\"-\(]+)(\w)/$1.uc($2)/ge; return $result; }
sub AlloCineParse { my $content = $_[0];
# Translate linefeeds $content =~ s/\015/\012/gm;
# Remove blank lines
$content =~ s|^\s*\012||gm;
# Figure out day offsets
my @now = localtime ();
my $DOW = $now[6];
my %dayoffsets = ();
my $daynum = 0;
foreach my $day ( 'Dim'\, 'Lun'\, 'Mar'\, 'Mer'\, 'Jeu'\, 'Ven'\, 'Sam' )
{
$dayoffsets{ $day } = $daynum - $DOW;
if ( $dayoffsets{ $day } \< 0 && !( $daynum \< $DOW && $daynum >= 3 ))
{
$dayoffsets{ $day } += 7;
}
$daynum++; }
my $mode = ""; foreach my $line ( split /\012/\, $content ) { if ( $line =~ /^\[(.+)\]$/ ) { $mode = $1; next; }
if ( $mode eq "SALLES" ) { my ( $TID\, $theatername\, $address\, $zip\, $city ) = split ( /\,/\, $line );
#translate ~'s into \,'s $theatername =~ s/~/\,/g; $address =~ s/~/\,/g;
next if ( IgnoringTheater ( $theatername ));
my $theaterinfo = sprintf ( "%s\, %s\, %s"\, $address\, $zip\, $city );
$hTheaters{ $TID }{ "Name" } = $theatername; $hTheaters{ $TID }{ "Info" } = $theaterinfo; } elsif ( $mode eq "SEANCES" ) { if ( $line =~ /^(\w+)\s*\,\s*(\w+)\s*\,\s*(.+)\s\,(\d)$/ ) { my $MID = $1; my $TID = $2; my $times = $3; my $lang = $4;
next if ( !exists ( $hTheaters{ $TID }));
my %daytimes = ();
my $lastcnk = "time"; my @incdays = ( 'Dim'\, 'Lun'\, 'Mar'\, 'Mer'\, 'Jeu'\, 'Ven'\, 'Sam' ); my @excdays = (); my @times = (); foreach my $cnk ( split ( /[\,\s]+/\, $times )) { if ( $cnk =~ /(Dim)|(Lun)|(Mar)|(Mer)|(Jeu)|(Ven)|(Sam)/i ) { if ( $lastcnk eq "time" ) { filltimes ( \%daytimes\, \@incdays\, \@excdays\, \@times );
@incdays = $cnk;
$lastcnk = "dow"; } elsif ( $lastcnk eq "sauf" ) { push @excdays\, $cnk; } else { push @incdays\, $cnk; $lastcnk = "dow"; } } elsif ( $cnk eq "sauf" ) { $lastcnk = "sauf"; } elsif ( $cnk =~ /^\d+/ ) { if ( $lastcnk eq "sauf" ) { filltimes ( \%daytimes\, \@incdays\, \@excdays\, \@times ); }
push @times\, $cnk; $lastcnk = "time"; } elsif ( $cnk eq "sup." ) { filltimes ( \%daytimes\, \@incdays\, \@excdays\, \@times );
$lastcnk = "time"; } }
filltimes ( \%daytimes\, \@incdays\, \@excdays\, \@times );
foreach my $day ( keys %daytimes )
{
# Ignore past data
if ( $dayoffsets{ $day } >= 0 )
{
# Add the day\, if need be\, and correct our local time into gm time.
my @gmtimebits = gmtime ();
my $time = timegm ( 0\, 0\, 0\, $gmtimebits[3]\, $gmtimebits[4]\, $gmtimebits[5]);
$time += $dayoffsets{ $day } * ( 60*60*24 );
# If we are running on a Mac\, we need to fudge the time and
# the following value will not be zero
my $timefudge = timegm ( 0\, 0\, 0\, 1\, 0\, 1970 );
$time -= $timefudge;
my $DID = -1;
if ( !exists ( $hTempDates{ $time })) {
$DID = $nDate++;
$hDates{ $DID }{ "Date" } = $time;
$hTempDates{ $time }{ "ID" } = $DID;
}
else {
$DID = $hTempDates{ $time }{ "ID" };
}
my $finalstr = $daytimes{ $day };
if ( $lang == 1 )
{
$finalstr .= " (VO)";
}
elsif ( $lang == 2 )
{
$finalstr .= " (VF)";
}
$daytimes{ $day } = $finalstr;
# Check that this ID combo hasn't been stored already
my $IDID = "_${MID}_${TID}_${DID}_";
if ( !exists ( $hTempShowtimes{ $IDID }))
{
$hTempShowtimes{ $IDID } = 1;
my $SID = -1;
if ( !exists ( $hTempTimeStrings{ $daytimes{ $day }}))
{
$SID = $nTimeString++;
$hTimeStrings{ $SID }{ "String" } = $daytimes{ $day };
$hTempTimeStrings{ $daytimes{ $day } }{ "ID" } = $SID;
}
else
{
$SID = $hTempTimeStrings{ $daytimes{ $day } }{ "ID" };
}
$hShowtimes{ $nShowtime }{ "MID" } = $MID;
$hShowtimes{ $nShowtime }{ "TID" } = $TID;
$hShowtimes{ $nShowtime }{ "DID" } = $DID;
$hShowtimes{ $nShowtime }{ "SID" } = $SID;
$nShowtime++;
}
}
}
}
}
elsif ( $mode eq "FILMS" )
{
#lop off garbage at end of line
$line =~ s/\s*$//;
my ( $MID\, $director\, $title\, $category\, $weight\, $actor1\, $actor2\, $actor3\, $origtitle ) = split ( /\s*\,\s*/\, $line );
#translate ~'s into \,'s $title =~ s/~/\,/g; $origtitle =~ s/~/\,/g;
# Make sure there is showtime data for this movie foreach my $IDID ( keys %hTempShowtimes ) { my @bits = split ( /_/\, $IDID ); if ( $bits[1] eq $MID ) { my $moviename = $title; if ( $origtitle ne "" ) { $moviename .= " ($origtitle)"; }
$hMovies{ $MID }{ "Name" } = $moviename; if ( $category eq "AV" ) { $hMovies{ $MID }{ "Length" } = "Aventure"; } elsif ( $category eq "CD" ) { $hMovies{ $MID }{ "Length" } = "Comedie dramatique"; } elsif ( $category eq "CE" ) { $hMovies{ $MID }{ "Length" } = "Comedie erotique"; } elsif ( $category eq "CM" ) { $hMovies{ $MID }{ "Length" } = "Court metrage"; } elsif ( $category eq "CO" ) { $hMovies{ $MID }{ "Length" } = "Comedie"; } elsif ( $category eq "DA" ) { $hMovies{ $MID }{ "Length" } = "Dessin anime"; } elsif ( $category eq "DO" ) { $hMovies{ $MID }{ "Length" } = "Documentaire"; } elsif ( $category eq "DR" ) { $hMovies{ $MID }{ "Length" } = "Drame"; } elsif ( $category eq "EH" ) { $hMovies{ $MID }{ "Length" } = "Epouvante horreur"; } elsif ( $category eq "ER" ) { $hMovies{ $MID }{ "Length" } = "Erotique"; } elsif ( $category eq "FE" ) { $hMovies{ $MID }{ "Length" } = "Festival"; } elsif ( $category eq "FF" ) { $hMovies{ $MID }{ "Length" } = "Film fantastique"; } elsif ( $category eq "FM" ) { $hMovies{ $MID }{ "Length" } = "Film musical"; } elsif ( $category eq "GU" ) { $hMovies{ $MID }{ "Length" } = "Film de guerre"; } elsif ( $category eq "HI" ) { $hMovies{ $MID }{ "Length" } = "Film historique"; } elsif ( $category eq "KA" ) { $hMovies{ $MID }{ "Length" } = "Karate"; } elsif ( $category eq "NR" ) { $hMovies{ $MID }{ "Length" } = "Non reference"; } elsif ( $category eq "PO" ) { $hMovies{ $MID }{ "Length" } = "Policier"; } elsif ( $category eq "WE" ) { $hMovies{ $MID }{ "Length" } = "Western"; } elsif ( $category eq "ZZ" ) { $hMovies{ $MID }{ "Length" } = "Divers"; }
last; } } } } }
#### auYahooParse contributed by Duncan Sargeant # #
# " (to balance my colouriser :-)
sub auYahooParse { my %days = ( 'sunday' => 0\, 'monday' => 1\, 'tuesday' => 2\, 'wednesday' => 3\, 'thursday' => 4\, 'friday' => 5\, 'saturday' => 6\, 'sunday' => 7 );
my ($content\, $URL) = @_;
# Figure out day offsets
my @now = localtime ();
my $DOW = $now[6];
# Make sure this is a valid page
if ( $content =~ /Nope\, sorry\, nothing/ ) {
print "This page was unavailable!\n\n";
return;
}
# $content is the list of cinemas in the selected area. $content =~ /(^.*\
# Lop off the first chunk\, cause it isn't really a theater shift @theaters;
foreach (@theaters) {
next unless (/^\(.*)\<\/a>/);
my $dir = $1;
my $theatername = $2;
if (IgnoringTheater ($theatername)) {
next;
}
print " Getting theater $theatername...\n";
my $foundtoday = 0; foreach my $day ('thursday'\, 'friday'\, 'saturday'\, 'sunday'\, 'monday'\, 'tuesday'\, 'wednesday') {
$foundtoday = 1 if ( $days { $day } == $DOW ); next unless $foundtoday;
print " Getting day $day...\n";
$content = grabpage ("$URL/$dir/$day.html"); ## theatername is mentioned twice - remove first instance. next unless $content =~ s/^.*$theatername.*$//m; ## second instance gives us the date. next unless $content =~ /^.*$theatername(.*)$/m; my $datestr = $1; $datestr =~ s/\<[^>]*>//g; $datestr =~ s/\ \;/ /g; my ($foo\, $date\, $monthstr\, $year) = split (/\s/\, $datestr); my $month = 0; foreach ('january'\, 'february'\, 'march'\, 'april'\, 'may'\, 'june'\, 'july'\, 'august'\, 'october'\, 'november'\, 'december') { if ($monthstr =~ /$_/i) { last; } $month++; }
# I think is has been fixed -jrray # # ## don't ask me why\, but ... -dunc # #$date++;
my $time = timegm ( 0\, 0\, 0\, $date\, $month\, $year );
# If we are running on a Mac\, we need to fudge the time and # the following value will not be zero my $timefudge = timegm ( 0\, 0\, 0\, 1\, 0\, 1970 ); $time -= $timefudge;
my $DID = -1;
if ( !exists ( $hTempDates{ $time })) {
$DID = $nDate++;
$hDates{ $DID }{ "Date" } = $time;
$hTempDates{ $time }{ "ID" } = $DID;
}
else {
$DID = $hTempDates{ $time }{ "ID" };
}
$content =~ />([^>][^>][^>]+)\n/s; my $theaterinfo = $1;
my $TID = -1; if (not exists $hTempTheaters{$theatername}) { $TID = $nTheater++; $hTheaters{ $TID }{ "Name" } = $theatername; $hTempTheaters{ $theatername }{ "ID" } = $TID; $hTheaters{ $TID }{ "Info" } = $theaterinfo; } else { $TID = $hTempTheaters{ $theatername }{ "ID" }; }
my @movies = split (/\
foreach my $movie ( @movies ) { # Remove the HTML from $movie $movie =~ s/\<[^>]*>//gs; $movie =~ s/ //gs;
my ($moviename\, $showtimes) = split (/ - /\, $movie);
my $MID = -1; if ( !exists ( $hTempMovies{ $moviename })) { $MID = $nMovie++; $hMovies{ $MID }{ "Name" } = $moviename; $hTempMovies{ $moviename }{ "ID" } = $MID; } else { $MID = $hTempMovies{ $moviename }{ "ID" }; }
# Check that this ID combo hasn't been stored already
my $IDID = "_${MID}_${TID}_${DID}_";
if ( !exists ( $hTempShowtimes{ $IDID })) {
$hTempShowtimes{ $IDID } = 1;
chomp $showtimes;
my $SID = -1;
if ( !exists ( $hTempTimeStrings{ $showtimes })) {
$SID = $nTimeString++;
$hTimeStrings{ $SID }{ "String" } = $showtimes;
$hTempTimeStrings{ $showtimes }{ "ID" } = $SID;
}
else {
$SID = $hTempTimeStrings{ $showtimes }{ "ID" };
}
$hShowtimes{ $nShowtime }{ "MID" } = $MID;
$hShowtimes{ $nShowtime }{ "TID" } = $TID;
$hShowtimes{ $nShowtime }{ "DID" } = $DID;
$hShowtimes{ $nShowtime }{ "SID" } = $SID;
$nShowtime++;
}
}
}
}
}
# # #### auYahooParse contributed by Duncan Sargeant
sub YahooParse { my %months = ( 'January' => 0\, 'February' => 1\, 'March' => 2\, 'April' => 3\, 'May' => 4\, 'June' => 5\, 'July' => 6\, 'August' => 7\, 'September' => 8\, 'October' => 9\, 'November' => 10\, 'December' => 11 );
my $content = $_[0];
#
# Make sure this is a valid page
#
if ( $content =~ /Nope\, sorry\, nothing/ )
{
print "This page was unavailable!\n\n";
next;
}
#
# Do some inital cleanup on the whole enchilada
#
# Translate linefeeds
$content =~ s/\015/\012/gm;
# Translate metaspaces into newlines
$content =~ s/ /\012/gs;
# Remove blank lines
$content =~ s|^\s*\012||gm;
# Lop off everything [Legend
$content =~ s/\Legend\<\/b>.*//s;
#
# Divide the HTML up by the theater token
#
my @theaters = split ( "\<!-- theater -->"\, $content );
#
# Lop off the first chunk\, cause it isn't really a theater
#
my $header = shift @theaters;
#
# Find the date in the first chunk
#
my $datestr;
my $time;
if ( $header =~ /(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)(\w*)\s(\d\d)\,\s(\d\d\d\d)/s )
{
my $monthstr = $1 . $2;
my $day = $3;
my $year = $4;
my $month=$months{$monthstr};
$time = timegm ( 0\, 0\, 0\, $day\, $month\, $year );
# If we are running on a Mac\, we need to fudge the time and # the following value will not be zero my $timefudge = timegm ( 0\, 0\, 0\, 1\, 0\, 1970 ); $time -= $timefudge; }
my $DID = -1;
if ( !exists ( $hTempDates{ $time }))
{
$DID = $nDate++;
$hDates{ $DID }{ "Date" } = $time;
$hTempDates{ $time }{ "ID" } = $DID;
}
else
{
$DID = $hTempDates{ $time }{ "ID" };
}
foreach my $theater ( @theaters )
{
( my $theaterinfo\, my @movies ) = split ( /\<!-- [RL]HS movie -->/\, $theater );
# Remove the HTML from theaterinfo
$theaterinfo =~ s/\<.*?>//gs;
# Remove "Map It"
$theaterinfo =~ s/Map It//g;
# Remove blank lines
$theaterinfo =~ s|^\s*\012||gm;
( my $theatername\, my @theaterextra ) = split ( /\012/\, $theaterinfo );
if ( IgnoringTheater ( $theatername )) { next; }
my $TID = -1; if ( !exists ( $hTempTheaters{ $theatername })) { $TID = $nTheater++;
$hTheaters{ $TID }{ "Name" } = $theatername;
$hTempTheaters{ $theatername }{ "ID" } = $TID;
if ( $#theaterextra > 1 && $theaterextra[0] =~ /^Handicapped/ )
{
# Roll the handicapped message around to the back
push ( @theaterextra\, shift @theaterextra );
}
$hTheaters{ $TID }{ "Info" } = join ( "\012"\, @theaterextra );
}
else
{
$TID = $hTempTheaters{ $theatername }{ "ID" };
}
foreach my $movie ( @movies )
{
# Skip theaters that don't have any movie info
if ( $movie =~ /Sorry\, we have no info/ )
{
next;
}
( my $movieinfo\, my $showtimes ) = split ( "\<!-- show info -->"\, $movie );
# Remove the HTML from movieinfo
$movieinfo =~ s/\<.*?>//gs;
# Remove blank lines
$movieinfo =~ s|^\s*\012||gm;
( my $moviename\, my @movieextra ) = split ( /\012/\, $movieinfo );
my $MID = -1;
if ( !exists ( $hTempMovies{ $moviename }))
{
$MID = $nMovie++;
#querymovie ( $moviename );
$hMovies{ $MID }{ "Name" } = $moviename;
$hTempMovies{ $moviename }{ "ID" } = $MID;
foreach my $line ( @movieextra )
{
# Attempt to figure out if this line is the rating\, or the running time
if ( $line =~ /^\d/ )
{
# First character is a number\, then it is probably the length
$hMovies{ $MID }{ "Length" } = $line;
}
else
{
# First character is a letter\, then it is probably the rating
$hMovies{ $MID }{ "Rating" } = $line;
}
}
}
else
{
$MID = $hTempMovies{ $moviename }{ "ID" };
}
# Check that this ID combo hasn't been stored already
my $IDID = "_${MID}_${TID}_${DID}_";
if ( !exists ( $hTempShowtimes{ $IDID }))
{
$hTempShowtimes{ $IDID } = 1;
# Remove the HTML from showtimes
$showtimes =~ s/\<.*?>//gs;
# Remove blank lines
$showtimes =~ s|^\s*\012||gm;
# Lop of extra garbage at the end $showtimes =~ s/\[\w.*\].*$//s;
# Remove the trailing linefeed chomp ( $showtimes );
my $SID = -1;
if ( !exists ( $hTempTimeStrings{ $showtimes }))
{
$SID = $nTimeString++;
$hTimeStrings{ $SID }{ "String" } = $showtimes;
$hTempTimeStrings{ $showtimes }{ "ID" } = $SID;
}
else
{
$SID = $hTempTimeStrings{ $showtimes }{ "ID" };
}
$hShowtimes{ $nShowtime }{ "MID" } = $MID;
$hShowtimes{ $nShowtime }{ "TID" } = $TID;
$hShowtimes{ $nShowtime }{ "DID" } = $DID;
$hShowtimes{ $nShowtime }{ "SID" } = $SID;
$nShowtime++;
}
}
}
}
sub ScootParse { my $content = $_[0]; my $Ignoring = 0;
#### GARETH'S SCOOT CODE STARTS HERE ### # There's also a new function called ucwords() which # I've included at the end of the file # # --- # $Ignoring stuff mine -- jrray
my %months = ( 'January' => 0\, 'February' => 1\, 'March' => 2\, 'April' => 3\, 'May' => 4\, 'June' => 5\, 'July' => 6\, 'August' => 7\, 'September' => 8\, 'October' => 9\, 'November' => 10\, 'December' => 11 );
# Translate linefeeds
$content =~ s/\015/\012/gm;
# Translate metaspaces into newlines
$content =~ s/ / /gs;
$content =~ s/\
/\012/gs;
# Remove blank lines
$content =~ s|^\s*\012||gm;
my @content=split(/\012/\,$content);
my ($theatername\,$theaterextra) = (''\,'');
my ($movie\,$showtimes)=(''\,'');
my ($date\,$location)=(''\,'');
my ($DID\,$TID\,$line\,$tline) = (-1\,-1\,''\,0);
LINE:foreach $line (@content) {
if (!$location) {
if ($line =~ /r=CINCL[^>]*>([^\<]+)/) {
$location=$1;
next LINE;
}
}
if (!$date) {
if ($line =~ /^Valid from \w+\, \w+ \d+\, \d+ to (\w+)\, (\w+) (\d+)\, (\d+)/) {
# Process date line
my ($dayname\,$monthstr\,$day\,$year)=($1\,$2\,$3\,$4);
my $month=$months{$monthstr};
my $time = timegm ( 0\, 0\, 0\, $day\, $month\, $year );
# If we are running on a Mac\, we need to fudge the time and # the following value will not be zero my $timefudge = timegm ( 0\, 0\, 0\, 1\, 0\, 1970 ); $time -= $timefudge;
$DID = -1;
if ( !exists ( $hTempDates{ $time })) {
$DID = $nDate++;
$hDates{ $DID }{ "Date" } = $time;
$hTempDates{ $time }{ "ID" } = $DID;
} else {
$DID = $hTempDates{ $time }{ "ID" };
}
$date=1;
}
next LINE;
}
if ((!$theatername || $tline>5) && (length($line) \< 80)) {
if ($line =~ /r=CINOC[^>]*>(.*?)\<\//) { $theatername=ucwords($1);
# If this theater is in our kill file\, ignore it -- jrray my $Ignoring = IgnoringTheater ( $theatername );
$tline=1;
$TID=-1;
if ( !$Ignoring )
{
if (!exists( $hTempTheaters{ $theatername })) {
$TID = $nTheater++;
$hTheaters{ $TID }{ "Name" } = $theatername;
$hTempTheaters{ $theatername }{ "ID" } = $TID;
} else {
$TID = $hTempTheaters{ $theatername }{ "ID" };
}
}
$theaterextra='';
}
next LINE if $tline\<6;
}
# There are 8 lines of Cinema info below each cinema name
if ($theatername && $tline\<6) {
if ($tline==1 && $line =~ /miles/) {
$line.=" from $location";
}
$theaterextra.=$line."\012";
$tline++;
if ( !$Ignoring )
{
if ($tline>5) {
$hTheaters{ $TID }{ "Info" } = $theaterextra;
}
}
next LINE;
}
if (!$movie && (length($line)>80)) {
if ($line =~ /r=CINOF[^>]+>([^\<]+)/) {
$movie=ucwords($1);
if ($movie =~ /^\s*$/ || $movie =~ /NO FILMS SHOW/i) {
$movie='';
}
}
next LINE;
}
if ($movie&&!$showtimes) {
$showtimes=$line;
$showtimes =~ s/^\s+//g; # surpress leading spaces
if ($showtimes =~ /^\s*$/ || !($showtimes =~ /^\/)) {
$movie=$showtimes=''; # invalid/empty
next LINE;
}
$showtimes =~ s/\<.*?>//gs;
$showtimes=&ucwords($showtimes);
$showtimes =~ s/\W+$//; # Strip trailing punctuation
my $MID = -1;
if ( !$Ignoring )
{
if ( !exists ( $hTempMovies{ $movie })) {
$MID = $nMovie++;
$hMovies{ $MID }{ "Name" } = $movie;
$hTempMovies{ $movie }{ "ID" } = $MID;
} else {
$MID = $hTempMovies{ $movie }{ "ID" };
}
}
##################### # # These changes by J Robert Ray
# Get rid of those pesky \,;'s
$showtimes =~ s/\,;/;/g;
# Translate ;'s into newlines
$showtimes =~ s/;/\012/g;
# Strip off trailing newlines
chomp $showtimes;
# #####################
# Check that this ID combo hasn't been stored already
my $IDID = "_${MID}_${TID}_${DID}_";
if ( !$Ignoring )
{
if ( !exists ( $hTempShowtimes{ $IDID })) {
$hTempShowtimes{ $IDID } = 1;
my $SID = -1;
if ( !exists ( $hTempTimeStrings{ $showtimes })) {
$SID = $nTimeString++;
$hTimeStrings{ $SID }{ "String" } = $showtimes;
$hTempTimeStrings{ $showtimes }{ "ID" } = $SID;
} else {
$SID = $hTempTimeStrings{ $showtimes }{ "ID" };
}
$hShowtimes{ $nShowtime }{ "MID" } = $MID;
$hShowtimes{ $nShowtime }{ "TID" } = $TID;
$hShowtimes{ $nShowtime }{ "DID" } = $DID;
$hShowtimes{ $nShowtime }{ "SID" } = $SID;
$nShowtime++;
}
}
$showtimes=$movie='';
}
}
### END OF SCOOT CODE
}
sub IgnoringTheater { my $theatername = $_[0];
if ( exists $TheaterIgnore{ $theatername }) { return $TheaterIgnore{ $theatername }; } else { $TheaterIgnore{ $theatername } = 0; }
return 0; }
sub printspaces
{
my $num = $_[0];
for ( my $i = 0; $i \< $num; $i++ )
{
print THEATERLIST " ";
}
}
sub querymovie { my $title = $_[0];
$title =~ s/\ /\+/g; $title =~ s/&/%26/g; $title =~ s/:/%3A/g;
my $URL = "http://us.imdb.com/Tfuzzy?title=" . $title . "&type=fuzzy&sort=chrono&tv=off";
#my $URL = "http://us.imdb.com/Plot?" . $title;
print $URL . "\n";
#my $request = new HTTP::Request ( 'GET'\, $URL ); }
sub filltimes { # Takes in references to the day hash\, inc days\, excl days\, and times.
if ( $#{$_[3]} >= 0 ) { DAY:foreach my $day ( @{$_[1]}) { foreach my $unday ( @{$_[2]}) { next DAY if ( $day eq $unday ); }
if ( exists ( ${_[0]}{ $day })) { ${$_[0]}{ $day } .= "\, "; } ${$_[0]}{ $day } .= join ( "\, "\, @{$_[3]} );
my @times = split ( /\,\s*/\, ${$_[0]}{ $day });
${$_[0]}{ $day } = join ( "\, "\, sort @times );
}
}
@{$_[1]} = ( 'Dim'\, 'Lun'\, 'Mar'\, 'Mer'\, 'Jeu'\, 'Ven'\, 'Sam' );
@{$_[2]} = ();
@{$_[3]} = ();
}
sub ParseParams
{
my $arg = "";
for ( my $i = 0; $i \<= $#ARGV; $i++ )
{
if ( substr ( $ARGV[$i]\, 0\, 1 ) eq "-" )
{
$arg = substr ( $ARGV[$i]\, 1\, length ( $ARGV[$i] ) - 1 );
SWITCH: {
( $arg eq "h" || $arg eq "help" ) && do { PrintUsage (); last SWITCH; };
}
}
else
{
SWITCH: {
$arg eq "d" && do { $ConfigPath = $ARGV[$i]; $arg = ""; last SWITCH; };
}
}
}
}
sub PrintUsage { print "USAGE: getdata.pl [-c configpath]\n\n"; print "-c configpath where configpath is path to find getdata.cfg\n";
pause (); exit 1; }
Migrated from rt.perl.org#1715 (status was 'resolved')
Searchable as RT1715$