[22012] in Perl-Users-Digest
Perl-Users Digest, Issue: 4234 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Dec 9 03:05:44 2002
Date: Mon, 9 Dec 2002 00:05:08 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Mon, 9 Dec 2002 Volume: 10 Number: 4234
Today's topics:
Re: CGI.pm uploaded file size is smaller than origina <ahj6@hotmail.com>
Complex log parsing. <darkage@freeshellzzzz.org>
Currency Regular expression (Elf)
Discerning an Open and Closed Socket... <brad.galiette@snet.net>
Discerning an Open and Closed Socket... <brad.galiette@snet.net>
Re: Help with "Chomp" Command (Tad McClellan)
Re: Multi-dimensional hash question <spam@thecouch.homeip.net>
Re: Multi-dimensional hash question <stremitz@consultant.com>
Re: Multi-dimensional hash question (Tad McClellan)
Output Lines of 70 Characters (David Tian)
Re: Output Lines of 70 Characters <jurgenex@hotmail.com>
stringTTF() Fails to Display String in GD::Image <jsnelson@telocity.com>
Re: stringTTF() Fails to Display String in GD::Image <usenet@atrixnet.com>
VBA equivalent of Range in Perl (FMAS)
Why doesn't my array grow? (Rob Richardson)
Re: Why doesn't my array grow? <jeff@vpservices.com>
Re: Why doesn't my array grow? <dave@dave.org.uk>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Mon, 9 Dec 2002 08:11:44 +0900
From: "Hyungjin Ahn" <ahj6@hotmail.com>
Subject: Re: CGI.pm uploaded file size is smaller than original one. help
Message-Id: <at0i2s$igt$1@news1.kornet.net>
"Dave Cross" <dave@dave.org.uk> wrote in message
news:pan.2002.12.08.15.57.02.529766@dave.org.uk...
> On Sun, 08 Dec 2002 23:17:00 +0900, Hyungjin Ahn wrote:
>
> > I uploaded abcd.jpg and saved it in the server fold as xxx.jpg. When
> > compared, abcd.jpg = 78,526bytes and xxx.jpg = 77,824bytes;
> >
> > xxx.jpg was well showed the same image to the original one, but why are
the
> > sizes of both different?
>
> At a guess you need to read the docs for "binmode".
When I ommited "binmode OUTFILE, ':raw';", created file was not valid. So I
setted binmode to ':raw' that the created file was valid but the file size
was smaller that the original one.
------------------------------
Date: Mon, 9 Dec 2002 11:59:29 +1100
From: "^darkage" <darkage@freeshellzzzz.org>
Subject: Complex log parsing.
Message-Id: <at0pti$68g$1@perki.connect.com.au>
This is the sample output of the type of information I want to parse. the
unique number is 1447844 which I have to match with number 1474. Currently
I've been trying to regex a line at a line breaking up the lines into an
array. Then hoping to join everything at the end. I want to be able to
pull from this FROM emailaddress, TO emailaddress, SUCCESS or FAILURE,
REASON y failed (which is in the same space as the "accepted message" line
below) and time and date which isn't hard to convert here in multilog
format. The reason y I want to do this, is that I wish is to put the above
info into a mysql db which I have the hang of already (: Im not sure if
Im attacking this from the right direction?
@400000003df03e640e689364 new msg 1447844
@400000003df03e640e6ae524 info msg 1447844: bytes 2419 from <me@me.com> qp
25584 uid 1005
@400000003df03e640eb73834 starting delivery 1474: msg 1447844 to remote
email@email.com
@400000003df03e773af12e14 delivery 1474: success:
10.0.0.2_accepted_message./Remote_host_said:_250_OK/
@400000003df03e773b11354c end msg 1447844
#!/usr/bin/perl -w
open(FP, "current_mail_log") || die "Unable to open file b'coz $!\n";
chomp(@my_array = <FP>);
close(FP);
foreach $ele ( @my_array )
{
if ($ele=~/new\smsg/){
@newfields = split /\s+/, $ele;
$newmsg = @newfields[4];
push @newmsgid, $newmsg;
}
if ($ele=~/info\smsg/){
@infofields = split /\s+/, $ele;
#print @infofields[8]; email
@infocompare = split /:/, @infofields[4];
$infocompare1 = @infocompare;
push @infomsgid, $infocompare1
}
HERE hope to put @newmsgid && @infomsgid info a regex search to get start
delivery line. then etc.
}
#close FILE;
exit 1;
------------------------------
Date: 8 Dec 2002 22:11:08 -0800
From: smltestau@yahoo.com.au (Elf)
Subject: Currency Regular expression
Message-Id: <6c45ec57.0212082211.7b2d7bf6@posting.google.com>
Hi Group,
I'm trying to write a regular expression which will validate a
currency string.
It's specificly for Javascript, but have cross posted to the Perl
group as you lot generaly have a strong(ger) knowledge of regular
expressions.
What I've got so far is as follows:
new RegExp( /^\$?\d+(?:,\d{3})*(?:\.\d{1,2}){0,1}$/ );
\$? - Optional $ sign at start of string
\d+ - One or more numbers
(?:,\d{3})* - 0 or more groups of comma followed by three digits
That works fine. The next bit doesn't.
(?:\.\d{1,2}){0,1} - an optional group of a full stop followed by 1 or
2 digits
If anyone can offer some help, that would be greatly appreciated.
Elf.
------------------------------
Date: Sun, 08 Dec 2002 21:09:16 GMT
From: "Brad W. Galiette" <brad.galiette@snet.net>
Subject: Discerning an Open and Closed Socket...
Message-Id: <0yOI9.3104$l17.792753225@newssvr10.news.prodigy.com>
I am attempting to create a server application in Perl that offers a simple
keyword-based data access system to be used by a separate, Windows-GUI
client application. Although I have included the entirety of the developing
application below (which is based closely upon the example found at
http://www.perldoc.com/perl5.8.0/pod/perlipc.html ), I am most concerned
with the server_run() routine.
This method within the script is in essence the "base location" of execution
following a fork() from the parent application. Provided that the client
terminates a session with the "QUIT" or "LOGOFF" keywords, the child script
quits cooperatively and the parent releases any resources that had been
consumed by the sub-session. HOWEVER, if the client disconnects WITHOUT
first sending a termination keyword, the child is flung into an infinite
(and *exceptionally* resource-demanding!) loop; the code fragment referenced
by SIG{CHLD} is never executed either. I am presuming that this is the
result of server_run()'s while loop, which encounters an infinitely-true
statement and is then unable to realize that STDIN is no longer linked to
the client (which was previously DUPed from Client). Thus my ultimate
question is rather straightforward: how would I determine if STDIN (or
Client) is still open? Note that I have tried (-S STDIN) and (-S Client);
neither have worked as I intended.
Any help would be greatly appreciated!
Regards,
Brad Galiette
--------------------------------------------------------------------------
#!/usr/bin/perl
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
my $EOL = "\015\012";
my @data_lines;
my $data_id = "";
my $port = 2323;
my $proto = getprotobyname('tcp');
my $active_user = 1;
sub spawn; # forward declaration
sub logmsg
{
open(ID, ">>id.txt");
print ID scalar localtime, ": @_\n";
close(ID);
}
($port) = $port =~ /^(\d+)$/ or die "invalid port";
socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";
logmsg "Server started";
&parse_data();
my $waitedpid = 0;
my $paddr;
sub REAPER {
$waitedpid = wait;
$SIG{CHLD} = \&REAPER; # loathe sysV
logmsg "Terminated...";
}
$SIG{CHLD} = \&REAPER;
for ( $waitedpid = 0; ($paddr = accept(Client,Server)) || $waitedpid;
$waitedpid = 0, close Client)
{
next if $waitedpid and not $paddr;
my($port,$iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr,AF_INET);
logmsg "Client connected!";
spawn sub {
$| = 1;
select(STDOUT);
$| = 1;
&server_run();
};
}
sub spawn {
my $coderef = shift;
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
confess "usage: spawn CODEREF";
}
my $pid;
if (!defined($pid = fork)) {
logmsg "cannot fork: $!";
return;
} elsif ($pid) {
logmsg "begat $pid";
return; # I'm the parent
}
# else I'm the child -- go spawn
open(STDIN, "<&Client") || die "can't dup client to stdin";
open(STDOUT, ">&Client") || die "can't dup client to stdout";
## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
exit &$coderef();
}
sub server_run
{
my $line = "";
print "200 Welcome\n";
my $timeout_stage = 0;
while ($active_user == 1)
{
eval{
logmsg "Waiting for input";
local $SIG{ALRM} = sub{die "\n" };
alarm 10;
$line = &read_args();
alarm 0;
};
if ($@)
{
$timeout_stage++;
if ($timeout_stage == 3)
{
logmsg "Timeout 30";
&update_data();
$timeout_stage = 0;
}
else
{
logmsg "Timeout 10";
}
}
else
{
logmsg "Evaluating";
&evaluate($line);
}
}
}
sub update_data
{
}
sub read_args
{
my $line = <STDIN>;
chop($line);
return $line;
}
sub evaluate
{
my($line) = @_;
logmsg $line;
my @arg_ele = ();
@arg_ele = split(/\\n/, $line);
for (my $i = 0; $i < @arg_ele; $i++)
{
logmsg $arg_ele[$i];
my @line_ele = split(/\s+/, $arg_ele[$i]);
if ($line_ele[0] =~ /^ANNC$/i)
{
#&annc_respond($line_ele[1]);
if ($line_ele[1] eq "" || $line_ele[1] ne $data_id)
{
#$socket->send("231 " . $data_id . "\n");
print "231 " . $data_id . "";
for (my $i = 0; $i < @data_lines; $i++)
{
my @indiv_ele = split(/\|/, $data_lines[$i]);
#$socket->send($indiv_ele[3] . "|" . $indiv_ele[1] . "|" . $indiv_ele[2]
. "|" . $indiv_ele[4] . "\n");
print $indiv_ele[3] . "|" . $indiv_ele[1] . "|" . $indiv_ele[2] . "|" .
$indiv_ele[4] . "\n";
#print $indiv_ele[3] . "|" . $indiv_ele[1] . "|" . $indiv_ele[2] . "|" .
$indiv_ele[4] . "\n";
}
#$socket->send(".");
print ".";
}
else
{
#$socket->send("230 " . $data_id . "\n");
print "230 " . $data_id . "";
}
logmsg "ANNC SENT";
}
elsif ($line_ele[0] =~ /^TIME$/i)
{
#&time_respond();
my($sec, $min, $hour, $day, $mon, $year) = (localtime(time))[0,1,2,3,4,5];
print "210 " . $hour . "|" . $min . "|" . $sec . "|" . $mon . "|" . $day .
"|" . $year . "\r\n";
logmsg "210 " . $hour . "|" . $min . "|" . $sec . "|" . $mon . "|" . $day
. "|" . $year;
logmsg "TIME SENT";
}
elsif ($line_ele[0] =~ /^STATUS$/i)
{
#&status_respond();
print "220 1|HELLO\n";
logmsg "STATUS SENT";
}
elsif ($line_ele[0] =~ /^QUIT$/i || $line_ele[0] =~ /^LOGOFF$/i)
{
logmsg "Client logoff...\n";
$active_user = 0;
last;
}
}
}
sub annc_respond
{
my ($input_arg) = @_;
if ($input_arg eq "" || $input_arg ne $data_id)
{
#$socket->send("231 " . $data_id . "\n");
print "231 " . $data_id . "\n";
for (my $i = 0; $i < @data_lines; $i++)
{
my @indiv_ele = split(/\|/, $data_lines[$i]);
#$socket->send($indiv_ele[3] . "|" . $indiv_ele[1] . "|" . $indiv_ele[2] .
"|" . $indiv_ele[4] . "\n");
print $indiv_ele[3] . "|" . $indiv_ele[1] . "|" . $indiv_ele[2] . "|" .
$indiv_ele[4] . "\n";
#print $indiv_ele[3] . "|" . $indiv_ele[1] . "|" . $indiv_ele[2] . "|" .
$indiv_ele[4] . "\n";
}
#$socket->send(".");
print ".";
}
else
{
#$socket->send("230 " . $data_id . "\n");
print "230 " . $data_id . "\n";
}
#print "Sending anncs...\n";
logmsg "Anncs sent";
}
sub time_respond
{
#my ($socket) = @_;
my($sec, $min, $hour, $day, $mon, $year) = (localtime(time))[0,1,2,3,4,5];
print "210 " . $hour . "|" . $min . "|" . $sec . "|" . $mon . "|" . $day .
"|" . $year;
#print "Sending time...\n";
logmsg "Time sent";
}
sub status_respond
{
#my ($socket) = @_;
print "220 1|HELLO";
#print "Sending status...\n";
logmsg "Status sent";
}
sub parse_data
{
my $data_line = "";
my $temp_data_id = "";
my $data_inc = 0;
open(DATA, "data.txt");
$temp_data_id = <DATA>;
chop($temp_data_id);
if ($temp_data_id ne $data_id)
{
$data_line = <DATA>;
chop($data_line);
while ($data_line ne "")
{
$data_lines[$data_inc] = $data_line;
$data_line = <DATA>;
chop($data_line);
$data_inc++;
}
$data_id = $temp_data_id;
}
close(DATA);
logmsg "Data parsed";
}
------------------------------
Date: Mon, 09 Dec 2002 02:02:30 GMT
From: "Brad W. Galiette" <brad.galiette@snet.net>
Subject: Discerning an Open and Closed Socket...
Message-Id: <WQSI9.3147$3g2.805676043@newssvr10.news.prodigy.com>
How would one go about determining if a client is still active on a
server-based socket? (i.e., does the socket remain open and is there a
computer at the other end? :-)
Brad
------------------------------
Date: Sun, 8 Dec 2002 20:56:53 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: Help with "Chomp" Command
Message-Id: <slrnav81jl.b2i.tadmc@magna.augustmail.com>
Brad W. Galiette <brad.galiette@snet.net> wrote:
> A good source of reference
It is a "good source", but not the "best source".
> for the chop() and chomp() functions are
> available at http://www.perldoc.com/perl5.6.1/pod/func/chop.html and
> http://www.perldoc.com/perl5.6.1/pod/func/chomp.html respectively;
The best source of information is the version that got installed
on your hard disk along with perl itself.
The above is only good if you happen to be using one particular
version of perl.
The docs that come with perl will always be in sync with that perl version.
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sun, 08 Dec 2002 18:30:17 -0500
From: Mina Naguib <spam@thecouch.homeip.net>
Subject: Re: Multi-dimensional hash question
Message-Id: <3DF3D609.8070607@thecouch.homeip.net>
-----BEGIN xxx SIGNED MESSAGE-----
Hash: SHA1
Alexander Stremitzer wrote:
| Your comments have been extremely helpful. I was reading perlref and
| perldoc. However, all the information is a little much to comprehend at
| once. I was experimenting with what I have learned . Especially the
| information that values of hashes can only contain scalar values from
| another poster has helped my understanding. I am extremely pleased with
| the quality and timeliness of answers I have received in this newsgroup.
| Something I definitely did not expect when I posted my first question
here.
As long as you post clear questions, and you've done *some* homework and
posted what you've tried, people are extremely helpful here.
|
| Now back to the topic.
| My main goal is to utilize the search performance that a hash (or should
| I say associative array)
Other languages call it an associative array. In perl it's mainly
called a hash :)
| provides. The problem is that I have a key
| which is not unique. I want to retrieve multiple values for one hash
| key. I know this is not exactly what the hash was built for but it beats
| sequentially looping through the array.
In that case you can have a hash key hold an array (reference, of course).
In perl there's nothing stopping you (whily using references) of
building something like:
scalar -> hash -> array -> array -> array -> hash -> hash -> array ->
hash . .
You get the point.
|
| So far I got my data structure initialized properly (verified with
| Dumper).
The way you've described it seems impossible. Re-using the same hash
key with a new value will definately override the old one.
| Now my problem is in getting the values back out. I would like
| a loop to iterate over all entries with the key 'patid2'.
| $pat_id_list_ref seems to point to just that.I don't know the value of
| $accno in advance.
|
| Data file (list_data):
| patid1 acc1 mod1
| patid2 acc2 mod2
| patid2 acc3 mod3
| patid3 acc4 mod4
| patid3 acc5 mod5
|
| Program I wrote (my 2 unsuccessful attempts commented out at the end):
| #!/usr/bin/perl -w
|
| use strict;
| use Data::Dumper;
|
| my %myhash = ();
| my @LoL;
|
| open (DATA,"<list_data");
| while (<DATA>) {
| my $tmp = $_;
$tmp seems like a waste of a variable, take it out. You can use $_ until
the end of the block.
| push @LoL, $_;
@LoL seems unused.. Take it out.
| my ($patid, $accno, $mod) = split();
Just " = split;" will do. No need for the brackets, especially sinc
eyou're not passing split any parameters.
| print ("patid: $patid accno: $accno mod: $mod\n");
| $myhash{$patid}{$accno} = [ $tmp ];
" = [ $tmp ];" it redundant. It assigns an array(ref) of only 1 element
to that hash's key. This is illogical since an array is used to hold
multi-element lists. Just use $tmp as another 3rd-level-hash key.
But... I don't see why you can't just do:
$myhash{$patid}{$accno}{$mod} = 1;
here
Based on the data sample you outlined above, there are no 2 records with
a repeated patid and account number (and mod for that matter). Since
they're all unique, using a hash-of-hash-of-hash as above would be the
best solution.
If however your data sample above is inaccurate and there's a
possibility of key overlap, then you will have to introduce arrays into
the picture. You can use hashes up until the first key with the
possibility of overlap. At which point you must use an array. Inside
that array you can revert back to using hashes again for dependant keys
(if they're unique) or stick with using arrays if they're non-uniqye.
Back to Perl, if patid is unique, accno is unique and mod is non-unique:
%patid -> %accno -> @mod
If patid is unique, accno is non-unique and mod is unique (per accno):
%patid -> @accno -> %mod
Adding to a hash is simple:
$hash{keyname} = value;
Same goes for hash of hashes:
$hash{parentkey}{childkey} = childkeysvalue;
However, if you have an array nested deep into a hash(es) it gets tricky:
push (@{ $hash{parentkey} } , arrayitemvalue);
Breaking that into parts inside-out:
$hash{parentkey} means "the value of the key parentkey in hash %hash"
@{ something } means "treat something as an arrayref, then dereference
it into an array"
push @array, something means "add something as an item in @array"
The magic happens when you try to dereference $hash{parentkey} as an
array. Perl will automatically make it's value an arrayref for you !
Of course, you can also say:
$hash{parentkey} = [];
or
$hash{parentkey} = ['something'];
However that will assign the new arrayref as the value of
$hash{parentkey}, losing the old value assigned there. Using the above
@{ } dereference trick will allow you to push values into the existing
array without losing old ones.
Best of luck.
-----BEGIN xxx SIGNATURE-----
Version: GnuPG v1.0.6 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org
iD8DBQE989YJeS99pGMif6wRAmpjAJ9d9uQd4rTkCT1JNYDRFUpQJcGUugCeJmUX
2YcX+tw1rqnI3YdX//Tij4Q=
=Txrq
-----END PGP SIGNATURE-----
------------------------------
Date: Sun, 08 Dec 2002 18:40:03 -0500
From: Alexander Stremitzer <stremitz@consultant.com>
Subject: Re: Multi-dimensional hash question
Message-Id: <3DF3D853.5010904@consultant.com>
--------------090104040303020306070403
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit
Ben Morrow wrote:
>[please do not top-post]
>[please snip properly]
>
>Alexander Stremitzer <stremitz@consultant.com> wrote:
>
>
>>Now back to the topic.
>>My main goal is to utilize the search performance that a hash (or should
>>I say associative array) provides. The problem is that I have a key
>>which is not unique. I want to retrieve multiple values for one hash
>>key. I know this is not exactly what the hash was built for but it beats
>>sequentially looping through the array.
>>
>>So far I got my data structure initialized properly (verified with
>>Dumper). Now my problem is in getting the values back out. I would like
>>a loop to iterate over all entries with the key 'patid2'.
>>$pat_id_list_ref seems to point to just that.I don't know the value of
>>$accno in advance.
>>
>>Data file (list_data):
>>patid1 acc1 mod1
>>patid2 acc2 mod2
>>patid2 acc3 mod3
>>patid3 acc4 mod4
>>patid3 acc5 mod5
>>
>>Program I wrote (my 2 unsuccessful attempts commented out at the end):
>>#!/usr/bin/perl -w
>>
>>use strict;
>>use Data::Dumper;
>>
>>my %myhash = ();
>>my @LoL;
>>
>>open (DATA,"<list_data");
>>while (<DATA>) {
>> my $tmp = $_;
>> push @LoL, $_;
>> my ($patid, $accno, $mod) = split();
>> print ("patid: $patid accno: $accno mod: $mod\n");
>> $myhash{$patid}{$accno} = [ $tmp ];
>>
>>
>
>No. What you want here is:
>
> my ($patid, $accno, $mod) = split;
> push @{ $myhash{$patid}{$accno} }, $mod;
>
>This will create a hash-of-hashes-of-lists, which is I think what you want
>here. I don't quite know what you were intending to do with @LoL?
>The [ $tmp ] is daft: it will always return a ref to an array with only one
>element. Using push instead will add the element to the end (the @{...} is
>to deref the array ref in $myhash{$patid}{$accno}, which will magically
>spring into being if it wasn't there previously. Perl's good like that :).
>
>
Actually what I wanted here is:
$myhash{$patid}{$accno} = [ $tmp ];
I did want to store the whole line for other reasons. In the final
program there will be more fields than just $mod.
But it seems that your statement ( I modified it to store the whole
line) seems to do the same. I don't know what the difference is:
push @{ $myhash{$patid}{$accno} }, $tmp;
>
>
>>}
>>
>>print Dumper(\%myhash);
>>
>>my $pat_id_list_ref = $myhash{'patid2'};
>>
>>
>
>This is in fact a hashref, not a array ref.
>Also, you don't need the quotes.
>
>You will then need a double loop
>for my $acc (keys %$pat_id_list_ref) {
> for my $mod (@$pat_id_list_ref{$_}) {
>
After modifying it slightly, it does exactly what I want it to do.
Thanks for all your help.
for my $acc (keys %$pat_id_list_ref) {
for my $mod (@$pat_id_list_ref{$acc}) {
> <do summat>
> }
>}
>to iterate over all mods for a gived patid.
>
>
>
>>print Dumper($pat_id_list_ref);
>>
>>print ("number: #$pat_id_list_ref\n");
>>
>>
>
>This won't work: $pilr is a hashref. You need a double loop like the above and
>count them; or do something cleverer with map.
>
>
>
>>exit 0;
>>
>>
>
>Not needed.
>
>Ben
>
>
--
All man's miseries derive from not being able to sit quietly in a room alone. (Pascal)
--------------090104040303020306070403
Content-Type: text/html; charset=us-ascii
Content-Transfer-Encoding: 7bit
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html;charset=ISO-8859-1">
<title></title>
</head>
<body>
<br>
<br>
Ben Morrow wrote:<br>
<blockquote type="cite"
cite="midat0am1$2jg$1@wisteria.csv.warwick.ac.uk">
<pre wrap="">[please do not top-post]
[please snip properly]
Alexander Stremitzer <a class="moz-txt-link-rfc2396E" href="mailto:stremitz@consultant.com"><stremitz@consultant.com></a> wrote:
</pre>
<blockquote type="cite">
<pre wrap="">Now back to the topic.
My main goal is to utilize the search performance that a hash (or should
I say associative array) provides. The problem is that I have a key
which is not unique. I want to retrieve multiple values for one hash
key. I know this is not exactly what the hash was built for but it beats
sequentially looping through the array.
So far I got my data structure initialized properly (verified with
Dumper). Now my problem is in getting the values back out. I would like
a loop to iterate over all entries with the key 'patid2'.
$pat_id_list_ref seems to point to just that.I don't know the value of
$accno in advance.
Data file (list_data):
patid1 acc1 mod1
patid2 acc2 mod2
patid2 acc3 mod3
patid3 acc4 mod4
patid3 acc5 mod5
Program I wrote (my 2 unsuccessful attempts commented out at the end):
#!/usr/bin/perl -w
use strict;
use <a class="moz-txt-link-freetext" href="Data::Dumper">Data::Dumper</a>;
my %myhash = ();
my @LoL;
open (DATA,"<list_data");
while (<DATA>) {
my $tmp = $_;
push @LoL, $_;
my ($patid, $accno, $mod) = split();
print ("patid: $patid accno: $accno mod: $mod\n");
$myhash{$patid}{$accno} = [ $tmp ];
</pre>
</blockquote>
<pre wrap=""><!---->
No. What you want here is:
my ($patid, $accno, $mod) = split;
push @{ $myhash{$patid}{$accno} }, $mod;
This will create a hash-of-hashes-of-lists, which is I think what you want
here. I don't quite know what you were intending to do with @LoL?
The [ $tmp ] is daft: it will always return a ref to an array with only one
element. Using push instead will add the element to the end (the @{...} is
to deref the array ref in $myhash{$patid}{$accno}, which will magically
spring into being if it wasn't there previously. Perl's good like that :).
</pre>
</blockquote>
Actually what I wanted here is:<br>
$myhash{$patid}{$accno} = [ $tmp ];<br>
I did want to store the whole line for other reasons. In the final program
there will be more fields than just $mod.<br>
<br>
But it seems that your statement ( I modified it to store the whole line)
seems to do the same. I don't know what the difference is:<br>
push @{ $myhash{$patid}{$accno} }, $tmp;
<blockquote type="cite"
cite="midat0am1$2jg$1@wisteria.csv.warwick.ac.uk">
<pre wrap="">
</pre>
<blockquote type="cite">
<pre wrap="">}
print Dumper(\%myhash);
my $pat_id_list_ref = $myhash{'patid2'};
</pre>
</blockquote>
<pre wrap=""><!---->
This is in fact a hashref, not a array ref.
Also, you don't need the quotes.
You will then need a double loop
for my $acc (keys %$pat_id_list_ref) {
for my $mod (@$pat_id_list_ref{$_}) {</pre>
</blockquote>
After modifying it slightly, it does exactly what I want it to do. Thanks
for all your help.<br>
<pre wrap="">for my $acc (keys %$pat_id_list_ref) {
for my $mod (@$pat_id_list_ref{$acc}) {
</pre>
<blockquote type="cite"
cite="midat0am1$2jg$1@wisteria.csv.warwick.ac.uk">
<pre wrap="">
<do summat>
}
}
to iterate over all mods for a gived patid.
</pre>
<blockquote type="cite">
<pre wrap="">print Dumper($pat_id_list_ref);
print ("number: #$pat_id_list_ref\n");
</pre>
</blockquote>
<pre wrap=""><!---->
This won't work: $pilr is a hashref. You need a double loop like the above and
count them; or do something cleverer with map.
</pre>
<blockquote type="cite">
<pre wrap="">exit 0;
</pre>
</blockquote>
<pre wrap=""><!---->
Not needed.
Ben
</pre>
</blockquote>
<br>
<pre class="moz-signature" cols="$mailwrapcol">--
All man's miseries derive from not being able to sit quietly in a room alone. (Pascal)</pre>
<br>
</body>
</html>
--------------090104040303020306070403--
------------------------------
Date: Sun, 8 Dec 2002 20:59:35 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: Multi-dimensional hash question
Message-Id: <slrnav81on.b2i.tadmc@magna.augustmail.com>
Alexander Stremitzer <stremitz@consultant.com> wrote:
> Ben Morrow wrote:
>>[please snip properly]
Please TRIM your replies, as Ben suggested.
http://www.geocities.com/nnqweb/nquote.html
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 8 Dec 2002 22:27:01 -0800
From: yuanxi80@hotmail.com (David Tian)
Subject: Output Lines of 70 Characters
Message-Id: <da930649.0212082227.6061d88d@posting.google.com>
I am writing a Perl program. Given an input of some lines of text as a
string with no newline chars, where each line contains some
combination of:
alphabetic symbols, either upper case or lower case
punctuation symbols: '.' ',' ';' ':' '!' '?'
spaces
The program should output lines of 70 characters on standard output,
so that:
each line should start with the beginning of a word (no word splits
across lines);
Each line contain as many words as possible within limits.
The lines are left aligned.
My program is as follows, but it doesn't do any substitutions, so the
input texts are unchanged:
&lines_of_70($input_lines,$leng_input,68,$leng_input);
#$input_lines - input lines of text a string
#68 - the index number 68 in $input_lines
sub lines_of_70 {
my($input_lines,$leng_input,$index,$no_of_chars_left)=@_;
#$input_lines: lines of text
#$leng_input: length of $input_lines
#$index: index no. of next 70th char
#no_of_chars_left: no. of chars need to be
processed
if($no_of_chars_left <= 70)
{ print"$input_lines\n"; } #output lines of texts.
else {
$_ = substr($input_lines,$index,1);#get the 70th char in string
if($_ =~/(\s)/){print"case1\n"; #case1:70th char is a space.
s/$1/\n/; #replace space with a newline.
$no_of_chars_left = $leng_input - ($index+1); #find the no. of
chars left.
&lines_of_70($input_lines,$leng_input,$index+69,$no_of_chars_left);
}
elsif($_ =~ /([,.;:?!])/){ #case2: 70th char is a punctuation.
s/$1/$1\n/; #put a newline after it.
# print"case2\n";
$no_of_chars_left = $length_input -
($index+1); #find the no. of chars left.
&lines_of_70($input_lines,$leng_input,$index+69,&no_of_chars_left);
}
#case 3: the 70th char is a letter.
elsif($'=~ /^(\s)/){ #print"case 3\n"; #if the char to its right
matches a space.
$_ = $'; #this is needed for substitution
s/$1/\n/; #put a space after it.
$no_of_chars_left = $leng_input - ($index+1); #find the no. of
chars left.
&lines_of_70($input_lines,$leng_input,$index+69,$no_of_chars_left);
} #replace it by \n.
else{ print"case 4";
$`=~/\s(\w+)($_)/; #the letter is in the mid of a
#word or the end of a word followed by
a punctuation.
$_ = $`; #so get the space infront of that word
s/\s$1$2/\n$1$2/;#replace that space by a \n.
$where = index($`,$&);
$current = $where + 1;
$no_of_chars_left = $leng_input - ($current+1); #find
the no. of chars left.
&lines_of_70($input_lines,$leng_input,$current+69,$no_of_chars_left);
}
}
}
Help please.
thanks,
David
------------------------------
Date: Mon, 09 Dec 2002 06:38:34 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: Output Lines of 70 Characters
Message-Id: <KTWI9.594$K03.22@nwrddc01.gnilink.net>
David Tian wrote:
> The program should output lines of 70 characters on standard output,
> so that:
> each line should start with the beginning of a word (no word splits
> across lines);
Have you tried Text::Wrap?
jue
------------------------------
Date: Sun, 8 Dec 2002 20:54:00 -0500
From: "DirecTV News Server" <jsnelson@telocity.com>
Subject: stringTTF() Fails to Display String in GD::Image
Message-Id: <3df3f7b9$1_4@nopics.sjc>
Hello,
When I run this piece of code on Win2000, it always displays each character
of the string as if it is a 'non-printable' character (you know, the little
square boxes). Has anyone been able to get Truetype fonts to work in the
GD package? BTW, this code works fine on Red Hat Linux 7.3.
--------- --------- Start of Perl program --------- ---------
#!perl -w
# ActiveState Perl v5.6.1, binary build 629, 20-Aug-2001, for
MSWin32-x86-multi-thread
# on Win2000
use strict;
use GD; # using GD 1.27.2, which includes GDTextUtil 0.80
my $image = new GD::Image( 600, 400 )
or die "Error: Failed to create GD::Image: $!\n";
my $font = 'C:\WINNT\Fonts\micross.ttf';
my $fontsz = 36;
my $white = $image->colorAllocate(255,255,255);
my $black = $image->colorAllocate(0,0,0);
$image->stringTTF( $black, $font, $fontsz, 0, 100, 100, "This is a test." );
my $targetfile = "ttftest.jpg";
open( FILE, "> $targetfile" )
or die "Error: Unable to open file $targetfile : $!; $@\n";
binmode FILE;
print FILE $image->jpeg;
close FILE;
system "start \"TTF Test\" $targetfile";
--------- --------- End of Perl program --------- ---------
------------------------------
Date: Mon, 09 Dec 2002 01:01:26 -0600
From: Tommy Butler <usenet@atrixnet.com>
To: DirecTV News Server <jsnelson@telocity.com>
Subject: Re: stringTTF() Fails to Display String in GD::Image
Message-Id: <3DF43FC6.1020607@atrixnet.com>
DirecTV News Server wrote:
> Hello,
>=20
> When I run this piece of code on Win2000, it always displays each chara=
cter
> of the string as if it is a 'non-printable' character (you know, the li=
ttle
> square boxes). Has anyone been able to get Truetype fonts to work in =
the
> GD package? BTW, this code works fine on Red Hat Linux 7.3.
http://ooopps.sourceforge.net/cgi-bin/archive.pl/pub/modules/_related_/wo=
rking-GD/
--=20
-Tommy Butler
see if I'm online =BBhttp://ooopps.sourceforge.net/online
Tommy Butler <tommy@atrixnet.com>
phone: (817)-468-7716
6711 Forest Park Dr
Arlington, TX
76001-8403
Download my r=E9sum=E9 in PDF, MS Word, HTML, text
http://www.atrixnet.com/
the ooOPps Code Library
http://ooopps.sourceforge.net/pub/
------------------------------
Date: 8 Dec 2002 21:50:48 -0800
From: massion@gmx.de (FMAS)
Subject: VBA equivalent of Range in Perl
Message-Id: <f0b3f4c9.0212082150.26075ea3@posting.google.com>
Pardon me if the question is too simple, but I am a lousy amateur...
I wonder if there is something similar to the range function of VBA in perl.
I want first to define one or more Text range(s) in a document
Then I want to find out if a particular string is in the range(s)
if yes --> some action (e.g. DEL the whole range)
Any help would be appreciated.
------------------------------
Date: 8 Dec 2002 20:16:44 -0800
From: therobs@n2net.net (Rob Richardson)
Subject: Why doesn't my array grow?
Message-Id: <f79bc007.0212082016.6c334c9@posting.google.com>
Greetings!
I am trying to generate a calendar. Since a calendar can conceivably
require 6 rows of 7 cells each, I am trying to create a 42-element
array. Those cells that represent valid dates will get the date in a
string format. Those that don't represent dates will get an empty
string. Here's the code:
sub calendar
{
<initialization code snipped>
# Create a 42-element array starting at the start index.
# @calendar = ($startIndex .. $startIndex + 42);
@calendar = ();
# for ($i = $startIndex; $i < ($startIndex + 42); $i++)
for ($i = 0; $i < 42; $i++)
{
$currentIndex = $startIndex + $i;
if ($currentIndex < 1 || $currentIndex > $daysInThisMonth)
{
$calendar[currentIndex] = ""
}
else
{
$calendar[currentIndex] = "$actualMonth.$currentIndex.$actualYear"
}
print "Index: $currentIndex; contents: $calendar[currentIndex]! <BR>"
}
$arraySize = @calendar;
print "Before returning from subroutine, calendar has $arraySize
elements. <BR>";
return @calendar;
}
I'm a newbie in Perl, but I understand that arrays are supposed to
grow if you write to an element beyond the current end of the array.
The print statement that reports the contents of the cells shows that
the cells are being populated as expected. But the print statement
that reports the size of the array says the array only has one
element! What don't I know yet?
Thanks!
Rob
------------------------------
Date: Sun, 08 Dec 2002 20:28:13 -0800
From: Jeff Zucker <jeff@vpservices.com>
Subject: Re: Why doesn't my array grow?
Message-Id: <3DF41BDD.5050609@vpservices.com>
Rob Richardson wrote:
> if ($currentIndex < 1 || $currentIndex > $daysInThisMonth)
> {
> $calendar[currentIndex] = ""
You're missing a $ on the currentIndex variable.
--
Jeff
------------------------------
Date: Mon, 09 Dec 2002 07:56:02 +0000
From: "Dave Cross" <dave@dave.org.uk>
Subject: Re: Why doesn't my array grow?
Message-Id: <pan.2002.12.09.07.56.02.188541@dave.org.uk>
On Sun, 08 Dec 2002 20:16:44 +0000, Rob Richardson wrote:
> I am trying to generate a calendar.
Have you looked at Calendar::Simple?
<http://search.cpan.org/dist/Calendar-Simple/>
Dave...
--
"Don't you boys know any _nice_ songs?"
------------------------------
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 4234
***************************************
