[10636] in Perl-Users-Digest
Perl-Users Digest, Issue: 4228 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Nov 16 07:07:52 1998
Date: Mon, 16 Nov 98 04:00:18 -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 Mon, 16 Nov 1998 Volume: 8 Number: 4228
Today's topics:
A Newbie Pattern Match Question dean_at_brand@my-dejanews.com
Re: A Newbie Pattern Match Question <mackr@rbg.ul.bw.schule.de>
Re: A Newbie Pattern Match Question (Matthew Bafford)
ANNOUNCE: Net::DICT 0.02 available (Peter Orbaek)
Re: Cannot get Sprite example query to work! (Peter Sorensen)
cgi question <m@rtin.nu>
Re: Just a perl question dave@mag-sol.com
Module loading error: Apache can't load Apache::Server <cc047@ecs.pc.cranfield.ac.uk>
Re: Perl scripts as a NT service <ibelgaufts@gfc-net.de>
programing fun: tree: Map <xah@best.com>
Q: how to sort reference designators? erik_lembke@my-dejanews.com
Re: Q: how to sort reference designators? <rra@stanford.edu>
Re: Shared Variable <prauz@sprynet.com>
Re: Why does this give a warning! dave@mag-sol.com
Special: Digest Administrivia (Last modified: 12 Mar 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Mon, 16 Nov 1998 09:17:09 GMT
From: dean_at_brand@my-dejanews.com
Subject: A Newbie Pattern Match Question
Message-Id: <72oqik$vvo$1@nnrp1.dejanews.com>
Apologise for the most of simplest questions. I have a file which contains
several lines of text. Each line is made up of a number of fields, delimited
by commas, like so:
67677,some text,897.9869
64378,some more text,8654.87
How do I extract each filed from a line with the following:
($value, $desc, $score) = / WHATS IN HERE /;
Its the 'WHATS IN HERE' bit I am seriously stuck with, I have tried various
bits and pieces and am now banging my head agains Larry's Wall!
Thanks in advance.
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Mon, 16 Nov 1998 10:40:18 +0100
From: Ruediger Mack <mackr@rbg.ul.bw.schule.de>
Subject: Re: A Newbie Pattern Match Question
Message-Id: <364FF302.57CA8FA@rbg.ul.bw.schule.de>
Hi,
The easiest way is to use the split function.
Something like this:
($value, $desc, $score) = split /,/,$line;
... Ruediger
------------------------------
Date: Mon, 16 Nov 1998 06:10:27 -0500
From: dragons@scescape.net (Matthew Bafford)
Subject: Re: A Newbie Pattern Match Question
Message-Id: <MPG.10b9d22c76971990989715@news.scescape.net>
[Followups set]
In article <72oqik$vvo$1@nnrp1.dejanews.com>, dean_at_brand@my-
dejanews.com <dean_at_brand@my-dejanews.com> pounded in the following:
=> Apologise for the most of simplest questions. I have a file which contains
=> several lines of text. Each line is made up of a number of fields, delimited
=> by commas, like so:
=>
=> 67677,some text,897.9869
=> 64378,some more text,8654.87
=>
=> How do I extract each filed from a line with the following:
=>
=> ($value, $desc, $score) = / WHATS IN HERE /;
=>
=> Its the 'WHATS IN HERE' bit I am seriously stuck with, I have tried various
=> bits and pieces and am now banging my head agains Larry's Wall!
Part of the reason people aren't banging their heads on the Wall over
Perl is there is a GREAT reference manual included with the dist. Use
it!
=> Thanks in advance.
Why post this twice? Several people (including myself) posted perfectly
acceptable answers to your 'A really novice question?' which (as I just
noticed) was also posted to clp.modules.
WHAT does this have to do with modules? There may be a module that fits
the bill (and there is), but you are not using it, so clp.modules does
NOT belong.
HTH,
--Matthew
------------------------------
Date: 16 Nov 1998 10:19:04 GMT
From: poe@daimi.aau.dk (Peter Orbaek)
Subject: ANNOUNCE: Net::DICT 0.02 available
Message-Id: <72ou6o$frv$1@xinwen.daimi.au.dk>
Keywords: DICT, protocol, RFC 2229, client
This is to announce the availability of version 0.02 of the
Net::DICT
module.
Net::DICT implements an object oriented interface to the DICT
dictionary lookup protocol defined in RFC 2229. See also
http://www.dict.org/, and the embedded POD documentation.
This initial version is available from
http://www.daimi.au.dk/~poe/perl-modules/
Depending on comments and requests, a more polished version will be
uploaded to PAUSE/CPAN in a few days.
Cheers,
- Peter.
--
Peter Orbaek, poe@daimi.au.dk
Phone: +45 89 42 56 07, http://www.daimi.au.dk/~poe
Comp. Sci. Department of Aarhus University, Denmark.
------------------------------
Date: 16 Nov 1998 09:35:05 GMT
From: maspsr@dou.ou.dk (Peter Sorensen)
Subject: Re: Cannot get Sprite example query to work!
Message-Id: <72ork9$he2$1@news.net.uni-c.dk>
In article <72komc$r4h$1@nnrp1.dejanews.com>, charlie66@my-dejanews.com says...
>
>Ok I did a dejanews search on this ng and found an identical problem to mine
>from a few months back. No one answered it, so I hope I fare better!
>
>Trying to get an example from CGI Programming on thw WWW to work. All I am
>trying to do is a simple select query from the database. What I should get
>back is an array of strings. What I get back in reality is an array of what
>seem to be packed strings. Any one had this happen?
>
Yes I think I had the same problem. The problems is that what you get back is
an array of arrays.
In the example the code says:
foreach $record (@data) {
$record =~.....;
print $record, "\n";
}
try:
foreach $record (@data) {
$record =~.....;
print @$record, "\n";
}
--
Peter Sorensen / University of Odense,dk/e-mail:maspsr@dou.ou.dk
------------------------------
Date: Mon, 16 Nov 1998 11:45:58 +0100
From: Martin <m@rtin.nu>
Subject: cgi question
Message-Id: <36500266.97C3404A@rtin.nu>
Hi
I need to define what domains that is allowed to run my perl script. I
have the unix cgi folder on a difirent computer/domain. It's an
accesscounter script that is called with SSI on a NT machine. But the
error message
Cannot #EXEC 'http...' due to lack of EXECUTE permission
Even though I have put all the permissions that I should on the script
an folder.
Martin
m@rtin.nu
http://www.highwaytohell.net/
------------------------------
Date: Mon, 16 Nov 1998 09:58:56 GMT
From: dave@mag-sol.com
Subject: Re: Just a perl question
Message-Id: <72ot10$1q4$1@nnrp1.dejanews.com>
In article <72iinf$ht2@fidoii.cc.Lehigh.EDU>,
"Dunnigan,Jack [Edm]" <Jack.Dunnigan@EC.GC.CA> wrote:
> Sorry folks...no Tk involved on this one.
In which case it should really be in comp.lang.perl.misc (followups set).
> Is there any way to create an array name "on the fly"? i.e. The array name
> is stored in a changing variable.
>
> eg. Instead of
>
> @arrayname=@list;
>
> I want something like:
>
> $var="arrayname";
> @$var = @list;
>
> Is there any proper format for this type of thing? I get error messages
> while using 'strict'.
Yeah. 'use strict' disallows symbolic references. One handy way to get round
this would be to use hashes. Try something like this...
my %on_the_fly_vars;
$on_the_fly_vars{arrayname} = [@list];
# You can the access the elements of your list as
$on_the_fly_vars{arrayname}->[0];
# or the whole thing as
@{on_the_fly_vars{arrayname}};
hth,
Dave...
--
Magnum Solutions Ltd: <http://www.mag-sol.com/>
London Perl M[ou]ngers: <http://london.pm.org/>
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Mon, 16 Nov 1998 09:06:39 +0000
From: Jeffrey Goldberg <cc047@ecs.pc.cranfield.ac.uk>
Subject: Module loading error: Apache can't load Apache::Server
Message-Id: <Pine.LNX.4.05.9811160837200.16717-100000@arpad.thegreen.private>
Unfortunately I can't provide all of the details that should be provided
in a desparate plea for help (and this is desparate). The person who
actually understands our site's Apache configuration is at a conference
(he was going to walk me through it next week).
Basically, when I try to start apache, I get
[Mon Nov 16 08:42:06 1998] [error] Can't locate loadable object for module
Apache::Server in @INC (@INC contains:
/usr/local/lib/perl5/alpha-dec_osf/5.00404 /usr/local/lib/perl5
/usr/local/lib/perl5/site_perl/alpha-dec_osf
/usr/local/lib/perl5/site_perl /usr/local/lib/perl5/alpha-dec_osf .
/usr/web/apache/ /usr/web/apache/lib/perl) at
/usr/local/lib/perl5/Apache.pm line 23
Can't load Perl module `Apache', exiting...
[Lines broken for readability]
Obviously my first thought is that there is something missing from @INC,
but as you can see /usr/local/lib/perl5 is in @INC and the following file
exists:
/usr/local/lib/perl5/Apache/Server.pm
Line 23 of Apache.pm is the first time any of the specific modules are
required, so I assume it is nothing special with Apache::Server
Some additional info:
An extract from the httpd.conf file is:
# Add the Perl autoload search path; we put this here so that the
# srm.conf need not know about it.
<Perl>
push ( @main::INC , '/usr/web/apache/perl' ) ;
use lib qw(/usr/web/apache/perl);
1 ;
</Perl>
But that seems irrelevant to me, since /usr/local/lib/perl5 is
in INC before that. (Also, I don't know why there is both the "push"
and the "use lib", "use lib" ought to do the job.)
This is so we can pick up some of our home grown modules under the
Apache:: namespace, and those files are in /usr/web/apache/perl/Apache/
Here is an excerpt from srm.conf
<Perl>
require Apache::Registry ;
require Apache::Status ;
require Apache::WebAdmin ;
require Apache::LowerCaseGETs ;
require Apache::LowerCaseGETs ;
require Apache::FixDirIndexes ;
require Apache::Tilde ;
require Apache::Public ;
require Apache::Mailform ;
</Perl>
Would someone point me in the right direction (please send mail).
If you need more info (like how Apache was compiled etc, please give me a
hint at how to probe for that information), but I can tell you this much:
This is perl, version 5.004_04 built for alpha-dec_osf
If there is a more appropriate newsgroup of this, also let me know.
Desparately yours,
Jeff
--
Jeffrey Goldberg +44 (0)1234 750 111 x 2826
Cranfield Computer Centre FAX 751 814
J.Goldberg@Cranfield.ac.uk http://WWW.Cranfield.ac.uk/public/cc/cc047/
Relativism is the triumph of authority over truth, convention over justice.
------------------------------
Date: Mon, 16 Nov 1998 11:15:24 +0100
From: "J|rgen Ibelgaufts" <ibelgaufts@gfc-net.de>
Subject: Re: Perl scripts as a NT service
Message-Id: <364FFB3C.EDB154FA@gfc-net.de>
Hi,
what does NT service mean for you? In which way do you invoke your perl
interpreter and script to run as a service? Do you register perl with sc.exe so
that you can control its start and end by means of My Computer -> System ->
Services ? Where do you find the error messages? As far as I know, perl is a
console program that prints to stdout rather than to the services logfile. Do you
want your program start before any user logs on?
Sorry that I only have questions and no answers :-)
Juergen Ibelgaufts
-----------------------------------------------------------------------------------
Farouk Khawaja schrieb:
>
> Hi All,
>
> I'm trying to start run a perl script as a NT service. My problem is that
> my Perl code, interperter, and libraries are on a virtual drive (R: ) .
> Unfortuantely, that's my environment and I cannot change it. When I try to
> start the script from any other drive besides R:, perl cannot find any of
> its libraries.
>
> e.g. My script calls socket.pm by invoking 'use socket'. @INC points to
> '\usr\lib\perllib\socket.pm'. This is the correct location of the module
> but it cannot be located if the script is started from say c:\
>
> c:\>r:\usr\sbin\mhs\replicate.pl
>
> Is there any way to define a default drive in perl for Windows? Does
> anyone know how I can get around this limitation?
>
> I guess I could always compile the code, but that would be one of my last
> options.
------------------------------
Date: Mon, 16 Nov 1998 03:25:41 -0800
From: "Xah" <xah@best.com>
Subject: programing fun: tree: Map
Message-Id: <36500bbb$0$12761@nntp1.ba.best.com>
Here's "this week's" programing problem on trees. The problem is programing the "Map" function. Here's the spec:
=pod
Map(f, tree) returns the result of applying f to first level nodes of tree. f must be a reference to a subroutine or anonymous function. For example: Map( sub {$_**2;}, [9,2,5]); returns [81,4,25]. Map(f, tree) is similar to Perl's "map".
Map(f, tree, levelSpec) maps f to nodes specified by levelSpec. Map(f, tree) is equivalent to Map(f, tree, [1]). The general form of levelSpec is [m,n]. f is applied to the tree in the same order as in Level. That is, commonly known as "depth first". See Level for detail about levels and levelSpec.
The most common use of Map is applying a function to a specific level of a tree. For example, Map( $func , $tree, [3]) will return a modified $tree, where all nodes at level 3 are transformed by having $func applied to them. Map( $func , $tree, [-1]) will apply $func to all the leaves of the tree.
Related: xxxxx, Apply, MapIndexed, MapAll, MapThread.
Example:
Map( sub {$_[0]**2;}, [1,2,3,4]); # returns [1,4,9,16].
Map( sub {$_[0]**2;}, [1,2,3,4], [1]); # returns [1,4,9,16].
Map( sub {$_[0]**2;}, [[1],[2],[3]], [2]); # returns [[1],[4],[9]].
# The levelSpec [-1] specified all the atoms/leaves of the tree.
Map( sub {$_[0]**2;}, [7,[3],[5]], [-1]); # returns [49,[9],[25]].
xxxxxx Needs more examples. Need examples that uses multiple levels, and practical examples showing the usefulness of Map.
=cut
A solution is pasted below my sig. Copy and paste and it will run. At the very end is one test case.
This problem is not particular interesting since the solution shares 98% of the code for the Level function posted two weeks ago. I suppose some readers here are curious to see it anyway. Again, if you have improvements, shoot!
Xah, xah@best.com
http://www.best.com/~xah/PageTwo_dir/more.html
"Unix = shit pile; GNU's Not Unix. <www.gnu.com>"
----------------------------------------
#!/usr/local/bin/perl5 -w
use strict;
use Data::Dumper qw(Dumper); $Data::Dumper::Indent=0;
#-------
# _nodeDepth(completeIndexSet, index) returns the depth of the index.
# problem: given an index I and a complete index set S, how to find the depth of the index?
# solution:
# 1. find all the indexes that starts with the same components as I. (i.e. all offsprings of I, including itself.)
# 2. count the number of the trailing components. The answer is max+1.
sub _nodeDepth ($$) {
my @indexSet = @{$_[0]};
my @index = @{$_[1]};
my $length = scalar @index;
@indexSet = grep {
my $temp =1;
HH: for (my $i=0; $i <= $#index; $i++) {
if ($index[$i] != $_->[$i]) {$temp =0; last HH;};
};
$temp;
} (grep {scalar @{$_} >= $length} @indexSet);
my $result = $length;
foreach $_ (@indexSet) {
if (scalar @{$_} > $result) {$result = scalar @{$_};};
};
return $result -$length + 1;
};
#_____ 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
#_____ 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
#_____ IndexSetSort _____ _____ _____ _____
=pod
B<IndexSetSort>
IndexSetSort([index1,index2,...]) returns the indexes sorted. This is equivalent to IndexSetSort([index1,index2,...],0,1,1). The indexes have the form [[a1,a2,...],[b1,b2,...],...].
IndexSetSort([index1,index2,...], $sortByIndexFirstQ, $indexAscendingQ, $lengthAscendingQ) returns the indexes sorted. The rest of the parameters are booleans specifying the sorting criterions application order and directions.
The indexes are sorted using two criterions: (1) index number sequence from left to right. (2) the length of the indexes.
sortByIndexFirstQ controls which criterion will be used first. The other two arguments indexAscendingQ, lengthAscendingQ controls the ascending or decending direction for each criterion. The three booleans forms a total of 8 possible ways of ordering. Any number of the booleans can be omitted. User specified booleans will replace the defaults (0, 1, 1) from the left.
Example:
IndexSetSort([[0], [1, 0], [1, 1, 0], [1, 1, 1], [1, 1, 2], [1, 1], [1, 2, 0], [1, 2, 1], [1, 2, 2], [1, 2], [1], [2, 0], [2, 1, 0], [2, 1, 1], [2, 1, 2], [2, 1], [2, 2, 0], [2, 2, 1], [2, 2, 2], [2, 2], [2]], 0, 1, 1);
Depending on the last three arguments, it returns one of the following:
#(0,0,0)
#sort by (depth decending, then index decending).
#[[2,2,2],[2,2,1],[2,2,0],[2,1,2],[2,1,1],[2,1,0],[1,2,2],[1,2,1],[1,2,0],[1,1,2],[1,1,1],[1,1,0],[2,2],[2,1],[2,0],[1,2],[1,1],[1,0],[2],[1],[0]];
#(0,0,1)
#sort by (depth ascending, then index decending).
#[[2],[1],[0],[2,2],[2,1],[2,0],[1,2],[1,1],[1,0],[2,2,2],[2,2,1],[2,2,0],[2,1,2],[2,1,1],[2,1,0],[1,2,2],[1,2,1],[1,2,0],[1,1,2],[1,1,1],[1,1,0]];
#(0,1,0)
#sort by (depth decending, then index ascending).
#[[1,1,0],[1,1,1],[1,1,2],[1,2,0],[1,2,1],[1,2,2],[2,1,0],[2,1,1],[2,1,2],[2,2,0],[2,2,1],[2,2,2],[1,0],[1,1],[1,2],[2,0],[2,1],[2,2],[0],[1],[2]];
#(0,1,1)
#sort by (depth ascending, then index ascending). (Common)
#[[0],[1],[2],[1,0],[1,1],[1,2],[2,0],[2,1],[2,2],[1,1,0],[1,1,1],[1,1,2],[1,2,0],[1,2,1],[1,2,2],[2,1,0],[2,1,1],[2,1,2],[2,2,0],[2,2,1],[2,2,2]];
#(1,0,0)
#sort by (index decending, then depth decending).
#[[2,2,2],[2,2,1],[2,2,0],[2,2],[2,1,2],[2,1,1],[2,1,0],[2,1],[2,0],[2],[1,2,2],[1,2,1],[1,2,0],[1,2],[1,1,2],[1,1,1],[1,1,0],[1,1],[1,0],[1],[0]];
#(1,0,1)
#sort by (index decending, then depth ascending).
#[[2],[2,2],[2,2,2],[2,2,1],[2,2,0],[2,1],[2,1,2],[2,1,1],[2,1,0],[2,0],[1],[1,2],[1,2,2],[1,2,1],[1,2,0],[1,1],[1,1,2],[1,1,1],[1,1,0],[1,0],[0]];
#(1,1,0)
#Sort by (index ascending, then depth decending): (Common)
#[[0],[1,0],[1,1,0],[1,1,1],[1,1,2],[1,1],[1,2,0],[1,2,1],[1,2,2],[1,2],[1],[2,0],[2,1,0],[2,1,1],[2,1,2],[2,1],[2,2,0],[2,2,1],[2,2,2],[2,2],[2]];
#(1,1,1)
#Sort by (index ascending, then depth ascending): (Common)
#[[0],[1],[1,0],[1,1],[1,1,0],[1,1,1],[1,1,2],[1,2],[1,2,0],[1,2,1],[1,2,2],[2],[2,0],[2,1],[2,1,0],[2,1,1],[2,1,2],[2,2],[2,2,0],[2,2,1],[2,2,2]];
=cut
# implementation note:
# Dependent functions: _indexOrdering
# misc notes: this function needs heavy testing. The speed can also be improved greatly by eleminating the inner loop in the sort, using Swatze transform technique instead. Basically: convert all indexes to same length strings, and sort this string. xxxxx'
#push (@EXPORT, q(IndexSetSort));
#push (@EXPORT_OK, q(IndexSetSort));
# _indexOrdering([a1,a2,...],[b1,b2,...]) returns -1, 0, or 1 by comparing the number sequence in each array reference from left to right. If both begins with the same sequence, then it returns 0. The length of the arrays has no effect. Example: print "@{[_indexOrdering([2,2],[2,3,3])]}";
sub _indexOrdering ($$) {
my @array1 = @{$_[0]};
my @array2 = @{$_[1]};
my $minLength;
if (scalar @array1 < scalar @array2) {$minLength = scalar @array1}
else {$minLength = scalar @array2};
for my $i (0..$minLength -1) {
if ($array1[$i] <=> $array2[$i]) {return $array1[$i] <=> $array2[$i];}
};
return 0;
};
sub IndexSetSort ($;$$$) {
if (scalar @_ == 1) {return _indexSetSortFullArguments($_[0],0,1,1);};
if (scalar @_ == 2) {return _indexSetSortFullArguments($_[0],$_[1],1,1);};
if (scalar @_ == 3) {return _indexSetSortFullArguments($_[0],$_[1],$_[2],1);};
return _indexSetSortFullArguments(@_);
};
#_indexSetSortFullArguments([index1, index2,...], sortByIndexFirstQ, indexAscendingQ, lengthAscendingQ)
sub _indexSetSortFullArguments ($$$$) {
my @indexList = @{$_[0]};
my $sortByIndexFirstQ = $_[1];
my ($indexAscendingQ, $lengthAscendingQ) = ($_[2],$_[3]);
if ($sortByIndexFirstQ) {
if ($indexAscendingQ) {
if ($lengthAscendingQ) {@indexList = sort {_indexOrdering($a,$b) || scalar @{$a} <=> scalar @{$b} } @indexList;}
else {@indexList = sort {_indexOrdering($a,$b) || scalar @{$b} <=> scalar @{$a} } @indexList;}
}
else {
if ($lengthAscendingQ) {@indexList = sort {_indexOrdering($b,$a) || scalar @{$a} <=> scalar @{$b} } @indexList;}
else {@indexList = sort {_indexOrdering($b,$a) || scalar @{$b} <=> scalar @{$a} } @indexList;}
};
}
else {
if ($indexAscendingQ) {
if ($lengthAscendingQ) {@indexList = sort {scalar @{$a} <=> scalar @{$b} || "@{$a}" cmp "@{$b}"} @indexList;}
else {@indexList = sort {scalar @{$b} <=> scalar @{$a} || "@{$a}" cmp "@{$b}"} @indexList;}
}
else {
if ($lengthAscendingQ) {@indexList = sort {scalar @{$a} <=> scalar @{$b} || "@{$b}" cmp "@{$a}" } @indexList;}
else {@indexList = sort { scalar @{$b} <=> scalar @{$a} || "@{$b}" cmp "@{$a}" } @indexList;}
};
};
return \@indexList;
};
#_____ Map _____ _____ _____ _____
# implementation note: See the implementation note for Level.
# Dependent functions: _treeToIndexSet, _completeIndexSet, _indexSetSortFullArguments, _nodeDepth.
#push (@EXPORT, q(Map));
#push (@EXPORT_OK, q(Map));
sub Map ($$;$) {
# input checks here...
return _map(@_);
};
sub _map ($$;$) {
# this function generates full arguments for Map, then pass it to _mapWithFullArgs.
if (scalar @_ == 2) {return _mapWithFullArgs( @_, [1,1])}
else { # _map is passed 3 arguments here.
if ( ref $_[2] eq 'ARRAY') { # last arg is an array
if (scalar @{$_[2]}==1) { # the level spec has the form [n].
return _mapWithFullArgs($_[0], $_[1], [$_[2]->[0], $_[2]->[0] ]); }
else {return _mapWithFullArgs( @_ ); };
}
else {return _mapWithFullArgs( @_, [1, $_[2]]); };
};
};
# form: _mapWithFullArgs($function, $tree, $levelSpecFullForm).
sub _mapWithFullArgs ($$$) {
my $ref_func = $_[0];
my $ref_tree = $_[1];
my ($A, $B) = @{$_[2]};
my ($a, $b) =(abs $A, abs $B);
my $ref_completeIndexSet = _indexSetSortFullArguments( _completeIndexSet([map {$_ = $_->[0];} @{ _treeToIndexSet($ref_tree)}]),1,1,0);
my $predicateString =
($A >= 0 ?
($B >= 0 ?
'((scalar @{$_} >= $a) and ( scalar @{$_} <= $b))':
'((scalar @{$_} >= $a) and ( _nodeDepth($ref_completeIndexSet, $_) >= $b))'
):
( $B >= 0 ?
'((_nodeDepth($ref_completeIndexSet, $_) <= $a) and (scalar @{$_} <= $b))':
'(( _nodeDepth($ref_completeIndexSet, $_) <= $a) and ( _nodeDepth($ref_completeIndexSet, $_) >= $b))'
)
);
foreach my $ref_index (grep {eval $predicateString} @{$ref_completeIndexSet}) {
# $treePartsString has the form: e.g. '$ref_tree->[n1]->[n2]'
my $treePartsString = '$ref_tree' . join('', (map {"->[$_]"} @$ref_index));
eval("$treePartsString" . ' = &{$ref_func}' . "($treePartsString)");
};
return $ref_tree;
};
#end Map
#----------------------
# testing
print Dumper
Map( sub {$_[0]**2;}, [[1],[2],[3]], [2]); # [[1],[4],[9]]
__END__
------------------------------
Date: Mon, 16 Nov 1998 10:12:44 GMT
From: erik_lembke@my-dejanews.com
Subject: Q: how to sort reference designators?
Message-Id: <72otqs$2j3$1@nnrp1.dejanews.com>
Hello,
i have to sort reference designators.
They have following Syntax:
<alphabetic description><number of occurance>
example: R1, R10, CBL1, CBL2, CBL10
if i sort them i got following order:
CBL1, CBL10, CBL2, R1, R10
I can't sort them numerically (because of the alphabetic description)
are there any modules/functions available which would solve this problem??
cheers Erik
PS: Please reply my by E-Mail
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: 16 Nov 1998 02:44:14 -0800
From: Russ Allbery <rra@stanford.edu>
To: erik_lembke@my-dejanews.com
Subject: Re: Q: how to sort reference designators?
Message-Id: <ylyapbex35.fsf@windlord.stanford.edu>
[ Posted and mailed. ]
erik lembke <erik_lembke@my-dejanews.com> writes:
> i have to sort reference designators.
> They have following Syntax:
> <alphabetic description><number of occurance>
> example: R1, R10, CBL1, CBL2, CBL10
> if i sort them i got following order:
> CBL1, CBL10, CBL2, R1, R10
> I can't sort them numerically (because of the alphabetic description)
> are there any modules/functions available which would solve this
> problem??
I don't know of a module, but here's what I wrote to solve a similar
problem.
@data = map { $$_[0] }
sort { $$a[1] cmp $$b[1] || $$a[2] <=> $$b[2] }
map { [ $_, split (/(\d+)$/, $_, 2) ] } @data;
This makes the most sense when read from the last line up. The last map
splits up each piece of data into a three-element anonymous array, where
the first element is the original piece of data, the second is the
alphabetic part, and the third is the numeric part. The second line, the
sort, then sorts the resulting list of arrays first alphabetically by the
first part of each element and then numerically by the second part.
Finally, the top line strips off the extra data from the now-sorted array,
turning it into the final sorted list of elements.
Hope this helps.
--
#!/usr/bin/perl -- Russ Allbery, Just Another Perl Hacker
$^=q;@!>~|{>krw>yn{u<$$<[~||<Juukn{=,<S~|}<Jwx}qn{<Yn{u<Qjltn{ > 0gFzD gD,
00Fz, 0,,( 0hF 0g)F/=, 0> "L$/GEIFewe{,$/ 0C$~> "@=,m,|,(e 0.), 01,pnn,y{
rw} >;,$0=q,$,,($_=$^)=~y,$/ C-~><@=\n\r,-~$:-u/ #y,d,s,(\$.),$1,gee,print
------------------------------
Date: Mon, 16 Nov 1998 10:01:41 +0000
From: Balazs Rauznitz <prauz@sprynet.com>
To: Jean-Michel Houmard <jean-michel.houmard@bakom.admin.ch>
Subject: Re: Shared Variable
Message-Id: <364FF805.300F471B@sprynet.com>
Jean-Michel Houmard wrote:
>
> Hi,
> I get the following message when I start my perl script:
>
> Variable "$vVar" will not stay shared at /tmp/jmh.pl line 8.
> Test
>
> Any Idea why and how can I work with $vVar in subroutines without error
> message?
>
> Regards
>
> Jean-Michel
>
> PS: the script:
>
> #!/usr/bin/perl -w
> #
> sub F1
> {
> my $vVar="Test";
> sub F2
> {
> print "$vVar\n";
> }
> F2;
> }
> F1;
> # -- End file
perldoc perldiag:
Variable """"%s"""" will not stay shared
(W) An inner (nested) named subroutine is referencing
a lexical variable defined in an outer subroutine.
When the inner subroutine is called, it will probably
see the value of the outer subroutine's variable as it
was before and during the *first* call to the outer
subroutine; in this case, after the first call to the
outer subroutine is complete, the inner and outer
subroutines will no longer share a common value for
the variable. In other words, the variable will no
longer be shared.
Furthermore, if the outer subroutine is anonymous and
references a lexical variable outside itself, then the
outer and inner subroutines will never share the given
variable.
This problem can usually be solved by making the inner
subroutine anonymous, using the sub {} syntax. When
inner anonymous subs that reference variables in outer
subroutines are called or referenced, they are
automatically rebound to the current values of such
variables.
You might want something like this:
#!/usr/bin/perl -w
sub f1 {
my var="test";
my $f2 = sub {
print $var ,"\n";
};
&$f2;
}
f1;
Hope this helped:
Balazs
------------------------------
Date: Mon, 16 Nov 1998 09:48:43 GMT
From: dave@mag-sol.com
Subject: Re: Why does this give a warning!
Message-Id: <72osds$1c6$1@nnrp1.dejanews.com>
In article <364F8081.61B9BB4F@unicomp.net>,
Eric Molitor <spamsucks@unicomp.net> wrote:
> Why does the following give the uninitialed error listed in the code
> below?
>
> #!/usr/bin/perl -w
> # Perl script to report number of POP Mail sessions
> use strict;
>
> my $count=0;
> my $ignore=0;
> open NETSTAT, "/bin/netstat -n --tcp|";
> while (<NETSTAT>) {
> if ($ignore eq 0) {
> $ignore=1;
> } else {
> # Why does the following line give the error
> # Use of uninitialized value at line ..., <NETSTAT> chunk2.
> if ((split(/:/,(split(/ +/))[3]))[1] eq "110") {
> $count+=1;
> }
> }
> }
> close NETSTAT;
> print "$count\n";
There are a couple of errors in your code that might be causing your problem.
1/ You don't check the success of the open command. It might be that the
command is just not working.
2/ Your "if ($ignore eq 0)" line probably isn't doing what you think it's
doing. I think you want to be comparing the value of $ignore with the integer
0. Number comparison is done using the '==' operator ('eq' is used for
strings). The line is therefore better written as "if ($ignore == 0)", this
can be further improved to "unless ($ignore)".
3/ It's most likely that your complex "split" expression isn't doing what you
want. It's hard to be sure without an example of your input data. You might
like to break the split up into the two separate sections and have a look at
the values returned in the debugger.
hth,
Dave...
--
Magnum Solutions Ltd: <http://www.mag-sol.com/>
London Perl M[ou]ngers: <http://london.pm.org/>
-----------== 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 4228
**************************************
