[10582] in Perl-Users-Digest
Perl-Users Digest, Issue: 4174 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Nov 7 16:07:16 1998
Date: Sat, 7 Nov 98 13:00:17 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sat, 7 Nov 1998 Volume: 8 Number: 4174
Today's topics:
'Indent' when printing array (was Re: SEEK function on (Ronald J Kimball)
Re: a small question <prauz@sprynet.com>
Array of FileHandles possible/allowed ?! <vlierd@uni-oldenburg.de>
Re: Array of FileHandles possible/allowed ?! <rootbeer@teleport.com>
Re: Comparing ASCII dates bhoylma@uswest.com
Re: exact search <prauz@sprynet.com>
Re: Help on version 4/5 -- I did it their.. way... (Tad McClellan)
History of Perl <johnnyb@shell.webzone.net>
Re: How to delete files older than specific date. <shadowtracker@worsdall.demon.co.uk>
I thought unbound variables were guaranteed to be zero <brannon@quake.usc.edu>
Re: images in perl <web@networkcomputerz.com>
Re: indenting perl elsif clauses in emacs bhoylma@uswest.com
Re: Making debugging methods work in a CGI environment bhoylma@uswest.com
Re: opendir() VS glob - WAS Re: readdir bug in win95 pe <rootbeer@teleport.com>
Re: opendir() VS glob - WAS Re: readdir bug in win95 pe (Ronald J Kimball)
Re: opendir() VS glob - WAS Re: readdir bug in win95 pe <rootbeer@teleport.com>
Re: Perl Warning Message? (Abdul Ali)
Re: programing fun: tree: Transpose <xah@best.com>
Q: XSubs and variables (Dave Steiner)
RE:a small question <rootbeer@teleport.com>
Re: sending an email to two different email addresses bhoylma@uswest.com
Special: Digest Administrivia (Last modified: 12 Mar 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 7 Nov 1998 13:21:45 -0500
From: rjk@coos.dartmouth.edu (Ronald J Kimball)
Subject: 'Indent' when printing array (was Re: SEEK function on NT)
Message-Id: <1di4ktt.q10ydt1f26iioN@bay1-338.quincy.ziplink.net>
Spider <mjd@sgi.net> wrote:
> print TEXT <<NEW_TEXT;
> ^^pause(1500) $TheDate
> $in{'S1'}\r\n
> @textfile
> NEW_TEXT
Refer to the perlvar documentation for an explanation of the $"
variable, and how it is used when interpolating an array in a
double-quotish string.
--
_ / ' _ / - aka - rjk@coos.dartmouth.edu
( /)//)//)(//)/( Ronald J Kimball chipmunk@m-net.arbornet.org
/ http://www.ziplink.net/~rjk/
"It's funny 'cause it's true ... and vice versa."
------------------------------
Date: Sat, 07 Nov 1998 19:44:06 +0000
From: Balazs Rauznitz <prauz@sprynet.com>
To: #YE XIANGZHOU# <S141608376@ntu.edu.sg>
Subject: Re: a small question
Message-Id: <3644A306.2A73E250@sprynet.com>
#YE XIANGZHOU# wrote:
>
> How to tell whether a number or string is stored in a scalar variable?
You should check with some fancy regexp whether the value is a number or
not.
/^-?(?:\d+(?:\.\d*)?|\.\d+)$/ is a rather general one. ( take nfrom the
Perl Cookbook page 44)
Balazs
------------------------------
Date: Sat, 07 Nov 1998 20:10:44 +0100
From: Claus van de Vlierd <vlierd@uni-oldenburg.de>
Subject: Array of FileHandles possible/allowed ?!
Message-Id: <36449B34.3D4240FE@uni-oldenburg.de>
--
*****************************************
* Universitaet Oldenburg *
* Hochschulrechenzentrum *
* Claus van de Vlierd *
* Uhlhornsweg *
* 26111 Oldenburg *
* *
* Germany *
* *
* Tel. : +49-441-798-4814 *
* FAX. : +49-441-798-2555 *
* email : vlierd@uni-oldenburg.de *
*****************************************
Hello ,
I tried the following construction :
use FileHandle;
$i=0;
$FH[$i] = new FileHandle;
open($FH[$i],"xxx") || die ("could not open \"xxx\");
while (<$FH[$i]>)
{
bla bla
}
###################
well .. : the "open" was o.k. --
but in the "while"-loop he did n o t accept $FH[$i] as a
FileHandle .. !
So what :
is it possible to construct an array of FileHandles or not ?!
Does anybody know it and could perhaps share this knowledge whith me
?!
thanks in advancd .. ::
regards ,
Claus van de Vlierd
------------------------------
Date: Sat, 07 Nov 1998 19:21:41 GMT
From: Tom Phoenix <rootbeer@teleport.com>
Subject: Re: Array of FileHandles possible/allowed ?!
Message-Id: <Pine.GSO.4.02A.9811071120420.21718-100000@user2.teleport.com>
On Sat, 7 Nov 1998, Claus van de Vlierd wrote:
> Subject: Array of FileHandles possible/allowed ?!
Have you seen what the FAQ says about this? Hope this helps!
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: Sat, 07 Nov 1998 19:43:04 GMT
From: bhoylma@uswest.com
Subject: Re: Comparing ASCII dates
Message-Id: <7227s9$lgh$1@nnrp1.dejanews.com>
In article <364250BE.32A0B0@X-no.spam-X.lawrence.edu>,
Robert Lowe <Robert.H.Lowe@X-no.spam-X.lawrence.edu> wrote:
> Hi!
>
> Before I re-invent something in a messy way, does anyone have
> any tips on how to get the difference between two ASCII dates
> in days? The dates are in DD-MMM-YYYY format. I suppose it
> would trivial if an ASCII date could somehow be converted to
> an internal system time, but I don't know if there is such a
> mechanism.
>
CPAN is your friend! Check out Date::Manip, for one. It has a wealth of
methods for date comparison, operations, etc. There are others as well.
Peace.
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Sat, 07 Nov 1998 19:38:12 +0000
From: Balazs Rauznitz <prauz@sprynet.com>
To: E-swap <webmaster@eswap.co.uk>
Subject: Re: exact search
Message-Id: <3644A1A4.679F8283@sprynet.com>
E-swap wrote:
>
> Hi
>
> I am trying to submit an exact search through an array in files I have and
> am using:
>
> if (($cat[0] =~ /$form{'searchstring2'}\b/i)
>
> but, if I search for ED it is also returning entries for RED ... any ideas??
>
> Thanks for all help
what about a \b before the variable as well ?
Balazs
------------------------------
Date: Sat, 7 Nov 1998 11:18:45 -0600
From: tadmc@flash.net (Tad McClellan)
Subject: Re: Help on version 4/5 -- I did it their.. way...
Message-Id: <ldv127.9cd.ln@flash.net>
Rusty Williamson (rwilliamson@uno.gers.com) wrote:
: Thank all of you for the responses. Regarding ' systems vulnerable to
: crackers'. Salteen? :-) They're all behind a firewall and serve only our
: Intranet.
And crackers never work at a place where their Intranet is
behind a firewall?
Hopefully all of your employees and contractors are currently
gruntled ;-) But if that should change...
Security is still a Good Idea.
--
Tad McClellan SGML Consulting
tadmc@metronet.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sat, 07 Nov 1998 20:31:48 GMT
From: Jonathan Bartlett <johnnyb@shell.webzone.net>
Subject: History of Perl
Message-Id: <3644BDD6.5E38822F@shell.webzone.net>
Does anyone know a site I can visit that has the history of the Perl
programming lnaguage?
Jonathan Bartlett
------------------------------
Date: Sat, 7 Nov 1998 17:35:10 +0000
From: Mark Worsdall <shadowtracker@worsdall.demon.co.uk>
Subject: Re: How to delete files older than specific date.
Message-Id: <KOwRpVAOTIR2EwII@worsdall.demon.co.uk>
In article <Pine.GSO.4.02A.9811041218300.7431-100000@user2.teleport.com>
, Tom Phoenix <rootbeer@teleport.com> writes
>On Wed, 4 Nov 1998, Azimi wrote:
>
>> Newsgroups: comp.lang.perl.misc, comp.lang.perl.modules
>
>What does this have to do with modules?
>
>> The following script will list the files older than 10 days but I
>> don't know how to go about deleting them.
>
>There's a function documented in the perlfunc manpage. Good luck!
>
Tom, I think this should be inserted as part of your signature from now
on:-)
--
Mark Worsdall (Webmaster) - WEB site:- http://www.shadow.org.uk
Shadow:- webmasterATshadow.org.uk
Home :- shadowwebATworsdall.demon.co.uk
Any opinion given is my own personal belief...
------------------------------
Date: 7 Nov 1998 12:53:33 -0800
From: tbrannon <brannon@quake.usc.edu>
Subject: I thought unbound variables were guaranteed to be zero
Message-Id: <ysizlnlnjkc5.fsf@nunki.usc.edu>
#!/usr/bin/perl -w
$total_synapses=16;
$total_branches=24;
$cluster{size}=4;
$cluster{amount}{min}=0;
# *********** the line below does not cause an error because
# *********** $cluster{amount} is not zero upon program start
$cluster{amount}{max}=$total_synapses/$cluster{amount};
for ($c=$cluster{amount}{min}; $c<=$cluster{amount}{max}; ++$c) {
print $c,$/;
# allocate clusters
$incr=$total_branches/$cluster{size};
for ($x=0; $x<$total_branches; $x += $incr) {
print "$cluster{size} on branch[$x]\n";
}
}
=head1
=cut
--
Terrence Brannon * brannon@quake.usc.edu * http://quake.usc.edu/~brannon
------------------------------
Date: Sat, 07 Nov 1998 18:27:51 +0000
From: Andrew Otwell <web@networkcomputerz.com>
Subject: Re: images in perl
Message-Id: <36449127.52B7D325@networkcomputerz.com>
--------------9DFE04ED2A14BC8E0CD5DAF3
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Tore Aursand wrote:
> On 2 Nov 1998 00:06:35 GMT, root@ejv108.rh.psu.edu (Operator) wrote:
> >I have a perl cgi that outputs html, but when I put image html code (<img
> >src="..."> I get server 500 error. Is there a special way to do this?
>
> If you do something like this...
>
> print("<IMG SRC="image.gif">\n");
>
> ...it won't work, 'cause you are using " inside a print, which
> should be substituted with \" (escape sequence);
>
> print("<IMG SRC=\"image.gif\">\n");
>
> Hope this helps!
>
> --
> Tore Aursand
> ForumNett Online AS
> http://www.forumnett.no/
Hold the phone:
Just simply enter
print "<img src='images/blahblahblah.jpg'><br>";
(use forward slashes).
--
Andrew Otwell, B.B.A.
Network Computerz
Perl, CGI, RAID, SCSI, A+
ato@networkcomputerz.com
--------------9DFE04ED2A14BC8E0CD5DAF3
Content-Type: text/html; charset=us-ascii
Content-Transfer-Encoding: 7bit
<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
Tore Aursand wrote:
<blockquote TYPE=CITE>On 2 Nov 1998 00:06:35 GMT, root@ejv108.rh.psu.edu
(Operator) wrote:
<br>>I have a perl cgi that outputs html, but when I put image html code
(<img
<br>>src="..."> I get server 500 error. Is there a special way to do this?
<p>If you do something like this...
<p> print("<IMG SRC="image.gif">\n");
<p>...it won't work, 'cause you are using " inside a print, which
<br>should be substituted with \" (escape sequence);
<p> print("<IMG SRC=\"image.gif\">\n");
<p>Hope this helps!
<p>--
<br>Tore Aursand
<br>ForumNett Online AS
<br><a href="http://www.forumnett.no/">http://www.forumnett.no/</a></blockquote>
<p><br>Hold the phone:
<p>Just simply enter
<p>print "<img src='images/blahblahblah.jpg'><br>";
<pre>(use forward slashes).</pre>
<pre>--
Andrew Otwell, B.B.A.
Network Computerz
Perl, CGI, RAID, SCSI, A+
ato@networkcomputerz.com</pre>
</html>
--------------9DFE04ED2A14BC8E0CD5DAF3--
------------------------------
Date: Sat, 07 Nov 1998 19:35:53 GMT
From: bhoylma@uswest.com
Subject: Re: indenting perl elsif clauses in emacs
Message-Id: <7227ep$lbp$1@nnrp1.dejanews.com>
In article <71smlm$mnc$1@nnrp1.dejanews.com>,
tbhanson@startribune.com wrote:
> Hmmm, can anyone explain how to get emacs in perl mode to indent elsif
clauses
> like this:
>
If you're not using the most excellent cperl-mode, I suggest you get it. It
has numerous indentation and syntax coloring features that will allow you to
manage the display of your perl code pretty much anyway you like. You can
always get the latest version at:
ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/
By the way, it appears to indent the elsif block the way you want out of the
box.
HTHYO.
Peace.
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Sat, 07 Nov 1998 20:24:54 GMT
From: bhoylma@uswest.com
Subject: Re: Making debugging methods work in a CGI environment
Message-Id: <722aam$nia$1@nnrp1.dejanews.com>
In article <364350C3.FB5307EF@genome.wi.mit.edu>,
Aravind Subramanian <aravind@genome.wi.mit.edu> wrote:
>
> Just to be clear - I would like to see the debug info in the browser -
> *not* in the log file. When run in debug mode, the HTML page would
> render with debug info interspersed within the normal components
> intended for that page.
>
Look at the CGI::Carp module, available from your nearest CPAN site. The
'fatalsToBrowser' pragma is just what you want. There is also a 'carpout'
construct that allows you to funnel CGI output, for example, to a private log
file. Invaluable during debugging as web server log files can get messy at
times.
HTHYO.
Peace.
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Sat, 07 Nov 1998 18:06:10 GMT
From: Tom Phoenix <rootbeer@teleport.com>
Subject: Re: opendir() VS glob - WAS Re: readdir bug in win95 perl 5.00402?
Message-Id: <Pine.GSO.4.02A.9811070939370.21718-100000@user2.teleport.com>
On Sat, 7 Nov 1998, Dan Baker wrote:
> why would you choose to use opendir() rather than just glob<>? Are
> there speed or other advantages/disadvantages?
opendir() and friends are generally faster, since they don't spawn a
separate process. They return every item every time, so you need to use
your own code to take out any items you don't want, such as dotfiles.
glob() is potentially dangerous, since it can suffer from csh's security
holes, so it's disallowed on some systems when taint checks are turned on.
It may fail to return any matches if there are many, since csh is buggy.
It may return files which don't actually exist. It may have trouble with
filenames containing unusual characters, depending upon which shells you
have (or don't have) installed. It works differently on some systems than
others. It starts a separate process (on most systems). It's faster to
code, especially if you want only certain files which can be selected with
a glob. A glob may easily be made to return a full pathname, rather than
just the basename, which can be useful in many cases (as you found).
A future version of Perl will improve glob(), calling opendir() internally
and thereby eliminating most of its inherent problems. Until then, many
people choose to use a glob only in quick-and-dirty programs, using
opendir() on anything serious.
Hope this helps!
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: Sat, 7 Nov 1998 13:21:43 -0500
From: rjk@coos.dartmouth.edu (Ronald J Kimball)
Subject: Re: opendir() VS glob - WAS Re: readdir bug in win95 perl 5.00402?
Message-Id: <1di4kev.1lv7dy9yahcx6N@bay1-338.quincy.ziplink.net>
Dan Baker <dtbaker-@busprod.com> wrote:
> This DOES bring up a question that you may be able to shed some light
> on... for many uses I can think of you would need to use chdir() in
> combination with opendir()/readdir()/closedir() to be able to do things
> like file testing, etc.
chdir() is one way to use opendir()/etc. in combination with file
testing, but it's not the only way.
$dir = '/path/to/dir';
opendir(DIR, $dir) or die "Unable to opendir $dir: $!\n";
while (defined($file = readdir(DIR))) {
print "Directory: $file\n" if -d "$dir/$file"; # <--------
}
closedir(DIR);
In other words, just specify the full path to the file when you use the
filetest operator.
> So, the question is... why would you choose to
> use opendir() rather than just glob<>? Are there speed or other
> advantages/disadvantages?
I don't know if there are speed advantages to using opendir()/etc.; you
could probably find out by using Benchmark.
There are certainly other advantages, though. Here are two I thought of
offhand:
opendir()/etc. gives you more control over the 'glob'. Suppose you want
all the files in the directory, but you want to put them in different
arrays depending on extension. With opendir()/etc., you do one loop
over the directory contents, pushing each file to the appropriate array.
With glob(), you either do one glob() for each type, or one glob() for
all the files and loop over the contents anyway.
opendir()/etc. allows you to store one file at a time, while glob()
always means having a list of fiels. It's analogous to the difference
between:
while (<FILE>) {
# ...
}
and
foreach (<FILE>) {
# ...
}
--
_ / ' _ / - aka - rjk@coos.dartmouth.edu
( /)//)//)(//)/( Ronald J Kimball chipmunk@m-net.arbornet.org
/ http://www.ziplink.net/~rjk/
"It's funny 'cause it's true ... and vice versa."
------------------------------
Date: Sat, 07 Nov 1998 18:30:06 GMT
From: Tom Phoenix <rootbeer@teleport.com>
Subject: Re: opendir() VS glob - WAS Re: readdir bug in win95 perl 5.00402?
Message-Id: <Pine.GSO.4.02A.9811071028130.21718-100000@user2.teleport.com>
On Sat, 7 Nov 1998, Ronald J Kimball wrote:
> opendir()/etc. allows you to store one file at a time, while glob()
> always means having a list of fiels.
Naw, you can use glob() in a scalar context.
while (<*.c>) {
print "One C source file is $_\n";
}
Or maybe I didn't see what you meant. Cheers!
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: Sat, 07 Nov 1998 20:36:57 GMT
From: aali@ix.netcom.com (Abdul Ali)
Subject: Re: Perl Warning Message?
Message-Id: <3644ab2d.16321424@nntp.ix.netcom.com>
On Sat, 7 Nov 1998 10:06:10 -0600, tadmc@flash.net (Tad McClellan)
wrote:
>Abdul Ali (aali@ix.netcom.com) wrote:
>
>: I'm getting the following Perl warning message: "Use of initialized
>: value at fix_it line xx". The "xx" line is:
>: $curr = join(/["]/, @FIELDS);.
> ^^^^^
>
> this is equivalent to:
>
> $_ =~ /["]/
>
> have you put a value into the $_ special variable?
>
>
> It is pretty strange to use a pattern match as your join()
> expression though. I have no idea what you might really want
> here.
>
> Do you want to put a double quote between each array element?
>
> Or a double quote inside of square brackets?
>
> Or double quotes _surrounding_ each element?
>
> ???
Tad
No, I did not put a value into $_.
I had split the line around quoted text [i.e. @FIELDS = split
(/(["].+?["])/, $curr);]. I wanted to join the line back together
around the quotes after processing. So, if I originally had a line
like:
text1 "text inside quotes" text2
When I split this line I get three elements in @FIELDS like this:
$FIELDS[0] = text1
$FIELDS[1] = "text inside quotes"
$FIELDS[2] = text2
I then do some modifications on each element of the array. When I am
done I join the array back together and get:
modified_text1 "modified text inside quotes" modified_text2.
This is working as designed accept I don't know why the warning
message appears. Are you saying that I need to initialize the special
variable $_ to get rid of the warning? Would that cause problems?
Thanks,
Abdul
------------------------------
Date: Sat, 07 Nov 1998 10:38:17 -0800
From: "Xah" <xah@best.com>
Subject: Re: programing fun: tree: Transpose
Message-Id: <3644939e$0$12775@nntp1.ba.best.com>
Here's a solution to the "Transpose" problem I posted. (attached below my sig) At the very end is a little test case. You can cut and paste and run.
The heart of the code is this:
sub _transpose ($;$) {
# this function adds the optional arg, then pass it to _transposeFullArgs.
if ( scalar @_ == 1) {return _transposeFullArgs( $_[0], [2,1]);}
else {return _transposeFullArgs(@_);};
};
sub _transposeFullArgs ($$) {
my $ref_tree = $_[0];
my $ref_perm = $_[1];
my $transposeLevel = scalar @$ref_perm;
my $ref_completeIndexSet = [grep {scalar @$_ == $transposeLevel} @{ _completeIndexSet([map {$_ = $_->[0];} @{ _treeToIndexSet($ref_tree)}]) }];
my $ref_resultTree;
foreach my $ref_index (@$ref_completeIndexSet) {
eval(
'$ref_resultTree' . join('', (map {"->[$_]"} @{Permute($ref_index, $ref_perm)})) . '=' .
'$ref_tree' . join('', (map {"->[$_]"} @$ref_index)) . ';'
);
};
return $ref_resultTree;
};
--
Perl mongers are really disappointing... They can't fly, they can't puff magic, and they can't even sate a panting nymph in comp.lang.perl.misc.
Xah, xah@best.com
Member of Church of Emacs
http://www.best.com/~xah/PageTwo_dir/more.html
PS This post uses long-lines because it's immoral to kill code by mutilation.
#!/usr/local/bin/perl5 -w
use strict;
use Data::Dumper; $Data::Dumper::Indent=0; $Data::Dumper::Deepcopy=1;
#_____ CompleteIndexSet _____ _____ _____ _____
=pod
B<CompleteIndexSet>
CompleteIndexSet([index1,index2,...]) returns a modified version of argument in which indexes that are implied by givens are inserted. The elements in the result list is arbitrary ordered, and without duplicates.
Related: MinimumIndexSet, FullArrayIndexSet, IndexSetSort.
Example:
The empty array [] in the result represents the index for the root node.
IndexSetSort( CompleteIndexSet( [[2, 1]] ) );
#returns [[],[0],[1],[2],[2,0],[2,1]].
IndexSetSort( CompleteIndexSet( [[2, 1], [3]] ) );
#returns [[],[0],[1],[2],[3],[2,0],[2,1]].
IndexSetSort( CompleteIndexSet( [[2, 1], [3], [3]] ) );
#returns [[],[0],[1],[2],[3],[2,0],[2,1]].
IndexSetSort( CompleteIndexSet( [[3, 3], [4]] ) );
#returns [[],[0],[1],[2],[3],[4],[3,0],[3,1],[3,2],[3,3]].
IndexSetSort( CompleteIndexSet( [[3, 3], [1, 1], [4]] ) );
#returns [[],[0],[1],[2],[3],[4],[1,0],[1,1],[3,0],[3,1],[3,2],[3,3]].
=cut
# implementation note:
# some description:
# Suppose one of the given index is {a,b,c,d}. If the last digit is not 0, then generate {a,b,c,d-1}. If the last digit is 0, then generate {a,b,c}. Add the new element into a result list. Now take new element as input and repeat the process until it becomes {}. Now do the above with every given index. Now eliminate duplicates and {} in the result list. The result is as desired.
# Dependent functions: (none)
# misc notes: this function needs heavy testing. This function's time complexity can also be improved by first generate a minimum index set, and use a smart algorithm to avoid generating repeatitions (without even checking for presence). xxxxx
#push (@EXPORT, q(CompleteIndexSet));
#push (@EXPORT_OK, q(CompleteIndexSet));
sub CompleteIndexSet ($) {
# arg checks here...
return _completeIndexSet(@_);
};
sub _completeIndexSet ($) {
my @indexList = @{$_[0]};
my %indexListHash;
foreach my $elem (@indexList) {$indexListHash{"@{$elem}"} = $elem;};
foreach my $ref_index (@indexList) {
my @index = @{$ref_index};
LOOP1: while (@index) {
if ($index[-1]-- == 0) {pop(@index);};
if (exists $indexListHash{"@index"}) {last LOOP1;};
$indexListHash{"@index"} = [@index];
};
};
return [values %indexListHash];
};
#end CompleteIndexSet
#_____ TreeToIndexSet _____ _____ _____ _____
=pod
B<TreeToIndexSet>
TreeToIndexSet(tree) returns a list of all atoms (leaves) and their positions that represents the tree completely. The return value consists of pairs of position indexes and corresponding atoms.
The input tree must have the form [[...],...] where an atomic element is anything that is not a reference to an array. The return value is a reference to an array, of the form [[positionIndex1, atom1],[positionIndex2,atom2],...], where each positionIndex has the form [n1,n2,...].
Unimplemented extension: TreeToIndexSet(tree,levelSpec) returns the indexes and corresponding subexpression at levspec. xxxxx
Related: xxxxx IndexSetToExpression.
Example:
TreeToIndexSet( [0,1,2,3] );
#returns [[[0],0],[[1],1],[[2],2],[[3],3]]
TreeToIndexSet( [[3,4],'b',[[7,8],'love']] );
#returns [[[0,0],3],[[0,1],4],[[1],'b'],[[2,0,0],7],[[2,0,1],8],[[2,1],'love']]
TreeToIndexSet( [[[1,1],[1,2]],[[2,1],[2,2]],[[3,1],[3,2]]] );
#returns: [[[0,0,0],1],[[0,0,1],1],[[0,1,0],1],[[0,1,1],2],[[1,0,0],2],[[1,0,1],1],[[1,1,0],2],[[1,1,1],2],[[2,0,0],3],[[2,0,1],1],[[2,1,0],3],[[2,1,1],2]]
# hash references can also serve as atoms, but not recommended.
TreeToIndexSet ( [[3,4],[{'key1' => 1,'key2' => 2}, 5]] )
#returns: [[[0,0],3],[[0,1],4],[[1,0],{'key1' => 1,'key2' => 2}],[[1,1],5]]
=cut
# implementation note:
# Dependent functions: (none)
# misc notes: this function needs heavy testing. xxxxx
#push (@EXPORT, q(TreeToIndexSet));
#push (@EXPORT_OK, q(TreeToIndexSet));
# A interface gate for the possibility of adding input error checking.
sub TreeToIndexSet ($) {
return _treeToIndexSet($_[0]);
};
sub _treeToIndexSet ($) {
my $ref_tree = $_[0];
my @result;
# &$_recursor(currentPositionIndex, ASubexpression) ... works like this:
# loop through ASubexperssion.
# if an element is an atom, then add the index (currentPositionIndex,$i) to the result.
# else, do &$_recursor( (currentPositionIndex,$i), $currentElement)
my $rf_recursor;
$rf_recursor = sub {
my $ref_currentPosition = $_[0];
my $ref_input = $_[1];
for my $i (0 .. $#{$ref_input}) {
if (ref $ref_input->[$i] ne 'ARRAY')
{push( @result, [[(@{$ref_currentPosition},$i)], $ref_input->[$i] ]);}
else
{&$rf_recursor( [(@{$ref_currentPosition},$i)], $ref_input->[$i] ); };
};
};
&$rf_recursor([],$ref_tree);
return \@result;
};
#end TreeToIndexSet
#_____ Transpose _____ _____ _____ _____
=pod
B<Transpose>
Transpose(tree) returns a result that is the given tree with the first two levels transposed. e.g. Transpose( [[1,2,3],['a','b','c']] ) returns [[1,'a'],[2,'b'],[3,'c']].
Transpose(tree, permutationList) transposes the tree according to permutationList of the form [n1,n2,...,nm], where each n_i is a unique positive integer from 1 to m. Transpose( [[1,2,3],['a','b','c']] ) is equivalent to Transpose( [[1,2,3],['a','b','c']], [2,1] ).
Transpose essentially restructures a tree into a different shape. Here are some explanations, examples follows at the end. First, we'll use a simple example to illustrate. Suppose we have $tree = [[1,2,3],['a','b','c']] and $permutationList = [2,1]. The elements at level two of the tree have these position indexes:
element position index
1 [0,0]
2 [0,1]
3 [0,2]
'a' [1,0]
'b' [1,1]
'c' [1,2]
Since the length of $permutationList is two, thus Transpose will reshape the tree at level two. For each node, Transpose will apply the given permutation to its position index. Here's the result:
element position index
1 [0,0]
2 [1,0]
3 [2,0]
'a' [0,1]
'b' [1,1]
'c' [2,1]
Transpose then construct a tree by this new element/index pair. The result is [[1,'a'],[2,'b'],[3,'c']]. Because transposition with permutation [2,1] is common (matrix computations), thus it is the default behavior for Transpose with just one argument.
The given tree needs to be a rectangular array only up to the level m, where m is the length of the specified permutation. For example, suppose we have $tree = [[1,2,3],[$anotherTree,'b','c']] and $permutationList = [2,1]. It all works just as before, except that the element 'a' is substituted by $anotherTree. For example, Transpose([[ 1,2,3],[ ['m','n'] ,'b','c']], [2,1]) returns [[1,['m','n']],[2,'b'],[3,'c']].
Longer permutations also works similarly. For example, suppose
$tree = [ [['x1','x2'],['y1','y2'],['z1','z2']], [ ['a1','a2'] ,['b1','b2'], ['c1','c2']]];
$permutationList = [3,1,2];
Since the length of $permutationList is 3, thus looking at level 3 of the tree we have
element position index
before / after permute by [3,1,2]
'x1' [0,0,0] [0,0,0]
'x2' [0,0,1] [1,0,0]
'y1' [0,1,0] [0,0,1]
'y2' [0,1,1] [1,0,1]
'z1' [0,2,0] [0,0,2]
'z2' [0,2,1] [1,0,2]
'a1' [1,0,0] [0,1,0]
'a2' [1,0,1] [1,1,0]
'b1' [1,1,0] [0,1,1]
'b2' [1,1,1] [1,1,1]
'c1' [1,2,0] [0,1,2]
'c2' [1,2,1] [1,1,2]
Therefore, the result is [[['x1','y1','z1'],['a1','b1','c1']],[['x2','y2','z2'],['a2','b2','c2']]].
There are some implied restrictions on the input to Transpose:
1. The second argument must be a permutation of a range of m numbers that starts with one.
2. The tree must be a rectangular array up to level m. That is, Length(Dimensions($tree)) >= m.
A property of Transpose:
If $tree is a rectangular array, then the following is always true.
Permute(Dimensions($tree), $permutationList) == Dimensions(Transpose($tree, $permutationList))
If $tree is a rectangular array up to level m only, then the left and right hand side agrees up to the first m numbers.
Example:
my $tree =
[
[ ['x1','x2'], ['y1','y2'], ['z1','z2']],
[ ['a1','a2'], ['b1','b2'], ['c1','c2']]
];
Transpose( $tree, [1, 2, 3]);
# returns [[['x1','x2'],['y1','y2'],['z1','z2']],[['a1','a2'],['b1','b2'],['c1','c2']]]
Transpose( $tree, [1, 3, 2]);
# returns [[['x1','y1','z1'],['x2','y2','z2']],[['a1','b1','c1'],['a2','b2','c2']]]
Transpose( $tree, [2, 1, 3]);
# returns [[['x1','x2'],['a1','a2']],[['y1','y2'],['b1','b2']],[['z1','z2'],['c1','c2']]]
Transpose( $tree, [2, 3, 1]);
# returns [[['x1','a1'],['x2','a2']],[['y1','b1'],['y2','b2']],[['z1','c1'],['z2','c2']]]
Transpose( $tree, [3, 1, 2]);
# returns [[['x1','y1','z1'],['a1','b1','c1']],[['x2','y2','z2'],['a2','b2','c2']]]
Transpose( $tree, [3, 2, 1]);
# returns [[['x1','a1'],['y1','b1'],['z1','c1']],[['x2','a2'],['y2','b2'],['z2','c2']]]
=cut
# Permute([$e1, $e2,...], $ref_permutationList) permutes the first argument by the specifed permutation. e.g. Permute (['a',2,3,4,5],[3,2,5,4,1]).
sub Permute ($$) {
my $ref_list = $_[0];
my $ref_perm = $_[1];
my @result;
for (my $i = 0; $i <= $#{$ref_list}; $i++) {
$result[$i] = $ref_list->[$ref_perm->[$i] -1];
};
return \@result;
};
#push (@EXPORT, q(Transpose));
#push (@EXPORT_OK, q(Transpose));
# implementation note:
# plan:
# check validity of arguments.
# get a complete index set of the tree.
# select the indexes that are on the right level.
# reassign the nodes, using the form $ref_resultTree->[n1][n2] = $ref_tree->[n2][n1].
# Dependent functions: _treeToIndexSet, _completeIndexSet, Permute.
sub Transpose ($;$) {
# input checks here...
return _transpose(@_);
};
sub _transpose ($;$) {
# this function adds the optional arg, then pass it to _transposeFullArgs.
if ( scalar @_ == 1) {return _transposeFullArgs( $_[0], [2,1]);}
else {return _transposeFullArgs(@_);};
};
sub _transposeFullArgs ($$) {
my $ref_tree = $_[0];
my $ref_perm = $_[1];
my $transposeLevel = scalar @$ref_perm;
my $ref_completeIndexSet = [grep {scalar @$_ == $transposeLevel} @{ _completeIndexSet([map {$_ = $_->[0];} @{ _treeToIndexSet($ref_tree)}]) }];
my $ref_resultTree;
foreach my $ref_index (@$ref_completeIndexSet) {
eval(
'$ref_resultTree' . join('', (map {"->[$_]"} @{Permute($ref_index, $ref_perm)})) . '=' .
'$ref_tree' . join('', (map {"->[$_]"} @$ref_index)) . ';'
);
};
return $ref_resultTree;
};
#end Transpose
#-------------------------------
#testing
my $tree = [ [['x1','x2'],['y1','y2'],['z1','z2']], [ ['a1','a2'] ,['b1','b2'], ['c1','c2']]];
print Dumper _transpose( $tree, [1, 2, 3]);
print Dumper _transpose( $tree, [1, 3, 2]);
print Dumper _transpose( $tree, [2, 1, 3]);
print Dumper _transpose( $tree, [2, 3, 1]);
print Dumper _transpose( $tree, [3, 1, 2]);
print Dumper _transpose( $tree, [3, 2, 1]);
print Dumper _transpose( $tree, [2, 1]);
__END__
------------------------------
Date: 7 Nov 1998 14:50:49 -0500
From: steiner@bakerst.rutgers.edu (Dave Steiner)
Subject: Q: XSubs and variables
Message-Id: <7228ap$5e3$1@bakerst.rutgers.edu>
Keywords: XSub, variables between C and perl
First, some background. We have a local C library that has functions
similar to the normal crypt but has some extra arguments and does
additional processing. After finding people (and myself) writing C
wrappers (that load and call the library) and then calling those C
programs via system or a pipe from within their perl script, I decided
this would be a good place to learn about XSubs.
There are 4 functions in the library:
ru_crypt(p, salt, uid)
ru_crypt_cf(p, salt, uid, confname)
ru_crypt_cf_time(p, salt, uid, confname, time)
ru_crypt_cf_time_err(p, salt, uid, confname, time, reterr)
Instead of having 4 separate functions, I decided to have a single
function where the last three arguments were optional. So my XS code
looked like:
char*
ru_crypt(p, salt, uid, confname=NULL, time=0, reterr="")
char * p
char * salt
int uid
char * confname
int time
char * reterr
CODE:
RETVAL = ru_crypt_cf_time_err(p, salt, uid, confname,
time, &reterr);
OUTPUT:
reterr
RETVAL
This worked fine. Now someone suggested using perl variables
(conf_file & timeout) that could be set; generally people don't need
to set those arguments but if they do, they probably want them
consistant throughout their program. That made sense.
So I started looking into how variables would be done. Unfortunately,
their not mentioned in perlxs or perlxstut. I'm working my way
through perlguts and obviously need some of the code mentioned in
there but I'm still not sure how to put it all together. I also
looked at some existing modules; the only one that used variables was
DynaLoader. So after trying and failing, my questions are (besides
the general "how do I do this" :-)
1. I have to declare these vars in the xs file; should they be
SV*, etc? (The dl_debug var from Dynaloader is just an int but
arrays are AV*. They also are initialized when declared but I'm
not sure if that's necessary if you use perl_get_sv()?)
2. I would then set them up in an init() function which gets called
via "BOOT:". Modulo how things are declared, is this code correct?
conf_file = perl_get_sv("conf_file", TRUE); /* add to symbol table */
(void)sv_setpv(conf_file, Nullch); /* initialize */
timeout = perl_get_sv("timeout", TRUE);
(void)sv_setiv(timeout, (IV)0);
3. Can I then use these directly as defaults in the XS declaration or
do I have to write the "if (items < N)" type code myself? From
what the perlxs and perlxstut say, the defaults can only be strings
or numbers. Would something like '..., time="SvIV(timeout)"' work;
I haven't tried that.
Am I on the right track here? I've tried a few variations on this and
haven't gotten things to work. I could just do all this in the .pm
file but now that I've started this I want to find out how it works!
One last question: I tried passing a NULL (actually $POSIX::NULL) for
the confname arg but I think the library is seeing that as "0" and
then not finding that file. Is there a way I can pass a NULL correctly
from perl?
thanks,
ds
--
Dave Steiner
Associate Director of Network Services, Rutgers University Computing Services
steiner@bakerst.rutgers.edu or steiner@nbcs-ns.rutgers.edu
------------------------------
Date: Sat, 07 Nov 1998 18:20:51 GMT
From: Tom Phoenix <rootbeer@teleport.com>
Subject: RE:a small question
Message-Id: <Pine.GSO.4.02A.9811071008220.21718-100000@user2.teleport.com>
On Sat, 7 Nov 1998, Tk Soh wrote:
> print 'is an integer' if $var =~/^\d+$/;
Isn't -3 still an integer? :-)
If you must "roll your own" code to do this, make sure it's better than
what's in the FAQ, at a minimum.
print "'$var' is an integer\n" if $var =~ /^-?\d+$/;
At that, that could be improved upon, for some values of "improved".
print "'$var' is an integer\n"
if $var =~ /^\s*[+\-]?\d+\.?\s*$/;
Not that that's necessarily what the original poster needed; the FAQ is in
order, there. Cheers!
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: Sat, 07 Nov 1998 19:50:21 GMT
From: bhoylma@uswest.com
Subject: Re: sending an email to two different email addresses
Message-Id: <72289t$lta$1@nnrp1.dejanews.com>
In article <3642FD3B.41D64D4E@ctrl-v.nl>,
Marco Vlemmings <marcov@ctrl-v.nl> wrote:
> Hello,
>
> I have a script which will send an email to one person.
> Now i want to send the same email to two or more persons.
> Can anybody help me?
>
Using UN*X sendmail, a 'To:' header to multiple addresses is simply a
comma-seperated list.
Check out some of the RFCs documenting these standards for more details.
HTHYO.
Peace.
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: 12 Jul 98 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Special: Digest Administrivia (Last modified: 12 Mar 98)
Message-Id: <null>
Administrivia:
Special notice: in a few days, the new group comp.lang.perl.moderated
should be formed. I would rather not support two different groups, and I
know of no other plans to create a digested moderated group. This leaves
me with two options: 1) keep on with this group 2) change to the
moderated one.
If you have opinions on this, send them to
perl-users-request@ruby.oce.orst.edu.
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 4174
**************************************
