develooper Front page | perl.perl5.porters | Postings from October 1999

[ID 19991026.001] perl segmentation fault report

Thread Previous | Thread Next
From:
Larry W. Virden
Date:
October 26, 1999 04:19
Subject:
[ID 19991026.001] perl segmentation fault report
Message ID:
199910261118.HAA11822@cas.org
This is a bug report for perl from lvirden@cas.org,
generated with the help of perlbug 1.27 running under perl 5.00562.


-----------------------------------------------------------------
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 ( <THEATERLIST> )
	{
	    chomp $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 ( <CONFIG> )
  {
    if ( $line =~ /^[\#\s\n]/ )
    {
      next;
    }

    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 = <STDIN>;
}

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 =~ /(^.*<li>.*$)/mi;
  $content = $1;
  my @theaters = split ( /<li>/i, $content );
  
  # Lop off the first chunk, cause it isn't really a theater
  shift @theaters;

  foreach (@theaters) {
    next unless (/^<a href="(.*)\/">(.*)<\/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/\&nbsp\;/ /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 (/<li>/i, $content);
        shift @movies;
        $movies[$#movies] =~ s/\n.*$//s;
    
        foreach my $movie ( @movies ) {
            # Remove the HTML from $movie
            $movie =~ s/<[^>]*>//gs;
            $movie =~ s/&nbsp;//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/&nbsp;/\012/gs;
  
  # Remove blank lines
  $content =~ s|^\s*\012||gm;
  
  # Lop off everything [Legend
  $content =~ s/<b>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/&nbsp;/ /gs;
  $content =~ s/<BR>/\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 =~ /^<I>/)) {
       $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;
}



[Please do not change anything below this line]
-----------------------------------------------------------------

---
Site configuration information for perl 5.00562:

Configured by lwv26 at Sat Oct 16 16:29:03 EDT 1999.

Summary of my perl5 (revision 5.0 version 5 subversion 62) configuration:
  Platform:
    osname=solaris, osvers=2.6, archname=sun4-solaris
    uname='sunos lwv26awu 5.6 generic_105181-16 sun4u sparc sunw,ultra-5_10 '
    config_args=''
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef useperlio=undef d_sfio=undef
    use64bits=undef usemultiplicity=undef
  Compiler:
    cc='cc', optimize='-g', gccversion=
    cppflags='-DDEBUGGING -I/usr/ccs/include -I/vol/lwv26ldatae/include -I/projects/gnu/sparc-sun-solaris2.6/include'
    ccflags ='-DDEBUGGING -I/usr/ccs/include -I/vol/lwv26ldatae/include -I/projects/gnu/sparc-sun-solaris2.6/include'
    stdchar='unsigned char', d_stdstdio=define, usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    alignbytes=8, usemymalloc=y, prototype=define
  Linker and Libraries:
    ld='cc', ldflags ='-L/usr/ccs/lib -L/vol/lwv26ldatae/lib -L/projects/gnu/sparc-sun-solaris2.6/lib -R/usr/ccs/lib:/vol/lwv26ldatae/lib:/projects/gnu/sparc-sun-solaris2.6/lib'
    libpth=/lib /usr/ccs/lib /vol/lwv26ldatae/lib /projects/gnu/sparc-sun-solaris2.6/lib
    libs=-lsocket -lnsl -lgdbm -ldb -ldl -lm -lc -lcrypt -lsec
    libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-KPIC', lddlflags='-G -L/usr/ccs/lib -L/vol/lwv26ldatae/lib -L/projects/gnu/sparc-sun-solaris2.6/lib -R/usr/ccs/lib:/vol/lwv26ldatae/lib:/projects/gnu/sparc-sun-solaris2.6/lib'

Locally applied patches:
    

---
@INC for perl 5.00562:
    /home/lwv26/lib/perl5/
    /projects/sprs_lwv/lib/perl5/
    /vol/lwv26ldatae/lib/perl5/5.006/sun4-solaris
    /vol/lwv26ldatae/lib/perl5/5.006
    /vol/lwv26ldatae/lib/site_perl/5.006/sun4-solaris
    /vol/lwv26ldatae/lib/site_perl
    .

---
Environment for perl 5.00562:
    HOME=/home/lwv26
    LANG=C
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/lprod/cas/lib:/usr/dt/lib:/usr/openwin/lib:/usr/lib
    LOGDIR (unset)
    PATH=/opt/SUNWspro/bin:/ldatae/bin:/projects/sprs_lwv/sol26/bin:/projects/sprs_lwv/sol26/bin/mime:/projects/sprs_lwv/sol2/bin:/projects/sprs_lwv/bin:/projects/sprs_lwv/bin/mime:/home/lwv26/bin/D.news:/usr/perl5/bin:/projects/gnu/sparc-sun-solaris2.6/bin:/usr/tcl82/sun4/bin:/usr/tcl82/bin:/projects/xopsrc/sun4/bin:/projects/xopsrc/bin:/usr/atria/bin:/projects/intranet/bin:/projects/clearcase/bin:/vol/tclsrcsol/TclPro1.3/solaris-sparc/bin:/ldata2/teTeX/bin/sparc-sun-solaris2.6:/ldata/bin:/home/lwv26/bin/D.aws:/home/lwv26/bin/sol2:/home/lwv26/bin/D.frontend:/home/lwv26/bin/D.ksh:/cas/test/bin/sun4:/projects/sprs_lwv/bin/sol2:/usr/java1.2/bin:/home/lwv26/bin/sun4:/lprod/cas/bin:/usr/local/bin:/usr/dt/bin:/usr/openwin/bin:/bin:/cas/bin/sun4:/cas/abin/sun4:/cas/X11/sun4/bin:/usr/ccs/bin:/uprod/bin:/usr/sbin:/cas/tools/bin/sun4:/cas/X11/sun4/tools/bin:/usr/ucb:/home/lwv26/bin:/cas/tools/pdbin/sun4:/home/lwv26/bin/D.mistypes:/home/lwv26/bin/D.toys:/home/lwv26/bin/D.tools:/projects!
/npd/npdweb/bin-sol2
    PERL5LIB=/home/lwv26/lib/perl5/:/projects/sprs_lwv/lib/perl5/:
    PERLDOC=-t
    PERLLIB=/home/lwv26/lib/perl:/projects/sprs_lwv/lib/perl:
    PERL_BADLANG (unset)
    SHELL=/bin/ksh

-- 
<URL: mailto:lvirden@cas.org> Quote: Pikachu, I choose you!
<*> O- <URL: http://www.purl.org/NET/lvirden/>
Unless explicitly stated to the contrary, nothing in this posting
should be construed as representing my employer's opinions.
-><-

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About