[8815] in Perl-Users-Digest
Perl-Users Digest, Issue: 2431 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Apr 27 17:17:24 1998
Date: Mon, 27 Apr 98 14:00:31 -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 Mon, 27 Apr 1998 Volume: 8 Number: 2431
Today's topics:
"magical autoincrement algorithm?" <grinch@whoville.com>
Re: 'each' and recursion, do they mix? <jll@skynet.be>
Re: 'each' and recursion, do they mix? (Mark-Jason Dominus)
A general purpose logfile processing script (repost) (Ofer Inbar)
Re: Auto-generate HTML Tables <newsgroups@reza.net>
DBD-Oracle emulation - ofetch or ora_fetch??? (Project Mobile)
Dummie question: EASY !! file copy wanted (Michael Haertfelder)
Re: Dummie question: EASY !! file copy wanted (brian d foy)
Free Help for newbies and profs <m.ubl@elmshorn.netsurf.de>
How to add \ to an email address spencer@luckman.com
How to edit a file most efficiently? <yong@shell.com>
Re: How to load the module with calculated name? (Petr Prikryl)
Re: How to load the module with calculated name? (Petr Prikryl)
Interpolation tricks (was Re: Print Currency) <jkry3025@comenius.ms.mff.cuni.cz>
Re: Interrupt handling with pipes with perl (Charles DeRykus)
Re: Looking for example of IO::Socket for UDP Server <tchrist@mox.perl.com>
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Mon, 27 Apr 1998 14:40:11 -0400
From: "Grinch" <grinch@whoville.com>
Subject: "magical autoincrement algorithm?"
Message-Id: <6i2ii1$hj0@fridge.shore.net>
Where can I find out more about the "magical autoincrement algorithm" used
for the range operator?
More specifically, can anyone tell me how to obtain a mixed-case list? I
expected ('AA'..'zz') to work, but it returns all 676 upper case
combinations. ('aa'..'ZZ') returns all 676 lower case combinations. What I
want is all 2704 mixed-case, two-letter combinations.
I can come up with workarounds using various looping constructs, and for my
current project I'll probably wind up doing exactly that. I just want to
clear up my (mis?)understanding of '..', and figure out why ('AA'..'zz')
doesn't do what I expected.
TIA!
-grinch
--
-----
"Yes, I'm paranoid, but that doesn't mean
no one's out to get me." - me
Sherm Pendley
grinch@whoville.com
http://www.whoville.com
------------------------------
Date: Mon, 27 Apr 1998 20:30:13 +0200
From: Jean-Louis Leroy <jll@skynet.be>
Subject: Re: 'each' and recursion, do they mix?
Message-Id: <VA.0000003c.0087dfec@enterprise>
> In article <VA.000000a4.0f7c0ed0@jll>, Jean-Louis Leroy <jll@skynet.be> wrote:
> I gave an example elsewhere in this thread of a case where moving a
> statement into a foreach loop would break it [snip]
Okay, altering 'each' would break that code, and there's probably a lot of code
like that around. So it shouldn't be done.
Historical reasons aside, I don't find the hypothetical behavior your describe
counterintuitive. I'll think harder about it...
> >We could simply say, ` la Camel p. 159: "You must not add elements to
> >the hash while there exist iterators on it".
>
> What do you mean, `while there exist iterators'? I think you've
> really missed the point here.
> [...]
> But x will *always* have an iterator for the hash.
I was replying to Ilya's comment about having separate iterator objects, like in
the STL. Do you think I should have quoted more generously??
> * x dumps core next time you call it?
Yes, exactly. If multiple iterators were introduced, the choice would be between:
1) doing extensive cleanup each time a hash is modified
2) say: you can't do that, and if you do it, your program has a bug
I find (2) perfectly acceptable.
Also, what do you think of making *the* iterator amenable to local()? That would
solve the problem you mentioned, wouldn't it?
And right now, I'm not so much interested in changing 'each' than in
understanding why my benchmarks say that it's slower than looping over the keys
and indexing the hash. If you can tell me why, or give me pointers to the
explanation, I'll be grateful.
jl
------------------------------
Date: 27 Apr 1998 15:51:16 -0400
From: mjd@op.net (Mark-Jason Dominus)
Subject: Re: 'each' and recursion, do they mix?
Message-Id: <6i2njk$i5e$1@monet.op.net>
Keywords: inestimable sauerkraut tenor wed
In article <VA.0000003c.0087dfec@enterprise>,
Jean-Louis Leroy <jll@skynet.be> wrote:
> Do you think I should have quoted more generously??
I guess I didn't understand the context of your response.
>> * x dumps core next time you call it?
>
>Yes, exactly.
That is not very Perlish!
Something you might want to consider, if you're really interested in
this, is a tied hash class that supports explicit iterators. These
would be objects, so they'd have local scoping semantics. Then you
could say things like this:
Use myHash;
tie %h => myHash;
%h = (a => 1, ...);
{
my $iterator = (tied %h)->new_iterator;
my ($k1, $v1) = $iterator->next;
my ($k2, $v2) = $iterator->next;
$iterator->reset;
my ($k3, $v3) = $iterator->next; # Get k1/v1 again
# iterator is automatically destroyed here
}
This might give you a sense of the difficulties involved. I don't see
how it would solve your reentrancy problem, (which is why I don't
understand your approach to this entire discussion) but maybe you can
think of a way to do it.
>Also, what do you think of making *the* iterator amenable to local()?
>That would solve the problem you mentioned, wouldn't it?
I'm not sure I understand what you want to do here. The iterator is
part of the variable. If you local() the variable, the iterator is
saved and restored along with everything else.
%h = (a => 1, b=> 2, c=> 3);
sub foo {
local (%h) = (p => 5, q => 6);
print each %h, "\n";
}
while (($k, $v) = each %h) {
print ">> $k => $v\n";
foo();
}
Here the `each' in subroutine `foo' doesn't interfere with the `each'
in the main program at all.
Perhaps you could explain better the way you would want it to look.
>I'm interested in understanding why my benchmarks say that it's
>slower than looping over the keys. If you can tell me why, or give
>me pointers to the explanation, I'll be grateful.
I don't know why; I had expected it to be slower, but not as slow as
it is. (`each' is not for speed; it is a space optimization, not a
time optimization. You should expect it to be slower.)
If yu really want to know, the place to look is in the Perl source.
The files to start looking at are pp.c and pp_hot.c, which contain the
code for the operators themselves; the `pp_keys', `pp_values', and
`pp_each' functions are called when you use the `keys', `values', and
`each' operators. `pp_keys' and `pp_values' just call `do_kv', which
is in doop.c; `pp_each' is handled inline. Most of the important
utility functions that deal with hashes are in hv.c.
------------------------------
Date: Mon, 27 Apr 1998 20:23:29 GMT
From: cos@zax.whoville.leftbank.com (Ofer Inbar)
Subject: A general purpose logfile processing script (repost)
Message-Id: <6i2p7v$7jf@zax.whoville.leftbank.com>
This is the Left Bank Operation logrotation script.
The documentation is in the comments at the beginning of the script.
If you use this script, please email me any useful changes you make.
[slightly modified from the version I posted yesterday]
----------------------------------------------------------------------
#!/usr/bin/perl
#
# logrotation - periodically process system log files
# syntax: logrotation [explist=file] [gzip=file] [gz=ext] <period>
# $Id: logrotation,v 3.1 1998/04/27 20:12:18 cos Exp $
#
# Reads from explist (defined below) a list of log files to process.
# Each entry in the explist file should have four fields, separated
# by whitespace. The last field actually contains everything from
# the fourth whitespace-separated column to the end of line, so it
# may itself contain whitespace.
#
# The fields are, in order:
# - full absolute pathname of the log file
# - period in which to process this log file
# - method for log file processing
# - arguments, depending on method
# Only logs in the period matching the command line argument will be
# processed. For example, "logrotation monthly" will process only
# entries which say "monthly" in the second field.
#
# There are five methods defined for log file processing:
# (there is also a pseudo-method "pidfile" - see below)
#
# * rotate - compress the current logfile and start a new one.
# In this case, the fourth field is a number indicating how many old
# logs to keep. For example, a log file rotated once a week with
# "rotate 5" will keep the past five weeks, compressed. Old copies
# of the log file are numbered, with <file>.1 being the most recent
#
# * lines - shrink the logile to a specified number of entries.
# The last <n> lines of the logfile will be kept, the rest
# discarded, with <n> being the fourth field from explist.
#
# The logfile must be plaintext. By default, each line is a single
# newline delimited line of text. If log entries are multiline, but
# have a predictable separator, you can specify this separator as a
# fifth field, after the number of lines. This fifth field may
# contain whitespace, and perl interpolation metacharacters such as
# \n. For example, if each log entry is a block of text followed by a
# single blank line, put \n\n in the fifth field.
#
# * pipe - send the contents of this log to an external program.
# This does not alter the log file in any way, but opens a pipe to the
# program specified in the arguments (fourth field) and sends the
# entire text of the logfile to that process's standard input.
#
# * program - a separate program will perform the processing.
# The program name and arguments are taken from the fourth field.
# An @ in the fourth field will be replaced by the name of the log
# file being processed, and a $ by its directory. If you want an
# actual @ or $, use \@ or \$ respectively.
#
# * rename - rename the file, optionally by date.
# The logfile is renamed and compressed.
# A new logfile by the same name as the original is started. No files
# are deleted, so manual cleanup will eventually be necessary.
#
# There are two optional arguments, space separated. The first is
# a format to use for renaming the file, which may include special
# format substrings that will be replaced by the current date. The
# second is an optional date offset, in minutes, can be specified in
# the argument field. For example, if logrotation is run at 2am and
# you'd like the file to be dated as the previous day, put "-60*3" to
# "backdate" it by three hours. The default is "@.YYYYMMDD -60".
#
# In the rename format, the following strings are special:
# @ original name of the log file
# YYYY 4-digit year
# YY 2-digit year
# MMM month name, 3-letter form
# MM month, numeric form
# DD day of month, numeric form
# JJJ "Julian" date - day of year
# DDD day of week, 3-letter form
# HH hour, 24 hour time
# :MM minutes, preceded by a colon
# :SS seconds, preceded by a colon
#
# After processing logs using any method, a SIGHUP is sent to syslogd.
# Also, the current or new logfile is reset to the same ownership and
# permissions that the current or old file had before processing.
#
# For some logs, there are other programs that may need to be sent
# SIGHUP after the log is processed. You can define this using the
# "pidfile" pseudo-method. Make an entry, preceding the real log file
# entry, and with identical directory, file, and period names. The
# method is "pidfile" and the argument is the name of a file that
# contains the PID of the process to receive a SIGHUP. You may define
# multiple pidfiles for a single log - just make sure they all precede
# that log and are identical in the first two columns.
#
# Some sample explist entries:
# /var/adm/sulog monthly lines 20000
# /var/cron/log monthly lines 10000 \n> CMD:
# /var/adm/wtmp weekly program rotate_wtmp 180
# /usr/local/man/windex weekly program catman -w -M $
# /usr/spool/mqueue/syslog daily pidfile /etc/sendmail.pid
# /usr/spool/mqueue/syslog daily rotate 7
# /web/logs/httpd.log daily pipe webstats mail=ops
# /web/logs/httpd.log daily rename @.DDD -30
#
# Some sample crontab entries:
# 0 0 * * * /usr/local/etc/logrotation daily > /dev/null
# 0 0 * * 0 /usr/local/etc/logrotation weekly > /dev/null
# 0 0 1 * * /usr/local/etc/logrotation monthly > /dev/null
# 0 0 1 1 * /usr/local/etc/logrotation yearly > /dev/null
#
# If you don't have gzip installed, you can use compress:
# logrotation gzip=/usr/ucb/compress gz=.Z <period>
#
# If you'd like to test things out with a different explist file:
# logrotation explist=/path/file <period>
# Otherwise, the default explist is /usr/local/etc/logs.expire.
#
# Bug: There is a small chance that some logging information may be
# lost if the system attempts to write it during the brief moment
# during which this script is replacing the log file.
#
# This script is distributed under the terms of Larry Wall's
# excellent Artistic License. If you have bug fixes or enhancements,
# email cos@leftbank.com. For a copy of the Artistic License, see:
# http://language.perl.com/misc/Artistic.html
#
# (C)opyright 1998 The Left Bank Operation (Cohesive Network Systems)
# -- Ofer Inbar <cos@leftbank.com> 26 April 1998
require 5;
require "timelocal.pl";
@wname = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat","Sun");
@mname = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");
#%mnum = ("Jan","01", "Feb","02", "Mar","03", "Apr","04", "May","05", "Jun","06",
# "Jul","07", "Aug","08", "Sep","09", "Oct","10", "Nov","11", "Dec","12");
@pidfiles = ("/etc/syslog.pid");
$explist = "/usr/local/etc/logs.expire";
$gzip = "/usr/local/bin/gzip";
$gz = ".gz";
eval "warn \$die='Unknown switch $1\n' if \$$1 eq ''; \$$1=\$2;"
while ($ARGV[0] =~ /^(\w+)=(.*)/ && shift);
exit 1 if $die; # process any FOO=bar switches
$thisperiod = shift
or die "usage: $0 [explist=path] [gzip=path [gz=extension]] period\n";
eval "warn \$die='Unknown switch $1\n' if \$$1 eq ''; \$$1=\$2;"
while ($ARGV[0] =~ /^(\w+)=(.*)/ && shift);
exit 1 if $die; # process any FOO=bar switches
open EXPLIST, "< $explist"
or die "can't open $explist: $!\n";
while (<EXPLIST>)
{ next if /^#/;
next if /^\s*$/;
my @entry = m#^\s*(/\S+)?/([^/\s]+)\s+(\w+)\s+(\w+)\s+(.+)$#
or warn "$0: syntax error in $explist line $.: $_" and next;
push @list, \@entry;
} close EXPLIST;
foreach $entry (@list)
{ my ($dir,$file,$period,$method,$args) = @$entry;
$dir ||= "/";
$method = lc($method);
if (lc($period) eq lc($thisperiod))
{ chdir $dir
or warn "$0: can't chdir to $dir: $!\n(skipping $file)\n" and next;
$dir = "" if $dir eq "/";
my ($mod,$uid,$gid) = (stat($file))[2,4,5]
or warn "$0: can't stat $dir/$file:$!\n" and next;
-f _ or warn "$0: $dir/$file not a plain file, skipping it\n" and next;
# -------------------- PIDFILE
if ($method eq "pidfile")
{ push @{$pidfiles{"$dir$file"}}, $args }
# -------------------- PROGRAM
elsif ($method eq "program")
{ $args =~ s"([^\\])\$"$1$dir"g;
$args =~ s"([^\\])\@"$1$file"g;
$args =~ s"\\$"\$"g;
$args =~ s"\\@"\@"g;
$args =~ s"\\\\"\\"g;
$output = `$args`;
}
# -------------------- PIPE
elsif ($method eq "pipe")
{ my $prog = $args;
open PIPE, "| $prog"
or warn "$0: can't run $prog: $!\n(skipping $dir/$file)\n"
and next;
open LOG, "< $file"
or warn "$0: can't read $file: $!\n(skipping $dir/$file)\n"
and close PIPE and next;
$sigpiped = 0;
$SIG{'PIPE'} = sub { $sigpiped = 1 };
while (defined($_ = <LOG>) and not $sigpiped) {print PIPE}
warn "$0: $prog died prematurely, on $dir/$file\n" if $sigpiped;
close PIPE or warn "$0: $prog failed, on $dir/$file: $!\n";
close LOG;
$SIG{'PIPE'} = 'DEFAULT';
}
# -------------------- ROTATE
elsif ($method eq "rotate")
{ for ($ver=$args; $ver > 1; $ver--)
{ $nxt = $ver-1;
if (-f "$file.$nxt$gz" )
{ $output .= `mv $file.$nxt$gz $file.$ver$gz` }
}
$output .= `mv $file $file.1`;
$output .= `touch $file`;
$output .= sendhups(@pidfiles, @{$pidfiles{"$dir$file"}});
push @zfiles, "$file.1";
}
# -------------------- LINES
elsif ($method eq "lines")
{ `rm -f $file.new`;
my($lines,$separator) = $args =~ /^\s*(\d+)\s+(\S.*)/;
if ($separator) { $/ = eval "\"$separator\"" } else { $lines = $args }
if ($lines < 1) { warn "$0: can't chop to $lines lines! skipping $dir/$file\n"; next }
unless (-T _) { warn "$0: $dir/$file not a text file, skipping it\n"; next }
open LOG, $file
or warn "$0: can't read $dir/$file: $!\n" and next;
while (<LOG>)
{ push @lines, $_;
shift @lines if @lines > $lines;
}
close LOG;
next if @lines < $lines;
open LOG, "> $file"
or warn "$0: can't write $dir/$file: $!\n" and next;
print LOG @lines
or warn "$0: can't write $dir/$file: $!\n";
close LOG;
$output .= sendhups(@pidfiles, @{$pidfiles{"$dir$file"}});
}
# -------------------- RENAME
elsif ($method eq "rename")
{ my ($format,$offset) = $args =~ /^(\S+)\s*(.*)$/;
$offset = -60 if $offset =~ /^\s*$/;
my $time = time + 60 * eval($offset);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
$format = "@.YYYYMMDD" if $format =~ /^\s*$/;
my $fstring = ""; @fvars = ();
while($format)
{ if ($format=~s/^YYYY//) { $fstring .= "%4d"; push @fvars, $year+1900 }
elsif ($format=~s/^YY//) { $fstring .= "%2d"; push @fvars, $year }
elsif ($format=~s/^MMM//) { $fstring .= "%s"; push @fvars, $mname[$mon] }
elsif ($format=~s/^DDD//) { $fstring .= "%s"; push @fvars, $wname[$wday] }
elsif ($format=~s/^JJJ//) { $fstring .= "%03d"; push @fvars, $yday }
elsif ($format=~s/^MM//) { $fstring .= "%02d"; push @fvars, $mon+1 }
elsif ($format=~s/^DD//) { $fstring .= "%02d"; push @fvars, $mday }
elsif ($format=~s/^HH//) { $fstring .= "%02d"; push @fvars, $hour }
elsif ($format=~s/^:MM//) { $fstring .= ":%02d"; push @fvars, $min }
elsif ($format=~s/^:SS//) { $fstring .= ":%02d"; push @fvars, $sec }
elsif ($format=~s/^@//) { $fstring .= "%s"; push @fvars, $file }
else { $format =~ s/^(.)/($fstring .= $1), ""/se }
}
my $newname = sprintf($fstring, @fvars);
$output .= `mv $file $newname`;
unless (-f $newname)
{ warn "$0: can't rename $dir/$file to $newname\n"; next }
$output .= `touch $file`;
$output .= sendhups(@pidfiles, @{$pidfiles{"$dir$file"}});
push @zfiles, "$newname";
}
else { warn "skipping $dir/$file - unknown method: $method\n" }
if ((chmod $mod, $file) != 1) { warn "$0: couldn't chmod $file to $mod\n" }
if ((chown $uid, $gid, $file) != 1) { warn "$0: couldn't chown $file to $uid, $gid\n" }
warn $output unless $output =~ /^\s*$/;
$output = "";
}
}
foreach $file (@zfiles) { print `$gzip $file` }
sub sendhups
{ my (@pidfiles, @pids) = @_;
foreach $pidfile (@pidfiles)
{ open (PIDFILE, $pidfile) or warn "can't open $pidfile\n" and next;
chomp ($pid = <PIDFILE>);
push @pids, $pid;
}
return `kill -HUP @pids`;
}
----------------------------------------------------------------------
-- Cos (Ofer Inbar) -- cos@leftbank.com cos@cs.brandeis.edu
-- The Left Bank Operation -- lbo@leftbank.com http://www.leftbank.com/
It's been said that if a sysadmin does his job perfectly, he's the
fellow that people wonder what he does and why the company needs him,
until he goes on vacation. -- comp.unix.admin FAQ
------------------------------
Date: Mon, 27 Apr 1998 13:07:58 -0700
From: Reza Naima <newsgroups@reza.net>
To: dtbaker_@flash.net
Subject: Re: Auto-generate HTML Tables
Message-Id: <3544E59E.E46327AC@reza.net>
Dan Baker wrote:
> > $table = new Table;
> > $table->{content} = [ {contentstyle->['font color=white','i'],
> > style=>'bgcolor=blue',
> > content=>['Name','Phone Number']
> > }
> > ];
> >
> > push @{$table->{content}}, @{$q->fetchrow_arrayref};
> >
> > print $table->generate();
> > and that's all it takes to make a table, with a cool header.
> > let me know if there would be any interest in it.
> --------------------
> sounds pretty cool! do you have somewhere on the web you can put it for
> download? or, maybe submit it to Matt's script archive (or some other
> one?) ?
>
> Dan
What's matt's script archive? I suppose I'de need to thow some
documentation for it together first, as it can be used in a fairly
complex manner if you wanted to. I could drop in in CPAN, but there are
already a bunch of HTML::Table's out there.
For the time being, I threw that and a couple of other modules I wrote
on
http://www.reza.net/perl
Reza
------------------------------
Date: Mon, 27 Apr 1998 20:40:16 GMT
From: mobile@visi.com (Project Mobile)
Subject: DBD-Oracle emulation - ofetch or ora_fetch???
Message-Id: <Q2611.303$p_.1904431@ptah.visi.com>
Hi,
I have been looking thru the DBD-Oracle code for some oci syntax -
could someone pls advise where the xlation occurs?
tx
mr
------------------------------
Date: 27 Apr 1998 21:34:00 +0200
From: haert@wharp.rhein-main.de (Michael Haertfelder)
Subject: Dummie question: EASY !! file copy wanted
Message-Id: <6sgJ8gq-ZZB@wharp.rhein-main.de>
Well, I could copy a file in perl like this:
while(<OLD>) {
print NEW $_; }
but I feel that there is another easier (shorter) way to do that.
Any suggestions ?
Thanx in advance
Michael
------------------------------
Date: Mon, 27 Apr 1998 16:11:49 -0400
From: comdog@computerdog.com (brian d foy)
Subject: Re: Dummie question: EASY !! file copy wanted
Message-Id: <comdog-ya02408000R2704981611490001@news.panix.com>
Keywords: from just another new york perl hacker
In article <6sgJ8gq-ZZB@wharp.rhein-main.de>, haert@wharp.rhein-main.de (Michael Haertfelder) posted:
>Well, I could copy a file in perl like this:
perhaps File::Copy?
--
brian d foy <comdog@computerdog.com>
CGI Meta FAQ <URL:http://computerdog.com/CGI_MetaFAQ.html>
Comprehensive Perl Archive Network (CPAN) <URL:http://www.perl.com>
Perl Mongers <URL:http://www.pm.org>
------------------------------
Date: Mon, 27 Apr 1998 21:20:49 +0100
From: Malte Ubl <m.ubl@elmshorn.netsurf.de>
Subject: Free Help for newbies and profs
Message-Id: <3544E8A1.60BD@elmshorn.netsurf.de>
Hi,
if you are one of the people who had problems with
difficult installations of CGI-scripts, file-permissions, etc.
I have the solution for you:
easyScriptsOffice!
An integrated powerful suite of tools to make website-
management a piece of cake.
Access-Counter, Visitor-Information, HTTP-Referer and
Statistics - all in one.
CGI and HTML based.
No EXE files. No SSI needed. No log-file access needed.
I developed it during my work as a webmaster for a commercial
website and in my free time. It's absolutely free!
(I am always happy if someone writes me an eMail with his
thoughts about my scripts)
Check it out at:
http://easy.web66.com
Thank you,
Malte Ubl
------------------------------
Date: Mon, 27 Apr 1998 15:23:52 -0600
From: spencer@luckman.com
Subject: How to add \ to an email address
Message-Id: <6i2pgn$ncn$1@nnrp1.dejanews.com>
Hi,
How do I add \ to a string that contains @ and . characters in Perl? I want to
convert an email address like:
somebody@here.company.com
to this:
somebody\@here\.company\.com
Thanks, Spencer
-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/ Now offering spam-free web-based newsreading
------------------------------
Date: Mon, 27 Apr 1998 14:44:25 -0500
From: Yong Huang <yong@shell.com>
Subject: How to edit a file most efficiently?
Message-Id: <3544E019.A1F7A6D6@shell.com>
If I want to edit a file (say, remove all comment lines), I can do this:
open IN, "myin.dat" or die: $!;
open OUT, ">myout.dat" or die: $!; #I may use $$ as filename (another
issue)
while (<IN>)
{ print OUT $_ unless (/^#/);
}
close OUT;
close IN;
rename "myout.dat", "myin.dat";
But this opens two files and does a rename. I suspect this won't be very
efficient. Is there a better way? Thanks for any advice.
Yong Huang (yong@shell.com)
------------------------------
Date: 27 Apr 1998 19:46:02 GMT
From: prikryl@dcse.fee.vutbr.cz (Petr Prikryl)
Subject: Re: How to load the module with calculated name?
Message-Id: <6i2n9q$7iu$2@boco.fee.vutbr.cz>
Andrew M. Langmead (aml@world.std.com) wrote:
>prikryl@dcse.fee.vutbr.cz (Petr Prikryl) writes:
>>Please, how can I load the module when its name was calculated (read
>>from the input text file into a variable). The module is placed in
>>the subdirectory which was also calculated (it is not in @INC).
[...]
>I guess you could also simply do:
>eval "use lib '$directory';use $module";
[...]
I tried eval "use lib..." but it did not work.
--
Petr Prikryl (prikryl@dcse.fee.vutbr.cz) http://www.fee.vutbr.cz/~prikryl/
TU of Brno, Dept. of Computer Sci. & Engineering; tel. +420-(0)5-7275 218
------------------------------
Date: 27 Apr 1998 20:28:07 GMT
From: prikryl@dcse.fee.vutbr.cz (Petr Prikryl)
Subject: Re: How to load the module with calculated name?
Message-Id: <6i2pon$dtq$1@boco.fee.vutbr.cz>
Tom Christiansen (tchrist@mox.perl.com) wrote:
>prikryl@dcse.fee.vutbr.cz (Petr Prikryl) writes:
>:Please, how can I load the module when its name was calculated (read
>:from the input text file into a variable). The module is placed in
>:the subdirectory which was also calculated (it is not in @INC).
>:
>:My solution up to now is:
>:
>: require "$directory/$module.pm";
>: eval "$module\::function()";
>:
>:[...] I do "use strict" and I want to keep the strict mode.
>That's not really a solution. And the eval there is overkill.
>--tom
So how to make it work in strict mode without eval? Even with
eval I had to use backslash before ::. Otherwise the Perl complained
"Use of uninitialized value at the line". As the value of the
$module variable was defined, I expect that the Perl was searching
for the "function" which was not defined.
>[Excerpt from a draft of the Perl Cookbook follows.]
> Problem: You need to load in a module that might not be present on
> your system. This normally results in a fatal exception. How
> do you detect and trap such failures?
> Solution
> Wrap the `require' or `use' in an `eval'.
[...]
You are right. I did test whether the file $module.pm exists
(berore require), but it is not the same
> # no import
> unless (eval "require $mod") {
> warn "couldn't load $mod: $@";
> }
[...]
I do not use import, so I did not use the second example with "use".
I stopped to use bareword "require". Now the solution looks like this:
foreach my $task (@tasklist) {
eval "require '$mydir/$module.pm'" or
die "Unsuccessful require '$mydir/$module.pm'': $@";
eval "$module\::function()";
}
Could you comment on this? I still could not avoid the second eval.
Moreover, I still observe the problem mentioned earlier; when I place "die"
into the $module::function() -- for example as the first command --
the function simply returns (or maybe the module is "quit" in some
sense) but the Perl does not complain. It does not write anything
related to die.
To summarize, the behaviour is the same as it was in my previous
solution the code is probably more "water resistant".
Thanks for ideas,
Petr
--
Petr Prikryl (prikryl@dcse.fee.vutbr.cz) http://www.fee.vutbr.cz/~prikryl/
TU of Brno, Dept. of Computer Sci. & Engineering; tel. +420-(0)5-7275 218
------------------------------
Date: Mon, 27 Apr 1998 22:02:09 -0700
From: Jan Krynicky <jkry3025@comenius.ms.mff.cuni.cz>
To: Mark-Jason Dominus <mjd@op.net>, Self <Jenda@McCann.cz>
Subject: Interpolation tricks (was Re: Print Currency)
Message-Id: <354562D1.4D33@comenius.ms.mff.cuni.cz>
Mark-Jason Dominus wrote:
>
> In article <35449B3F.1609@min.net>, John Porter <jdporter@min.net> wrote:
> >tanr@vancpower.com wrote:
> >> What would be the easiest way to print a float number in a currency format
> >> ($xx,xxx.xx)? Thanks!
> > use Interpolation commify => 'commify';
> > $gross = 666000.42;
> > print "Total tax: \$$commify{ $gross * 0.28 } \n";
>
> I personally might try this:
>
> > use Interpolation '$' => 'commify';
> > $gross = 666000.42;
> > print "Total tax: \$$${ $gross * 0.28 } \n";
>
> It does the same thing, but looks funnier.
It would do, only if $ wouldn't be so special.
I tried it and got
Total tax: $
No number. You have to do at least:
use Interpolation 'S' => 'commify';
$gross = 666000.42;
print "Total tax: \$$S{ $gross * 0.28 } \n";
Or better
use Interpolation 'S' => sub
{'$'.&{$Interpolation::builtin{commify}}(@_)};
$gross = 666000.42;
print "Total tax: $S{ $gross * 0.28 } \n";
so that you do not have to prepend it by \$.
> Someone had a really delightful suggestion for a use for
> `Interpolation' that I had not thought of before. They are using it
> to escape character strings when they interpolate them into SQL
> queries:
>
> use Interpolation SQ => \&SQL_escape_single_quoted;
> ...
> $query = join " AND ", map { "$_ = '$SQ{$field{$_}}'" } keys %field;
> $db->query("select from $table where $query");
I would use:
use Interpolation "'" => sub {$_=$_[0];s/'/''/gm;"'".$_."'"};
$db->Sql("SELECT * FROM Table WHERE FName = $'{$fname} AND LName =
$'{$lname}");
or maybe
use Interpolation "'" => sub {$_=$_[0];s/'/''/gm;"'".$_};
$db->Sql("SELECT * FROM Table WHERE FName = $'{$fname}' AND LName =
$'{$lname}' ");
Looks nice, doesn't it? ;-)
Jenda
BTW: Mark-Jason didn't you think about creating a library of
such Interpolation tricks. You could use some Guestbook code
for establishing it.
BTOW: I think this module should be included in the standard
instalation.
------------------------------
Date: Mon, 27 Apr 1998 18:51:57 GMT
From: ced@bcstec.ca.boeing.com (Charles DeRykus)
Subject: Re: Interrupt handling with pipes with perl
Message-Id: <Es35qL.IMI@news.boeing.com>
In article <01bd71f5$20f1b6c0$66daf726@vasco>,
Ryan Allen <rallen@seafloor.com> wrote:
>
> I need to re-direct my standard output to many places, so I am using the
> 'tee' utility. Now I need to enhance my error handling to capture a
> interrupt or a break in the processing.
>
> If a user sends a Ctrl+c during the 'tee' part of execution, my script does
> not capture the interrupt.
>
> here is a small example of what I mean
> about pipe and error handler,
> -----------------------
> #!/usr/local/bin/perl
>
> $| = 1;
> $SIG{'INT'} = 'bad_news';
>
> print "this is a test-backquotes\n";
> $result = 'date; sleep 10; date';
> print "done with backquotes\n";
> print "result is \n$result";
> print "all done\n";
>
> sub bad_news { print @_; &clean_up; exit 1; }
>
> sub clean_up {
> print "cleaning up ...";
> print "done\n";
> }
> -----------------------
> ok, say this script is named "junk"
> % junk
> ctrl-c
> and clean_up will run
>
> % junk | tee
> ctrl-c
> and clean_up will not run
>
> I need to somehow capture that signal!!! Does anybody know how?
>
> P.S. I am running this on Sun Solaris 2.51
>
Your signal handler STDOUT is diverted by the pipe to tee.
A slight change to the clean_up:
sub bad_news { print STDERR @_; &clean_up; exit 1; }
sub clean_up {
print STDERR "cleaning up ...";
print STDERR "done\n";
}
gave me the expected terminal output: "INTcleaning up ... done"
HTH,
--
Charles DeRykus
------------------------------
Date: 27 Apr 1998 20:26:32 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Looking for example of IO::Socket for UDP Server
Message-Id: <6i2plo$f92$1@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
"Ephrayim \"EJ\" Naiman" <enaiman@ndsisrael.com> writes:
:I've looked around and can't find an example of a UDP Server (e.g. echo)
:using IO::Socket. If anybody knows where one is, please point me there.
The following is unpublished source code of the Perl Cookbook.
Comments welcome.
--tom
=head1 Setting up a UDP Client
=head2 Problem
You want to exchange messages with another process using
UDP (datagrams).
=head2 Solution
To set up a UDP socket handle, either use the low-level Socket module:
use Socket;
socket(SockHandle, PF_INET, SOCK_DGRAM, getprotobyname("udp"))
|| die "socket: $!";
or else use IO::Socket:
use IO::Socket;
$handle = IO::Socket::INET->new(Proto => 'udp')
|| die "socket: $@"; # yes, it uses $@ here
Then to send a message to a machine named $HOSTNAME on
port number $PORTNO:
$ipaddr = inet_aton($HOSTNAME));
$portaddr = sockaddr_in($PORTNO, $ipaddr);
send(SockHandle, $MSG, 0, $portaddr) == length($MSG)
|| die "cannot send to $HOSTNAME($PORTNO): $!";
And to receive a message of up to length $MAXLEN:
$portaddr = recv(SockHandle, $MSG, $MAXLEN, 0)) || die "recv: $!";
($portno, $ipaddr) = sockaddr_in($portaddr);
$host = gethostbyaddr($ipaddr, AF_INET);
print "$host($portno) said $MSG\n";
=head2 Discussion
Datagram sockets are quite unlike stream sockets. Streams provide
sessions, giving the illusion of a stable connection. You might think
of them as working like a telephone call. Somewhat expensive to set up,
but once established, reliable and easy to use. Datagrams, though,
are more like the postal system. Just as it'sj cheaper to mail your
penpal on the other side a letter than to ring them up on the phone,
datagrams are easier on the system than streams. You send a small amount
of information at a time, one message at a time. But your messages'
delivery isn't guaranteed, and they might even arrive in the wrong order.
Like a small post box, the receiver's queue might fill up and cause
further messages to be dropped.
Why then, if datagrams are unreliable, do we have them? Because some
applications are most sensibly implemented in terms of datagrams.
For instance, streaming audio where it's more important that the stream
as a whole be preserved than every packet get through, especially if
packets are being dropped because there's not enough bandwidth for
them all. Another use for datagrams is broadcasting, which corresponds
to mass mailing of adverts in the postal model, and equally popular in
most circles. One use for broadcast packets it to send out a message
to your local subnet saying "Hey, is there anybody around here who wants
to be my server?"
Because datagrams don't providing the illusion of a single durable
connection, you get a little more freedom in how you use them. Every
You
don't have to C<connect> your socket to the remote socket you're
sending data to. Instead, you can address each of your datagrams
individually when you C<send>. Assuming C<$remote_addr> is the
results of a call to C<sockaddr_in>:
send(MYSOCKET, $msg_buffer, $flags, $remote_addr) || die "Can't send: $!\n";
The only flag argument used with any frequency is MSG_OOB,
which lets you send and receive out-of-band data. See the recipe
``Communicating over a TCP Connection'' for more information on
out-of-band data.
The remote address should be a port and internet address combination
returned by the Socket module's C<sockaddr_in> function. If you
want, you can call C<connect> on that address instead. Then you
can omit the last argument to your C<send>s, after which they'll
all go to that recipient. Unlike streams, you are free to reconnect
to another machine with the same datagram socket.
Here's a small example of a UDP program. It contacts the
UDP time port of the
the machine whose name is given on the command line, or the local
machine by default. This doesn't work on all machines, but those
with a server will send you back a 4-byte integer packed in network
byte order that represents what time that machine thinks it is.
The time returned, however, is in the number of seconds since 1900.
You have to subtract the number of seconds between 1900 and 1970
to feed that time to the C<localtime> or C<gmtime> conversion functions.
#!/usr/bin/perl
# clockdrift - compare another system's clock with this one
use strict;
use Socket;
my ($host, $him, $src, $port, $ipaddr, $ptime, $delta);
my $SECS_of_70_YEARS = 2_208_988_800;
socket(MsgBox, PF_INET, SOCK_DGRAM, getprotobyname("udp")) || die "socket: $!";
$him = sockaddr_in(scalar(getservbyname("time", "udp")), inet_aton(shift || '127.1'));
defined(send(MsgBox, 0, 0, $him)) || die "send: $!";
defined($src = recv(MsgBox, $ptime, 4, 0)) || die "recv: $!";
($port, $ipaddr) = sockaddr_in($src);
$host = gethostbyaddr($ipaddr, AF_INET);
my $delta = (unpack("N", $ptime) - $SECS_of_70_YEARS) - time();
print "Clock on $host is $delta seconds ahead of this one.\n";
If the machine you're trying to contact isn't alive, or if its
response is lost, you'll only realize this because your program
will get stuck in the C<recv> waiting for an answer that will
never come.
=head2 See Also
[* LOTS *]
=head1 Setting up a UDP Server
=head2 Problem
You want to write a UDP server.
=head2 Solution
First C<bind> to the port the server is to be contacted
on. With IO::Socket, this is easily accomplished:
use IO::Socket;
$server = IO::Socket::INET->new(LocalPort => $server_port,
Proto => "udp",
) || die "Couldn't be a udp server on port $server_port : $@\n";
Then go into a loop receiving messages:
while ($him = $server->recv($datagram, $MAX_TO_READ, $flags)) {
# do something
}
=head2 Discussion
Life with UDP is much simpler than life with TCP. Instead of accepting
client connections one at a time and committing yourself to a long-time
relationship, you just take messages from your clients as they come in.
The C<recv> function returns the address of the sender, which you can
then decode.
Here's a small UDP-based server that just sits around waiting for
messages. Every time a message comes in, we send to whoever sent it the
previous message, and save the old one.
#!/usr/bin/perl -w
# udpqotd - UDP message server
use strict;
use IO::Socket;
my($sock, $oldmsg, $newmsg, $hisaddr, $hishost, $MAXLEN, $PORTNO);
$MAXLEN = 1024;
$PORTNO = 5151;
$sock = IO::Socket::INET->new(LocalPort => $PORTNO, Proto => 'udp')
|| die "socket: $@";
print "Awaiting UDP messages on port $PORTNO\n";
$oldmsg = "This is the starting message.";
while ($sock->recv($newmsg, $MAXLEN)) {
my($port, $ipaddr) = sockaddr_in($sock->peername);
$hishost = gethostbyaddr($ipaddr, AF_INET);
print "Client $hishost said ``$newmsg''\n";
$sock->send($oldmsg);
$oldmsg = "[$hishost] $newmsg";
}
die "recv: $!";
This program is a little easier using IO::Socket than using the
raw Socket module. Notice we don't have to say where to send the
message? It's not as though we've connected; it's because the
library kept track of who sent the last message and stored
that information away on the $sock object. The C<peername>
method retrieved it for decoding.
You can't use the I<telnet> program to talk to this server.
You have to use a dedicate client. Here's one.
#!/usr/bin/perl -w
# udpmsg - send a message to the udpquotd server
my($sock, $server_host, $msg, $port, $ipaddr, $hishost,
$MAXLEN, $PORTNO, $TIMEOUT,
);
use IO::Socket;
use strict;
$MAXLEN = 1024;
$PORTNO = 5151;
$TIMEOUT = 5;
$server_host = shift;
$msg = "@ARGV";
$sock = IO::Socket::INET->new(Proto => 'udp',
PeerPort => $PORTNO,
PeerAddr => $server_host,
);
$sock->send($msg) || die "send: $!";
eval {
$SIG{ALRM} = sub { die "alarm time out" };
alarm $TIMEOUT;
$sock->recv($msg, $MAXLEN) || die "recv: $!";
alarm 0;
1; # return value from eval on normalcy
} || die "recv from $server_host timed out after $TIMEOUT seconds.\n";
($port, $ipaddr) = sockaddr_in($sock->peername);
$hishost = gethostbyaddr($ipaddr, AF_INET);
print "Server $hishost responded ``$msg''\n";
This time when we create the socket, we supply a peer host and
port right at the start, allowing us to omit that information
in the C<send>.
We've added an C<alarm> timeout in case the server isn't responsive,
maybe not even alive. Because C<recv> is a blocking system call that
there's no guarantee will ever return, we wrap it in a standard C<eval>
block construct.
=head2 See Also
[* LOTS of stuff *]
--
Tom Christiansen tchrist@jhereg.perl.com
"Hey, I like C too, and have written uglier programs than that." --Larry Wall
------------------------------
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 2431
**************************************
