[9226] in Perl-Users-Digest
Perl-Users Digest, Issue: 2821 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Jun 9 12:17:58 1998
Date: Tue, 9 Jun 98 09:00:29 -0700
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Tue, 9 Jun 1998 Volume: 8 Number: 2821
Today's topics:
Re: - sort with DBM key output... - <aqumsieh@matrox.com>
Re: accessing a:\ (Clinton Pierce)
Re: Animated gifs question ... (Jouke Visser)
Re: Animated gifs question ... <joe@halbrook.com>
Re: Animated gifs question ... <tchrist@mox.perl.com>
Re: C++ parser <gmarzot@baynetworks.com>
Re: CODE: Win32 Registry search & replace (Andy Lester)
Re: Date Manipulation ptimmins@netserv.unmc.edu
Determinging Mode of Perl Filehandle aircond@my-dejanews.com
Re: Determinging Mode of Perl Filehandle <tchrist@mox.perl.com>
Re: Help! <rootbeer@teleport.com>
Re: how to execute UNIX history <rootbeer@teleport.com>
Re: lambda fun in Perl <jdporter@min.net>
Re: locking DBM files... <brianm@kodak.com>
Re: McCabe complexity analysis (Charlie Stross)
Re: NEED HELP: stty and the perl compiler <rootbeer@teleport.com>
Re: Package Question -- How can I circularly include? <tchrist@mox.perl.com>
Re: Package Question -- How can I circularly include? <quednauf@nortel.co.uk>
Perl Books? <web1@netcomuk.co.uk>
Re: perl on sunos 4.1 <rootbeer@teleport.com>
Re: perlTk Perl Debugger (Andrew E Page)
Re: Question about =~ <aqumsieh@matrox.com>
Re: Question about =~ <tchrist@mox.perl.com>
Re: raliases???? (Chris Reynolds)
Reading Directories dukeboy77@my-dejanews.com
Re: Reading Directories <irsan@tcf.nl>
Re: Reading Directories <tchrist@mox.perl.com>
Return characters from a string <f024101@fr.ibm.com>
Re: Return characters from a string <tchrist@mox.perl.com>
Re: Return characters from a string <zenin@bawdycaste.org>
Stopping Perl from interpreting fprintf's in a C file <gibsonc@aztec.asu.edu>
Windows STDIN weirdness was (Re: Exercise in Llama Book <due@murray.fordham.edu>
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 09 Jun 1998 09:44:16 -0400
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: - sort with DBM key output... -
Message-Id: <357D3C30.2C7D4163@matrox.com>
James wrote:
> Hi,
>
> I was wondering if anyone would be able to help me? I have been though all
> the help files and FAQs etc but with no luck..
Hmmm... browsing through
perldoc perlfunc
I found the following:
To sort an array by value, you'll need to use a
sort{} function. Here's a descending numeric sort
of a hash by its values:
foreach $key (sort { $hash{$b} <=> $hash{$a} } keys %hash)) {
printf "%4d %s\n", $hash{$key}, $key;
}
I believe this is very close to what you want!
> dbmopen(%last_good, "keywords.dbm",0666);
> foreach $name (sort keys(%last_good)) {
> @items = (split(/\t/, $last_good{$name}));
> $hits = $items[0];
> $time = localtime($items[1]);
> $hours = (time - $items[1]) / 3600;
> print "Keyword: $name - Hits: $hits - Last Search: $time - Hours since last
> search: $hours\n";
> }
Please ... indent your code properly. This hurts my eyes!
> I have tried merging the data to create a new array with
> $hits, $name and $time listed together but this does not appear to work
> either. Does anyone know how I can deal with this??
Ok ... assuming you did this and you have a hash %hits with the keys = the
keywords and the values = the number of hits ...(note: I am assuming that the
number of hits aren't unique. So you can't have them as keys to your hash)
using the above code:
foreach $key (sort { $hits{$a} <=> $hits{$b} } keys %hits)) {
print "Keyword: $key - Hits: $hits{$key}\n";
}
> Thanks very much for any help with this!
>
> James
> james@cydaps.co.uk.NOSPAM (please remove .NOSPAM if replying by email)
Hope this helps.
--
Ala Qumsieh | No .. not just another
ASIC Design Engineer | Perl Hacker!!!!!
Matrox Graphics Inc. |
Montreal, Quebec | (Not yet!)
------------------------------
Date: 9 Jun 1998 14:17:00 GMT
From: cpierce1@cp500.fsic.ford.com (Clinton Pierce)
To: kthor@idt.net
Subject: Re: accessing a:\
Message-Id: <6ljg4s$d913@eccws1.dearborn.ford.com>
In article <357C09F9.185D@idt.net>,
Kevin Thorley <kthor@idt.net> writes:
>I'm writing a script to access the a: drive and return a list of its
>contents. But I keep getting "Bad command or file name." Here's the
>code
>
>chdir( "a:" );
>while( <"*.*"> ){
>print "$_\n" ;
>}
>
>It works fine if I use any directory on the c: drive. It seems to be
>going to the a: drive that is causing problems.
What's wrong with opendir/readdir? It requires a lot less magic, and
is more likely to do what you'd expect:
opendir(DIR, "A:/") || die "Can't open A:/: $!\n";
@FILES=readdir DIR;
closedir(DIR);
print join("\n", @FILES), "\n";
Haven't tested that code on a DOS machine though. I SUSPECT that
an opendir on "A:/" will do the right thing. Perl usually does.
--
+------------------------------------------------------------------------+
| Clinton A. Pierce | "If you rush a Miracle Man, | http://www. |
| cpierce1@ford.com | you get rotten miracles" | dcicorp.com/ |
| fubar@ameritech.net |--Miracle Max, The Princess Bride| ~clintp |
+------------------------------------------------------------------------+
GCSd-s+:+a-C++UALIS++++P+++L++E---t++X+b+++DI++++G++e+>++h----r+++y+++>y*
------------------------------
Date: Tue, 09 Jun 1998 14:15:21 GMT
From: jouke@RemoveThisToReplycom-bat.nl (Jouke Visser)
Subject: Re: Animated gifs question ...
Message-Id: <357d42f3.26657024@news.telecom.ptt.nl>
Hi Joe,
Maybe if you show the Perl code I can figure out why it doesn't work.
I've written a procedure which sends back an animated gif and it works
fine for me.
The same procedure sends a non-animated gif fine as well.
Greetings,
Jouke Visser
On Tue, 09 Jun 1998 08:49:05 -0500, Joe Halbrook <joe@halbrook.com>
wrote:
>I've come across a strange occurrence:
>
>I load a rotating image via a Perl script:
>
><IMG SRC="http://www.my.server.com/cgi-bin/image.pl?A4993948585" ...>
>
>When the image is not animated, all is fine. But, when the image is an
>animated gif, it only runs thru the first iteration of the animation,
>then stops. Why doesn't it loop continuously, like it does when I
>replace the above line with:
>
><IMG SRC="http://www.my.server.com/image.gif ...>
>
>Any help is appreciated.
>
>-Joe Halbrook
------------------------------
Date: Tue, 09 Jun 1998 10:31:27 -0500
From: Joe Halbrook <joe@halbrook.com>
Subject: Re: Animated gifs question ...
Message-Id: <357D554F.3552@halbrook.com>
Here's the code. Thanks for your time on this, Jouke.
>>>>
opendir(DIR, $dir);
@files = readdir(DIR);
# Pick a Random Number
srand(time ^ $$);
$num = rand(@files);
while ( ($files[$num] eq '.') || ($files[$num] eq '..') ) {
srand(time ^ $$);
$num = rand(@files);
}
# Print Out Header With Random Filename and Base Directory
print "Location: $banner_url/$files[$num]\n\n";
<<<<
Jouke Visser wrote:
>
> Hi Joe,
>
> Maybe if you show the Perl code I can figure out why it doesn't work.
> I've written a procedure which sends back an animated gif and it works
> fine for me.
>
> The same procedure sends a non-animated gif fine as well.
>
> Greetings,
>
> Jouke Visser
>
------------------------------
Date: 9 Jun 1998 15:37:32 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Animated gifs question ...
Message-Id: <6ljkrs$mq8$2@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
joe@halbrook.com writes:
: srand(time ^ $$);
: $num = rand(@files);
: while ( ($files[$num] eq '.') || ($files[$num] eq '..') ) {
: srand(time ^ $$);
: $num = rand(@files);
: }
+---------------------------------+
| NEVER CALL srand TWICE!!!!!!!!! |
+---------------------------------+
In 5.004ish, never call it at all.
And remember that that x^y is the same 1/3 of the time as
(x+1)^(y+1).
And just how many seconds do you think between those calls to time()?
--tom
--
Supercomputer - a computer that can complete an endless loop in under 5 minutes
------------------------------
Date: 09 Jun 1998 11:08:05 -0400
From: Joe Marzot <gmarzot@baynetworks.com>
Subject: Re: C++ parser
Message-Id: <pdyav6bokq.fsf@baynetworks.com>
ben_jones@usa.net (Ben Jones) writes:
>
> Hi,
>
> Does anyone know of a perl script which will parse C++ source files,
> and extract class/function names etc.
>
> Thanks,
>
> ben_jones@usa.net
here is an old script that I had to do this. It is not perfect
(pre-alpha?) and was written prior to some of the newer regex features
like non-greedy matching so it could be improved alot. It produces a
TAGS file like etags but with more info. It was written to support a
emacs based smalltalk-like class browser which I never finished (a shame
because it was way cool). enjoy it FWIW.
-GSM
------cxxtags.pl-------
#!/usr/bin/perl5.000
require "flush.pl";
$class_tag = 'c';
$fmemb_tag = 'f';
$dmemb_tag = 'd';
@class_stack = ();
@access_stack = ();
$in_comment = 0;
$char_num = 0;
$brace_level = 0;
$statement = "";
$out_buf = "";
sub uncomment_line {
# print "uc:: $_ \n";
if ($in_comment) {
return $in_comment if (! m!\*/!);
$_ = $';
$in_comment = 0;
}
$line = "";
while ($_) {
if (m!/[*/]!) { #look for // and /*
$line .= $`;
if ($& eq '/*') {
if (m!\*/!) {
$_ = $'; next;
}
$in_comment = 1;
}
$line .= "\n";
} else {
$line .= $_;
}
return $in_comment;
}
print "uc:: error empty line??\n";
return $in_comment;
}
sub class_header {
if ($header =~
/(template\s*<[^>]*>)?\s*(class|struct)\s+(\w+)\s*(:\s*(private|public)*
\s*(\w+))*/) {
push(@class_stack,$3);
($2 eq 'class' ?
push(@access_stack,'private') : push(@access_stack,'public'));
$access = $5;$prop_tag = "";
$prop_tag .= 'p' if $access eq 'public';
$prop_tag .= 'x' if $access eq 'private';
$prop_tag .= 't' if $access eq 'protected';
$out_buf .= "$3\c?$.,$char_num\c?$class_tag,$6,$prop_tag\n";
} else {
0;
}
}
sub class_statement {
$cur_stmnt = $`;
$prop_tag = '';
$result = '';
return $result
if $cur_stmnt =~ /^[\s|;]*$/; # return if this is an empty statement
if ($cur_stmnt =~ s/(\b(public|private|protected)\b\s*:\s*)+/ /) {
# print STDERR "($+:) $cur_stmnt\n";
$access_stack[$#access_stack] = $+;
}
if ($cur_stmnt =~ /([^:]):[^:]/) { #ignore the tail end of a constructor
$cur_stmnt = $` . $1;
}
$pattern = ($cur_stmnt =~ /\boperator\b/ ?
'(operator.*)(\([^\)]*\))(\s*)(=.*)?\s*(const)?\s*$' :
'([~\w]+)\s*(\([^\)]*\))?\s*(\[[^\]]*\]\s*)*(=.*)?\s*(const)?\s*$');
if ($cur_stmnt =~ /$pattern/) {
$memb = $1; $func = $2; $init = $4; $const = $5;
$prefix = $`; $memb =~ s/\s*$//;
$memb_tag = ($func ? $fmemb_tag : $dmemb_tag);
if (!$func) {
# print "prefix:$prefix\n";
if ($prefix =~ s/,[*\s]*$/;/) {
$result = $prefix;
# print "result:$result\n";
}
}
$access = $access_stack[$#access_stack];
# print STDERR "$access \n";
# print STDERR "$const \n";
$prop_tag .= 'p' if $access eq 'public';
$prop_tag .= 'x' if $access eq 'private';
$prop_tag .= 't' if $access eq 'protected';
$prop_tag .= 'i' if $prefix =~ /\binline\b/;
$prop_tag .= 's' if $prefix =~ /\bstatic\b/;
$prop_tag .= ($init?'u':'v') if $prefix =~ /\bvirtual\b/;
$prop_tag .= 'c' if $const eq 'const';
$prop_tag .= 'f' if $prefix =~ /\bfriend\b/;
$out_buf .=
"$memb\c?$.,$char_num\c?$memb_tag,$class_stack[$#class_stack],$prop_
tag\n";
}
return $result;
}
open(tag_file, ">CxxTAGS") || die "can't open CxxTAGS file!\n";
while (<>) {
$char_num += length;
next if &uncomment_line;
next if $line =~ /(^#|^\s*$)/;
next if $brace_level && !($line =~ /(\{|\})/);
# print "line:$line\n";
$statement .= $line;
chop($statement);
# print "statement:$statement\n";
# study $statement;
while ($statement) {
if (!$brace_level) {
if ($statement =~ /\{/) {
$rest = $';
$header = $`;
if (&class_header()) {
$statement = $rest;
} else {
$statement =~ s/\{/\200/;
$brace_level++;
# print "brace++:level=$brace_level:$statement\n";
}
next;
} elsif ($statement =~ /(\;|\})/) {
$rest = $';
if ($& eq ';') {
if (@class_stack) {
$rest = &class_statement . $rest;
}
$statement = $rest;
} else {
$front = $`;
#add ; to un-terminated statement
if ($front =~ /[^\s]/) {
$statement = $front . ';}' . $rest;
} else {
$statement = $rest;
pop(@class_stack);
# $statement = pop(@class_stack) . ' ' . $rest;
pop(@access_stack);
}
}
next;
} else {
last;
}
} else {
if ($statement =~ s/\200[^\}]*\{/\200/ ) {
$brace_level++;
# print "brace++:level=$brace_level:$statement\n";
next;
}
if ($statement =~ /\}/) {
if (--$brace_level) {
$statement =~ s/\}/ /;
} else {
#add ; to inline members
$inline = (@class_stack?'inline ':'');
# print "brace--:level=$brace_level:$statement\n";
$statement =~
s/(.*)\200[^\}]*\}/$inline \1;/;
# print "brace--:level=$brace_level:$statement\n";
}
next;
}
}
last;
}
# chop($line);
# print "$line line#=$. char#=$char_num\n";
} continue {
if (eof) {
if ($out_buf) {
$buf_len = length($out_buf);
print tag_file "\cL\n$ARGV,$buf_len\n";
print tag_file "$out_buf";
$out_buf = "";
}
$statement = "";
$char_num = 0;
# print STDOUT "\r", "$ARGV",' ' x 80;
# &flush(STDOUT);
close(ARGV);
}
}
close(tag_file);
print STDOUT "\n";
--
G.S. Marzot email: gmarzot@baynetworks.com
Bay Networks Inc. voice: (978)670-8888 x63990
600 Tech Park M/S BL60-101 pager: (800)409-6080 (4096080@skytel.com)
Billerica, MA 01821 fax: (978)670-8145
------------------------------
Date: 9 Jun 1998 14:16:34 GMT
From: petdance@maxx.mc.net (Andy Lester)
Subject: Re: CODE: Win32 Registry search & replace
Message-Id: <6ljg42$sf1$1@supernews.com>
: Or use Registry Search & Replace, I think I got it from
: http://www.winfiles.com
I knew I'd seen programs like that before, but I couldn't find one on
NoNags, and I knew I didn't want to pay for one for a one-time deal, so I
didn't bother searching further. Besides, Perl is fun.
xoxo,
Andy
--
--
Andy Lester: <andy@petdance.com> http://tezcat.com/~andy/
Chicago Shows List: <shows@ChicagoMusic.com> http://ChicagoMusic.com/
------------------------------
Date: Tue, 09 Jun 1998 15:09:27 GMT
From: ptimmins@netserv.unmc.edu
Subject: Re: Date Manipulation
Message-Id: <6ljj77$oqp$1@nnrp1.dejanews.com>
In article <357E024B.BD377B5B@perlsearch.hypermart.net>,
webmaster@perlsearch.hypermart.net wrote:
>
> I'm having trouble converting a string into a nicely formatted
> date.
> I've tried HTTP::Date, but it will not accept the format.
>
> I'm trying for example to convert:
>
> 980517 to 17 May 1998 or 17/May/1998
>
> I know its not very Y2K compliant, but obviously simtel has
> not cottoned on to converting their CSV file listings.
>
> --
> Matt McKenzie, Creator and Administrator
> Perl Crawler - http://perlsearch.hypermart.net
> http://perlsearch.fsn.net
>
Can we see your actual data?
First you'd have to some how match the '980517' string based on where it is in
your data layout using a regex. eg: if they were all in a "left most" column,
you could say something like this
if (/^(\d{2})(\d{2})(\d{2})/ {
$temp_year = $1;
$temp_month = $2;
$temp_day = $3;
}
You could build hashes in your program so that the $temp_month variable above
could be easily converted to the desired format. eg:
%month = ('01' => January,
'02' => February,
'03' => March,
'04' => April,
'05' => May,
'06' => June,
'07' => July,
'08' => August,
'09' => September,
'10' => October,
'11' => November,
'12' => December,
);
You would then have to decide what years belong in the 20th century and which
in the 21st. eg: 00 to 09 means 2000 to 2009, not 1900 to 1909. You could do
this by something like:
if ($temp_year =~ /(0\d)/) {
$year = $temp_year + 2000;
} else {
$year = $temp_year + 1900;
}
You would also have to remove the padding zero's from days prior to the 10th.
eg:
if ($temp_day =~ /0(\d)/ {
$day = $1;
} else {
$day = $temp_day;
}
Your original date o>
<input type=
-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/ Now offering spam-free web-based newsreading
------------------------------
Date: Tue, 09 Jun 1998 14:15:10 GMT
From: aircond@my-dejanews.com
Subject: Determinging Mode of Perl Filehandle
Message-Id: <6ljg1e$kel$1@nnrp1.dejanews.com>
Does anyone out there know if it is possible to determine if an already-open
file handle (or its file descriptor) was opened in read or write mode? I can
determine this now by using tricks with eof and print, but they are ugly and
generally make the file handle unusable without a close-then-reopen step.
Any help is appreciated!
AC
-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/ Now offering spam-free web-based newsreading
------------------------------
Date: 9 Jun 1998 15:13:48 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Determinging Mode of Perl Filehandle
Message-Id: <6ljjfc$lbq$1@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc, aircond@my-dejanews.com writes:
:Does anyone out there know if it is possible to determine if an already-open
:file handle (or its file descriptor) was opened in read or write mode? I can
:determine this now by using tricks with eof and print, but they are ugly and
:generally make the file handle unusable without a close-then-reopen step.
% perl /tmp/fdflags < /dev/null > /dev/null
*main::STDIN is fd0=00000000 read-only
*main::STDOUT is fd1=00000001 write-only
*main::STDERR is fd2=00000002 read-write
*main::TTY is fd3=00000C02 read-write, with O_NONBLOCK | O_APPEND
--tom
#!/usr/bin/perl -w
# fdflags
use strict;
use Fcntl;
sysopen(TTY, "/dev/tty", O_RDWR|O_NOCTTY|O_NONBLOCK|O_APPEND|O_TRUNC)
or die "can't open /dev/tty: $!";
select(TTY);
for my $fh (*STDIN, *STDOUT, *STDERR, *TTY) {
show_flags($fh);
}
BEGIN {
my @flagnames = grep { /^O_(?!RDWR|(WR|RD)ONLY)/ }
keys %{ Fcntl:: };
sub show_flags(*) {
my $fh = shift;
my ($fd, $flags);
unless (defined ($fd = fileno($fh))) {
warn "$fh is not open: $!\n";
return;
}
unless ($flags = fcntl($fh, F_GETFL, 0)) {
warn "ioctl $fh F_GETFL: $!";
return;
}
printf "%-18s is fd%d=%08X ", $fh, $fd, $flags;
print do {
($flags & O_WRONLY) ? "write-only" :
($flags & O_RDWR) ? "read-write" :
"read-only";
};
my @set_flags = ();
for my $fname (@flagnames) {
no strict 'refs';
if (defined &{"Fcntl::$fname"} && ($flags & &$fname())) {
push @set_flags, $fname;
}
}
print ", with ", join(" | ", @set_flags) if @set_flags;
print "\n";
}
}
__END__
--
Malt does more than Milton can
To justify God's ways to Man.
------------------------------
Date: Tue, 09 Jun 1998 15:57:14 GMT
From: Tom Phoenix <rootbeer@teleport.com>
Subject: Re: Help!
Message-Id: <Pine.GSO.3.96.980609085115.29617n-100000@user2.teleport.com>
On Tue, 9 Jun 1998 zucker@my-dejanews.com wrote:
> Subject: Help!
Please check out this helpful information on choosing good subject
lines. It will be a big help to you in making it more likely that your
requests will be answered.
http://www.perl.com/CPAN/authors/Dean_Roehrich/subjects.post
Your problem seemed to be that you sent a browser some commands, but the
browser didn't do what you wished. If you're following the proper protocol
but some browser or server doesn't cooperate, then it's the other
program's fault. If you're not following the protocol, then it's your
fault. If you aren't sure about the protocol, you should read the protocol
specification. If you've read it and you're still not sure, you should ask
in a newsgroup about the protocol.
Hope this helps!
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: Tue, 09 Jun 1998 15:50:32 GMT
From: Tom Phoenix <rootbeer@teleport.com>
Subject: Re: how to execute UNIX history
Message-Id: <Pine.GSO.3.96.980609084833.29617l-100000@user2.teleport.com>
On Tue, 9 Jun 1998, Leif Jonsson wrote:
> how to execute UNIX history with a perl scrip.
The Unix 'history' command is normally a shell built-in. But if the
history information is stored in a file, you may be able to read that file
directly from Perl. Some shells may not update that file upon every
command, though, so the most recent commands may not be listed. Good luck!
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: Tue, 09 Jun 1998 13:54:50 GMT
From: John Porter <jdporter@min.net>
Subject: Re: lambda fun in Perl
Message-Id: <357D4030.4D6A@min.net>
Xah Lee wrote:
>
> Is there a way to sequence pure functions without
> using a nesting notation such as the following?
>
> sub{sort @_;} ->
> (sub{map {$_/2} @_;}->
> ( sub {reverse @_;}->
> ( sub {map {$_ *2} @_; } ->
> (1..4))));
Um, any reason why that is to be prefered over, say,
sort
map { $_ / 2 }
reverse
map { $_ * 2 }
(1..4);
> In Mathematica, one can write f[g[h]] as f@g@h or h//g//f.
Seems like Xah's actively looking for reasons to think
Perl is inferior.
> Xah, xah@best.com
> "Perl: all unix's stupidity in one."
Yep, now we know where this guy's coming from.
John Porter
------------------------------
Date: Tue, 09 Jun 1998 11:00:21 -0400
From: Brian Mathis <brianm@kodak.com>
To: James <james@cydaps.co.uk>
Subject: Re: locking DBM files...
Message-Id: <357D4E05.29C06479@kodak.com>
[posted and emailed] [note on email address, please remove munged address]
James wrote:
>
> Hi,
>
> What is the best way to lock a DBM file? I have been told that they don't
> have any locking features of their own, so I should use Flock(), but is
> there any special method to using flock() with DBM files or would the
> following work okay??
>
> dbmopen(%DATA, "database.dbm", 0666);
> &lock_excl(DATA); # should this be &lock_exel(%DATA);??
> $data_out = $DATA{$name};
> dbmclose(%DATA);
> &lock_unlock(DATA);#should this be &lock_unlock(%DATA);
To lock a DBM file, you will need to use the DB_File module instead of the
depricated dbmopen() functions. There is a nice example of how to do the file
locking in perldoc DB_File.
Brian Mathis
--
$_="
,.,,,.,,.,,.,,,,..,,,,,,,,.,,,,,,,,,,,,,,,,,,,,,,,.,,,,,,,..,..,,.,,,,,,,,,
";s/\s//gs;tr/,./05/;@a=split(//);$_=<DATA>;tr/~`'"^/0-4/;map{$o.=$a[$i]
+$_;$i++}split(//);map{print chr}map{$j+=3;substr($o,$j-3,3)}@a;__DATA__
~'^``'``~```~"'~^'``~```````~^`~```^~"'``'`~```^`~"~"'`~^~^'~^^`~'`~```^~`~
------------------------------
Date: Tue, 09 Jun 1998 15:31:57 GMT
From: charlie@antipope.org (Charlie Stross)
Subject: Re: McCabe complexity analysis
Message-Id: <slrn6nqlgc.m99.charlie@cs.ed.datacash.com>
In the name of Kibo the Compassionate, the Merciful,
on 8 Jun 1998 15:55:35 GMT,Tom Christiansen
the supplicant <tchrist@mox.perl.com> implored:
>Why do people write code that's hard to grok with too many conditionals
>and branches within loops? Is it because they're Prisoners of Pascal?
>We end up getting really wicked code like this:
[ snipped -- yuck ]
I suspect it's because the unless statement is alien to Pascal; it also
requires the newish programmers to learn an additional flow-of-control
construct, and that might make their heads hurt. Besides, if/then logic
is easy to understand; the inverse relationship with {} unless isn't
so obvious.
-- Charlie
"Computers depreciate faster than you expect, even when you take
Charlie's Depreciation Hypothesis into account"
-- Charlie's Depreciation Hypothesis
------------------------------
Date: Tue, 09 Jun 1998 15:26:37 GMT
From: Tom Phoenix <rootbeer@teleport.com>
Subject: Re: NEED HELP: stty and the perl compiler
Message-Id: <Pine.GSO.3.96.980609082256.29617j-100000@user2.teleport.com>
On Tue, 9 Jun 1998, James W. Thornton wrote:
> Any ideas on why this is not working when translated to C and compiled?
Perhaps it's because the translator to C isn't finished yet. If you're
using it, you must be using a test version. If you're testing it, you
should be trying to fix any bugs in it - or, at least, reporting them to
the proper authorities. :-)
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: 9 Jun 1998 13:59:53 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Package Question -- How can I circularly include?
Message-Id: <6ljf4p$gk4$1@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
Nicholas Konidaris <npk@bnl.gov> writes:
:So, it does not seem I can have a circular 'use'
:
:What am I doing wrong?
(BTW, wrapping use with BEGIN in superfluous.)
This isn't usually a problem. This works fine:
==> main <==
#!/usr/bin/perl -w
use Alpha;
use Beta;
print "main done.\n";
==> Alpha.pm <==
package Alpha;
use Beta;
print "Alpha done.\n";
1;
==> Beta.pm <==
package Beta;
use Alpha;
print "Beta done.\n";
1;
The only case where mutual inclusions will be a problem is if Alpha were
to try to call something in Beta during compile time initialization. (Or
Beta call Alpha). I'm talking about this kind of thing, which doesn't
work:
==> Alpha.pm <==
package Alpha;
use Beta;
sub func { print "Alpha::func called\n" }
$x = Beta::func();
print "Alpha done.\n";
1;
==> Beta.pm <==
package Beta;
use Alpha;
sub func { print "Beta::func called\n" }
$x = Alpha::func();
print "Beta done.\n";
1;
The solution to this is to employ require, maybe with an import.
That way the compiler has already compiled the current module before
pulling in the other one.
==> main <==
#!/usr/bin/perl -w
print "In main.\n";
use Alpha;
use Beta;
Alpha::func();
Beta::func();
print "main done.\n";
==> Alpha.pm <==
package Alpha;
print "Loading Alpha\n";
require Beta;
Beta->import();
sub func { print "Alpha::func called\n" }
$x = Beta::func();
print "Alpha done.\n";
1;
==> Beta.pm <==
package Beta;
print "Loading Beta\n";
require Alpha;
Alpha->import();
sub func { print "Beta::func called\n" }
$x = Alpha::func();
print "Beta done.\n";
1;
When run, that produces:
Loading Alpha
Loading Beta
Alpha::func called
Beta done.
Beta::func called
Alpha done.
In main.
Alpha::func called
Beta::func called
main done.
Understanding ordering of print statements here
is probably important.
--tom
--
if (rsfp = mypopen("/bin/mail root","w")) { /* heh, heh */
--Larry Wall in perl.c from the perl source code
------------------------------
Date: Tue, 09 Jun 1998 15:25:07 +0100
From: "F.Quednau" <quednauf@nortel.co.uk>
Subject: Re: Package Question -- How can I circularly include?
Message-Id: <357D45C2.CB9523F9@nortel.co.uk>
Nicholas Konidaris wrote:
> What am I doing wrong?
You should possibly have a look in the inheritance section of the
perltoot pages.
--
____________________________________________________________
Frank Quednau
http://www.surrey.ac.uk/~me51fq
________________________________________________
------------------------------
Date: Tue, 09 Jun 1998 15:45:47 GMT
From: The Dukester <web1@netcomuk.co.uk>
Subject: Perl Books?
Message-Id: <6ljlgt$pf1$1@taliesin.netcom.net.uk>
Dear All,
I'm in the UK and was wondering if anyone could suggest a good Perl book, which would be able to get my head around (I've done
basic, little bits of C+ and assembly) and use as a refernce guide? I wouldn't want to spunk #50 on rubbish.
Many thanks
Email <a href="mailto:webmaster@vci.co.uk">Luke</A>
or: webmaster@vci.co.uk
Cheers
Luke
------------------------------
Date: Tue, 09 Jun 1998 15:46:20 GMT
From: Tom Phoenix <rootbeer@teleport.com>
Subject: Re: perl on sunos 4.1
Message-Id: <Pine.GSO.3.96.980609083440.29617k-100000@user2.teleport.com>
On Tue, 9 Jun 1998, Justin Wills wrote:
> Subject: perl on sunos 4.1
>
> I don't seem to be able to get it to build at all. anybody got a
> pointer to an installable binary ?????
You should be able to get it to build; SunOS 4.1 is a common and
supported platform. If it won't build, that's probably a sign that
something on your system is misconfigured - so somebody else's binary
wouldn't work anyway.
Generally, you should choose the default answers when running ./Configure,
on the theory that it's more likely to get the right answer than you are.
:-) In fact, I nearly always build Perl with the "reds" option to
Configure, which tells it to just use the default options without my help.
$ ./Configure -reds
That won't be right in every case, but it's a good first try. Does that
give you any helpful diagnostic message?
Also, does the hints file for your system tell you anything important?
Good luck!
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: Tue, 9 Jun 1998 14:52:55 GMT
From: aep@world.std.com (Andrew E Page)
Subject: Re: perlTk Perl Debugger
Message-Id: <EuAHC7.JD5@world.std.com>
In article <Eu3Gr9.LHx@world.std.com>, Andrew E Page <aep@world.std.com> wrote:
>
> I'm experimenting with writing a debugger for perl with a GUI
>interface built in perlTk. You can find it at:
>
>http://world.std.com/~aep/ptkdb
>
><a href ="http://world.std.com/~aep/ptkdb">ptkdb</a>
>
> If you're interested have a look and give it a try. It
>requires Tk800.500 but there are links on the page to
>help you find it, if you do not already have it.
>
>
I've updated this so that it now only requires Tk400.002.
--
Andrew E. Page (Warrior Poet) | Decision and Effort The Archer and Arrow
Mac Consultant | The difference between what we are
Macintosh and DSP Technology | and what we want to be.
------------------------------
Date: Tue, 09 Jun 1998 10:01:37 -0400
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: Question about =~
Message-Id: <357D4041.1313AF66@matrox.com>
Keppy Boone wrote:
> I am having some difficulty getting a search to work given a string.
>
> ex.
>
> $_ =~ /look/i; # works fine.
Just a note:When referring to the default $_ variable, you can simply
write:
/look/i;
> $search = "/look/i";
> $_ =~ $search; #Doesn't work.
>
> Charles Boone
You can use eval():
$pat = "/look/i";
$str = "I come to look";
if (eval "\$str =~ $pat") { die "YES\n";}
print "NO\n";
--
Ala Qumsieh | No .. not just another
ASIC Design Engineer | Perl Hacker!!!!!
Matrox Graphics Inc. |
Montreal, Quebec | (Not yet!)
------------------------------
Date: 9 Jun 1998 15:18:39 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Question about =~
Message-Id: <6ljjof$lbq$2@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
Ala Qumsieh <aqumsieh@matrox.com> writes:
: You can use eval():
:
:$pat = "/look/i";
:$str = "I come to look";
:
:if (eval "\$str =~ $pat") { die "YES\n";}
That's a really, lousy idea. It's slow, unreliable, *and* insecure.
--tom
--
"They'll get my perl when they pry it from my cold, dead /usr/local/bin."
Randy Futor in <1992Sep13.175035.5623@tc.fluke.COM>
------------------------------
Date: Tue, 09 Jun 1998 14:05:52 GMT
From: cmreynolds@hotmail.com (Chris Reynolds)
Subject: Re: raliases????
Message-Id: <357d4118.158313137@news.sprint.ca>
On Mon, 08 Jun 1998 23:50:57 GMT, Tom Phoenix <rootbeer@teleport.com>
wrote:
>
>> How and/or would the best way be to make a mail alias. You know, like
>> make a script that will extract the email address corresponding to an
>> email alias in unix.
>
>Perhaps you want to read the system mail aliases database? If that's not
>what you want, maybe you should ask again. Hope this helps!
>
Well, I did that. But for some reason I must be missing something,
basically it's not working!
------------------------------
Date: Tue, 09 Jun 1998 14:49:04 GMT
From: dukeboy77@my-dejanews.com
Subject: Reading Directories
Message-Id: <6lji10$nc3$1@nnrp1.dejanews.com>
I need a script that will search a directory read the name of every file
and put it into an array called @files. I've tried and tried with no success
and had no idea where else to turn. If someone could help me I would be very
greatful. Thank you.
Curtis Howard
-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/ Now offering spam-free web-based newsreading
------------------------------
Date: Tue, 9 Jun 1998 17:12:38 +0200
From: "Irsan Widarto" <irsan@tcf.nl>
Subject: Re: Reading Directories
Message-Id: <6ljjeh$5mj$1@news2.xs4all.nl>
dukeboy77@my-dejanews.com wrote in message <6lji10$nc3$1@nnrp1.dejanews.com>...
>I need a script that will search a directory read the name of every file
>and put it into an array called @files.
not sure what you mean with 'search a directory', but this should do the reading
part of your quest:
opendir(MY_DIR, "/some/directory") || die "huh? $!";
@files = readdir(MY_DIR);
closedir(MY_DIR);
>I've tried and tried with no success
>and had no idea where else to turn.
buy the Camel book (perl.ora.com), it's essential reading for any _serious_ Perl
programmer.
>If someone could help me I would be very greatful. Thank you.
no worries,
Irsan.
#-- irsan@tcf.nl
#-- The Connection Factory b.v.
#-- http://www.tcf.nl
------------------------------
Date: 9 Jun 1998 15:20:23 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Reading Directories
Message-Id: <6ljjrn$lbq$3@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
dukeboy77@my-dejanews.com writes:
:I need a script that will search a directory read the name of every file
:and put it into an array called @files. I've tried and tried with no success
:and had no idea where else to turn.
I suggest turning to the manpages, whence cometh thy help.
perlfunc would a good start.
--tom
--
Eighty percent of air pollution comes from plants and trees.
--Ronald Reagan, famous movie star
------------------------------
Date: Tue, 09 Jun 1998 15:03:04 GMT
From: Mike Baroukh <f024101@fr.ibm.com>
Subject: Return characters from a string
Message-Id: <6ljir8$o96$1@nnrp1.dejanews.com>
Hi.
I'd like to return char 1 to 22 of q string. Is there a way to do it without
using functions like cut ?
Thanks
Mike Baroukh
-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/ Now offering spam-free web-based newsreading
------------------------------
Date: 9 Jun 1998 15:34:11 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Return characters from a string
Message-Id: <6ljklj$mq8$1@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
Mike Baroukh <f024101@fr.ibm.com> writes:
:I'd like to return char 1 to 22 of q string. Is there a way to do it without
:using functions like cut ?
I wasn't aware that cut() was a built-in. I certainly am partial
to it, but it's not included in the standard distribution. I've
included my own copy in the enclosed program.
Probably you need to learn what strings are about in Perl.
Here's an unsolicited Perl Cookbook excerpt (I'm sorry, but
it's all I've written for a year and a half. :-)
Perl's fundamental unit for working with data is the scalar,
corresponding to single values stored in single (scalar)
variables. Scalar variables hold strings, numbers, and
references. Array and hash variables hold lists or associations of
scalars, respectively. References are a way of talking about other
values indirectly, somewhat like--and somewhat unlike--pointers in
low-level languages. Numbers are usually stored in your machine's
double- precision floating point notation. Strings in Perl may be of
any length (well, any length that fits into your machine's virtual
memory) and contain any sort of data you care to put there--even
binary data containing null bytes.
A string is not an array of bytes: you cannot use array subscripting
on a string to address one of its characters; use `substr' for
that. Like all data types in Perl, strings grow and shrink on
demand. They get reclaimed by Perl's garbage collection system when
no longer used, which is typically when the variables holding them
go out of scope, or when the expression in which they were used has
been evaluated. In other words, memory management is already taken
care of for you, so you don't have to worry about it.
In short, substr is cheap and easy and happy to be your friend.
He doesn't even require pointer management or live goat sacrifices.
--tom
Yes, this program following is from That Damned Book.
It's got about four pages of explanation. As I said,
it's most of what I've written for a long time.
#!/usr/bin/perl -w
# psgrep - print selected lines of ps output by
# compiling user queries into code
#
# by tchrist@perl.com
#
# Examples:
#
# $ psgrep '/sh\b/'
# $ psgrep 'command =~ /sh$/'
# $ psgrep 'uid < 10'
# $ psgrep 'command =~ /^-/' 'tty ne "?"'
# $ psgrep 'tty =~ /^[p-t]/'
# $ psgrep 'uid && tty eq "?"'
# $ psgrep 'size > 10 * 2**10' 'uid != 0'
use strict;
# each field from the PS header
my @fieldnames = qw(FLAGS UID PID PPID PRI NICE SIZE
RSS WCHAN STAT TTY TIME COMMAND);
# determine the unpack format needed (hard-coded for Linux ps)
my $fmt = cut2fmt(8, 14, 20, 26, 30, 34, 41, 47, 59, 63, 67, 72);
my %fields; # where the data will store
die <<Thanatos unless @ARGV;
usage: $0 criterion ...
Each criterion is one a Perl expression involving:
@fieldnames
All criteria must be met for a line to be printed.
Thanatos
# Create function aliases for uid, size, UID, SIZE, etc.
# Empty parens on closure args needed for void prototyping.
for my $name (@fieldnames) {
no strict 'refs';
*$name = *{lc $name} = sub () { $fields{$name} };
}
my $code = "sub is_desirable { " . join(" and ", @ARGV) . " } ";
unless (eval $code.1) {
die "Error in code: $@\n\t$code\n";
}
open(PS, "ps wwaxl |") || die "cannot fork: $!";
print scalar <PS>; # emit header line
while (<PS>) {
@fields{@fieldnames} = trim(unpack($fmt, $_));
print if is_desirable(); # line matches their criteria
}
close(PS) || die "ps failed!";
# convert cut positions to unpack format
sub cut2fmt {
my(@positions) = @_;
my $template = '';
my $lastpos = 1;
for my $place (@positions) {
$template .= "A" . ($place - $lastpos) . " ";
$lastpos = $place;
}
$template .= "A*";
return $template;
}
sub trim {
my @strings = @_;
for (@strings) {
s/^\s+//;
s/\s+$//;
}
return wantarray ? @strings : $strings[0];
}
# the following was used to determine column cut points.
# sample input data follows
#123456789012345678901234567890123456789012345678901234567890123456789012345
# 1 2 3 4 5 6 7
# Positioning:
# 8 14 20 26 30 34 41 47 59 63 67 72
# | | | | | | | | | | | |
__END__
FLAGS UID PID PPID PRI NI SIZE RSS WCHAN STA TTY TIME COMMAND
100 0 1 0 0 0 760 432 do_select S ? 0:02 init
140 0 187 1 0 0 784 452 do_select S ? 0:02 syslogd
100100 101 428 1 0 0 1436 944 do_exit S 1 0:00 /bin/login
100140 99 30217 402 0 0 1552 1008 posix_lock_ S ? 0:00 httpd
0 101 593 428 0 0 1780 1260 copy_thread S 1 0:00 -tcsh
100000 101 30639 9562 17 0 924 496 R p1 0:00 ps axl
0 101 25145 9563 0 0 2964 2360 idetape_rea S p2 0:06 trn
100100 0 10116 9564 0 0 1412 928 setup_frame T p3 0:00 ssh -C www
100100 0 26554 9653 0 0 812 436 setup_frame T p2 0:00 man perlfunc
100100 0 26560 26554 0 0 1076 572 setup_frame T p2 0:00 less
100000 101 19058 9562 0 0 1396 900 setup_frame T p1 0:02 nvi /tmp/a
--
"Incrementing C by 1 is not enough to make a good object-oriented language."
(M. Sakkinen, in "On the Darker Side of C++", ECOOP'88)
------------------------------
Date: 9 Jun 1998 15:54:42 GMT
From: Zenin <zenin@bawdycaste.org>
Subject: Re: Return characters from a string
Message-Id: <897408170.468968@thrush.omix.com>
Mike Baroukh <f024101@fr.ibm.com> wrote:
: I'd like to return char 1 to 22 of q string. Is there a way to do it without
: using functions like cut ?
perldoc -f substr
$string = 'A' x 100;
$piece = substr $string, 0, 22; # 0 is first char/byte of string
--
-Zenin
zenin@archive.rhps.org
------------------------------
Date: Tue, 9 Jun 1998 08:33:52 -0700
From: "gip" <gibsonc@aztec.asu.edu>
Subject: Stopping Perl from interpreting fprintf's in a C file
Message-Id: <6ljksj$1o7@bmw.hwcae.az.Honeywell.COM>
I have a simple script that removes C++ comments from a file.
The problem is that some lines, that I'm not even interested in, are being
processed before getting written out to the new file. How do I keep this
from happening?
For example, the following line is originally this:
fprintf(outfile, "\nvertRec[%d]\n \t\txpos = %f, ypos = %f, r = %f, g = %f,
b = %f\n",
vertex_reg, vertex_recs[vertex_reg].xpos,
vertex_recs[vertex_reg].ypos,
vertex_recs[vertex_reg].color.r,
vertex_recs[vertex_reg].color.g, vertex_recs[vertex_reg].color.b);
But after a "printf( OUTFILE, $line );", it becomes this:
fprintf(outfile, "\nvertRec[0]\n \t\txpos = 0.000000, ypos = 0.000000, r =
0.000000, g = 0.000000, b = 0.000000\n",
vertex_reg, vertex_recs[vertex_reg].xpos,
vertex_recs[vertex_reg].ypos,
vertex_recs[vertex_reg].color.r,
vertex_recs[vertex_reg].color.g, vertex_recs[vertex_reg].color.b);
Please email me at gibsonc@aztec.asu.edu Thanks!
------------------------------
Date: 9 Jun 1998 15:04:32 GMT
From: "Allan M. Due" <due@murray.fordham.edu>
Subject: Windows STDIN weirdness was (Re: Exercise in Llama Book)
Message-Id: <6ljiu0$4fd$0@206.165.146.164>
Tim Benjamin wrote in message <357C854F.DEAB6D64@mcmail.com>...
>I don't know if this is a bug or if I'm doing something incredibly dumb,
but
>here goes:
>
>-w;
>print "Type some strings, finish with CTRL-Z:\n";
>@array=<STDIN>;
>print @array;
>
>If you type in
>a b c d e f
>(each on new lines)
>it prints out:
>b c d e f
>(each on new lines)
>However, if you change line 3 to
>chomp(@array=<STDIN>);
>it works, i.e. it gives:
>abcdef
You know that is not what I get, but what I do get is very strange none the
less. No output is sent to the screen if I use the second version (chomp).
Using the latest Gurusamy Sarathy windows port, I need to print a new line
before any other printing and then both of these snippets work as expected.
Thus:
-w
print "Type some strings, finish with CTRL-Z:\n";
@array=<STDIN>;
print "\n";
print @array;
produces the desired results as does:
-w;
print "Type some strings, finish with CTRL-Z:\n";
chomp(@array=<STDIN>);
print "\n";
print @array;
>
>Can anyone cast any light on this?
>I am using the most recent Win32 version of Perl.
>
Only a little gloom is lifted as I have no idea why this works, I just know
that it does. It must have something to do with the CTRL-Z. I can run the
two original snippets on a FreeBSD box without needing the extra new line.
Very odd.
Bug or feature?
Allan M. Due
Due@discovernet.net
Admin@WhiteCrow.net
The beginning of wisdom is the definitions of terms.
- Socrates
------------------------------
Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 8 Mar 97)
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.misc (and this Digest), send your
article to perl-users@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.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
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 V8 Issue 2821
**************************************
