[19649] in Perl-Users-Digest
Perl-Users Digest, Issue: 1844 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Sep 30 00:05:31 2001
Date: Sat, 29 Sep 2001 21:05:06 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <1001822706-v10-i1844@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Sat, 29 Sep 2001 Volume: 10 Number: 1844
Today's topics:
Re: carriage return <goldbb2@earthlink.net>
Re: DBI/MySQL "$sth->fetch" help needed <goldbb2@earthlink.net>
Re: File I/O Problem <goldbb2@earthlink.net>
Re: GIF encoding <goldbb2@earthlink.net>
Re: GIF encoding (Martien Verbruggen)
Re: HTML substitution <bwalton@rochester.rr.com>
Re: HTML substitution <jurgenex@hotmail.com>
Re: including local file in .cgi <michael@heiming.de>
Limitation <sun_tong@users.sourceforge.net>
Re: Mission Statement for this newsgroup? (Garry Williams)
newbie question (bal)
Re: newbie question (Mark Jason Dominus)
Re: newbie question <echang@netstorm.net>
Programming wvdial frontend <Crazydj@web.de>
Re: Sorting by version number... <goldbb2@earthlink.net>
Re: Sourcing Things in Perl ? <goldbb2@earthlink.net>
Re: testing the "flatness" of a structured file <goldbb2@earthlink.net>
Re: validating handle to perl module <goldbb2@earthlink.net>
Re: warnings with cgi will crash Win32 perl core (Joe Smith)
Re: who said this? <sun_tong@users.sourceforge.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 29 Sep 2001 20:17:39 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: carriage return
Message-Id: <3BB664A3.9FD73CC1@earthlink.net>
Michael wrote:
>
> "Graham Wood" <Graham.T.Wood@oracle.com> wrote in message
> news:3BB317B0.21D68E64@oracle.com...
> > Michael wrote:
> >
> > > How do I replace carriage ruturn character with a space?
> > > s/\n/ /g or s/\r\n/ /g can't work.
> > >
> > > Michael
> >
> > In what context are you trying to do this and why can't they work?
> >
> > Graham Wood
> >
>
> I am trying to handle the content in "comments" area (in a text box
> from form submission), replacing all carriage returns with spaces, so
> it turns into a regular string that can be carried into a query
> string, then a remote server can accept it.
There's a lot more to do to make an arbitrary string into something
which will be safe to use as part of a query string than just changing
newlines to spaces.
You need to urlencode it... convert those characters which are special
in urls into url-escapes... which are %xx where xx is a two digit
hexidecimal number.
I would advise against doing roll-your-own. Use a library.
use URI::Escape;
my $encoded = uri_escape( $textarea );
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Sat, 29 Sep 2001 23:44:44 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: DBI/MySQL "$sth->fetch" help needed
Message-Id: <3BB6952C.221527F1@earthlink.net>
martinblack wrote:
>
> Hi, I am having trouble with a DBI script. I can't seem to access the
> rows returned from the SQL command. I have tried numerous methods to
> grab the rows, but no such luck. I am not getting any error messages
> from this script, and I am at my wits end. Any help would be very much
> appreciated. Thanks in advance.
> Cheers.
> Martinblack.
>
> Below is a copy of the script:
>
> #!/usr/bin/perl
#!/usr/bin/perl -w
use strict;
> BEGIN {
> open (STDERR, ">html/error.txt");
> }
use CGI::Carp qw(fatalsToBrowser carpout);
BEGIN {
open( local(*LOG), ">>html/error.txt" )
or die "Unable to open html/error.txt: $!";
carpout(*LOG);
}
> ### search.cgi
>
> use CGI qw/:standard/;
I would just do:
use CGI;
until I find I need something more than that...
like this:
use CGI qw(*table);
> use DBI;
> $q = new CGI;
If you're not using mod_perl, and you aren't dealing with more than one
CGI connection, you probably don't want the object oriented interface to
CGI... the functional interface is nicer looking, and easier to use.
Don't create $q, and remove all things which say $q->
>
> # input..................................
>
> $io{'id'} = $id = $q->param('id') || '';
> $io{'title'} = $title = $q->param('title') || '';
Why are you storing these things in %io ? You could just as easily use
$id, etc throughout.
And of course since strict is on, you need to declare your variables.
my $id = param('id') || '';
my $title = param('title') || '';
> # mainline...............................
>
> &DBstart;
Preceding subroutine calls with & went out of style with perl4. Also,
passing data around with globals is also bad style.
Also, there's no reason you can't just do this right here, without a
sub. It's not as if this ever gets used more than once per script.
my $dbh = DBI->connect(
"dbi:mysql:blabla:localhost",
"myusername", "mypassword",
{ RaiseError=>1 }
) or die $DBI::errstr;
my $sth;
> if (defined $io{'id'} && $io{'id'} ne '') {
You've already made sure that the id isn't '', because of the || '' that
you did. And you should be using $id here.
if( $id ) {
> ($company_id, $product_id) =
> $id=~/^([A-Za-z]{1,3})\-([A-Za-z\-0-9]{1,})$/;
> &clean($company_id);
> &clean($product_id);
> $SQL = "select company_id, product_id, title,
> description, spex, price, sex
> from product
> where product_id='$product_id' and
> company_id='$company_id';";
> &Do_SQL;
$sth = $dbh->prepare( qq[
SELECT *
FROM product
WHERE product_id = ? AND company_id = ?
] );
$sth->execute( split /-/, $id, 2 );
> #print "Content-type: text/html\n\n";
> #print "hi \n Here's the first command: $SQL";
> #$dbh->disconnect || die "disconnection problem: ", $dbh->errstr;
> #exit;
>
> } else {
> &clean($title);
> $SQL = "select company_id, product_id, title,
> description, spex, price, sex
> from product
> where title='$title';";
>
> #print "Content-type: text/html\n\n";
> #print "hi \n Here's the second command: $SQL";
> #$dbh->disconnect || die "disconnection problem: ", $dbh->errstr;
> #exit;
> &Do_SQL;
$sth = $dbh->prepare( q[
SELECT *
FROM product
WHERE title = ?
] );
$sth->execute( $title );
> }
>
> eval {&fetch_results;};
> if($@){
> $dbh->disconnect;
> print "Content-type: text/html\n\n";
> print "An ERROR occurred! $@\n";
> exit;
> }
No need for you to do the eval and test of $@, since CGI::Carp installs
a special handler for die.
Anyway..
$sth->{FetchHashKeyName} = "NAME_lc";
my $onerow = $sth->fetchrow_hashref;
$sth->finish; # because we only got one row, call this.
>
> &print_results;
print header, start_html("Search Thing");
print font {size=>6,align=>center}, "Search Results";
print start_table {border=>1, cellspacing=>0};
print Tr td {bgcolor=>"#c0c0c0",colspan=>6,align=>center}, b
"MySQL/Perl Integration Example";
print Tr map {
td {bgcolor=>"#c0c0c0"},
font {size=>2, face=>"arial", align=>center},
b($onerow->{$_}), "= ", $_
} qw(id title description spex price sex);
print end_html;
exit;
> $sth->finish() || die "finish problem: ", $sth->errstr;
Best place to do finish is right after you finish using the statement
handle.
> $dbh->disconnect || die "disconnection problem: ", $dbh->errstr;
If you only connect for reading from the db, there's no need to
explicitly disconnect, as this will happen when you exit the script
without problems.
>
> exit;
>
> # the subs are coming.............................
>
> sub fetch_results {
>
> while ($x = $sth->fetchrow_hashref) {
> $com = $x->{'company_id'};
> $pro = $x->{'product_id'};
> $tit = $x->{'title'};
> $des = $x->{'description'};
> $spe = $x->{'spex'};
> $pri = $x->{'price'};
> $morf = $x->{'sex'};
> $newid = $com ."-".$pro;
> }
>
> $sth->execute;
> }
You need to do the execute *before* fetch is called. Looking through
your code, I see that you do that... meaning that this call *after* is
utterly pointless.
Also, as I've said, passing data to the calling function via globals,
rather than via returning something is generally dumb.
>
> #sub alternate {
>
> # my($com, $pro, $tit, $des, $spe, $pri, $morf);
> # $sth->bind_columns(undef, \$com, \$pro, \$tit, \$des, \$spe,
> \$pri, \$morf) || die "bind problem: ", $sth->errstr;
>
> # while ($sth->fetch) {
> # print "Content-type: text/html\n\n";
> # print "hi\n";
> # print join("\t", $com, $pro, $tit, $des, $spe, $pri, $morf),
> "\n";
> # exit;
> # }
> #}
Why did you include this here? When asking folks on the web to help
you, you should try to give the minimal amount of code which
demonstrates your problem.
> sub print_results {
>
> print <<HTML;
>
> <HTML><HEAD><TITLE>Search Thing</TITLE></HEAD>
> <BODY BGCOLOR="#FFFFFF">
> <CENTER><FONT SIZE=6>Search Results</FONT></CENTER>
> <HR WIDTH=80%>
> <P>
> <CENTER><TABLE BORDER=1 CELLSPACING=0>
> <TR>
> <TD BGCOLOR="#c0c0c0" COLSPAN=6>
> <CENTER><B>MySQL/Perl Integration Example</B></CENTER>
> </TD>
> </TR>
> <TR>
> <TD BGCOLOR="c0c0c0">
> <FONT SIZE=2 FACE=ARIAL><CENTER><B>id</B>=
> $newid</CENTER></FONT></TD>
> <TD BGCOLOR="c0c0c0">
> <FONT SIZE=2 FACE=ARIAL><CENTER><B>title</B>=
> $tit</CENTER></FONT></TD>
> <TD BGCOLOR="c0c0c0">
> <FONT SIZE=2 FACE=ARIAL><CENTER><B>description</B>=
> $des</CENTER></FONT></TD>
> <TD BGCOLOR="c0c0c0">
> <FONT SIZE=2 FACE=ARIAL><CENTER><B>spex</B>=
> $spe</CENTER></FONT></TD>
> <TD BGCOLOR="c0c0c0">
> <FONT SIZE=2 FACE=ARIAL><CENTER><B>price</B>=
> $pri</CENTER></FONT></TD>
> <TD BGCOLOR="c0c0c0">
> <FONT SIZE=2 FACE=ARIAL><CENTER><B>sex</B>=
> $morf</CENTER></FONT></TD>
> </TR>
> HTML
>
> }
Any time you are repeating stuff, alot, use a loop.
>
> sub DBstart() {
> $DBname= "dbi:mysql:blabla";
> $DBhost = "localhost";
> $DBusername = "myuname";
> $DBpassword = "mypswrd";
>
> $dbh = DBI->connect("$DBname:$DBhost", $DBusername, $DBpassword) ||
> die "connection problem: ", $dbh->errstr;
> $dbh->{'RaiseError'} = 1;
> $dbh;
>
> }
This is short enough to get rid of the function call.
> sub Do_SQL{
> eval{
> $sth = $dbh->prepare($SQL);
> };
>
> if($@){
> $dbh->disconnect;
> print "Content-type: text/html\n\n";
> print "An ERROR occurred! $@\n";
> exit;
> } else {
> $sth->execute;
> }
> return ($sth);
> }
using CGI::Carp eliminates the need for this.
>
> sub clean {
> $_[0]=~s/\'/\\\'/g;
> return $_[0];
> }
Passing parameters to the query via execute eliminates the need for
this.
> sub disconnect{
> $dbh->disconnect || die "disconnection problem: ", $dbh->errstr;
> }
Not needed. The dbh disconnects automatically when we exit. Only if
you were inserting or updating would you have to do it explicitly.
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Sat, 29 Sep 2001 18:14:03 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: File I/O Problem
Message-Id: <3BB647AB.110BE7DC@earthlink.net>
RICHARD BROMBERG wrote:
>
> I am learning Perl . The following code generates an error on the
> fourth line, the "print" statement . Any idea what's wrong.
>
> #! /perl/work -w
> print ("\nPerl program running\n ");
> open("mydata",">>filea") || die "Opening filea ... $! ";
> print "mydata" "abc";
> close "mydata" || die ;
If you want to use a string, like "mydata" as a filehandle, then you
need to put it in a block for print to work:
open("mydata",">>filea") || die "Opening filea ... $! ";
print { "mydata" } "abc";
close "mydata" || die ;
Using a bareword [well, actually a glob, but it's *written* as a
bareword], or a variable is the preferred thing to do:
open( MYDATA, ">>filea" ) ....
or
open( my ($mydata), ">>filea" ) ....
Both of these will work with print without needing the block:
print MYDATA "abc";
or
print $mydata "abc";
Note that for before 5.6, you can't depend on open to fill in $mydata
with a filehandle, and need to do it yourself:
my $mydata = do {\local *X};
open( $mydata, ">>filea" ) ...
NB: none of this code is tested.
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Sat, 29 Sep 2001 20:25:27 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: GIF encoding
Message-Id: <3BB66677.AD36BB3E@earthlink.net>
Martien Verbruggen wrote:
>
> On Thu, 27 Sep 2001 05:35:18 GMT,
> Steve Spivey <sspivey3@tampabay.rr.com> wrote:
> > Does anyone know o a good GIF encoding script? I need to create a
> > pic on the fly, but I don't know anything about how to encode the
> > pixels.
> >
> > I know the file format, so if the script can just encode, then I can
> > build the GIF.
>
> You're confusing me. If you know the file format, then you know the
> 'encoding'. If you are talking about LZW compression, then you can
> forget it. The LZW compression scheme is proprietory, and is not
> allowed to be used without licensing fees being paid to Unisys.
I believe there exists an encoding scheme which produces output which
can be decoded by LZW decompressors, but which doesn't use LZW
compression. It doesn't compress the data any of course, but it will
produce something which will work with most gif viewers.
I forget the name, though.
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Sun, 30 Sep 2001 10:56:59 +1000
From: mgjv@tradingpost.com.au (Martien Verbruggen)
Subject: Re: GIF encoding
Message-Id: <slrn9rcrer.t75.mgjv@martien.heliotrope.home>
On Sat, 29 Sep 2001 20:25:27 -0400,
Benjamin Goldberg <goldbb2@earthlink.net> wrote:
> Martien Verbruggen wrote:
>>
>> On Thu, 27 Sep 2001 05:35:18 GMT,
>> Steve Spivey <sspivey3@tampabay.rr.com> wrote:
>> > Does anyone know o a good GIF encoding script? I need to create a
>> > pic on the fly, but I don't know anything about how to encode the
>> > pixels.
>> >
>> > I know the file format, so if the script can just encode, then I can
>> > build the GIF.
>>
>> You're confusing me. If you know the file format, then you know the
>> 'encoding'. If you are talking about LZW compression, then you can
>> forget it. The LZW compression scheme is proprietory, and is not
>> allowed to be used without licensing fees being paid to Unisys.
>
> I believe there exists an encoding scheme which produces output which
> can be decoded by LZW decompressors, but which doesn't use LZW
> compression. It doesn't compress the data any of course, but it will
> produce something which will work with most gif viewers.
The GIF format doesn't require LZW compression. You can write
uncompressed GIF without problems. Of course, it requires a byte per
pixel, which is hardly efficient. I don't think any LZW decompressor
comes in anywhere. The GIF data is just not compressed.
> I forget the name, though.
Are you thinking of libungif?
Martien
--
Martien Verbruggen |
Interactive Media Division | Never hire a poor lawyer. Never buy
Commercial Dynamics Pty. Ltd. | from a rich salesperson.
NSW, Australia |
------------------------------
Date: Sun, 30 Sep 2001 03:26:40 GMT
From: Bob Walton <bwalton@rochester.rr.com>
Subject: Re: HTML substitution
Message-Id: <3BB68F67.8AF9A308@rochester.rr.com>
Brady Doll wrote:
>
> I am attempting to replace a tag in an HTML file.
> I wrote a method to seperate the HTML tags and
> search for the tag. For some reason, though, it isn't
> searching all of the file.
>
> I open the file and recurse through the lines and pass
> whole lines from the file into my replace method.
>
> sub replace
> {
> ($line) = @_; # line from HTML file
> local($temp, $replace);
>
> $_ = $line;
>
> while (/([^<]*)^<([^>]*)>/)
> {
> $replace = &parse_tag($2, $line);
>
> if ($replace ne "")
> {
> $temp = "$temp$1$2$replace";
> }
> else
> {
> $temp = "$temp$1<$2>";
> }
>
> $_ =~ s/(?:[^<]*)^<(?:[^>]*)>//;
> }
>
> return $temp;
> }
>
> When passed the line:
> "<TITLE>News Update</TITLE>"
> it only looks at the <TITLE> tag and ignores the rest
> of the line. I can't figure out why this happens.
>
> when it gets into the while
> the first time through
>
> $2 = "TITLE"
>
> and when
> $_ =~ s/(?:[^<]*)^<(?:[^>]*)>//;
> is run
>
> $_ = "News Update</TITLE>"
>
> but instead of going back through the loop it ends the
> method.
>
> This method does work with "<IMG SRC="image.jpg"><IMG SRC="image2.jpg">",
> though.
>
> Can someone help me figure out what is wrong with this so I can get it to
> work
> correctly.
When I try to run your code (with the addition of a line to call your
"sub replace" with the input line you suggest), I get:
Undefined subroutine &main::parse_tag called at junk91.pl line 11,
<DATA> line 1.
Please provide a complete example we can copy/paste/execute that
exhibits the problem you are having. Thanks.
--
Bob Walton
------------------------------
Date: Sat, 29 Sep 2001 20:39:39 -0700
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: HTML substitution
Message-Id: <3bb693fc@news.microsoft.com>
[Please don't post jeopardy style\
"Brady Doll" <gte574u@prism.gatech.edu> wrote in message
news:9p3sbd$nc2$1@news-int.gatech.edu...
> The HTML tag I'm searching for is a HTML comment and I want to replace
this
> with a specific peice of data. But my problem isn't with finding the HTML
> comment or replacing it...it is as I explained in the first post.
Didn't you write your problem was
[Quote]:
> When passed the line:
> "<TITLE>News Update</TITLE>"
> it only looks at the <TITLE> tag and ignores the rest
> of the line.
[EndQuote]?
If you would use HTML::Parser then you would not have this problem in the
first place.
Therefore using HTML::Parser would solve your problem.
Of course, if you insist on doing it the hard way that is certainly your
perogative.
jue
------------------------------
Date: Sun, 30 Sep 2001 00:29:32 +0200
From: Michael Heiming <michael@heiming.de>
Subject: Re: including local file in .cgi
Message-Id: <d0i5p9.5jb.ln@charon.heiming.de>
nobull@mail.com (nobull@mail.com) wrote at Saturday 29 September 2001
19:31:
[SNIP]
> Ah...! So this is a very ofuscated way of asking (FAQ) "How can I
> expand variables in text strings?"
No, this was not the problem, but you may have pointed me to the
proper FAQ.
Michael Heiming
------------------------------
Date: 29 Sep 2001 20:22:40 -0300
From: * Tong * <sun_tong@users.sourceforge.net>
Subject: Limitation
Message-Id: <sa8n13d4m67.fsf_-_@suntong.personal.users.sourceforge.net>
gazelle@yin.interaccess.com (Kenny McCormack) writes:
> >With a PC, I always felt limited by the software available.
> >On Unix, I am limited only by my knowledge.
>
> But, of course, the real question is, what does this quote actually mean?
> Since it was posted in a Unix group, we tend to assume it is the typical
> "Unix good - Windoze bad" sort of thing, but OTOH, being attributed to
> Leader Bill, one ought to assume the contrary. And, in fact, it could
> easily be interpreted in just that way. I.e., that the whole point of the
> PC/DOS/Windoze is to remove the limitation of being limited by one's own
> wisdom (which is, let's be honest, a rare commodity in the general
> population) and instead, to allow everyone to benefit from the efforts of
> the few.
>
> I don't think this later interpretation is at all unreasonable.
"to allow everyone to benefit from the efforts of the few"? Oh, then
it must be *nix (Unix/Linux), not windows. In windows, you have to
pay for them, and also suffer from their limitations.
I was hindered by the saying "Look how many application written for
Windows, and how many for Linux", before I enter the Linux world.
I'm not saying it is wrong, it is still true by now. But the
difference is I know "why" now. Offline browser, for example, *nix
has only one official tool -- wget, "quite pathetic" you might
think, since there are dozens of such tools under Windoze (I
personally have tried more than 10 of them).
My interpretation of "many application written for Windows and so
less for Linux" is "all applications under windoze sucks". People
get frustrated with the existing ones so they have to create another
one. Yet they all sucks. Ever tried to dowload a web site that
wraps the URLs in javascript? I was forced to write an offline
browser of my own when I was in Windoze. (Of cause, my offline
browser sucks the most. :->)
Another example, if you have a rather large collection of MP3 files,
getting from different sources, spreading over several directories
(or maybe just one), how can you ensure that they all have the same
naming convention? how can you ensure that each of them is
different, ie, same file with different naming convention do not
exist across all those directories... *nix people will go ahead
write a tool to deal with it, and publish the them as freeware.
Windoze people, unfortunately, have to wait for such kind of
commercial tools, then happily spend their money on them.
PS.
Both the aforementioned tools exist in *nix world now. One make
sure MP3 naming convention consistency, and the other find out all
similar named files on the disk.
--
Tong (remove underscore(s) to reply)
*niX Power Tools Project: http://xpt.sourceforge.net/
- All free contribution & collection
------------------------------
Date: Sun, 30 Sep 2001 03:50:16 GMT
From: garry@ifr.zvolve.net (Garry Williams)
Subject: Re: Mission Statement for this newsgroup?
Message-Id: <slrn9rd5jo.bdp.garry@zfw.zvolve.net>
On 27 Sep 2001 12:02:57 -0700, Randal L. Schwartz
<merlyn@stonehenge.com> wrote:
>>>>>> "P" == P Thompson <thompson-nospam@new.rr.com> writes:
>
>P> http://umweb1.unitedmedia.com/comics/dilbert/career/bin/ms2.cgi
>
> and reload each day. :)
Since they give you their vocabulary, here's a Perl implementation:
#!/usr/bin/perl
use warnings;
use strict;
use Text::Wrap qw( wrap $columns );
$columns = 60;
my $init_tab = "\t";
my $subs_tab = "\t";
# Generate a mission statement
#
# The following list of words and phrases was unabashedly
# stolen from:
# http://www.unitedmedia.com/comics/dilbert/career/bin/ms2.cgi
my @adverbs = split /\s*,\s*/,
q(quickly, proactively, efficiently, assertively,
interactively, professionally, authoritatively,
conveniently, completely, continually, dramatically,
enthusiastically, collaboratively, synergistically,
seamlessly, competently, globally);
my @verbs = split /\s*,\s*/,
q(maintain, supply, provide access to, disseminate,
network, create, engineer, integrate,
leverage other's, leverage existing, coordinate,
administrate, initiate, facilitate, promote,
restore, fashion, revolutionize, build, enhance,
simplify, pursue, utilize, foster, customize,
negotiate);
my @adjectives = split /\s*,\s*/,
q(professional, timely, effective, unique,
cost effective, virtual, scalable,
economically sound, inexpensive, value-added,
business, quality, diverse, high-quality,
competitive, excellent, innovative, corporate,
high standards in, world-class, error-free,
performance based, multimedia based, market-driven,
cutting edge, high-payoff, low-risk high-yield,
long-term high-impact, prospective, progressive,
ethical, enterprise-wide, principle-centered,
mission-critical, parallel, interdependent,
emerging, seven-habits-conforming,
resource-leveling);
my @nouns = split /\s*,\s*/,
q(content, paradigms, data, opportunities,
information, services, materials, technology,
benefits, solutions, infrastructures, products,
deliverables, catalysts for change, resources,
methods of empowerment, sources, leadership skills,
meta-services, intellectual capital);
my @prologues = split /\s*,\s*/,
q(We, We envison to, Our goal is to,
It is our mission to, It's our resposibility to,
We have committed to, Our challenge is to,
We exist to, The customer can count on us to,
It is our business to, It is our job to,
We strive to, Our mission is to);
my @epilogues = split /\s*,\s*/,
q(while promoting personal employee growth,
to exceed customer expectations,
while maintaining the highest standards,
to meet our customer's needs,
to stay competitive in tomorrow's world,
to set us apart from the competition,
for 100% customer satisfaction,
because that is what the customer expects);
my @conjunctions = split /\s*,\s*/,
q(and, such that we may continue to,
while continuing to, as well as to,
so that we may endeavor to,
in order to, in order that we may,
so that we may);
sub ADV () { $adverbs[rand @adverbs] }
sub VERB () { $verbs[rand @verbs] }
sub ADJ () { $adjectives[rand @adjectives] }
sub NOUN () { $nouns[rand @nouns] }
sub BLAH () { ( ADV, VERB, ADJ, NOUN ) }
sub PROLOG () { $prologues[rand @prologues] }
sub EPILOG () { $epilogues[rand @epilogues] }
sub CONJ () { $conjunctions[rand @conjunctions] }
# 3/4s of the time, use a conjuction and a second BLAH
# 1/2 of the time, tack on an epilogue
my $statement = join(" ",
PROLOG, BLAH,
rand(4) >= 1 ? ( CONJ, BLAH ) : (),
rand(2) >= 1 ? EPILOG : (),
);
print "\n", " Our mission statement:\n\n",
wrap($init_tab, $subs_tab, "$statement."), "\n\n";
exit 0;
--
Garry Williams
Our mission statement:
It is our business to professionally foster quality
services in order to dramatically leverage existing
virtual products to set us apart from the
competition.
------------------------------
Date: 29 Sep 2001 16:22:40 -0700
From: balsellathurai@hotmail.com (bal)
Subject: newbie question
Message-Id: <58504532.0109291522.5872229b@posting.google.com>
Hi
I have the following program:
#!/usr/bin/perl -w
$file = 'a.txt';
open(INFO, $file);
$qw=1;
while ($l = <INFO>) {
print $qw." "."$l";
$qw=$qw+1;
}
close(INFO);
How can I alter it so that line numbers are printed as 001, 002, ...,
009, 010, 011, 012, etc as opposed to 1,2,3,etc
Cheers
Bal.
------------------------------
Date: Sat, 29 Sep 2001 23:35:26 GMT
From: mjd@plover.com (Mark Jason Dominus)
Subject: Re: newbie question
Message-Id: <3bb65abd.3673$286@news.op.net>
In article <58504532.0109291522.5872229b@posting.google.com>,
bal <balsellathurai@hotmail.com> wrote:
> print $qw." "."$l";
>
>How can I alter it so that line numbers are printed as 001, 002, ...,
>009, 010, 011, 012, etc as opposed to 1,2,3,etc
printf "%03d", $qw;
print " "."$l";
--
@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{
@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord
($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print
------------------------------
Date: Sun, 30 Sep 2001 00:27:14 GMT
From: "E.Chang" <echang@netstorm.net>
Subject: Re: newbie question
Message-Id: <Xns912BD0EF27358echangnetstormnet@207.106.93.86>
balsellathurai@hotmail.com (bal) wrote in
news:58504532.0109291522.5872229b@posting.google.com:
> Hi
> I have the following program:
>
>#!/usr/bin/perl -w
Enabling warnings - good. Also look into "use strict". Read up on
"my" if you haven't already.
> $file = 'a.txt';
> open(INFO, $file);
open(INFO, $file) or die "Can't open $file $!";
Now is the time to get into the habit of checking the return value of
open().
> $qw=1;
> while ($l = <INFO>) {
> print $qw." "."$l";
> $qw=$qw+1;
> }
> close(INFO);
close(INFO) or die "Can't close $file $!";
> How can I alter it so that line numbers are printed as 001, 002, ...,
> 009, 010, 011, 012, etc as opposed to 1,2,3,etc
> Cheers
> Bal.
while ($l = <INFO>) {
print sprintf("%03d", $.), " $l";
}
You can use the sprintf function for output formatting. (perldoc -f
sprintf, or see the perlfunc manpage at
http://www.perldoc.com/perl5.6.1/pod/perlfunc.html.) The format "%03d"
specifys 3 digits, filled with zeros rather than spaces.
The special variable $. holds the current record (normally a line)
number in the file. No need for an extra variable or for the
incrementation step.
You can interpolate variables into double-quoted strings, as in " $l".
It makes it easier to read and to include spacing and other characters.
The print function takes a list of arguments, so I used "," instead of
".". Personally I find it simpler in this situation.
If you want to simplify the code, you also have the option of using the
default variable $_ and the modifier form of while.
print sprintf("%03d", $.), " $_" while <INFO>;
It may look cryptic until you are comfortable with $_
--
EBC
------------------------------
Date: Sun, 30 Sep 2001 03:05:30 +0200
From: Bastian Ballmann <Crazydj@web.de>
Subject: Programming wvdial frontend
Message-Id: <3BB66FDA.39226407@web.de>
Dies ist eine mehrteilige Nachricht im MIME-Format.
--------------C7721F184D7474AE95798020
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Hi @ll!!! =)
I am programming a frontend using SSH to control wvdial on my gateway
box.
I am using threads, because the frontend would hang otherwise.
I can log into my gateway and start wvdial without any problem, but if I
try to disconnect (call the command killall wvdial) or any other command
it wont work...
I have tried to disconnect from the gateway, reconnect and then call a
command --> bad result, nothing happens...
Reading perldoc Threads and perldoc Net::SSH::Perl or the chapter
Threads in the book "Programming Perl"...
Mmmmhhhh... Well... I still dont know how to solve my problem.
But if I close the problem, start it again, connect to the gatewy it
will accept one(!!!) command, but still only one!!!
Could anybody help me debugging my script here, please?
I have experimented for hours but I dont know what wrong....
Thanx in advance! :-p
Greets
Bastian Ballmann
--
<<< Djz rule the world!!! >>> ...and some other staff ;-p
[ Find out at http://www.crazydj.de ]
[ Use Linux! Information can better be used when it's free... ]
--------------C7721F184D7474AE95798020
Content-Type: text/plain; charset=us-ascii;
name="gwcontrol.pl"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="gwcontrol.pl"
#!/usr/bin/perl
# Controlling the Gateway
# C0D3D by <<<ByteBeater>>>
# 29.09.2001
use Tk;
use Thread;
use Net::SSH::Perl;
$top = MainWindow->new();
$top->title('Just connecting...');
$top->configure(background => 'black', foreground => 'green');
$oben = $top->Frame(background => 'black')->pack(side => 'top',padx => 10, pady => 10);
$oben->configure(background => 'black');
$status = $oben->Label(text => 'Controling the gateway =)',
background => 'black',
foreground => 'green',
border => 0,
relief => 'groove',
anchor => 'n')->pack(-side => 'top', padx => 25);
$mitte = $top->Frame()->pack(padx => 10, pady => 10);
$mitte->configure(background => 'black');
$mitte->Label(text => 'Enter password',
background => 'black',
foreground => 'green',
border => 0,
relief => 'groove')->pack(pady => 20);
$passtmp = $mitte->Entry(show => '*')->pack(padx => 25);
$down = $top->Frame()->pack(side => 'bottom',padx => 10, pady => 10);
$down->configure(background => 'black');
$kill = $down->Button(text => 'Kill em! Kiiiiiill!!! ;-p',
background => 'black',
foreground => 'green',
borderwidth => 0,
border => 0,
command => \&killgw_thread)->pack(side => 'bottom', padx => 25, pady => 15, fill => 'x');
$offline = $down->Button(text => 'Raus aus dem Netz, Du Sack!',
background => 'black',
foreground => 'green',
borderwidth => 0,
border => 0,
command => \&offline_thread)->pack(side => 'bottom', padx => 25, pady => 15, fill => 'x');
$online = $down->Button(text => 'Tank sind wir online??',
background => 'black',
foreground => 'green',
borderwidth => 0,
border => 0,
command => \&online_thread)->pack(side => 'bottom', padx => 25, pady => 15, fill => 'x');
$disconnect = $down->Button(text => 'Disconnect',
background => 'black',
foreground => 'green',
borderwidth => 0,
border => 0,
command => \&disconnect_thread)->pack(side => 'bottom', padx => 25, pady => 15, fill => 'x');
$connect = $down->Button(text => 'Connect',
background => 'black',
foreground => 'green',
borderwidth => 0,
border => 0,
command => \&connect)->pack(side => 'bottom', padx => 25, pady => 15, fill => 'x');
MainLoop();
sub connect
{
$pass = $passtmp->get;
$ssh = Net::SSH::Perl->new('gateway');
$ssh->login('root', $pass);
&draw();
# $thread = new Thread \&online;
&draw();
# $status->configure(text => 'The gateway is online');
# $online->configure(text => 'Go offline!',
# command => \&offline($ssh));
return;
}
sub online_thread
{
$on_thread = new Thread \&online;
&draw();
$on_thread->detach();
return;
}
sub online
{
$ssh->cmd('/usr/bin/wvdial');
print "$!\n";
return;
}
sub offline_thread
{
$off_thread = new Thread \&offline;
&draw();
$off_thread->detach();
return;
}
sub offline
{
print "Going offline...\n";
$ssh->cmd('/sbin/offline');
print "$!\n";
&draw();
# $status->configure(text => 'Get the gateway online');
# $aktion->configure(text => 'Tank sind wir online??',
# command => \&connect);
&draw();
return;
}
sub disconnect_thread
{
$discconect = new Thread \&disconnect;
&draw();
return;
}
sub disconnect
{
$ssh->cmd('logout');
print "$!\n";
draw();
}
sub killgw_thread
{
$kill = new Thread \&killgw;
&draw();
return;
}
sub killgw
{
$ssh->cmd('shutdown -h now');
$top->destroy;
return;
}
sub draw
{
$top->update
}
--------------C7721F184D7474AE95798020--
------------------------------
Date: Sat, 29 Sep 2001 21:38:35 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Sorting by version number...
Message-Id: <3BB6779B.CC547976@earthlink.net>
F. Xavier Noria wrote:
>
> On Sat, 29 Sep 2001 05:26:26 GMT, Jason Boerner <jasonb@computer.org>
> wrote:
>
> : Does anyone have a sort routine for the following?
> : My version sucks! ;_)
> :
> : myprog-1.2.1
> : myprog-1.2.10
> : myprog-1.2.0
> : myprog-1.2.2
> :
> : So that the ascending order is:
> :
> : myprog-1.2.0
> : myprog-1.2.1
> : myprog-1.2.2
> : myprog-1.2.10
I don't have the op's message, I would do it as either of:
@versions =
map { $_->[0] } sort { $a->[1] cmp $b->[1] }
map { [$_, pack "U*", /\d+/g] } @versions;
or:
@versions =
map substr($_,3), sort
map pack("C3a*", (/\d+/g,0)[0..2], $_), @versions;
The ,0 is there because a slice of an empty list is an empty list, and
if by chance there are no numbers in the version string, I want the
slice to result in a *non* empty list, specifically one with three
numbers [it's ok if some are undef], and the ",0" should do that.
[If the slice results in an empty list, $_ will be in the wrong place,
and that would be Bad.]
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Sat, 29 Sep 2001 20:52:45 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Sourcing Things in Perl ?
Message-Id: <3BB66CDD.398A581F@earthlink.net>
[this message posted and mailed]
slightlysprintingdog@ntlworld.com wrote:
>
> I trying to source some stuff in a Perl Tk script.
>
> Basically I have a string setup somewhere else in the program ;
> $sourceme which contains the full path of the source file.
>
> And then I'm using the system command to source it like so :
>
> system ( "source $sourceme" );
>
> I don't get anything written to the console and the file is definately
> not sourced.
As you said elsewhere in the thread, the shell script you are trying to
use contains a bunch of setenvs and echos. If nothing is getting
written to the console, then the program isn't being called. The is
probably since system uses sh, and "source" doesn't exist within sh.
Since the script contains "setenv", we can assume it's a csh script.
There are various and sundry reasons not to use csh. The best solution
would be to rewrite the thing in perl if you can... It would look like:
$ENV{VAR1} = "blah";
$ENV{VAR2} = "blah2";
etc.
If you can't, try finding a csh parser, written in perl. There probably
doesn't exist any such beast, so you could try to do it ad-hoc.
open( CSH_SCRIPT, $sourceme ) or die "Couldn't open $sourceme: $!";
while( <CSH_SCRIPT> ) {
my ($key, $val) = /^\s*setenv\s+(\w+)\s+(.*?)\s*$/ or next;
$val =~ s/\$(\w+)/$ENV{$1} || $1/ge;
$ENV{$key} = $val;
}
This will only work in the simplest cases.
As a last resort, you could use csh itself... just remember that it's
changes to it's environment produce changes in perl's environment.
There's two workarounds.
The simpler one is to have csh call the thing you want it to control,
after it sources $sourceme... that way your other program runs from
within csh's modified environment.
system( "csh", "-c", "source $sourceme; modelsim" );
The more complicated one is to have csh print out it's environment after
changing it, then call your other program.
foreach( qx[csh -c 'source $sourceme > /dev/null; env'] ) {
next unless 2==(my ($key, $val) = split /=/, $_, 2);
# next unless $key =~ /I want this variable/;
$ENV{$key}=$val;
}
system("modelsim");
There's alot of unsafe stuff here, but with a bit of work, you could
make it reasonably safe, by only taking those env vars which you want.
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Sat, 29 Sep 2001 22:07:36 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: testing the "flatness" of a structured file
Message-Id: <3BB67E68.7A8183C1@earthlink.net>
Walter Hafner wrote:
>
> Hi!
>
> I'm sure there is a simple solution - i just can't see it.
>
> I have a couple of small, structured files in the form:
>
> ...
> [BEGIN xxx]
> ...
> [END xxx]
> ...
> [BEGIN yyy]
> ...
> [END yyy]
> ...
>
> I want to strip everything between the BEGIN ... END Blocks and write
> the blocks (including the delimiters) in an array.
[snip]
> How can i ensure that there aren't any nested blocks? I don't need to
> parse them, i simply need to stop parsing and print an error message.
> I know that Perl's regular expressions can't match nested balanced
> text.
my @chunks = do {
open my ($in), "<testfile" or die $!;
local $/;
<$in>;
} =~ /^[BEGIN.*]$(?s:.*?)^[END.*]$/mg;
if( grep { pos = 1; scalar /^[BEGIN.*]$/mg } @chunks ) {
die "Nested [BEGIN]";
}
However, I will say that if you *want* to deal with nested blocks, you
*can*, fairly easily, if you use the Text::Balanced, module.
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Sat, 29 Sep 2001 19:48:09 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: validating handle to perl module
Message-Id: <3BB65DB9.876138AC@earthlink.net>
Rob wrote:
[snip irrelevant stuff]
> I am transfering 500+ files in a day with the script running every 5
> minutes and transfering whatever files are ready for distributing. I
> realized that it is rediculous to:
> while (! [out of files]) {
> connect; -> put-next-file; -> disconnect; #repeat
> }
>
> So I changed my code to connect/login once and then put each of the
> fifty or so files, then disconnect. Seems to work very well.
>
> The reason for the post though, is this... When I do my put (in
> another sub routine,) how can I validate that the global variable $ftp
> is still valid? I would like to retry the connect without croaking
> but cannot identify a surefire way to validate the handle. Would I be
> best off asking for a pwd or dir from the $host or can Net::FTP
> validate the handle?
The best way is to assume that if it's not undef, then it's a valid
handle. Just remember to set the handle to undef after you disconnect.
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Sat, 29 Sep 2001 23:08:47 +0000 (UTC)
From: inwap@best.com (Joe Smith)
Subject: Re: warnings with cgi will crash Win32 perl core
Message-Id: <9p5k9v$e51$1@nntp1.ba.best.com>
In article <3B89DDB5.88B342C6@stomp.stomp.tokyo>,
Godzilla! <godzilla@stomp.stomp.tokyo> wrote:
>Godzilla! wrote:
>
>> I have been playing around with warnings in the format
>> of -w to discover how many other ways use of warnings
>> screws up a Perl script. They are numerous.
>
>(snipped)
>
>I have attached a simple script which well displays
>how erratic is the behavior of warnings.
I've modified your script slightly to show that the
warning is correct: the "shared" variable does not stay shared.
cat temp; perl -w temp
#!/usr/local/bin/perl5 -w
my $counter = 0;
foreach $test (1..3) {
print "\t\t Test $test\n";
&Nest_1;
}
exit;
sub Nest_1
{
my ($nest_1) = "nest " . ++$counter;
print "Nest 1: $nest_1\n";
my (@Array_1) = qw (nest_one);
print "@Array_1\n";
&Nest_2;
sub Nest_2
{
my ($nest_2) = "nest two";
print "Nest 2: $nest_1\n";
my (@Array_2) = qw (nest_two);
print "@Array_2\n";
&Nest_3;
sub Nest_3
{
my ($nest_3) = "nest three";
print "Nest 3: $nest_3\n";
my (@Array_3) = qw (nest_three);
print "@Array_3\n";
}
}
}
Variable "$nest_1" will not stay shared at temp line 22.
Test 1
Nest 1: nest 1
nest_one
Nest 2: nest 1
nest_two
Nest 3: nest three
nest_three
Test 2
Nest 1: nest 2
nest_one
Nest 2: nest 1
nest_two
Nest 3: nest three
nest_three
Test 3
Nest 1: nest 3
nest_one
Nest 2: nest 1
nest_two
Nest 3: nest three
nest_three
As you can see, the contents of $nest_1 in Nest_2 is the original
value set by Nest_1, but it is a separate variable, one that does
not share the changes to Nest_1's current $nest_1 variable.
What you are attempting to do is useful, but the perl language
was not designed to do that.
-Joe
--
See http://www.inwap.com/ for PDP-10 and "ReBoot" pages.
------------------------------
Date: 29 Sep 2001 20:29:44 -0300
From: * Tong * <sun_tong@users.sourceforge.net>
Subject: Re: who said this?
Message-Id: <sa8ite14luf.fsf@suntong.personal.users.sourceforge.net>
"Mike Miller" <miller5286@usenetserver.com> writes:
> > With a PC, I always felt limited by the software available.
> > On Unix, I am limited only by my knowledge.
>
> I run Unix on my PC. ;o)
I found it on google, it was said over 5 years ago. By that time,
PC means DOS/Windoze. I bet very few people would still think that
way now. :-)
--
Tong (remove underscore(s) to reply)
*niX Power Tools Project: http://xpt.sourceforge.net/
- All free contribution & collection
------------------------------
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.
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 V10 Issue 1844
***************************************
