[19573] in Perl-Users-Digest
Perl-Users Digest, Issue: 1768 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Sep 18 14:10:31 2001
Date: Tue, 18 Sep 2001 11:10:10 -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: <1000836610-v10-i1768@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Tue, 18 Sep 2001 Volume: 10 Number: 1768
Today's topics:
Problem with Storable, and pipes (buffering) (Stan Brown)
Re: Regular Expresion help needed <dtweed@acm.org>
Re: Storing info from a socket connection <oneconcept@yahoo.co.uk>
Re: Storing info from a socket connection <dtweed@acm.org>
Structured Boolean Search-Queries <junk@almide.demon.co.uk>
Re: write to a file handle <clay@panix.com>
Re: write to a file handle <mjcarman@home.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 18 Sep 2001 13:57:06 -0400
From: stanb@panix.com (Stan Brown)
Subject: Problem with Storable, and pipes (buffering)
Message-Id: <9o81ti$s91$1@panix1.panix.com>
OK, at the risk of being flaed for posting this.
I have managed to cut this down to what I consider a minimal way of
demonstrating the problem I have. If you run this code, press teh "Execute"
Button. You will see that the new_records subrotuine gets called an blocks
for lacj of data (I think), In any case, since it's blocked on the
fd_retrieve(0 call, it can;t do anything else (like return to the man
loop).
As you can see I am setting autoflush on the write end of the piep, but
that does not seem to fix the probelm.
I'm certain the problem must be blindingly obvious to some of you bright
people, so how about shareing the wisdom with this poor idiot.
#!/opt/local//bin/perl -w
use strict;
use Tk;
use POSIX qw(strftime strtod _exit);
use Storable qw(store_fd fd_retrieve);
use FileHandle;
# Global so that the error popups can reference it
my $MW;
# Button widgets
# Global so that the "active/disabled" states can be toggled/queried by
# callbacks
my $execute_button;
my $record_qty=0;
my $child_pid;
my $qr = 0;
$::Debug=1;
sub print_debug($$$$) {
##################################################################
#
# Print debug message to STDERR with appropriate number
# of leading "-"s to show level of debuging required
# to invoke this message
#
# Argument 1 is the debuging level required to ge this mesage
# Argument 2 is the message
# Argument 3 is a flag to get a datestamp
# Argument 4 is a flag to get PID printed
#
##################################################################
my ($level, $msg, $need_date, $pid_flag) = @_;
my $leader = '';
my $datetime = '';
my $i = 0;
STDERR->autoflush(1);
if ($::Debug >= $level)
{
if($pid_flag == 1)
{
$leader = " PID->$$: "
}
for ($i = 1; $i <= $level; $i++) {
$leader = "$leader-";
}
$leader = "$leader ";
$msg = "$leader$msg";
if ($need_date == 1)
{
$datetime = localtime();
# Yes, the leading space is on purpose
# It helps to sort out these from the other
# noise teh program may be putting ot
# If I asked for a datestamp, then I'm probably
# on scaning through the noise, looking ofr timeing
# rleationships
print STDERR (" $0: $datetime: $msg");
}
else
{
print STDERR ("$0: $msg");
}
}
}
sub cleanup_and_exit() {
################################################################
#
# cleanup_and_exit
#
# Should be called anywhere we want to exit the main
# procees (not the child), instead of exit
#
###############################################################
my $function_name = (caller(0))[3];
print_debug(2,"Entering $function_name()\n",0,0);
if( defined $child_pid)
{
kill 'SIGTERM' , $child_pid;
}
if( defined $MW)
{
$MW->destroy;
}
exit;
}
sub draw_buttons () {
#####################################################################
#
# Create the user action buttons
#
####################################################################
my(@seperator_attributes) = qw/-width 20 -height 10/;
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " .
( defined $_[$_] ? "->$_[$_]<-" :
'*UNDEF*'), 0 .. $#_;
print_debug(2,"Entering $function_name()\n",0,0);
print_debug(3,"$argtmp\n",0,0);
# Create a little space between entry fileds and buttons
my $spacer2 = $MW->Frame(@seperator_attributes);
$spacer2->pack( -side => 'left');
# Create 'execute' button
$execute_button = $MW->Button(-text => "Execute\nQuery",
-width => 15,
-background => 'PeachPuff1' ,
-activebackground => 'PeachPuff1' ,
-state => 'active' ,
-borderwidth => 2 ,
-command => sub
{
fetch_records();
});
$execute_button->pack( -side => 'top' );
# Create 'exit' button
my $exit = $MW->Button(-text => 'Exit',
-background => 'Red' ,
-activebackground => 'Red' ,
-foreground => 'White' ,
-activeforeground => 'White' ,
-state => 'active' ,
-borderwidth => 2 ,
-command => sub
{
cleanup_and_exit();
});
$exit->pack( -side => 'top');
print_debug(3,"Returning from $function_name()\n",0,0);
}
sub fetch_records () {
#####################################################################
#
# Prepares and executes a database query, based upon the
# info in %data_fileds
#
# Inputs
#
# Side effects
# Spawns a child task to execute the DB fetch
# The callback triggered by this cahild does the followig:
# Sets %record_set[] to contain all the returned records
# Adds quantity of records, and currently displayed record
# number widgets to main window
#
#####################################################################
my $pid;
my $pipe;
my $rc;
my $sths;
my $rp = 0;
my @a = [1, 2, 3, 4, 5, 6, 7, 8, 9];
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " .
( defined $_[$_] ? "->$_[$_]<-" :
'*UNDEF*'), 0 .. $#_;
print_debug(2,"Entering $function_name()\n",0,0);
print_debug(3,"$argtmp\n",0,0);
$MW->Busy;
pipe my ($reader, $writer) or die "pipe: $!";
if( my $pid = fork ) {
# parent process here
print_debug(1,"Parent task\n",0,1);
$child_pid = $pid;
close $writer;
$MW->fileevent($reader,
"readable",
[\&new_records_avail,
$reader,
$pid]);
} elsif( defined $pid ) {
# child process here
print_debug(1,"Child task started\n",0,1);
close $reader;
$writer->autoflush();
eval {
# Prepare query
my $i;
while( 1 ) {
store_fd( \@a, $writer ) or die "can't store to $writer\n";
if($rp == 100)
{
print_debug(1,"Sleeping after $i iterations\n",1,0);
sleep(10);
print_debug(1,"Done sleeping\n",1,0);
$rp = 0;
}
++$rp;
++$i;
}
store_fd( [], $writer ) or die "can't store to $writer\n";
print_debug(1, "Fetch done\n",1,0);
};
store_fd \$DBI::errstr, $writer if $@;
close $writer;
$sths->finish();
print_debug(5,"Child task done\n",0,1);
undef $child_pid;
POSIX::_exit(0);
}
print_debug(3,"Returning from $function_name()\n",0,0);
}
sub new_records_avail($$) {
######################################################################
#
# new_records_avail
#
# The callback routine, that is called when the child task, which
# does the actual DB fetch, has data available.
#
# Inpits
#
# 1. The filehandle to read from
# 2. The pid of the child
#
#####################################################################
my ($reader,$pid)=@_;
my $rb;
my $sb;
my $cb;
my $col;
my $plural;
my $junk;
my(@seperator_attributes) = qw/-width 10 -height 40/;
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " .
( defined $_[$_] ? "->$_[$_]<-" :
'*UNDEF*'), 0 .. $#_;
print_debug(1,"Entering $function_name()\n",1,0);
print_debug(3,"$argtmp\n",0,0);
my $arow = fd_retrieve $reader;
print_debug(1,"Got $arow()\n",1,0);
die "Unexpected eof $!" if !$arow;
if( !@$arow ) {
print_debug(1, "Done With Fetching commify($record_qty) Selected Records\n",1,1);
$MW->fileevent( $reader, "readable", "" );
print_debug(1, "Sending kill for preocess $pid\n",1,1);
kill 9, $pid;
waitpid( $pid , 0);
print_debug(1, "Preocess $pid is terminated\n",1,1);
close $reader;
$MW->Unbusy();
popup_msg("All Records That Match Your Selected Criteria Have Now Been Fetched");
}
if($record_qty == 0)
{
print_debug(1, "First record recieved\n",1,1);
++$record_qty;
print_debug(1, "First record Processing Complete\n",1,1);
return;
}
++$record_qty;
print_debug(1,"Returning from $function_name()\n",1,0);
}
# main()
# Initialze Tk
$MW = MainWindow->new();
$MW->title ("Data Manipulation Form");
my $label = $MW->Label(-text => "DataBase Table Editor For Table" ,
-anchor => 'n',
-justify => 'center');
$label->pack(-side => 'top', -fill => 'y', -expand => 'y');
draw_buttons();
# Interact...
MainLoop();
--
"They that would give up essential liberty for temporary safety deserve
neither liberty nor safety."
-- Benjamin Franklin
------------------------------
Date: Tue, 18 Sep 2001 13:18:56 GMT
From: Dave Tweed <dtweed@acm.org>
Subject: Re: Regular Expresion help needed
Message-Id: <3BA74881.DA1B4816@acm.org>
Fredrik wrote:
> [^-->] would match any character *except* '-' or '-' or '>'
[^-->] would match any character except '-' through '>', equivalent
to [^-./0123456789:;<=>]
-- Dave Tweed
------------------------------
Date: Tue, 18 Sep 2001 16:55:15 +0100
From: "Raj" <oneconcept@yahoo.co.uk>
Subject: Re: Storing info from a socket connection
Message-Id: <1000828468.19221.0.nnrp-01.c2d95a2c@news.demon.co.uk>
Maybe I have not given enough information.
Here's the code I am having trouble with:
$reply = <S>;
if ($reply =~ /^200\s+(.*)/) { # 200 Data follows = OK
while (<S>) {
#print "<P>".$_;
($key, $value) =~ /^BILL:(.*?)=(.*)/;
$address{$key} = $value;
}
close(S);
return 1;
} elseif {
return undef;
Where S is the socket connection. This socket connects fine, and the
commented out print line outputs the values I am trying to plug into the
assoc array.
Can anyone please help?
Regards,
Raj
"Raj" <oneconcept@yahoo.co.uk> wrote in message
news:1000810510.27820.0.nnrp-13.c2d95a2c@news.demon.co.uk...
> Hiya,
>
> I am having a problem storing information from a socket connection to an
> array. When I print the information to the screen it displays fine but I
> want to add each line into an assoc array.
>
> Then I want to use the values to populate text boxes of a form.
>
> Does anyone have any suggestions on how to acheive this?
>
> Thanks in advance for any help you can provide!
>
> Regards,
> Raj
>
>
------------------------------
Date: Tue, 18 Sep 2001 17:04:59 GMT
From: Dave Tweed <dtweed@acm.org>
Subject: Re: Storing info from a socket connection
Message-Id: <3BA77D7E.20361065@acm.org>
Raj wrote:
> ($key, $value) =~ /^BILL:(.*?)=(.*)/;
This attempts to apply the regex to the (scalar) value of the list
($key, $value). What you really want is:
($key, $value) = /^BILL:(.*?)=(.*)/;
which applies the regex to the $_ variable and returns the matched
substrings as a list, which then get assigned to $key and $value.
-- Dave Tweed
------------------------------
Date: Tue, 18 Sep 2001 14:05:12 +0100
From: Kelly and Sandy <junk@almide.demon.co.uk>
Subject: Structured Boolean Search-Queries
Message-Id: <11TZOJAIa0p7MwJq@almide.demon.co.uk>
Dear Weston Ruter,
I'm in the process of looking for a (fairly simple)
search system for my moderately growing archive of
articles on my website. Using
http://cgi.resourceindex.com, I have found a perl-based
system that's good enough for the present,
http://www.extropia.com/applications/search.html
One thing I've noticed in looking for a search engine
is that I can't find any that perform genuine "boolean"
structured queries. I find this the most natural way to
search. ie.
"jesus" AND ("brother stair" OR "overcomer ministry")
. . . . .
I can straightways tell that even though you're way
down the page and "unrated" by the cgi.resouceindex page,
your search package is actually by far and away the best
and most useful to anyone with a modicum experience of
computers and programming. I speak like this because I
myself was a programmer -- before I escaped the
tribulation of city life in London, England, and moved
away to the countryside and started running a farmstead
in the North York Moors with my wife:
http://www.almide.demon.co.uk/html/Complex/
Complex_for_Java.html
If your RuterSearch were to feature structured
boolean queries, I would certainly choose you over any
other. Therefore my suggestion for your RuterSearch is
that you add structured boolean querying (in the same way
that AltaVista advanced queries work).
With kind regards,
Sandy
P.S. Preferably, this implies using a parser built based
on a context-free BNF (Backus-Naur formalism)
description of the structured boolean "language".
No better way to come to grips with using the power
of formal language parsers and _parser_generators_
can be found than by looking at the free Java-based
work of JTB at purdue university:
http://www.cs.purdue.edu/jtb/index.html
/* C A U T I O N E X P L O S I V E B O L T S
-- REMOVE BEFORE ENGAGING REPLY
//
// Kelly and Sandy Anderson <kelsan@explosive-alma-services-bolts.co.uk>
// (alternatively kelsan_odoodle at ya who period, see oh em)
// Alexander (Sandy) 1B5A DF3D A3D9 B932 39EB 3F1B 981F 4110 27E1 64A4
// Kelly 673F 6751 6DBA 196F E8A8 6D87 4AEC F35E E9AD 099B
// Homepages http://www.explosive-alma-services-bolts.co.uk/
*/
------------------------------
Date: 18 Sep 2001 15:05:39 GMT
From: Clay Irving <clay@panix.com>
Subject: Re: write to a file handle
Message-Id: <slrn9qeoo2.dn7.clay@panix1.panix.com>
In article <3ba6a115.30075095@enews.newsguy.com>, Joe Chung wrote:
> i found out I must put the "\n" in the end of the string. why this
> happen? Is that if i want to write a line into a filehandle, I must
> end the line with "\n"?
You don't.
#!/usr/local/bin/perl
open F, ">foo3" or die "$!\n";
print F "This is a test";
Result:
clay@energy: cat foo3
This is a testclay@energy:
--
Clay Irving <clay@panix.com>
The remarkable thing about Shakespeare is that he really is very good, in
spite of all the people who say he is very good.
- Robert Graves
------------------------------
Date: Tue, 18 Sep 2001 10:48:18 -0500
From: Michael Carman <mjcarman@home.com>
Subject: Re: write to a file handle
Message-Id: <3BA76CC2.D08B0FA5@home.com>
[Please place your comments *after* the trimmed text that you are
repsonding to. Post reordered.]
Joe Chung wrote:
>
> David Efflandt wrote:
>>
>> Joe Chung wrote:
>>>
>>> i am trying to write to a filehandle
>>>
>>> open(LOCK,">/export/home/admin/log");
>>> print LOCK "test string";
>>>
>>> the premession of log is like this:
>>> -rw-r--r-- 1 root other 5 Sep 17 12:41 log
>>>
>>> why after the above statement execute, nothing is written to
>>> the file "log" (the file is empty)?
If you aren't running as root, you don't have permissions to open the
file for writing. If you are running as root, you shouldn't be. :)
Always test open() for success:
open(LOCK, '>/export/home/admin/log')
or die "Could not open file [$!]";
> i found out I must put the "\n" in the end of the string. why this
> happen? Is that if i want to write a line into a filehandle, I must
> end the line with "\n"?
David already told you:
>> print output is buffered until it reaches "\n" in the printed
>> string unless you set $| = 1;.
So if you check the contents of the file immediately after your print(),
you won't see anything. Closing the filehandle will also flush the
buffer.
-mjc
------------------------------
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 1768
***************************************
