perl segmentation fault report

[p5pRT]

Migrated from rt.perl.org#1715 (status was 'resolved')

Searchable as RT1715$

[p5pRT]

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 ( <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 =~ /(^.*&lt;li&gt;.*$)/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/ //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/<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/ / /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 &lt;= $#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;
}

Perl Info

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.
-><-

[p5pRT]

From [Unknown Contact. See original ticket]

I recompiled perl with -g and here is the stack trace I am getting.

program terminated by signal SEGV (no mapping at the fault address)
Current function is Perl_re_intuit_start
  371 CHR_SVLEN(prog->check_substr) +
(SvTAIL(prog->check_substr) != 0);
(dbx 1) where
=>[1] Perl_re_intuit_start(prog = 0x420488, sv = 0x41e504, strpos =
0x5ebc84 "A HRef="#T14">Cinemark Movies 10 - Westpointe Plaza</A>\n-\n<A
HRef="#T15">GC Westland 8</A>\n-\n<A HRef="#T16">Regal Georgesville
Square 16</A>\n-\n<A HRef="#T17">Marcus Cinema & IMAX Theatre -
Crosswoods Center</A>\n-\n<A HRef="#T18">Cinemark Movies 12 - Market at
Mill Run</A>\n-\n<A HRef="#T19">AMC Dublin Village 18</A>\n-\n<A
HRef="#T20">Hollywood - Indian Mound 11</A>\n-\n<A HRef="#T21">Hollywood
- Newark 4</A>\n-\n<A HRef="#T22">Regal River Valley
10</A></small><Br>\n<tr><td colspan=2 height=4></td></tr>\n\n\n\n<tr><td
al" ..., strend = 0x600c14 "", flags = 24U, data = (nil)), line 371 in
"regexec.c"
  [2] Perl_regexec_flags(prog = 0x420488, stringarg = 0x5eb9f1
"</td></tr>\n<tr><td colspan=2>\n<small><A HRef="#T0">AMC Eastland
Centre 8</A>\n-\n<A HRef="#T1">Silver Cinemas - Brice Outlet
Mall</A>\n-\n<A HRef="#T2">Marcus Cinema Pickerington</A>\n-\n<A
HRef="#T3">AMC Easton Town Center 30</A>\n-\n<A HRef="#T4">Drexel
Theatre</A>\n-\n<A HRef="#T5">Cinemark Movies 16 - Gahanna</A>\n-\n<A
HRef="#T6">Studio 35 Cinema</A>\n-\n<A HRef="#T7">AMC Lennox Town Center
24</A>\n-\n<A HRef="#T8">Drexel Grandview</A>\n-\n<A HRef="#T9">GC
Northland 8</A>\n-\n<A HRef="#T10">AMC Westerville 6</A>\n-\n<A HRef"
..., strend = 0x600c14 "", strbeg = 0x5eac08
"<html>\n<head>\n<title>Yahoo! Movies -
Showtimes</title>\n</head>\n<body>\n<A
Name="top">\n</A>\n<center>\n <Map Name="map">\n <area
shape=rect coords="13,0,63,58" \n
href="http​://www.yahoo.com">\n <area shape=rect
coords="71,0,117,58" \n
href="http​://my.yahoo.com">\n <area shape=rect
coords="348,0,387,58"\n
href="http​://www.yahoo.com/docs/info/help.html">\n <area
shape=rect coords="396,0,450,58" \n
href="http​://www.yahoo.com/docs/family/m" ..., minend = 0, sv =
0x41e504, data = (nil), flags = 24U), line 807 in "regexec.c"
  [3] Perl_pp_subst(), line 1777 in "pp_hot.c"
  [4] Perl_runops_debug(), line 51 in "run.c"
  [5] S_run_body(args = 0xefffd6b4), line 1080 in "perl.c"
  [6] Perl_vdefault_protect(pcur_env = 0xefffd6d4, excpt = 0xefffd734,
body = 0x2f060 = &`perl`perl.c`S_run_body(va_list args), args =
0xefffd654), line 45 in "scope.c"
  [7] Perl_default_protect(pcur_env = 0xefffd6d4, excpt = 0xefffd734,
body = 0x2f060 = &`perl`perl.c`S_run_body(va_list args), ...), line 26
in "scope.c"
  [8] perl_run(my_perl = 0x225c08), line 1018 in "perl.c"
  [9] main(argc = 2, argv = 0xefffd80c, env = 0xefffd818), line 53 in
"perlmain.c"
(dbx 2)
--
<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.
-><-

[p5pRT]

From [Unknown Contact. See original ticket]

Larry W. Virden writes​:

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?

Edit "cflags" file. I have

#optdebug='' # ensure -g used if building a -DDEBUGGING libperl
optdebug='-g -Dregister=' # ensure -g used if building a -DDEBUGGING libperl

$ gdb $(whence perl) core

Well, having something less than 1500+ lines long script would be
helpful too.

Ilya

[p5pRT]

From [Unknown Contact. See original ticket]

Larry W. Virden writes​:

Current function is Perl_re_intuit_start
371 CHR_SVLEN(prog->check_substr) +
(SvTAIL(prog->check_substr) != 0);

And may I ask what is the reason for segfault? What is the contents
of prog->check_substr? Keep in mind

  #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))

and I suspect you do not use utf8, right?

(dbx 1) where
=>[1] Perl_re_intuit_start(prog = 0x420488, sv = 0x41e504, strpos =
0x5ebc84 "A HRef="#T14">Cinemark Movies 10 - Westpointe Plaza</A>\n-\n<A
HRef="#T15">GC Westland 8</A>\n-\n<A HRef="#T16">Regal Georgesville
Square 16</A>\n-\n<A HRef="#T17">Marcus Cinema & IMAX Theatre -
Crosswoods Center</A>\n-\n<A HRef="#T18">Cinemark Movies 12 - Market at
Mill Run</A>\n-\n<A HRef="#T19">AMC Dublin Village 18</A>\n-\n<A
HRef="#T20">Hollywood - Indian Mound 11</A>\n-\n<A HRef="#T21">Hollywood
- Newark 4</A>\n-\n<A HRef="#T22">Regal River Valley
10</A></small><Br>\n<tr><td colspan=2 height=4></td></tr>\n\n\n\n<tr><td
al" ..., strend = 0x600c14 "", flags = 24U, data = (nil)), line 371 in
"regexec.c"

Hey, I have seen this string (rendered ;-) yesterday! How did you
happen too get it?

Ilya

[p5pRT]

From [Unknown Contact. See original ticket]

From​: Ilya Zakharevich <ilya@​math.ohio-state.edu>

  Larry W. Virden writes​:
  > Current function is Perl_re_intuit_start
  > 371 CHR_SVLEN(prog->check_substr) +
  > (SvTAIL(prog->check_substr) != 0);
 
  And may I ask what is the reason for segfault? What is the
contents
  of prog->check_substr? Keep in mind
 
  #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
 
  and I suspect you do not use utf8, right?

Current function is Perl_re_intuit_start
  371 CHR_SVLEN(prog->check_substr) +
(SvTAIL(prog->check_substr) != 0);
(dbx 1) print prog->check_substr
dbx​: can't find field "check_substr" in "*(prog)"
(dbx 2) print UTF
dbx​: "UTF" is not defined in the scope
`perl`regexec.c`Perl_re_intuit_start`

dbx​: see `help scope' for details
(dbx 3) print sv
sv = 0x41e504
(dbx 4) print *sv
*sv = {
  sv_any = 0x5aeb08
  sv_refcnt = 1U
  sv_flags = 67372295U
}
(dbx 5) print SvCUR(sv)
dbx​: "SvCUR" is not defined in the scope
`perl`regexec.c`Perl_re_intuit_start`

Unfortunately, I'm not familiar enough with Perl's internals to
figure out how to dig out the real info here...

--
Larry W. Virden <URL​: mailto​:lvirden@​cas.org> Windows is not the
answer, but
<URL​: http​://www.purl.org/NET/lvirden/> the question. No
is the answer.
Unless explicitly stated to the contrary, nothing in this posting
should be construed as representing my employer's opinions.

[p5pRT]

From [Unknown Contact. See original ticket]

On Tue, Oct 26, 1999 at 02​:35​:01PM -0400, Larry W. Virden wrote​:

Current function is Perl_re_intuit_start
371 CHR_SVLEN(prog->check_substr) +
(SvTAIL(prog->check_substr) != 0);
(dbx 1) print prog->check_substr
dbx​: can't find field "check_substr" in "*(prog)"

Well, it is not rocket science to resolve macros (at least if you run
'make etags' and use imenu-go.el in emacs).

#define check_substr substrs->data[2].substr
#define check_offset_min substrs->data[2].min_offset
#define check_offset_max substrs->data[2].max_offset

(dbx 5) print SvCUR(sv)
dbx​: "SvCUR" is not defined in the scope

Well, I think you know it already. *((GV*)sv)->sv_any is the simplest
way to access these guys I know.

Ilya

[p5pRT]

From [Unknown Contact. See original ticket]

From​: Ilya Zakharevich <ilya@​math.ohio-state.edu>

  Well, I think you know it already. *((GV*)sv)->sv_any is the
simplest
  way to access these guys I know.

print *((GV*)sv)->sv_any
*((struct gv *) sv)->sv_any = {
  xpv_pv = 0x5eac08 "<html>\n<head>\n<title>Yahoo! Movies
- Showtimes</title>\n</head>\n<body>\n<A
Name="top">\n</A>\n<center>\n <Map Name="map">\n
<area shape=rect coords="13,0,63,58" \n
href="http​://www.yahoo.com">\n <area shape=rect
coords="71,0,117,58" \n href="http​://my.yahoo.com">\n
  <area shape=rect coords="348,0,387,58"\n
href="http​://www.yahoo.com/docs/info/help.html">\n
<area shape=rect coords="396,0,450,58" \n
href="http​://www.yahoo.com/docs/family/m" ...
  xpv_cur = 90124U
  xpv_len = 97550U
  xiv_iv = 0
  xnv_nv = 0.0
  xmg_magic = (nil)
  xmg_stash = (nil)
  xgv_gp = 0x5c5588
  xgv_name = (nil)
  xgv_namelen = 6U
  xgv_stash = (nil)
  xgv_flags = '\0'
}

--
Larry W. Virden <URL​: mailto​:lvirden@​cas.org> Windows is not the
answer, but
<URL​: http​://www.purl.org/NET/lvirden/> the question. No
is the answer.
Unless explicitly stated to the contrary, nothing in this posting
should be construed as representing my employer's opinions.

[p5pRT]

From [Unknown Contact. See original ticket]

Larry W. Virden writes​:

print *((GV*)sv)->sv_any

This is all pretty nice, but I want to know why *segfault* happens.
The segfault line does not mention sv at all. Sorry for not
mentioning it upfront.

Ilya

[p5pRT]

From [Unknown Contact. See original ticket]

Larry W. Virden writes​:

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?

This is a plug only. It fixes a bug, but uncovers yet another
pessimization in the optimizer...

Enjoy,
Ilya

Inline Patch

--- ./t/op/pat.t~	Tue Oct  5 23:20:31 1999
+++ ./t/op/pat.t	Mon Nov  1 18:08:47 1999
@@ -4,7 +4,7 @@
 # the format supported by op/regexp.t.  If you want to add a test
 # that does fit that format, add it to op/re_tests, not here.
 
-print "1..193\n";
+print "1..194\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -891,5 +891,10 @@ $test++;
 $text = "aaXbXcc";
 pos($text)=0;
 $text =~ /\GXb*X/g and print 'not ';
+print "ok $test\n";
+$test++;
+
+$text = "xA\n" x 500;
+$text =~ /^\s*A/m and print 'not ';
 print "ok $test\n";
 $test++;
--- ./regexec.c~	Sun Oct 10 15:25:52 1999
+++ ./regexec.c	Mon Nov  1 18:02:03 1999
@@ -642,6 +642,9 @@ Perl_re_intuit_start(pTHX_ regexp *prog,
 	    prog->check_substr = Nullsv;	/* disable */
 	    prog->float_substr = Nullsv;	/* clear */
 	    s = strpos;
+	    /* XXXX This is a remnant of the old implementation.  It
+	            looks wasteful, since now INTUIT can use many
+	            other heuristics too. */
 	    prog->reganch &= ~RE_USE_INTUIT;
 	}
 	else
@@ -804,9 +807,13 @@ Perl_regexec_flags(pTHX_ register regexp
 		  after_try:
 		    if (s >= end)
 			goto phooey;
-		    s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
-		    if (!s)
-			goto phooey;
+		    if (prog->reganch & RE_USE_INTUIT) {
+			s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
+			if (!s)
+			    goto phooey;
+		    }
+		    else
+			s++;
 		}		
 	    } else {
 		if (s > startpos)

[p5pRT]

From [Unknown Contact. See original ticket]

Thank you for the patch. Unfortunately, after applying that patch and
running a make test on perl 5.005_62, I get​:

pragma/warnings.....PROG​:
# op.c
$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; # known scalar leak
use warnings 'unsafe' ;
my $a ; my @​a = () ; my %a = () ; my $b = \@​a ; my $c = \%a ;
@​a =~ /abc/ ;
@​a =~ s/a/b/ ;
@​a =~ tr/a/b/ ;
@​$b =~ /abc/ ;
@​$b =~ s/a/b/ ;
@​$b =~ tr/a/b/ ;
%a =~ /abc/ ;
%a =~ s/a/b/ ;
%a =~ tr/a/b/ ;
%$c =~ /abc/ ;
%$c =~ s/a/b/ ;
%$c =~ tr/a/b/ ;
{
no warnings 'unsafe' ;
my $a ; my @​a = () ; my %a = () ; my $b = \@​a ; my $c = \%a ;
@​a =~ /abc/ ;
@​a =~ s/a/b/ ;
@​a =~ tr/a/b/ ;
@​$b =~ /abc/ ;
@​$b =~ s/a/b/ ;
@​$b =~ tr/a/b/ ;
%a =~ /abc/ ;
%a =~ s/a/b/ ;
%a =~ tr/a/b/ ;
%$c =~ /abc/ ;
%$c =~ s/a/b/ ;
%$c =~ tr/a/b/ ;
}
EXPECTED​:
Applying pattern match (m//) to @​array will act on scalar(@​array) at - line 5.
Applying substitution (s///) to @​array will act on scalar(@​array) at - line 6.
Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;"
Applying transliteration (tr///) to @​array will act on scalar(@​array) at - line 7.
Applying pattern match (m//) to @​array will act on scalar(@​array) at - line 8.
Applying substitution (s///) to @​array will act on scalar(@​array) at - line 9.
Applying transliteration (tr///) to @​array will act on scalar(@​array) at - line 10.
Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 11.
Applying substitution (s///) to %hash will act on scalar(%hash) at - line 12.
Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 13.
Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14.
Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15.
Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
BEGIN not safe after errors--compilation aborted at - line 18.
GOT​:
Applying pattern match (m//) to @​array will act on scalar(@​array) at - line 5.
Applying substitution (s///) to @​array will act on scalar(@​array) at - line 6.
Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;"
Applying transliteration (tr///) to @​array will act on scalar(@​array) at - line 7.
Applying pattern match (m//) to @​array will act on scalar(@​array) at - line 8.
Applying substitution (s///) to @​array will act on scalar(@​array) at - line 9.
Applying transliteration (tr///) to @​array will act on scalar(@​array) at - line 10.
Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 11.
Applying substitution (s///) to %hash will act on scalar(%hash) at - line 12.
Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 13.
Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14.
Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15.
Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
BEGIN not safe after errors--compilation aborted at - line 18.
Scalars leaked​: 1
FAILED at test 160
--
Larry W. Virden <URL​: mailto​:lvirden@​cas.org>
<URL​: http​://www.purl.org/NET/lvirden/> <*> O-
Unless explicitly stated to the contrary, nothing in this posting should
be construed as representing my employer's opinions.
-><-

[p5pRT]

From [Unknown Contact. See original ticket]

On Tue, Nov 02, 1999 at 06​:47​:57AM -0500, Larry W. Virden wrote​:

Thank you for the patch. Unfortunately, after applying that patch and
running a make test on perl 5.005_62, I get​:

pragma/warnings.....PROG​:
# op.c
$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; # known scalar leak
use warnings 'unsafe' ;
my $a ; my @​a = () ; my %a = () ; my $b = \@​a ; my $c = \%a ;
@​a =~ /abc/ ;
EXPECTED​:
...
Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
BEGIN not safe after errors--compilation aborted at - line 18.
GOT​:
...
Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
BEGIN not safe after errors--compilation aborted at - line 18.
Scalars leaked​: 1
FAILED at test 160

Was not that seen before? I do not get this warning. Are you running
with PERL_DESTRUCT_LEVEL > 3?

Ilya

[p5pRT]

From [Unknown Contact. See original ticket]

Re​: was the error seen before?

No, this is the first time I have seen this error.

Re​: am I running with PERL_DESTRUCT_LEVEL > 3?

I have no such environment variable set - does the make test set
one?

--
Larry W. Virden <URL​: mailto​:lvirden@​cas.org> Windows is not the
answer, but
<URL​: http​://www.purl.org/NET/lvirden/> the question. No
is the answer.
Unless explicitly stated to the contrary, nothing in this posting
should be construed as representing my employer's opinions.

[p5pRT]

From [Unknown Contact. See original ticket]

On Tue, Nov 02, 1999 at 03​:37​:24PM -0500, Larry W. Virden wrote​:

Re​: was the error seen before?

No, this is the first time I have seen this error.

On p5p?

Re​: am I running with PERL_DESTRUCT_LEVEL > 3?

I have no such environment variable set - does the make test set
one?

It is set to 2 if not defined. The additional message "Scalars
leaked" which you see indicates that PERL_DESTRUCT_LEVEL > 3 - which
it should not be.

Ilya

[p5pRT]

From [Unknown Contact. See original ticket]

On Nov 2, 17​:16, Ilya Zakharevich wrote​:
} Subject​: Re​: [ID 19991026.001] perl segmentation fault report
--> On Tue, Nov 02, 1999 at 03​:37​:24PM -0500, Larry W. Virden wrote​:
--> > Re​: was the error seen before?
--> >
--> > No, this is the first time I have seen this error.
-->
--> On p5p?

I've never seen this error in person or on p5p <smile>...

--> > Re​: am I running with PERL_DESTRUCT_LEVEL > 3?
--> >
--> > I have no such environment variable set - does the make test set
--> > one?
-->
--> It is set to 2 if not defined. The additional message "Scalars
--> leaked" which you see indicates that PERL_DESTRUCT_LEVEL > 3 - which
--> it should not be.

Interesting...

--
<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.
-><-

[p5pRT]

From [Unknown Contact. See original ticket]

I'm continuing to see this segmentation fault. The last suggestion from
the list was that I had PERL_DESTRUCT_LEVEL set to a value greater
than 2. But I don't have any such variable set in my shell variable
environment. Is there someplace within perl's configuration environment
where this might be set?
--
Larry W. Virden <URL​: mailto​:lvirden@​cas.org>
<URL​: http​://www.purl.org/NET/lvirden/> <*> O-
Unless explicitly stated to the contrary, nothing in this posting should
be construed as representing my employer's opinions.
-><-