[19536] in Perl-Users-Digest
Perl-Users Digest, Issue: 1731 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Sep 11 09:10:31 2001
Date: Tue, 11 Sep 2001 06:10:12 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <1000213812-v10-i1731@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Tue, 11 Sep 2001 Volume: 10 Number: 1731
Today's topics:
Really bizzare syntax error (Stan Brown)
Re: Really bizzare syntax error (Mark Jason Dominus)
Re: recognize MS Windows with perl <tintin@snowy.calculus>
Re: recognize MS Windows with perl <wyzelli@yahoo.com>
Regular expression <email@timlauterborn.de>
Re: Regular expression <Rainer.Klier@erl.sbs.de>
Re: Regular expression (Tim Hammerquist)
Re: Regular expression <info@fruiture.de>
Sharing memory <gortona@cs.man.ac.uk>
Re: Warning on adding hash element (Anno Siegel)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 11 Sep 2001 08:24:12 -0400
From: stanb@panix.com (Stan Brown)
Subject: Really bizzare syntax error
Message-Id: <9nkvpc$m4c$1@panix1.panix.com>
I started off this morning by apllying some of my newfound (from this
group) perl wisdom. I was going through changin each occurence of:
my $argtmp = join ', ', map { "Arg$_ ->$_[$_]<-" } 0 .. $#_;
At the entrance to each of my finctions to:
my $argtmp = join ', ', map {defined($_[$_])
? "Arg$_ ->$_[$_]<-"
: "Arg$_ ->*UNDEF*<-"
} 0 .. $#_;
To handle the passing of 'undef's as arguments.
However the caused the following sunroutine to be declared to have a syntax
error by the compiler!
#!/usr/local/bin/perl
use Switch;
sub DoIt($$$) {
######################################################################
#
# DoIT
#
# main callback processing subroutine
#
# All state machine controls should be placed in here for ease of
# understanding the control flow
#
# Inpits
#
# 1. the name of the button widget that was pressed
# 2. the name of the table we are working on
# 3. pointer to an hash of data column nmaes, and atributes
#
######################################################################
my ($widget,$ltable,$hash_pointer)=@_;
my $col;
my $cb;
my $rb;
my $rc;
my $cl;
my $junk;
my $entry;
my $date;
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map {defined($_[$_])
? "Arg$_ ->$_[$_]<-"
: "Arg$_ ->*UNDEF*<-"
} 0 .. $#_;
print_debug(2,"Entering $function_name()\n",0,0);
print_debug(3,"$argtmp\n",0,0);
print_debug(3,"I am in DoIt called from widget $widget.\n",1,0);
# Process state machine
switch ($state) {
case 'NO_ACTIVE_QUERY' {
if ($widget eq 'enter')
{
# Set widgets to proper enabled/disabled state for the allowed
# actions in this state
$execute_button->configure( -state => 'active');
$enter_button->configure( -state => 'disabled');
foreach $entry (keys %Entries) {
$Entries{$entry}->configure( -state => 'normal');
}
foreach $entry (keys %Browsentries) {
$Browsentries{$entry}->configure( -state => 'readonly');
}
foreach $date (keys %Dates) {
$Dates{$date}->Walk(sub {
eval { $_[0]->configure(-state => 'normal') }
});
}
foreach $rb (@radiobuttons) {
if(defined $rb)
{
$rb->configure( -state => 'active');
}
}
# Go to new state
$state = 'ENTERING_QUERY';
}
}
case 'ENTERING_QUERY' {
if ($widget eq 'execute')
{
# Need to build query string
# execute it store results in an array,
# and update %data_fields with the first record returned
# here
#
# Loop through %data_fileds looking for defined fileds that
# are not equal to '', and build WHERE clause
# If no %date_feilds are defined and not '', then don't add WHERE
# cluae
#
# In all cases specify all cols explicitly to assure that we know
# what order thay will be returned in
fetch_records($ltable,$hash_pointer);
# Go to new state
# This will be reset asynchronously when the child returns to
# PROCESING_QUERY_RESULTS
$state = 'IN_QUERY';
}
}
case 'PROCESING_QUERY_RESULTS' {
switch ($widget) {
case 'enter' {
# Prepare for a new query
# Set widgets to proper enabled/disabled state for the allowed
# actions in this state
if(defined $insert_button)
{
$insert_button->configure( -state => 'disabled');
}
if(defined $update_button)
{
$update_button->configure( -state => 'disabled');
}
if(defined $delete_button)
{
$delete_button->configure( -state => 'disabled');
}
$next_button->configure( -state => 'disabled');
$prev_button->configure( -state => 'disabled');
if(defined $save_button)
{
$save_button->configure( -state => 'disabled');
}
$execute_button->configure( -state => 'active');
$enter_button->configure( -state => 'disabled');
print_debug(3,"Zaping Data Fields\n",0,0);
$MW->focus();
foreach my $key (keys %{$hash_pointer}) {
$$hash_pointer{$key} = '';
}
# destroy widgets conating info about qty of currently
# selected/displayed records
if(defined $rec_spacer)
{
$rec_spacer->destroy();
}
if(defined $rec_label)
{
$rec_label->destroy();
}
if(defined $rec_entry)
{
$rec_entry->destroy();
}
if(defined $rec_label2)
{
$rec_label2->destroy();
}
# Reset compariosn selector menuuttons to default case for new
# query
foreach $rb (@radiobuttons) {
if(defined $rb)
{
$rb->configure( -state => 'active');
}
}
while (($junk, $cb) = each %comparebuttons) {
if(defined $cb)
{
$cb->configure( -state => 'disabled');
$cb->configure( -text => 'Ignore');
}
}
while (($cl, $junk) = each %compare) {
$compare{$cl} = 'Ignore';
}
foreach $entry (keys %Entries) {
$Entries{$entry}->configure( -state => 'normal');
}
foreach $entry (keys %Browsentries) {
$Browsentries{$entry}->configure( -state => 'readonly');
}
foreach $date (keys %Dates) {
$Dates{$date}->Walk(sub {
eval { $_[0]->configure(-state => 'normal') }
});
}
# Go to new state
$state = 'ENTERING_QUERY';
}
case 'next' {
# Update %data_fields with next record here
# PopUp error message if already displaying last record
$pos++;
if($pos > $record_qty )
{
popup_msg("Already Displaying Last Record");
$pos = $record_qty;
}
else
{
# We depend upon the order of the columns to retrieve
# in the SELECT statement being created in this same order
# I don't like this, but the alternative was copying
# all the retrieved data rows, and this was prooblematic
# on large (1 million row) record sets
my $i = 0;
foreach $col (sort keys %cols)
{
if($cols{$col}{'DATA_TYPE'} eq 'DATE')
{
my $dt = ParseDate( $records_array_ref->[($pos - 1)]->[$i]);
$data_fields{$col} = UnixDate($dt, "%s");
}
else
{
$data_fields{$col} = $records_array_ref->[($pos - 1)]->[$i];
}
$i++;
}
# Make a copy, BEFORE anyone can change this
# Need this to use in UPDATE
%this_record = %data_fields;
}
}
case 'previous' {
# Update %data_fields with previous record here
# PopUp error message if already displaying first record
$pos--;
if($pos < 1)
{
popup_msg("Already Displaying First Record");
$pos = 1;
}
else
{
# We depend upon the order of the columns to retrieve
# in the SELECT statement being created in this same order
# I don't like this, but the alternative was copying
# all the retrieved data rows, and this was prooblematic
# on large (1 million row) record sets
my $i = 0;
foreach $col (sort keys %cols)
{
if($cols{$col}{'DATA_TYPE'} eq 'DATE')
{
my $dt = ParseDate( $records_array_ref->[($pos - 1)]->[$i]);
$data_fields{$col} = UnixDate($dt, "%s");
}
else
{
$data_fields{$col} = $records_array_ref->[($pos - 1)]->[$i];
}
$i++;
}
# Make a copy, BEFORE anyone can change this
# Need this to use in UPDATE
%this_record = %data_fields;
}
}
case 'insert' {
# create and execute an SQL "INSERT" here
# using all fileds of %data_fileds that are defined and not ''
# Be sure and capture DB errors (Duplicate Key) and use PopUp
# to display
$rc = validate_record();
if ($rc == 0)
{
my $stmt = create_insert_statement($ltable);
print "->$stmt<-\n";
print_debug(3,"Prepareing to execute\n->$stmt<-\n",0,0);
execute_input_statement($stmt);
}
}
case 'update' {
# create and execute an SQL "UPDATE" here
# using all fileds of %data_fileds that are defined and not ''
# Be sure and capture DB errors (No Such Record) and use PopUp
# to display
#
# Might want to try "INSERT", if "UPDATE" fails here ??
$rc = validate_record();
if ($rc == 0)
{
my $stmt = create_update_statement($ltable);
print_debug(3,"Prepareing to execute\n->$stmt<-\n",0,0);
# execute_input_statement($stmt);
}
}
case 'delete' {
# create and execute an SQL "DELETE" here
# using all fileds of %data_fileds that are defined and not ''
# Be sure and capture DB errors (No Such Record) and use PopUp
# to display
#
# If DB returns success, be certain to remove this record from the
# in memory records array, and decrement the record qty.
$rc = validate_record();
if ($rc == 0)
{
my $stmt = create_delete_statement($ltable);
print "->$stmt<-\n";
print_debug(3,"Prepareing to execute\n->$stmt<-\n",0,0);
# execute_input_statement($stmt);
}
}
}
}
}
print_debug(1,"State = $state.\n",0,0);
print_debug(3,"Returning from $function_name()\n",0,0);
}
It seems to be compalining about the first swithc statement.
What dumb user error have I made, here?
------------------------------
Date: Tue, 11 Sep 2001 13:02:56 GMT
From: mjd@plover.com (Mark Jason Dominus)
Subject: Re: Really bizzare syntax error
Message-Id: <3b9e0b80.2904$10@news.op.net>
In article <9nkvpc$m4c$1@panix1.panix.com>, Stan Brown <stanb@panix.com> wrote:
>However the caused the following sunroutine to be declared to have a syntax
>error by the compiler!
It appears that there is a bug in the 'Switch' module.
>What dumb user error have I made, here?
I don't think you have made any error.
--
@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{
@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord
($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print
------------------------------
Date: Tue, 11 Sep 2001 21:20:38 +1000
From: "Tintin" <tintin@snowy.calculus>
Subject: Re: recognize MS Windows with perl
Message-Id: <dtmn7.44$CT5.604290@news.interact.net.au>
"Jonadab the Unsightly One" <jonadab@bright.net> wrote in message
news:3b9d9943.8816028@news.bright.net...
> Alex Hart <news@althepal#nospam#.com> wrote:
>
> > What is the best way to determine whether my program is being run on a
> > MS Windows box? Is there a sure fire way?
>
> Parse `ver`
Buzzz. Doesn't work on VMS,OS/2, Unix, Mac
------------------------------
Date: Tue, 11 Sep 2001 22:01:06 +0930
From: "Wyzelli" <wyzelli@yahoo.com>
Subject: Re: recognize MS Windows with perl
Message-Id: <_8nn7.3$D87.488@wa.nnrp.telstra.net>
"Tintin" <tintin@snowy.calculus> wrote in message
news:dtmn7.44$CT5.604290@news.interact.net.au...
>
> "Jonadab the Unsightly One" <jonadab@bright.net> wrote in message
> news:3b9d9943.8816028@news.bright.net...
> > Alex Hart <news@althepal#nospam#.com> wrote:
> >
> > > What is the best way to determine whether my program is being run on a
> > > MS Windows box? Is there a sure fire way?
> >
> > Parse `ver`
>
> Buzzz. Doesn't work on VMS,OS/2, Unix, Mac
>
<tongue in cheek>
Which means failure could be taken as an indication of NOT being on win32,
whils success could indicate being on win32.
</tongue in cheek>
Oh, he did say 'best'.
Wyzelli
--
#Modified from the original by Jim Menard
for(reverse(1..100)){$s=($_==1)? '':'s';print"$_ bottle$s of beer on the
wall,\n";
print"$_ bottle$s of beer,\nTake one down, pass it around,\n";
$_--;$s=($_==1)?'':'s';print"$_ bottle$s of beer on the
wall\n\n";}print'*burp*';
------------------------------
Date: Tue, 11 Sep 2001 09:39:44 +0200
From: "Tim Lauterborn" <email@timlauterborn.de>
Subject: Regular expression
Message-Id: <9nkf4g$gar$1@nets3.rz.RWTH-Aachen.DE>
Hi,
I want to use the following line:
$file_content =~ s/This is/These are/gis;
Unfortunately "This is" is not replaced by "These are". Does someone know a
solution?
Thanks!
Greetings,
Tim
------------------------------
Date: Tue, 11 Sep 2001 08:58:15 -0100
From: Rainer Klier <Rainer.Klier@erl.sbs.de>
Subject: Re: Regular expression
Message-Id: <3B9DE037.E43E59EF@erl.sbs.de>
Tim Lauterborn wrote:
>
> I want to use the following line:
>
> $file_content =~ s/This is/These are/gis;
>
> Unfortunately "This is" is not replaced by "These are". Does someone know a
> solution?
#!/usr/bin/perl -w
while($file_content=<DATA>) {
$file_content =~ s/This is/These are/gis;
print $file_content;
}
__DATA__
This is a dog
$ /tmp/te.pl
These are a dog
There must be something else broken in your code.
Rainer
------------------------------
Date: Tue, 11 Sep 2001 07:49:02 GMT
From: tim@vegeta.ath.cx (Tim Hammerquist)
Subject: Re: Regular expression
Message-Id: <slrn9prh73.3dk.tim@vegeta.ath.cx>
[ cross-post removed ]
Me parece que Tim Lauterborn <email@timlauterborn.de> dijo:
> Hi,
>
> I want to use the following line:
>
> $file_content =~ s/This is/These are/gis;
>
> Unfortunately "This is" is not replaced by "These are". Does someone know a
> solution?
Sample code would be a very good thing, if you were to post it, of course.
What does $file_content actually contain?
--
It is a fool's prerogative to utter
truths that no one else will speak.
-- Morpheus, The Sandman
------------------------------
Date: Tue, 11 Sep 2001 09:48:15 +0200
From: "fruiture" <info@fruiture.de>
Subject: Re: Regular expression
Message-Id: <9nkfmh$aeq$05$1@news.t-online.com>
"Tim Lauterborn" <email@timlauterborn.de> wrote:
> Hi,
>
> I want to use the following line:
>
> $file_content =~ s/This is/These are/gis;
>
> Unfortunately "This is" is not replaced by "These are". Does someone
know a
> solution?
% perl -e "$_ = 'This is apples'; print "$_\n"; s/This is/These are/gis;
print;"
--
require Time::HiRes;my @m=split(/8/,55.52.56.49.49.55.56.49.49.53);push
@m,map{($_%2)?$_-1:$_+1} map ord($_),split//,'u!`onuids!Qdsm!i`bjds';
unshift @m,43 for(0..@m);for(0..@m){print map chr($_),@m[0..(@m/2-1)];
push @m,shift @m;print "\b"x(@m/2);Time::HiRes::usleep(0246*0xA**3);}
------------------------------
Date: Tue, 11 Sep 2001 09:06:00 +0100
From: Andrew Paul Gorton <gortona@cs.man.ac.uk>
Subject: Sharing memory
Message-Id: <3B9DC5E8.A1EA252A@cs.man.ac.uk>
Hi,
I have a script that forks children. The child pids are then used to
exec other scripts which individually run in continually while loop.
There is about seven of these.
I have tried using pipes to communicate bi-directional but it is getting
to complicated with the synchronization etc. Is there a simple way to
share information with the parent and the children and if so how, I am
getting desperate. I need the parent to be able to send configuration
data and the child to process information and reply. Can a parent share
its global varaibles with a child? The solution needs to be simple as I
am new to perl, but effective.
Sorry for being a pain in the arse
Cheers
Andy
------------------------------
Date: 11 Sep 2001 12:53:29 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Warning on adding hash element
Message-Id: <9nl1g9$74b$1@mamenchi.zrz.TU-Berlin.DE>
According to so <soosterh@my-deja.com>:
> soosterh@my-deja.com (so) wrote in message
> news:<db6cb1f3.0109100737.3f0726e1@posting.google.com>...
> > Hello all:
> >
> > I have a subroutine that accepts a reference to a hash.
> > Now I want to add an element to that hash.
> > The following line does actually work, but with
> > use strict enabled I get a warning...
> >
> > $hash_ref->{ 'subHash' } = { -option1=>'val1', -option2=>'val2' };
> >
> > produces...
> > Use of uninitialized value at (eval 11) line 17.
> [rest snipped]
>
> Sorry to reply to my own post, but I found the solution myself.
> Tad McClellan was correct that line of code is actually correct.
> What I was actually doing was this...
> $sInfo->{ '-script' } = {-language=>'javascript',-src=>'/macros_so.js' };
> print start_html( $sInfo ), "\n";
>
> I found I could easily fix the warning by changing '-script' to
> something else (ie. '-foo' ). So my guess is that inside of the
> CGI module's start_html() there is some dependency that an other
> element is defined for the '-script' subHash, and the function
> actually then blindly dereferences that element.
...a fact that is documented in CGI, though "-script" is missing
from the parameter description of start_html.
"You been a-messin' where ya shouldna been a-messin' ..."
> Now why exactly the warning showed up in my script and not in the module
> I have no clue -- perhaps they have an error handler that passes errors
> up the stack ?
It is standard procedure for modules to use the Carp module which
does exactly that.
Anno
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 1731
***************************************
