[30520] in Perl-Users-Digest
Perl-Users Digest, Issue: 1763 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Aug 4 17:50:00 2008
Date: Sat, 2 Aug 2008 13:09:07 -0700 (PDT)
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, 2 Aug 2008 Volume: 11 Number: 1763
Today's topics:
DBI:Pg script returning 'can't call method' error <marko.online@gmail.com>
Re: DBI:Pg script returning 'can't call method' error <m@rtij.nl.invlalid>
Re: DBI:Pg script returning 'can't call method' error <marko.online@gmail.com>
Re: FAQ 4.2 Why is int() broken? (Randal L. Schwartz)
Re: How come? RE matches, but does not set $^R <JustMe@somewhere.de>
Re: How do I PUSH an HTTP::POST using perl LWP? <m@rtij.nl.invlalid>
Is there a way to spawn a program from perl that is ind <twxxxxxx@hooya.com>
Re: Is there a way to spawn a program from perl that is <ben@morrow.me.uk>
Re: Is there a way to spawn a program from perl that is <jurgenex@hotmail.com>
Re: Is there a way to spawn a program from perl that is (Jens Thoms Toerring)
new CPAN modules on Sat Aug 2 2008 (Randal Schwartz)
Node ToolKit. __Was __ Re:C linked lists in Perl sln@netherlands.com
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 1 Aug 2008 21:25:23 -0700 (PDT)
From: marko <marko.online@gmail.com>
Subject: DBI:Pg script returning 'can't call method' error
Message-Id: <f4e6d808-6f09-41bf-9f7e-200476708aa9@x35g2000hsb.googlegroups.com>
This is my script in its current (troubleshooting) state:
----------------------------------------------------------
#!/usr/bin/perl -w
use DBI;
#use DBD::Pg;
use strict;
my $dbname = "test";
my $dbh = DBI->connect("DBI:Pg:dbname=
$dbname;host=localhost;port=5432","","",
{RaiseError => 1, PrintError => 1 })
or die "Can't connect to the db: $DBI::errstr\n";
if (undef $dbh) {die "cannot connect to database:$!\n";}
else {print "Success connecting!\n";}
my $statement = "select count(*) from tex_births";
my $rc = $dbh->ping; # this is the line returning the 'can't call
method 'ping' error'
print $rc . "\n";
#my $sth = $dbh->prepare($statement)
# or die "Can't prepare SQL statement: $DBI::errstr\n";
#if ( undef $sth ) {die "Could not prepare statement:$!\n";}
#$sth->execute or die "Can't Execute statement: $DBI::errstr\n";
while (my @row_ary = $dbh->selectrow_array($statement)) {
#while ( my @row = $sth->fetchrow_array() ) {
print @row_ary,"\n"; }
#$sth->finish;
$dbh->disconnect;
-------------------------------------------------------------------------
Perl, this script and postgresql are all running on this same
machine. The connect() method is what I would suspect as being the
culprit, naturally, but the die is not being triggerred and a
$DBI::errstr is not being printed out. In fact, a 'Success
connecting!' is instead being printed and the next output line is
'can't call method 'ping' on an undefined value'.
The log file to postgresql doesn't show anything out of the ordinary
at all! The psql command line is working fine connected to the
postgresql server, so I don't think its a server issue. **I'm really
stumped on this one.** Would anyone like to take a stab at helping me
find my way? Please?
------------------------------
Date: Sat, 2 Aug 2008 12:30:02 +0200
From: Martijn Lievaart <m@rtij.nl.invlalid>
Subject: Re: DBI:Pg script returning 'can't call method' error
Message-Id: <pan.2008.08.02.10.30.02@rtij.nl.invlalid>
On Fri, 01 Aug 2008 21:25:23 -0700, marko wrote:
> if (undef $dbh) {die "cannot connect to database:$!\n";} else {print
^^^^^^^^^^^^^^^
> "Success connecting!\n";} my $statement = "select count(*) from
Which means: Undefine the $dbh variable; if (undefined value == true)
{ die no connect } else { print success };
You probably want:
die "cannot connect to database:$!\n" unless defined $dbh;
print "Success connecting!\n";
HTH,
M4
------------------------------
Date: Sat, 2 Aug 2008 05:18:46 -0700 (PDT)
From: marko <marko.online@gmail.com>
Subject: Re: DBI:Pg script returning 'can't call method' error
Message-Id: <d5a3ad51-1e35-4e09-8441-ddac55d3cb05@l64g2000hse.googlegroups.com>
On Aug 2, 6:30=A0am, Martijn Lievaart <m...@rtij.nl.invlalid> wrote:
> On Fri, 01 Aug 2008 21:25:23 -0700, marko wrote:
> > if (undef $dbh) {die "cannot connect to database:$!\n";} else {print
> =A0 ^^^^^^^^^^^^^^^
> > "Success connecting!\n";} my $statement =3D "select count(*) from
>
> Which means: Undefine the $dbh variable; if (undefined value =3D=3D true)
> { die no connect } else { print success };
>
> You probably want:
>
> die "cannot connect to database:$!\n" unless defined $dbh;
> print "Success connecting!\n";
>
> HTH,
> M4
Whoopsie! Thanks. Wow. I gotta say as much as I like perl, it can
really be very unintuitive at times and I think the vast difference
between defined and undef is one of them. undef will change the value
of your variable and defined is a test!
Well, that was obviously my problem. It works now. Thanks.
------------------------------
Date: Sat, 02 Aug 2008 06:52:23 -0700
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: FAQ 4.2 Why is int() broken?
Message-Id: <863alna5ig.fsf@blue.stonehenge.com>
>>>>> "Dave" == Dave Stratford <daves@orpheusmail.co.uk> writes:
Dave> Obviously written by someone who doesn't know cobol at all well. Cobol
Dave> has been able to use binary since at least 1974. That 'normally' is
Dave> completely wrong, by default cobol wants to use binary. (at least since
Dave> 1974 it has!)
But 1974 is "relatively modern" with respect to Cobol, right?
/me ducks
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Smalltalk/Perl/Unix consulting, Technical writing, Comedy, etc. etc.
See http://methodsandmessages.vox.com/ for Smalltalk and Seaside discussion
------------------------------
Date: Sat, 2 Aug 2008 13:28:16 +0200
From: Hartmut Camphausen <JustMe@somewhere.de>
Subject: Re: How come? RE matches, but does not set $^R
Message-Id: <MPG.22fe631d93894a8198968f@news.t-online.de>
Am Thu, 31 Jul 2008 23:27:24 +0200 schrieb Dr.Ruud:
Thanks Charles & Ruud for investigating my little problem.
> Dr.Ruud wrote:
> Most probably a bug: if there is a quantifier at the end of the
> non-capturing group, and a quantifier directly after that group, then
> $^R is undefined.
This also happens for capturing groups.
As I just found out:
This seems to apply only if I do not set $^R explicitly via (?{$^R=...})
If I do so, everything works as expected.
So under these conditions Perl does not return the result of the last
statement within the code block as it otherwise uses to. (Well, as the
docs say, "This extended regular expression feature is considered highly
experimental"...)
So, I see two workarounds for this maybe rare case:
(1) set $^R explicitly:
(a+)?(?{$^R=...})
(2) enclose the search expression in (?>...):
(?>(a+)?)(?{...})
Thanks again + mfg,
Hartmut
--
------------------------------------------------
Hartmut Camphausen h.camp[bei]textix[punkt]de
------------------------------
Date: Sat, 2 Aug 2008 17:00:02 +0200
From: Martijn Lievaart <m@rtij.nl.invlalid>
Subject: Re: How do I PUSH an HTTP::POST using perl LWP?
Message-Id: <pan.2008.08.02.15.00.02@rtij.nl.invlalid>
On Wed, 23 Jul 2008 15:26:05 -0700, joemacbusiness wrote:
> Hi All,
>
> I want to use http POST to push several gzipped files to another apache
> server. We need to use this since our customers only allow access to
> port 80, so no ssh and no ftp.
If the webserver is only used for this, run sshd on port 80. :-)
M4
------------------------------
Date: Sat, 02 Aug 2008 11:10:54 -0500
From: Tom Wyley <twxxxxxx@hooya.com>
Subject: Is there a way to spawn a program from perl that is independent?
Message-Id: <uJKdnbY_K9CTGgnVnZ2dnUVZ_tzinZ2d@oco.net>
That is...
Backtics and System will start up a new program but it is modal - to get
back to the original script the spawned program must be closed.
Exec kills the original script when the spawned program starts up.
I want a script to throw off another script and go on with its business.
It would appear that Fork might the the answer, but so far RTFM'ing about
Fork is getting me even more confused.
Any other way?
Thanks
Tom W
------------------------------
Date: Sat, 2 Aug 2008 17:25:50 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: Is there a way to spawn a program from perl that is independent?
Message-Id: <edeem5-a99.ln1@osiris.mauzo.dyndns.org>
Quoth Tom Wyley <twxxxxxx@hooya.com>:
> That is...
>
> Backtics and System will start up a new program but it is modal - to get
> back to the original script the spawned program must be closed.
>
> Exec kills the original script when the spawned program starts up.
>
> I want a script to throw off another script and go on with its business.
>
> It would appear that Fork might the the answer, but so far RTFM'ing about
> Fork is getting me even more confused.
perldoc -q background.
I would recommend IPC::Run.
Ben
--
I've seen things you people wouldn't believe: attack ships on fire off
the shoulder of Orion; I watched C-beams glitter in the dark near the
Tannhauser Gate. All these moments will be lost, in time, like tears in rain.
Time to die. ben@morrow.me.uk
------------------------------
Date: Sat, 02 Aug 2008 16:45:49 GMT
From: Jürgen Exner <jurgenex@hotmail.com>
Subject: Re: Is there a way to spawn a program from perl that is independent?
Message-Id: <c93994975ijqhjqkldqbgnc7oadisu6idq@4ax.com>
Tom Wyley <twxxxxxx@hooya.com> wrote:
>Backtics and System will start up a new program but it is modal - to get
>back to the original script the spawned program must be closed.
Well, kind of. You can always run the external program in the background
(by whatever means your OS provides) in which case the shell will
return immediately after kicking off the background program.
>Exec kills the original script when the spawned program starts up.
That's what it is designed to do, yes.
>I want a script to throw off another script and go on with its business.
>It would appear that Fork might the the answer, but so far RTFM'ing about
>Fork is getting me even more confused.
fork() is really simply. You get two identical copies of your Perl
process except for their respective process id's and the return value of
their respective fork() calls.
One of them, usually the parent, you just let continue to run.
The other, usually the child, you replace immediately with the program
you want to run using exec().
jue
------------------------------
Date: 2 Aug 2008 16:51:28 GMT
From: jt@toerring.de (Jens Thoms Toerring)
Subject: Re: Is there a way to spawn a program from perl that is independent?
Message-Id: <6fjhkgFbu8o3U1@mid.uni-berlin.de>
Tom Wyley <twxxxxxx@hooya.com> wrote:
> Backtics and System will start up a new program but it is modal - to get
> back to the original script the spawned program must be closed.
> Exec kills the original script when the spawned program starts up.
> I want a script to throw off another script and go on with its business.
> It would appear that Fork might the the answer, but so far RTFM'ing about
> Fork is getting me even more confused.
> Any other way?
Why any other way than fork() when fork() is the correct way?
Just call it and (in case of success) you have a new process.
Something like
if ( fork() == 0 ) {
print "This is the new process\n";
exec( 'new_script' );
}
print "Parent: Just spawned a new process\n";
creates a new process (if fork() returns 0 you're running in the
new process, if it returns anything else you're still in the old
process).
What are you getting confused about with fork()?
Regards, Jens
--
\ Jens Thoms Toerring ___ jt@toerring.de
\__________________________ http://toerring.de
------------------------------
Date: Sat, 2 Aug 2008 04:42:21 GMT
From: merlyn@stonehenge.com (Randal Schwartz)
Subject: new CPAN modules on Sat Aug 2 2008
Message-Id: <K4yIEL.8zG@zorch.sf-bay.org>
The following modules have recently been added to or updated in the
Comprehensive Perl Archive Network (CPAN). You can install them using the
instructions in the 'perlmodinstall' page included with your Perl
distribution.
Apache-SWIT-Security-0.02
http://search.cpan.org/~bosu/Apache-SWIT-Security-0.02/
security subsystem for Apache::SWIT
----
Apache2-ASP-1.56_1
http://search.cpan.org/~johnd/Apache2-ASP-1.56_1/
Perl extension for ASP on mod_perl2.
----
Apache2-ASP-1.56_2
http://search.cpan.org/~johnd/Apache2-ASP-1.56_2/
Perl extension for ASP on mod_perl2.
----
Array-Tour-0.03
http://search.cpan.org/~jgamble/Array-Tour-0.03/
Base class for Array Tours.
----
Business-ISRC-0.01
http://search.cpan.org/~bonar/Business-ISRC-0.01/
Perl extension for manipulating International Standard Recording Code (ISRC)
----
Carp-Undead-0.00002
http://search.cpan.org/~nishikawa/Carp-Undead-0.00002/
override die function and warn function;
----
Catalyst-Controller-POD-0.02
http://search.cpan.org/~perler/Catalyst-Controller-POD-0.02/
Serves PODs right from your Catalyst application
----
Class-AlzaboWrapper-0.14
http://search.cpan.org/~drolsky/Class-AlzaboWrapper-0.14/
Higher level wrapper around Alzabo Row and Table objects
----
Class-DBI-Lite-0.007
http://search.cpan.org/~johnd/Class-DBI-Lite-0.007/
Lightweight ORM for Perl
----
Color-Fade-0.02
http://search.cpan.org/~kirsle/Color-Fade-0.02/
Perl extension for fading text colors.
----
DBD-Oracle-1.22
http://search.cpan.org/~pythian/DBD-Oracle-1.22/
Oracle database driver for the DBI module
----
DBIx-Class-Fixtures-1.001001
http://search.cpan.org/~lsaunders/DBIx-Class-Fixtures-1.001001/
----
DBIx-Class-Graph-0.02
http://search.cpan.org/~perler/DBIx-Class-Graph-0.02/
Represent a graph in a relational database using DBIC
----
DJabberd-0.84_01
http://search.cpan.org/~bradfitz/DJabberd-0.84_01/
scalable, extensible Jabber/XMPP server.
----
Daemon-Simple-0.03
http://search.cpan.org/~khs/Daemon-Simple-0.03/
Perl extension for making script as daemon with start|stop controlling on unix system
----
DateTime-Format-Natural-0.71_02
http://search.cpan.org/~schubiger/DateTime-Format-Natural-0.71_02/
Create machine readable date/time with natural parsing logic
----
Deliantra-1.21
http://search.cpan.org/~mlehmann/Deliantra-1.21/
Deliantra suppport module to read/write archetypes, maps etc.
----
Deliantra-Client-0.9974
http://search.cpan.org/~mlehmann/Deliantra-Client-0.9974/
----
Finance-QIF-3.00
http://search.cpan.org/~mmcgillis/Finance-QIF-3.00/
Parse and create Quicken Interchange Format files
----
GRID-Machine-0.098
http://search.cpan.org/~casiano/GRID-Machine-0.098/
Remote Procedure Calls over a SSH link
----
GRID-Machine-0.099
http://search.cpan.org/~casiano/GRID-Machine-0.099/
Remote Procedure Calls over a SSH link
----
Geometry-Primitive-0.06
http://search.cpan.org/~gphat/Geometry-Primitive-0.06/
Primitive Geometry Entities
----
Graphics-Primitive-0.09
http://search.cpan.org/~gphat/Graphics-Primitive-0.09/
Device and library agnostic graphic primitives
----
Graphics-Primitive-0.10
http://search.cpan.org/~gphat/Graphics-Primitive-0.10/
Device and library agnostic graphic primitives
----
Graphics-Primitive-Driver-Cairo-0.02
http://search.cpan.org/~gphat/Graphics-Primitive-Driver-Cairo-0.02/
Cairo backend for Graphics::Primitive
----
Graphics-Primitive-Driver-Cairo-0.03
http://search.cpan.org/~gphat/Graphics-Primitive-Driver-Cairo-0.03/
Cairo backend for Graphics::Primitive
----
Hey-heyPass-2.08
http://search.cpan.org/~wilsond/Hey-heyPass-2.08/
Client for heyPass Centralized Authentication System
----
Image-BoxModel-0.13
http://search.cpan.org/~mbp/Image-BoxModel-0.13/
Module for defining boxes on an image and putting things on them
----
Mail-Barracuda-API-0.01
http://search.cpan.org/~jauer/Mail-Barracuda-API-0.01/
Manage Barracuda Antispam Appliance
----
Net-Jifty-0.07
http://search.cpan.org/~sartak/Net-Jifty-0.07/
interface to online Jifty applications
----
Net-XMPP2-0.14
http://search.cpan.org/~elmex/Net-XMPP2-0.14/
An implementation of the XMPP Protocol
----
POE-Component-CPANPLUS-YACSmoke-1.36
http://search.cpan.org/~bingos/POE-Component-CPANPLUS-YACSmoke-1.36/
Bringing the power of POE to CPAN smoke testing.
----
POE-Component-SNMP-1.1001
http://search.cpan.org/~rdb/POE-Component-SNMP-1.1001/
POE interface to Net::SNMP
----
POE-Component-WWW-Cache-Google-0.0101
http://search.cpan.org/~zoffix/POE-Component-WWW-Cache-Google-0.0101/
non-blocking wrapper around WWW::Cache::Google
----
Pod-Browser-0.01
http://search.cpan.org/~perler/Pod-Browser-0.01/
Pod Web Server based on Catalyst and ExtJS
----
PowerDNS-Backend-MySQL-0.08
http://search.cpan.org/~augie/PowerDNS-Backend-MySQL-0.08/
Provides an interface to manipulate PowerDNS data in the MySQL Backend.
----
RDF-Redland-Model-ExifTool-0.01
http://search.cpan.org/~arnhemcr/RDF-Redland-Model-ExifTool-0.01/
extends Redland set of RDF statements (RDF::Redland::Model) to process Exif meta data from ExifTool (Image::ExifTool) into RDF statements
----
RPC-JSON-0.14
http://search.cpan.org/~chrisc/RPC-JSON-0.14/
JSON-RPC Client Library
----
Rose-DBx-AutoReconnect-0.01
http://search.cpan.org/~karman/Rose-DBx-AutoReconnect-0.01/
Rose::DB with auto-reconnect to server
----
Rose-DBx-AutoReconnect-0.02
http://search.cpan.org/~karman/Rose-DBx-AutoReconnect-0.02/
Rose::DB with auto-reconnect to server
----
Sub-Throttle-0.01
http://search.cpan.org/~kazuho/Sub-Throttle-0.01/
Throttle load of perl function
----
TRD-DebugLog-0.0.5
http://search.cpan.org/~ichi/TRD-DebugLog-0.0.5/
debug log
----
TRD-DebugLog-0.0.6
http://search.cpan.org/~ichi/TRD-DebugLog-0.0.6/
debug log
----
TRD-Uranai-0.0.1
http://search.cpan.org/~ichi/TRD-Uranai-0.0.1/
Today's Uranai Count down.
----
TRD-Velocity-0.0.5
http://search.cpan.org/~ichi/TRD-Velocity-0.0.5/
Template engine
----
Task-Smoke-0.17
http://search.cpan.org/~gaal/Task-Smoke-0.17/
Install modules required for Pugs-like smoke system
----
Task-Smoke-0.18
http://search.cpan.org/~gaal/Task-Smoke-0.18/
Install modules required for Pugs-like smoke system
----
Task-Smoke-0.19
http://search.cpan.org/~gaal/Task-Smoke-0.19/
Install modules required for Pugs-like smoke system
----
Template-Declare-0.29
http://search.cpan.org/~sartak/Template-Declare-0.29/
Perlish declarative templates
----
Test-Differences-0.49_01
http://search.cpan.org/~ovid/Test-Differences-0.49_01/
Test strings and data structures and show differences if not ok
----
Text-CSV-1.07
http://search.cpan.org/~makamaka/Text-CSV-1.07/
comma-separated values manipulator (using XS or PurePerl)
----
TheSchwartz-1.07
http://search.cpan.org/~bradfitz/TheSchwartz-1.07/
reliable job queue
----
WSRF-Lite-0.8.2.2.1
http://search.cpan.org/~ekawas/WSRF-Lite-0.8.2.2.1/
Implementation of the Web Service Resource Framework
----
WSRF-Lite-0.8.2.2.2
http://search.cpan.org/~ekawas/WSRF-Lite-0.8.2.2.2/
Implementation of the Web Service Resource Framework
----
WSRF-Lite-0.8.2.2.3
http://search.cpan.org/~ekawas/WSRF-Lite-0.8.2.2.3/
Implementation of the Web Service Resource Framework
----
WWW-RapidShare-v0.3
http://search.cpan.org/~rohan/WWW-RapidShare-v0.3/
Download files from Rapidshare
----
WordPress-XMLRPC-1.18
http://search.cpan.org/~leocharre/WordPress-XMLRPC-1.18/
api to wordpress rpc
----
XML-Compile-0.91
http://search.cpan.org/~markov/XML-Compile-0.91/
Compilation based XML processing
----
XML-Compile-Cache-0.13
http://search.cpan.org/~markov/XML-Compile-Cache-0.13/
Cache compiled XML translators
----
XML-Compile-SOAP-0.76
http://search.cpan.org/~markov/XML-Compile-SOAP-0.76/
base-class for SOAP implementations
----
o2sms-3.29
http://search.cpan.org/~mackers/o2sms-3.29/
A module to send SMS messages using the website of O2 Ireland
----
re-engine-Lua-0.04
http://search.cpan.org/~perrad/re-engine-Lua-0.04/
Lua regular expression engine
----
re-engine-Lua-0.05
http://search.cpan.org/~perrad/re-engine-Lua-0.05/
Lua regular expression engine
----
v6-0.032
http://search.cpan.org/~fglock/v6-0.032/
An experimental Perl 6 implementation
If you're an author of one of these modules, please submit a detailed
announcement to comp.lang.perl.announce, and we'll pass it along.
This message was generated by a Perl program described in my Linux
Magazine column, which can be found on-line (along with more than
200 other freely available past column articles) at
http://www.stonehenge.com/merlyn/LinuxMag/col82.html
print "Just another Perl hacker," # the original
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Smalltalk/Perl/Unix consulting, Technical writing, Comedy, etc. etc.
See http://methodsandmessages.vox.com/ for Smalltalk and Seaside discussion
------------------------------
Date: Sat, 02 Aug 2008 19:14:04 GMT
From: sln@netherlands.com
Subject: Node ToolKit. __Was __ Re:C linked lists in Perl
Message-Id: <u8c994ptb215l82vik29d0qovtcof53m2o@4ax.com>
On Wed, 16 Jul 2008 13:11:24 -0700 (PDT), cartercc <cartercc@gmail.com> wrote:
>I guess like almost everybody, I like to discuss (argue) the merits of
>different technologies. In my world, the big two are Java and
>ColdFusion. Recently, we had someone with a background in embedded
>systems who has been advocating C. The conversation goes something
>like this:
>
>him - Does Perl have linked lists?
>me - No.
>him - Therefore, C is better than Perl because it has linked lists.
>me - But Perl has other data structures that are easier to use than
>linked lists.
>him - So what? Perl still doesn't have linked lists.
>
>I've never studied linked lists and certainly never coded one (in C or
>anything else) but it aroused my curiosity. So after searching on
>c.l.p.m. and online, I decided to see if I couldn't do a linked list
>in Perl. My first thought is to do something like this:
>
>%linked_list{$key} = { prev => $linked_list{$prev_key}{prev},
> value => $value,
> next => $linked_list{$next_key}
>{next} };
>
>I know that most people will think I'm an absolute moron for thinking
>about this (and they likely would be right), but CAN you do a linked
>list in Perl (never mind that you would never want to), and if so, how
>would you go about it?
>
>My motive is to say to my C friend, "Nya, nya, nya."
>
>Thanks, CC.
I think C++ is better than Perl. If you don't know C++, I think Perl is better.
I have a little starter toolkit here for double linked lists. Don't worry if you
only need single lists, it still works.
Like all Lists, the only ambiguity is data. For these functions, I've left the data
allocation function "new_node()" at the top. Insert your own schema there.
This caveat and a few others prevent me from formalizing Lists in classes.
Many other functions should be added here before that takes place.
As it is, these are Node primitaves. More need to be added, a formalization process
needs to take place. For instance, binary tree's, joins, non-destructive unlink, etc..
All in all, I still don't see a need for Lists in Perl, maybe you can find one or two.
In the below functions, all Node removals and List destructions are Destructive,
ie: the Node (anonymous hash) themselves are destroyed. All future references to them
become "undef"ined. Thus adding a few more non-destructive functions will give the option
to plug them into somewhere else.
There are probably bugs, I didn't have time to test it all..
sln
## nodes.pl
## robic0@adelphia.net (my spam mailbox, but I read it)
##
use strict;
use warnings;
### Exercise List Creation and Destruction,
### the bare minimum.
### ---------------------------------------
# Create a new List with 1,000,000 nodes
#-
my $ListHead = CreateList();
my $ListTail = $ListHead;
my $curnode = $ListTail;
$curnode->{data}->{val} = 0;
print "\nAdding 1,000,000 nodes\n";
for (my $i=1; $i<1000000; $i++)
{
$curnode = CreateTail( $curnode );
$curnode->{data}->{val} = $i;
$ListTail = $curnode;
}
print "Done, sleeping 5 seconds\n";
sleep(5);
# Destroy it
#-
print "\nDestroying List\n";
DestroyList( $ListHead );
print "Done\n";
# Create a different List with 1,500,000 nodes
#-
$ListHead = CreateList();
$ListTail = $ListHead;
$curnode = $ListTail;
$curnode->{data}->{val} = 0;
print "\nAdding 1,500,000 nodes\n";
for (my $i=1; $i<1500000; $i++)
{
$curnode = CreateTail( $curnode );
$curnode->{data}->{val} = $i;
$ListTail = $curnode;
}
print "Done, sleeping 5 seconds\n";
sleep(5);
# Destroy it
#-
print "\nDestroying List\n";
DestroyList( $ListHead );
print "Done\n";
# Traverse the list from the Head, print data
#-
print "\nTraverse list from Head -\n";
$curnode = $ListHead;
while (defined $curnode)
{
if (defined $curnode->{data}->{val}) {
print "data is: val = $curnode->{data}->{val}\n";
}
$curnode = $curnode->{next};
}
print "sleeping 2 seconds\n";
sleep(2);
# Traverse the list from the Tail, print data
#-
print "\nTraverse list from Tail -\n";
$curnode = $ListTail;
while (defined $curnode)
{
if (defined $curnode->{data}->{val}) {
print "data is: val = $curnode->{data}->{val}\n";
}
$curnode = $curnode->{prev};
}
## =================================
## Node Functions
## =================================
# Make a new node
# Parameters- none
# Return - ref to a new node
# -
sub new_node
{
my $node = {
# Node Header
prev => undef,
next => undef,
# Node Data
data => {val => undef}
};
return $node;
}
# Create a new List
# Parameters - None
# Return - ref to a created List (ListHead)
# -
sub CreateList
{
return new_node();
}
# Destroy the List given any Node
# Parameters - $Node = any node in the List
# Return - None
# Notes - Destructive on all List node's
# -
sub DestroyList
{
my $Node = shift;
if (defined $Node)
{
TruncateListAfter( $Node );
TruncateListBefore( $Node );
undef (%{$Node});
}
}
# Create a new List Head from the given Node
# Parameters - $Node = find the head from this node, prepend new created head,
# creates new List if undef
# Return - ref to a created node (ListHead)
# -
sub CreateHead
{
my $Node = shift;
if (defined $Node)
{
while (defined $Node->{prev}) {
$Node = $Node->{prev};
}
}
return CreateHeadAtNode( $Node );
}
# Create a new List Tail from the given Node
# Parameters - $Node = find the tail from this node, append new created tail,
# creates new List if undef
# Return - ref to a created node (ListTail)
# Notes - Destructive on truncated node's
# -
sub CreateTail
{
my $Node = shift;
if (defined $Node)
{
while (defined $Node->{next}) {
$Node = $Node->{next};
}
}
return CreateTailAtNode( $Node );
}
# Create a new Head before Node, removes leading node's
# Parameters - $Node = node to prepend new head,
# creates new List if undef
# Return - ref to a created node (ListHead)
# -
sub CreateHeadAtNode
{
my $Node = shift;
my $ret = undef;
if (defined $Node)
{
my $newnode = new_node();
if (defined $Node->{prev}) {
TruncateListBefore( $Node );
}
$newnode->{next} = $Node;
$Node->{prev} = $newnode;
$ret = $newnode;
} else {
$ret = new_node();
}
return $ret;
}
# Create a new Tail after Node, removes trailing node's
# Parameters - $Node = node to append new tail,
# creates new List if undef
# Return - ref to a created node (ListTail)
# Notes - Destructive on truncated node's
# -
sub CreateTailAtNode
{
my $Node = shift;
my $ret = undef;
if (defined $Node)
{
my $newnode = new_node();
if (defined $Node->{next}) {
TruncateListAfter( $Node );
}
$newnode->{prev} = $Node;
$Node->{next} = $newnode;
$ret = $newnode;
} else {
$ret = new_node();
}
return $ret;
}
# Add the passed in Node to the List as its new Head
# Parameters - $Node = find the head from this node, prepend new head
# - $NewNode = the new node
# Return - ref to the added node (ListHead)
# -
sub AddHead
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
while (defined $Node->{prev}) {
$Node = $Node->{prev};
}
$ret = AddHeadAtNode( $Node, $NewNode );
}
return $ret;
}
# Add the passed in Node to the List as its new Tail
# Parameters - $Node = find the tail from this node, append new tail
# - $NewNode = the new node
# Return - ref to the added node (ListTail)
# -
sub AddTail
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
while (defined $Node->{next}) {
$Node = $Node->{next};
}
$ret = AddTailAtNode( $Node, $NewNode );
}
return $ret;
}
# Add a new Head before Node, removes leading nodes
# Parameters - $Node = node to prepend new head
# - $NewNode = the new node
# Return - ref to the added node (ListHead)
# Notes - Destructive on truncated node's
# -
sub AddHeadAtNode
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
my $newnode = $NewNode;
if (defined $Node->{prev}) {
TruncateListBefore( $Node );
}
$newnode->{next} = $Node;
$Node->{prev} = $newnode;
$ret = $newnode;
}
return $ret;
}
# Add a new Tail after Node, removes trailing nodes
# Parameters - $Node = node to append new tail
# - $NewNode = the new node
# Return - ref to the added node (ListTail)
# Notes - Destructive on truncated node's
# -
sub AddTailAtNode
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
my $newnode = $NewNode;
if (defined $Node->{next}) {
TruncateListAfter( $Node );
}
$newnode->{prev} = $Node;
$Node->{next} = $newnode;
$ret = $newnode;
}
return $ret;
}
# Truncate a List after a Node (Node is intact)
# Parameters - $Node = node to disconnect from
# Return - None
# Notes - Destructive on truncated node's
# -
sub TruncateListAfter
{
my $Node = shift;
if (defined $Node)
{
my $curnode = $Node->{next};
while (defined $curnode)
{
my $nextnode = $curnode->{next};
undef (%{$curnode});
$curnode = $nextnode;
}
$Node->{next} = undef;
}
}
# Truncate a List before a Node (Node is intact)
# Parameters - $Node = node to disconnect from
# Return - None
# Notes - Destructive on truncated node's
# -
sub TruncateListBefore
{
my $Node = shift;
if (defined $Node)
{
my $curnode = $Node->{prev};
while (defined $curnode)
{
my $prevnode = $curnode->{prev};
undef (%{$curnode});
$curnode = $prevnode;
}
$Node->{prev} = undef;
}
}
# Create a new node after a node
# Parameters - $Node = node to append to
# Return - ref to a created node
# -
sub CreateNextNode
{
my $Node = shift;
return InsertNextNode( $Node, new_node() );
}
# Create a new node before a node
# Parameters - $Node = node to prepend to
# Return - ref to a created node
# -
sub CreatePrevNode
{
my $Node = shift;
return InsertPrevNode( $Node, new_node() );
}
# Insert a passed in node after a node
# Parameters - $Node = node to append to
# - $NewNode = the new node
# Return - ref to the inserted node
# -
sub InsertNextNode
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
my $newnode = $NewNode;
my $nextnode = $Node->{next};
if (defined $nextnode) {
$nextnode->{prev} = $newnode;
$newnode->{next} = $nextnode;
}
$newnode->{prev} = $Node;
$Node->{next} = $newnode;
$ret = $newnode;
}
return $ret;
}
# Insert a passed in node before a node
# Parameters - $Node = node to prepend to
# - $NewNode = the new node
# Return - ref to the inserted node
# -
sub InsertPrevNode
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
my $newnode = $NewNode;
my $prevnode = $Node->{prev};
if (defined $prevnode) {
$prevnode->{next} = $newnode;
$newnode->{prev} = $prevnode;
}
$newnode->{next} = $Node;
$Node->{prev} = $newnode;
$ret = $newnode;
}
return $ret;
}
# Remove node from list
# Parameters - $Node = node ref
# Return - ref to next node
# Notes - Destructive on Node
# -
sub RemoveNodeRetNext
{
my $Node = shift;
my $ret = undef;
if (defined $Node)
{
my $nextnode = $Node->{next};
my $prevnode = $Node->{prev};
undef (%{$Node});
if (defined $nextnode && defined $prevnode) {
$nextnode->{prev} = $prevnode;
$prevnode->{next} = $nextnode;
$ret = $nextnode;
} elsif (defined $nextnode) {
$nextnode->{prev} = undef;
$ret = $nextnode;
} elsif (defined $prevnode) {
$prevnode->{next} = undef;
}
}
return $ret;
}
# Remove node from list
# Parameters - $Node = node ref
# Return - ref to prev node
# Notes - Destructive on Node
# -
sub RemoveNodeRetPrev
{
my $Node = shift;
my $ret = undef;
if (defined $Node)
{
my $nextnode = $Node->{next};
my $prevnode = $Node->{prev};
undef (%{$Node});
if (defined $nextnode && defined $prevnode) {
$nextnode->{prev} = $prevnode;
$prevnode->{next} = $nextnode;
$ret = $prevnode;
} elsif (defined $prevnode) {
$prevnode->{next} = undef;
$ret = $prevnode;
} elsif (defined $nextnode) {
$nextnode->{prev} = undef;
}
}
return $ret;
}
__END__
Output:
c:\>perl nodes.pl
Adding 1,000,000 nodes
Done, sleeping 5 seconds
Destroying List
Done
Adding 1,500,000 nodes
Done, sleeping 5 seconds
Destroying List
Done
Traverse list from Head -
sleeping 2 seconds
Traverse list from Tail -
C:\>
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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.
#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 V11 Issue 1763
***************************************
