[9429] in Perl-Users-Digest
Perl-Users Digest, Issue: 3029 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Jun 30 14:17:48 1998
Date: Tue, 30 Jun 98 11:03:24 -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, 30 Jun 1998 Volume: 8 Number: 3029
Today's topics:
Re: Advice on loading modules as needed. <tchrist@mox.perl.com>
Re: C lib to link with Perl5 (Nathan V. Patwardhan)
Re: change directory in perl <barnett@houston.Geco-Prakla.slb.com>
convert if statements to foreach Juli@my-dejanews.com
Re: localtime(time); gets wrong date <barnett@houston.Geco-Prakla.slb.com>
PUZZLE: dutree (new) <tchrist@mox.perl.com>
PUZZLE: dutree (old) <tchrist@mox.perl.com>
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 30 Jun 1998 17:38:47 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Advice on loading modules as needed.
Message-Id: <6nb7r7$ctq$1@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
"Shawn M Ferris" <shawnf@exabyte.com> writes:
:Is there a better way of doing this?A basic sample of what I done..
:
:$mod='MOD::Test';
:eval "require $mod" or die;
:$mh=$mod->new;
# no import
BEGIN {
unless (eval "require $mod") {
warn "couldn't load $mod: $@";
}
}
# imports into current package
BEGIN {
unless (eval "use $mod") {
warn "couldn't load $mod: $@";
}
}
Imagine you'd like to do this:
load_module('Fcntl');
or even
load_module('Fcntl', qw(O_EXCL O_CREAT O_RDWR));
You need to realize that this is wrong:
sub load_module {
require $_[0];
import $_[0];
}
Your job is to figure out why. This, hoever, is correct:
sub load_module {
eval "require $_[0]";
die if $@;
$_[0]->import(@_[1 .. $#_]);
}
--tom
--
TCP/IP: handling tomorrow's loads today
OSI: handling yesterday's loads someday
------------------------------
Date: 30 Jun 1998 17:19:08 GMT
From: nvp@shore.net (Nathan V. Patwardhan)
Subject: Re: C lib to link with Perl5
Message-Id: <6nb6mc$31k@fridge.shore.net>
Francois Claustres (Claustres@mail.dotcom.fr) wrote:
: I found some informations in the HTML documentation given with Perl (e.g.
: perlxs.html, perxstut.html), but it doesn't seem to apply to my specific
: case (not having the sources of the C code).
perlxstut is what you want. It walks you through step-by-step.
--
Nate Patwardhan|root@localhost
"Fortunately, I prefer to believe that we're all really just trapped in a
P.K. Dick book laced with Lovecraft, and this awful Terror Out of Cambridge
shall by the light of day evaporate, leaving nothing but good intentions in
its stead." Tom Christiansen in <6k02ha$hq6$3@csnews.cs.colorado.edu>
------------------------------
Date: Tue, 30 Jun 1998 12:25:28 -0500
From: Dave Barnett <barnett@houston.Geco-Prakla.slb.com>
To: waikei@my-dejanews.com
Subject: Re: change directory in perl
Message-Id: <35991F88.2F6650C5@houston.Geco-Prakla.slb.com>
[courtesy cc to cited author]
waikei@my-dejanews.com wrote:
>
> Hi,
>
> I want to write a script which is used to change the working
> directory. The problem is: After the script run, the working
> dir. is back to the original dir. but actually I want to stay
> in the new working directory. I change the dir. by the function
> chdir. Could anyone kindly give me some hints?
>
> Regards,
> Wilbur
>
> -----== Posted via Deja News, The Leader in Internet Discussion ==-----
> http://www.dejanews.com/rg_mkgrp.xp Create Your Own Free Member Forum
Wilbur:
Under unix operating systems, this is a normal behavior, for security
reasons. When you run the script, a new shell process is started. Any
changes you make to your environment (cd'ing to another directory,
setenv'ing variables, unsetenv'ing variables) only affect this new
shell. There is no way to affect the original (or parent) shell from
this new (child) shell.
How would you do what you want. In the parent shell:
command-prompt [] cd directory
command-prompt [] do some stuff
command-prompt [] cd back
Actually, you can, kinda do this in perl:
#!/usr/local/bin/perl -w
chdir(some_directory);
system("/usr/local/bin/tcsh") == 0 or die "Error launching shell: $!\n";
exit;
__END__
HTH.
Dave
--
"Security through obscurity is no security at all."
-comp.lang.perl.misc newsgroup posting
----------------------------------------------------------------------
Dave Barnett U.S.: barnett@houston.Geco-Prakla.slb.com
DAPD Software Support Eng U.K.: barnett@gatwick.Geco-Prakla.slb.com
----------------------------------------------------------------------
------------------------------
Date: Tue, 30 Jun 1998 17:31:12 GMT
From: Juli@my-dejanews.com
To: juli@my-dejanews.com
Subject: convert if statements to foreach
Message-Id: <6nb7d3$d8b$1@nnrp1.dejanews.com>
####################################################
# for each field in $rep_name,
# both 1st letters are capitalized
# remained are in lower case
# unless $rep_last matches a title in list.pl
$rep_name = "mike gary doug CPA";
@rep = split (/ /, $rep_name);
$one = $rep[0];
$two = $rep[1];
$three = $rep[2];
$four = $rep[3];
$i_first_letter = substr($one,0,1);
$i_first_letter =~ tr/a-z/A-Z/;
$i_the_rest = substr($one,1);
$i_the_rest =~ tr/A-Z/a-z/;
$first = $i_first_letter.$i_the_rest;
$ii_first_letter = substr($two,0,1);
$ii_first_letter =~ tr/a-z/A-Z/;
$ii_the_rest = substr($two,1);
$ii_the_rest =~ tr/A-Z/a-z/;
$second = $ii_first_letter.$ii_the_rest;
if (!open(LIST, "list.pl")){
print "can't open file";
}
$found_three = 0;
$found_four = 0;
while (<LIST>) {
if (/$three/) {
$found_three = 1;
}
$third2 = $three;
if (/$four/) {
$found_four = 1;
}
$fourth = $four;
}
unless ($found_three == 1){
$iii_first_letter = substr($three,0,1);
$iii_first_letter =~ tr/a-z/A-Z/;
$iii_the_rest = substr($three,1);
$iii_the_rest =~ tr/A-Z/a-z/;
$third = $iii_first_letter.$iii_the_rest;
}
if ($found_four == 1 && $found_three == 1){
$rep_name = $first.$".$second.$".$third2.$".$fourth;
print "#3 is $rep_name\n";
}
else {
$rep_name = $first.$".$second.$".$third.$".$fourth;
print "#4 is $rep_name\n";
}
if ($found_three == 1){
$rep_name = $first.$".$second.$".$third2;
print "#1 is $rep_name\n";
}
else {
$rep_name = $first.$".$second.$".$third;
print "#2 is $rep_name\n";
}
What I am trying to do is convert this into a foreach statement, instead of
all these if statements. Here's something like what I would like to do. I'm
not really sure how this works with an array.
$rep_name = "mike gary doug CPA";
@rep = split (/ /, $rep_name);
foreach $_ (@rep){
if (!open(LIST, "list.pl")){
print "can't open file";
}
while (<LIST>) {
if (/$_/) {
# if word matches word in list, keep value
}
else {
#capitalize the first letter, and make the rest lower case
$i_first_letter = substr($one,0,1);
$i_first_letter =~ tr/a-z/A-Z/;
$i_the_rest = substr($one,1);
$i_the_rest =~ tr/A-Z/a-z/;
$word = $i_first_letter.$i_the_rest;
}
-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/rg_mkgrp.xp Create Your Own Free Member Forum
------------------------------
Date: Tue, 30 Jun 1998 12:03:45 -0500
From: Dave Barnett <barnett@houston.Geco-Prakla.slb.com>
To: heribert.wettels@sueddeutsche.de
Subject: Re: localtime(time); gets wrong date
Message-Id: <35991A71.78ACEE5D@houston.Geco-Prakla.slb.com>
[ courtesy cc to cited author]
Heribert Wettels wrote:
>
> I have the following problem maybe anybody can help:
>
> In order to determin the date I use localtime(time); as described in the
> camel book. As result I always get month-1, i.e. "5" instead of "6"
> which would be correct for June. The shell command "date", however,
> delivers the correct date.
>
> > ($sec,$min,$hr,$mday,$mon,$year,$wday,$jtag,$isdst) = localtime(time);
>
> > print "Date: $mday\.$mon\.$year\n";
>
> > bash-2.02$ date
> > Tue Jun 30 11:50:25 MET DST 1998
>
> Am I doing something wrong or is this probably a known bug (didn't find
> any reference to it)?
It is not a bug.
See pg 185 of the Blue Camel, where localtime is discussed. It talks
about the struct tm (this comes directly from C), and then goes on to
explain a little about it.
Months are in 0..11 format. Weekday is in 0..6 format.
This makes it easy to do things like:
#!/usr/local/bin/perl -w
#
@Months = qw(January February March April May June July August
September October November December);
print "This month is: ", $Months[(localtime(time))[4]], "\n";
__END__
The book has an example for doing the same with days
@thisday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[(localtime)[6]];
>
> Thanks for taking your time to read (or even answer) this posting.
>
> Heribert
Days start at 1.
Year starts at 1900: year = 0 means 1900
year = 100 means 2000.
Julian Day starts at 0
0 = January 1
364 = December 31 (normal year)
365 = December 31 (leap year)
HTH.
Dave
--
"Security through obscurity is no security at all."
-comp.lang.perl.misc newsgroup posting
----------------------------------------------------------------------
Dave Barnett U.S.: barnett@houston.Geco-Prakla.slb.com
DAPD Software Support Eng U.K.: barnett@gatwick.Geco-Prakla.slb.com
----------------------------------------------------------------------
------------------------------
Date: 30 Jun 1998 17:42:46 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: PUZZLE: dutree (new)
Message-Id: <6nb82m$ctq$3@csnews.cs.colorado.edu>
Why does this version run thrice as fast as the previous one?
--tom
#!/usr/bin/perl -w
# dutree - print sorted indented rendition of du output
use strict;
my %Dirsize;
my %Kids;
getdots(my $topdir = input());
output($topdir);
# run du, read in input, save sizes and kids
# return last directory (file?) read
sub input {
my($size, $name, $parent);
@ARGV = ("du @ARGV |"); # prep the arguments
while (<>) { # magic open is our friend
($size, $name) = split;
$Dirsize{$name} = $size;
($parent = $name) =~ s#/[^/]+$##; # dirname
push @{ $Kids{$parent} }, $name unless eof;
}
return $name;
}
# figure out how much is taken up in each directory
# that isn't stored in subdirectories. add a new
# fake kit called "." containing that much.
sub getdots {
my $root = $_[0];
my($size, $cursize);
$size = $cursize = $Dirsize{$root};
if ($Kids{$root}) {
for my $kid (@{ $Kids{$root} }) {
$cursize -= $Dirsize{$kid};
getdots($kid);
}
}
if ($size != $cursize) {
my $dot = "$root/.";
$Dirsize{$dot} = $cursize;
push @{ $Kids{$root} }, $dot;
}
}
# recursively output everything,
# passing padding and number width in as well
# on recursive calls
sub output {
my($root, $prefix, $width) = (shift, shift || '', shift || 0);
my $path;
($path = $root) =~ s#.*/##; # basename
my $size = $Dirsize{$root};
my $line = sprintf("%${width}d %s", $size, $path);
print $prefix, $line, "\n";
for ($prefix .= $line) { # build up more output
s/\d /| /;
s/[^|]/ /g;
}
if ($Kids{$root}) { # not a bachelor node
my @Kids = @{ $Kids{$root} };
@Kids = sort { $Dirsize{$b} <=> $Dirsize{$a} } @Kids;
$Dirsize{$Kids[0]} =~ /(\d+)/;
my $width = length $1;
for my $kid (@Kids) { output($kid, $prefix, $width) }
}
}
--
English is a 5-tuple ... --dmr
------------------------------
Date: 30 Jun 1998 17:41:20 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: PUZZLE: dutree (old)
Message-Id: <6nb800$ctq$2@csnews.cs.colorado.edu>
What is the name of the hash table being used by this program?
#!/usr/bin/perl
# dutree-orig: the old version pre-perl5 (early 90s)
@lines = `du @ARGV`;
chop(@lines);
&input($top = pop @lines);
&output($top);
exit;
sub input {
local($root, *kid, $him) = @_[0,0];
while (@lines && &childof($root, $lines[$#lines])) {
&input($him = pop(@lines));
push(@kid, $him);
}
if (@kid) {
local($mysize) = ($root =~ /^(\d+)/);
for (@kid) { $mysize -= (/^(\d+)/)[0]; }
push(@kid, "$mysize .") if $size != $mysize;
}
@kid = &sizesort(*kid);
}
sub output {
local($root, *kid, $prefix) = @_[0,0,1];
local($size, $path) = split(' ', $root);
$path =~ s!.*/!!;
$line = sprintf("%${width}d %s", $size, $path);
print $prefix, $line, "\n";
$prefix .= $line;
$prefix =~ s/\d /| /;
$prefix =~ s/[^|]/ /g;
local($width) = $kid[0] =~ /(\d+)/ && length("$1");
for (@kid) { &output($_, $prefix); };
}
sub sizesort {
local(*list, @index) = shift;
sub bynum { $index[$b] <=> $index[$a]; }
for (@list) { push(@index, /(\d+)/); }
@list[sort bynum 0..$#list];
}
sub childof {
local(@pair) = @_;
for (@pair) { s/^\d+\s+//g; s/$/\//; }
index($pair[1], $pair[0]) >= 0;
}
--
"It is easier to port UNIX to a new machine, than an application to a new
operating system." -- Dennis Ritchie
------------------------------
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 3029
**************************************
