[22094] in Perl-Users-Digest
Perl-Users Digest, Issue: 4316 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Dec 27 03:05:54 2002
Date: Fri, 27 Dec 2002 00:05:08 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Fri, 27 Dec 2002 Volume: 10 Number: 4316
Today's topics:
Re: comment on 2 or 4 spaces indentation (Kevin Cline)
DBD::Oracle select * from v$parameter problrms (Daniel Koehne)
Re: DBD::Oracle select * from v$parameter problrms <kevin@vaildc.net>
Re: Free Program <palladium@spinn.net>
Re: Free Program (krakle)
Re: Getting Connecting Host Info from inetd <goldbb2@earthlink.net>
Re: help missing module <jaster@home.still>
Re: Is there a perl command equivalent to su - user ? <mlaks2000@nospam.yahoo.com>
Re: pre declare a split variables <bongie@gmx.net>
Re: pre declare a split variables (Joe Smith)
Re: Processing \0xx in nonliteral strings <goldbb2@earthlink.net>
Re: The Superiority of PHP over Perl <Jan@Bytesmiths.com>
Re: What does symlink point to? <goldbb2@earthlink.net>
Re: win32::ole woes <lance@augustmail.com>
Re: win32::ole woes (Jay Tilton)
Re: win32::ole woes <goldbb2@earthlink.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 26 Dec 2002 22:16:05 -0800
From: kcline17@hotmail.com (Kevin Cline)
Subject: Re: comment on 2 or 4 spaces indentation
Message-Id: <ba162549.0212262216.28587798@posting.google.com>
pkent <pkent77tea@yahoo.com.tea> wrote in message news:<pkent77tea-D5192E.23042519122002@[10.1.1.10]>...
> In article <ba162549.0212182104.1de9265c@posting.google.com>,
> kcline17@hotmail.com (Kevin Cline) wrote:
>
> <snip>
>
> > Four spaces is better because it discourages nesting control constructs
> > too deeply. Two levels of nesting are enough for any one function.
>
> :-) That has an air of all the wonderfully wrong things people have said
> about computers over the years (640K; world market of 4 machines; why
> would anyone want a computer at home; etc).
Since I started programming, computers have gotten 1000 times faster
while the cost has gone down by a factor of 100. But, sadly, computer
programmers have hardly evolved at all. So I don't expect programmers
ability to understand deeply nested code to improve any time soon.
> I bet plenty of people will
> now say "but just the other day I went to 4 levels of indent because the
> logic of the function demanded it and it was Right in that context to
> keep it all as one function" and similar.
I now figure that if I can't understand a function in five minutes,
it's probably wrong.
------------------------------
Date: 26 Dec 2002 19:07:12 -0800
From: koehned@act.org (Daniel Koehne)
Subject: DBD::Oracle select * from v$parameter problrms
Message-Id: <b0a7106e.0212261907.628ded1f@posting.google.com>
I am running an Oracle9i Enterprise Edition Release 9.2.0.1.0 database
on my laptop. I also have the ActiveState perl, v5.6.1 built for
MSWin32-x86-multi-thread, Binary build 633 installed.
I have installed the following ActiveState packages installed:
PPM interactive shell (2.1.6) - type 'help' for available commands.
PPM> query oracle
DBD-Oracle [1.06] Oracle database driver for the DBI module
DBD-Oracle8 [1.06] Oracle 8 database driver for the DBI module
PPM> query DBI
DBI [1.27] Database independent interface for Perl
PPM>
I am able to use DBD::Oracle to run a simple select statement and
process the return set.
Now I want to connect to the Oracle database as the system user (or a
user with the SYSDBA privilege) and do admin tasks (primarily check
configurations etc...).
I have written a perl script to run this select statement: select name
from v$parameter (this is a valid sql statement), but I am getting the
following errors:
D:\dfkoehne\perl\scripts\database>test2.pl
DBD::Oracle::db prepare failed: ORA-00942: table or view does not
exist (DBD ERR
OR: OCIStmtExecute/Describe) at
D:\dfkoehne\perl\scripts\database\test2.pl line
17.
Can't call method "execute" on an undefined value at
D:\dfkoehne\perl\scripts\da
tabase\test2.pl line 18.
D:\dfkoehne\perl\scripts\database>
Here is a copy of my perl script:
#!c:\perl\bin\perl.exe
use DBI;
$mode = 2; # SYSDBA
# Connecting without environment variables or tnsname.ora file
$dbh = DBI->connect("dbi:Oracle:host=10.1.1.81;sid=FOOBAR", system,
password, { ora_session_mode => $mode } ) ||
die "Database connection not made: $DBI::errstr";
my $sql = qq{ SELECT name FROM v$parameter };
my $sth = $dbh->prepare( $sql );
$sth->execute();
my( $name, $value, $isdefault );
$sth->bind_columns( undef, \$name);
while( $sth->fetch() ) {
print "$name\n";
}
$sth->finish();
$dbh->disconnect();
Any help is much appreciated.
Daniel Koehne
------------------------------
Date: Thu, 26 Dec 2002 23:22:19 -0500
From: Kevin Michael Vail <kevin@vaildc.net>
Subject: Re: DBD::Oracle select * from v$parameter problrms
Message-Id: <kevin-4F62D9.23221926122002@vienna7.his.com>
In article <b0a7106e.0212261907.628ded1f@posting.google.com>,
koehned@act.org (Daniel Koehne) wrote:
[snip]
> Now I want to connect to the Oracle database as the system user (or a
> user with the SYSDBA privilege) and do admin tasks (primarily check
> configurations etc...).
>
> I have written a perl script to run this select statement: select name
> from v$parameter (this is a valid sql statement), but I am getting the
> following errors:
>
> Here is a copy of my perl script:
> #!c:\perl\bin\perl.exe
> use DBI;
> $mode = 2; # SYSDBA
> # Connecting without environment variables or tnsname.ora file
> $dbh = DBI->connect("dbi:Oracle:host=10.1.1.81;sid=FOOBAR", system,
> password, { ora_session_mode => $mode } ) ||
> die "Database connection not made: $DBI::errstr";
> my $sql = qq{ SELECT name FROM v$parameter };
If you had specified 'use strict' or even 'use warnings', you would find
out what was wrong with this line. Hint: qq does double-quotish
interpolation (perldoc perlop) and you don't have a variable named
$parameter.
> my $sth = $dbh->prepare( $sql );
> $sth->execute();
> my( $name, $value, $isdefault );
> $sth->bind_columns( undef, \$name);
> while( $sth->fetch() ) {
> print "$name\n";
> }
> $sth->finish();
> $dbh->disconnect();
>
> Any help is much appreciated.
>
> Daniel Koehne
--
Kevin Michael Vail | Dogbert: That's circular reasoning.
kevin@vaildc.net | Dilbert: I prefer to think of it as no loose ends.
http://www.vaildc.net/kevin/
------------------------------
Date: Thu, 26 Dec 2002 22:33:41 -0700
From: "Rod" <palladium@spinn.net>
Subject: Re: Free Program
Message-Id: <v0nr84ojh3dv87@corp.supernews.com>
How about a global hash that keeps track of the inventory. And a simple
routine that adds, removes, uses based upon a data map.
ie based upon a simple data map.
#item type description use_on
1 1 "Sword" [1,12,13,16..35]
2 1 "FlameThrower" [12,13,16..35]
Types
#id Description
1 "Weapons"
2 "Potions"
3 "Maps"
You can have a monsters map similar
#id description hitpoints
1 "Dragon" 10
12 "Human" 5
Where the map shows that Flamethrowers can be used against Humans etc. But
not dragons.
Humm. Looks alot like a relational database model........
"Zarathustra" <varat@ix.netcom.com> wrote in message
news:3E0777F2.4060303@ix.netcom.com...
> I am writing an adventure game. It is pretty simple. I have gotten as
> far as I can but I don't know how to pick up treasure and use items. I
> will give this program away for free.
>
----------------------------------------------------------------------------
----
> #! usr/bin/perl -w
>
> use strict;
> use integer;
>
> my @maze=(
> [ qw( e sew we ws )],
> [ qw(ne new sw ns ) ],
> [ qw( ns - ns wn ) ],
> [ qw(ne w ne w )],
> );
> my %direction = (n=> [ -1, 0], s=> [1, 0], e => [0, 1], w => [0, -1]);
>
> my %full=( e => 'East', n => 'North', w=>'West', s =>'South');
> my($curr_x, $curr_y, $x, $y)=(0,0,3,3);
> my $move;
>
> my $num;
> my $n;
> my $c;
> my @p=(" ",10,1,0,7,6);
> my @m;
> my $mhp = $p[1];
> my @weapon;
> my @armor;
>
> sub disp_loc {
> my($cx, $cy)=@_;
> print "You may move ";
> while($maze [$cx] [$cy]=~/([nsew])/g) {
> print "$full{$1} ";
> }
> print "($maze[$cx][$cy])\n";
> }
> sub move_to {
> my($new, $xref, $yref)=@_;
>
> $new=substr(lc($new),0,1);
> if ($maze[$$xref] [$$yref]!~/$new/) {
> print "Can't go that way $new!\n";
> return;
> }
> $$xref += $direction{$new}[0];
> $$yref += $direction{$new}[1];
> }
>
> sub xps {
> my ($hp, $lv, $xp, $mxp) = @_;
> print "You got $mxp XP for the battle \n";
> $xp = $xp + $mxp;
> if ($xp > 100) {
> $lv++;
> $xp = $xp - 100;
> ($hp, $mhp) = nlv ($hp, $mxp);
> }
> return $hp, $lv, $xp;
> }
>
> sub nlv {
> my ($hp, $mhp) = @_;
> my $num;
>
> $num = (int(rand(10))+1);
> $hp = $hp + $num;
> $mhp = $mhp + $num;
> return $hp, $mhp;
> }
>
> sub atk {
> my ($hd, $ac) = @_;
> my $roll;
> my $hit;
> my $thaco;
>
> $roll = int(rand(20))+1;
> $thaco = 19 - $hd;
> if ($roll > ($thaco - $ac)) {
> $hit=1;
> print "Hit! \n";
> } else {
> print "Missed... \n";
> $hit=0;
> }
> return $hit;
> }
> sub fight {
>
> my $ht;
> my ($md, $pd) = @_;
> print "$$pd[0] is Fighting a $$md[0] \n";
> print "You have $$pd[1] HP, it has $$md[2] HP\n";
> $ht = atk ($$pd[2], $$md[3]);
> if ( $ht == 1 ) {
> $$md[2] = $$md[2] - (int(rand($$pd[5]))+1);
> }
> print "Now the $$md[0] attacks \n";
> $ht = atk ($$md[1], $$pd[2]);
> if ( $ht == 1 ) {
> $$pd[1] = $$pd[1] - (int(rand($$md[3]))+1);
> }
> return $$md[2], $$pd[1];
> }
>
> sub choosmon {
>
> my $x;
> my $v;
> my $rm;
> my $hp;
> my @mm = ();
> my @ml = (
> [ "Orc",1,0,6,15 ],
> [ "Gobblin",1,0,4,10 ],
> [ "Hobgobblin",2,0,6,25 ],
> [ "Skelliton",1,0,4,10 ],
> [ "Dragon!",4,0,7,100 ],
> [ "Wolf",2,0,3,20 ],
> );
>
> $rm = int(rand(6));
>
> for ($x=0; $x <= 5; $x++) {
> $mm[$x] = $ml[$rm][$x];
> }
>
> $v=$mm[1];
>
> for ($x=0; $x <= $v; $x++ ) {
> $hp = $hp + int(rand(6))+1;
> }
>
> print "You see a $mm[0] \n";
>
> $mm[2] = $hp;
> return @mm;
> }
>
>
> sub run {
> my ($hp)=@_;
> print "Running\n";
> $hp++;
> return $hp;
>
> }
>
> print "What is your name?";
> $p[0]=<STDIN>; chomp $p[0];
>
>
> until ( $curr_x == $x and $curr_y ==$y ) {
> disp_loc($curr_x, $curr_y);
> print "Which way? ";
> $move=<STDIN>; chomp $move;
> exit if ($move=~/^q/);
> move_to($move, \$curr_x, \$curr_y);
>
> $num = int(rand(4))+1;
> print " $num";
> if ($num == 1) {
> @m = choosmon (@m);
> CBT: while ( $p[1] > 0 ) {
>
> if ( $p[1] > $mhp ) {
>
> $p[1] = $mhp;
>
> }
>
>
> print "You have $p[1]/$mhp HP it has $m[2] \n";
> print "Do you want to f ight, r un d ie: ";
> $c=<STDIN>; chomp $c;
> if ( $c eq "f" ) {
> ($m[2], $p[1]) = fight(\@m, \@p);
> }
>
>
> if ($c eq "r" ) {
> $p[1] = run($p[1]);
> }
>
> if ( $c eq "l" ) {
> ($p[2], $mhp) = nlv ($p[2], $mhp);
> }
>
> if ( $m[2] <= 0 ) {
> print "You killed the $m[0] \n";
> ($p[1], $p[2], $p[3]) = xps ($p[1], $p[2], $p[3], $m[4]);
> last CBT;
> }
>
> if ( $c eq "d" ) {$p[1] = 0;
> }
>
>
>
> }
>
>
> if ( $p[1] <= 0 ) {
> print "You are dead";
> die; }
>
> }
> }
> print "You made it!\n";
>
------------------------------
Date: 26 Dec 2002 23:10:18 -0800
From: krakle@visto.com (krakle)
Subject: Re: Free Program
Message-Id: <237aaff8.0212262310.43127d48@posting.google.com>
neato... Now only if you told what it does people may just want it.
Too much work to try to determine what it is, how to use it and why by
reading the code.
ps. Loved the readme file...
------------------------------
Date: Thu, 26 Dec 2002 22:26:45 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Getting Connecting Host Info from inetd
Message-Id: <3E0BC875.A60D42DE@earthlink.net>
George Kuetemeyer wrote:
>
> I want to use inetd to kick off a Perl script. How can the script
> itself determine connecting host info, since inetd is brokering
> connections?
Inetd merely does accept, and then uses the dup2() function to make that
socket into the stdin and stdout (any maybe stderr, I don't recall) of
the newly started perl script.
This means that you should be able to do:
use IO::Socket;
# Tell perl that STDIN is actually a network socket.
my $in = bless \*STDIN, 'IO::Socket::INET';
my $peeraddr = $in->peeraddr;
my $peerport = $in->peerport;
print MYLOGFILE "The remote host is ", $in->peerhost, "\n";
[untested]
--
$..='(?:(?{local$^C=$^C|'.(1<<$_).'})|)'for+a..4;
$..='(?{print+substr"\n !,$^C,1 if $^C<26})(?!)';
$.=~s'!'haktrsreltanPJ,r coeueh"';BEGIN{${"\cH"}
|=(1<<21)}""=~$.;qw(Just another Perl hacker,\n);
------------------------------
Date: Fri, 27 Dec 2002 02:26:05 GMT
From: "jaster" <jaster@home.still>
Subject: Re: help missing module
Message-Id: <1TOO9.1214$WY2.742759566@newssvr11.news.prodigy.com>
Bob, thanks again for the reply. I resolved the problem, I just needed to
reinstall the modules by replacing the package.
"jaster" <jaster@home.still> wrote in message
news:t2FO9.1093$6z5.622285889@newssvr11.news.prodigy.com...
> Thanks for the reply. Yes it is perl-Digest-MD5-2.20.1 and MIME::Base64
is
> another missing module although these are shown as installed.
>
> $ rpm -qa perl*
> perl-HTML-Tagset-3.03-3
> perl-Parse-Yapp-1.04-3
> perl-XML-Encoding-1.01-2
> perl-libxml-enno-1.02-5
> perl-CPAN-1.59_54-26.72.3
> perl-Digest-MD5-2.20-1
> perl-HTML-Parser-3.25-2
> perl-MIME-Base64-2.12-6
> perl-Storable-0.6.11-6
> perl-libwww-perl-5.53-3
> perl-XML-Grove-0.46alpha-3
> perl-libxml-perl-0.07-5
> perl-XML-Dumper-0.4-5
> perl-DB_File-1.75-26.72.3
> perl-SGMLSpm-1.03ii-4
> perl-5.6.1-26.72.3
> perl-IO-stringy-2.108-2
> perl-DateManip-5.39-5
> perl-libnet-1.0703-6
> perl-URI-1.12-5
> perl-XML-Parser-2.30-7
> perl-XML-Twig-2.02-2
> perl-NDBM_File-1.75-26.72.3
> perl-CGI-2.752-26.72.3
> perl-MailTools-1.44-2
> $
>
>
> "Bob Walton" <bwalton@rochester.rr.com> wrote in message
> news:3E0A7BB1.2050506@rochester.rr.com...
> > jaster wrote:
> >
> > > Happy holiday to everyone.
> > > I'm using RH7.2 w/ Perl 5.6.1 but now if I " use Digest::MD5 " I get
an
> > > error module not found. I installed perl-Digest-2.20 and my rpm -qa
> perl*
> > > shows the module is installed. Any idea what I need to do to fix
this
> > > problem? Thanks for all help.
> >
> >
> > Are you sure that it isn't Digest-MD5-2.20 that you want?
> >
> > --
> > Bob Walton
> >
>
>
------------------------------
Date: Fri, 27 Dec 2002 05:57:48 GMT
From: Mitchell Laks <mlaks2000@nospam.yahoo.com>
Subject: Re: Is there a perl command equivalent to su - user ?
Message-Id: <wZRO9.135574$4W1.40560@nwrddc02.gnilink.net>
bd wrote:
> Have you tried -U?
I guess psql -U will work to connect to the database, which is good for
later parts of my scripts. But i needed to su to postgres to get to create
users as the postgres user. The fork and $>= $whatever above is really
cool and powerful, and i learned to use fork - good for system programming
steps in general. Thank you all for your patient tutorials!
mitchell
------------------------------
Date: Fri, 27 Dec 2002 05:23:44 +0100
From: "Harald H.-J. Bongartz" <bongie@gmx.net>
Subject: Re: pre declare a split variables
Message-Id: <2839133.XeimYYO5rj@nyoga.dubu.de>
Blnukem wrote:
> When I pre declare a split variables "$data_sting" why do they not
> work ?
You cannot "predeclare" variables that way. I assume you want to
separate the actual database fields from the code. Maybe a hash will
give you the answer.
> Snipped Code:
>
> open DBASE, ("<users.dat");
... or die $!;
And a strange use of parentheses. ;-)
> @allusers = <DBASE>;
> close(DBASE);
>
> my $data_sting = "$name,$age,$phone";
my @fieldnames = qw(Name Age Phone);
my %fields;
>
> foreach $user (@allusers){
> chomp($user);
> ($data_sting) = split (/\|/, $user);
@fields{@fieldnames} = split /\|/, $user;
(Beware of missing fields in the database, hash fields may remain filled
from the last loop.)
> print "Name:$name Phone:$phone<br>";
print "$_: $fields{$_} " for @fieldnames;
print "<br>\n";
> }
And if you don't need the @allusers array for something else, you should
leave it away and read the db file line by line:
my @fieldnames = qw(Name Age Phone);
my %fields;
open DBASE, "<users.dat" or die "could not open users.dat: $!";
while (defined (my $line = <DBASE>)) {
chomp $line;
@fields{@fieldnames} = split /\|/, $line;
print "$_: $fields{$_} " for @fieldnames;
print "<br>\n";
}
close DBASE;
Ciao,
Harald
--
Harald H.-J. Bongartz <bongie@gmx.net>
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Beware of bugs in the above code; I have only proved it correct,
not tried it. -- Donald Knuth
------------------------------
Date: Fri, 27 Dec 2002 05:21:40 GMT
From: inwap@inwap.com (Joe Smith)
Subject: Re: pre declare a split variables
Message-Id: <ErRO9.1428$io.61370@iad-read.news.verio.net>
In article <2839133.XeimYYO5rj@nyoga.dubu.de>,
Harald H.-J. Bongartz <bongie@gmx.net> wrote:
>Blnukem wrote:
>
>> When I pre declare a split variables "$data_sting" why do they not
>> work ?
I am guessing that the original poster was trying to make a generic
read-fields-from-file routine.
>And if you don't need the @allusers array for something else, you should
>leave it away and read the db file line by line:
>
> my @fieldnames = qw(Name Age Phone);
> my %fields;
> open DBASE, "<users.dat" or die "could not open users.dat: $!";
> while (defined (my $line = <DBASE>)) {
> chomp $line;
> @fields{@fieldnames} = split /\|/, $line;
> print "$_: $fields{$_} " for @fieldnames;
> print "<br>\n";
> }
> close DBASE;
sub print_file {
my $data_file = shift; # Name of file
my @data_names = @_; # List of fields in the file
my %fields;
open DBASE, "<", $data_file or return("Could not open $data_file: $!\n");
while(<DBASE>) {
chomp;
@fields{@data_names} = split /\|/, $_;
pring "$_: $fields{$_} for @fieldnames;
}
close DBASE;
""; # Success
}
$warn = print_file("users.dat", qw(Name Age Phone)) && warn $warn;
$warn = print_file("groups.dat", qw(Group Leader)) && warn $warn;
...
-Joe
--
See http://www.inwap.com/ for PDP-10 and "ReBoot" pages.
------------------------------
Date: Thu, 26 Dec 2002 22:16:24 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Processing \0xx in nonliteral strings
Message-Id: <3E0BC608.A1DA6A69@earthlink.net>
I am posting a followup to my own message due to Andrew Hamm asking for
an explanation of my code.
Benjamin Goldberg wrote:
[snip]
> If *all* you want is to process backslash-escapes just as if you were
> the perl preprocessor, then *use* the perl preprocessor.
>
> $string =~ s/\\(0x\d{1,2}|[0-7]{1,3}|.)/
> $1 ne '"' ? eval qq["\\$1"] : '"'/sge;
Any s/// expression has two parts -- the left part (the regex) and the
right part (the value to be substituted wherever the regex matches).
In this, the regex is:
/\\(0x\d{1,2}|[0-7]{1,3}|.)/s
Written out more verbosely, this is:
/
\\ # match a backslash.
( # group the following together and capture in $1.
0x \d{1,2} # a "0x" followed by one or two digits.
| # OR
[0-7]{1,3} # one to three octal digits.
| # OR
. # any single character.
) # end of the group to be captured in $1.
/xs
# the /x means that any whitespace and comments
# between the // aren't really part of the regex.
# The /s makes the '.' mean "any character", instead of [^\n].
The right part of the s/// is, due to the /e, a perl expression (without
the /e, it would be a string to be interpolated).
Written slightly more verbosely, it is:
$1 ne '"' ? # if the captured string *isn't* a " char,
eval qq["\\$1"] : # then let perl \\escape it itself.
'"'; # otherwise, just use it directly.
The /g on the s/// means "globally replace".
So, putting it together, find all backslashes, and if they're octal or
hex numbers or whatever, convert them to chars using eval EXPR.
> But, since you also want to escape %-thingies, then try:
>
> my $fmt = 'user: %u\ndomain:%d\n'; # example
> my %percent = (
> 'u' => $usr, 'd' => $dom, ....,
> );
This is a hash. I hope that you know what these are!
> $string =~ s<(?=([\\%])(?sx:
The s/// operator can take any kind of delimiters. If the start
delimiter is one that's normally paired (eg, (), <>, [], or {}), it's
closed by the corresponding close delimiter. Here, I'm delimiting the
regex using <>.
Then, I do a zero-width positive assertion that the next character is
either a \ or a %, and capture it in $1. This is both an optomization
(it doing the rest of the regex if it fails), and it allows me later on
match (but not capture again) the \\ or % (I don't "need" to capture it
again, since it's already in $1).
Then, the (?sx: non-capturing group is as documented in perldoc perlre.
> (?:\\(0x\d{1,2}|[0-7]{1,3}|.))
This is just like I'd had in the earlier substitution, except that it
goes into $2, since this is the second capturing group in the re as a
whole.
> |
> (?:%(.))
This matches a % followed by any single character, and stores the
captured character in $3. (The % is not part of $3).
> )>{
This ends the (?sx:, and is the closing > for the s<, and is the opening
mark for the right side of the s///. Remember, since { is one of those
things that perl recognizes as pairs, this is closed by a }.
> if( $1 eq "\\" ) {
The $1 here was captured by (?=([\\%])). It's used to tell what we're
substituting.
> $2 eq '"' ? '"' : eval qq["\\$2"];
This is the same as before, except with $2 instead of $1.
> } else {
> exists $percent{$3} ? $percent{$3} : "%$3";
This should be understandable to anyone who understands hashes, and
understands the ?: operator.
> }
> }ge;
The /g flag means substutute globally. The /e flag means that the
substitution is a perl expression, not an interpolated string.
--
$..='(?:(?{local$^C=$^C|'.(1<<$_).'})|)'for+a..4;
$..='(?{print+substr"\n !,$^C,1 if $^C<26})(?!)';
$.=~s'!'haktrsreltanPJ,r coeueh"';BEGIN{${"\cH"}
|=(1<<21)}""=~$.;qw(Just another Perl hacker,\n);
------------------------------
Date: Thu, 26 Dec 2002 23:44:29 -0800
From: Jan Steinman <Jan@Bytesmiths.com>
Subject: Re: The Superiority of PHP over Perl
Message-Id: <Jan-FDD564.23442926122002@news.speakeasy.net>
In article <4e2f159f.0212251625.702cd571@posting.google.com>,
eggtroll@yahoo.com (Egg Troll) wrote:
> * The OO of PHP is excellent. In my experience, it rivals Smalltalk.
Then you have no experience with Smalltalk! :-)
--
: Jan Steinman -- nature Transography(TM): <http://www.Bytesmiths.com>
: Bytesmiths -- artists' services: <http://www.Bytesmiths.com/Services>
: Buy My Step Van! <http://www.Bytesmiths.com/van>
------------------------------
Date: Fri, 27 Dec 2002 00:01:43 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: What does symlink point to?
Message-Id: <3E0BDEB7.EE03718@earthlink.net>
John Chambers wrote:
[snip]
> Anyhow, the problem is reading the contents of a symlink. Not the
> data of the file that it points to; I'm trying to get the name of
> the file that a symlink points to.
The readlink() operator will do this, but this will only produce the
final component of the symlink.
This might not sound too bad, but consider that symlinks can be
relative, and they are relative to the *real* directory that the file is
in.
Suppose in your filesystem you have the following symlinks:
/foo/bar/baz -> "/fnord/blargle/thud"
"/fnord/blargle/thud/grunt -> "../quux"
Then the file /foo/bar/baz/grunt is *really* the file
"/fnord/blargle/quux, and *not* /foo/bar/quux.
To *fully* resolve a symlink (in my example, to go from "/usr/bin/rm" to
"/bin/unlink") takes a bit more work.
Here's the BFI (brute force and ignorance) method:
my ($dev, $ino) = stat($symlink_filename);
my $foundit;
use File::Find;
find( {
# no_chdir => 1, # makes it faster on some systems?
preprocess => sub { $foundit ? () : @_ },
wanted => sub {
return $File::Find::prune = 1 if $foundit or -l;
my ($d, $i) = stat _;
if($d == $dev and $i == $ino) {
$foundit = $File::Find::name;
}
},
}, "/" ) if defined $dev or defined $ino;
It relies on the OS to fully resolve the link to get the device and
inode numbers, and then does a search of the whole filesystem finding
that file. (Well, half the filesystem on average, I suppose).
Here's a cleverer method, using readlink:
use File::Spec;
my $f = File::Spec->canonpath(File::Spec->rel2abs($file));
1 while $f =~ s{^
# Find the first symlink in the path. To do this, we
# find the shortest prefix of the path which is a symlink.
# The smallest number of whole path components...
((?>/+[^/]+)+?)
# I use (?>) instead of (?:) since it prevents a
# path like /foo/barbaz from matching as "/foo/bar",
# and it should reduce the amount of backtracking,
# compared to other methods of achieving that.
# ... such that these components are a symlink.
(?(?{ -l $1 }) | (?!) )
# see perldoc perlre for a description of how
# (?(condition)yes-pattern|no-pattern) works.
# If there are more components, set $2 to "/".
(/?)
}{
my $from = $1;
my $to = readlink( $from ) or die "readlink $from failed: $!";
my $t2 = File::Spec->canonpath( File::Spec->rel2abs($to, $from) );
die "File $from points to $to [$t2], which doesn't exist\n"
unless -e $t2;
if( $2 ) {
die "Expected a $t2 [$from -> $to] to be a directory\n"
unless -d _ or -l _;
$t2 .= "/" unless $t2 =~ m</\z>;
}
$t2;
}xsge;
[untested]
I only wrote this with unix in mind -- the only concession to cygwin
(the only other place I can think of offhand that might have symlinks)
is that I have "/+" where I otherwise would have had "/" when matching
directory components.
I'm not entirely certain that the canonpath calls are needed, but I *do*
believe that the rel2abs calls are.
--
$..='(?:(?{local$^C=$^C|'.(1<<$_).'})|)'for+a..4;
$..='(?{print+substr"\n !,$^C,1 if $^C<26})(?!)';
$.=~s'!'haktrsreltanPJ,r coeueh"';BEGIN{${"\cH"}
|=(1<<21)}""=~$.;qw(Just another Perl hacker,\n);
------------------------------
Date: Thu, 26 Dec 2002 20:20:05 -0600
From: Lance Hoffmeyer <lance@augustmail.com>
Subject: Re: win32::ole woes
Message-Id: <slrnb0ne75.6er.lance@buddha.hofflund.net>
I was still pretty far off track :). Thank you so much for your help.
The code is still not finding "msoEmbeddedOLDObject()".
I get:
undefined subroutine &main::msoEmbeddedOLEObject (paraphrased)
I can insert "7" and things run fine.
I have "use Win32::OLE::Const" defined but the constant is still
not being named? Any suggestion? Not a real big deal, just my
O/C.
I am writing perl instead of using Excel because I have a file that
opens Word, grabs some numbers and inserts them into Excel and PPT,
exclusively. Don't really need Excel but just planning ahead. I want
to keep every thing in one file (easy to locate) instead of having different
files to do different (test.pl + test.ppt + test.xls) things. Seems
like it could get confusing on down the line.
Lance Hoffmeyer
lance@augustmail.com
------------------------------
Date: Fri, 27 Dec 2002 04:13:09 GMT
From: tiltonj@erols.com (Jay Tilton)
Subject: Re: win32::ole woes
Message-Id: <3e0bbb95.173970147@news.erols.com>
Lance Hoffmeyer <lance@augustmail.com> wrote:
: The code is still not finding "msoEmbeddedOLDObject()".
:
: I get:
: undefined subroutine &main::msoEmbeddedOLEObject (paraphrased)
Wiggy. I'd have a look at what constants it does import.
use Win32::OLE::Const;
my $foo = Win32::OLE::Const->Load('Microsoft Office');
printf "%s => %s\n", $_, $foo->{$_} for sort keys %$foo;
: I can insert "7" and things run fine.
That works. If you anticipate using one or only a few constants,
looking up the numeric values is probably a better idea than having a
thousand constants (disguised as subroutines) jamming up your
namespace.
: I want
: to keep every thing in one file (easy to locate) instead of having different
: files to do different (test.pl + test.ppt + test.xls) things. Seems
: like it could get confusing on down the line.
Good point. Getting any kind of DWIM out of OLE is like herding cats.
Keeping track of where you put all the pieces of your project just
makes it worse.
------------------------------
Date: Fri, 27 Dec 2002 01:07:46 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: win32::ole woes
Message-Id: <3E0BEE32.7FCAD57F@earthlink.net>
Lance Hoffmeyer wrote:
[snip problem]
Your problem isn't really a perl problem, it's a lack of understanding
of PowerPoint's OLE interface. You would have similar problems no
matter what language you wrote this in.
However, I can give you a bit of general perl advice on your program,
which should help you write readable programs, and thus will help others
give you advice.
> use strict;
Good.
> use warnings;
Good.
> use Win32::OLE;
Ok.
> use Win32::OLE::Const;
Err, why do this?
The docs of that module only suggest you load it this way if you're
planning on later doing
my $something = Win32::OLE::Const->Load( .... );
If you're planning on importing the constants as subroutines, then you
don't need it.
> use Win32::OLE 'in';
If you have this here, then why do you have "use Win32::OLE;" earlier?
It seems to me to be a waste of cpu time.
> use Win32::OLE::Const 'Microsoft Office';
> use Win32::OLE::Const 'Microsoft PowerPoint';
The docs indicate that the argument is actually used as a regex, which
means that you can combine these two lines into the following single
line:
use Win32::OLE::Const 'Microsoft (Office|PowerPoint)';
> my $p1=Win32::OLE->GetActiveObject('Powerpoint.Application')
> ||Win32::OLE->new('PowerPoint.Application','Quit');
Have you read perldoc perlstyle? If not, do so.
Plus, you should have code which runs if ->new fails.
my $pl = Win32::OLE->GetActiveObject('Powerpoint.Application')
|| Win32::OLE->new('PowerPoint.Application','Quit')
or die "Couldn't load PowerPoint: ".Win32::OLE->LastError();
> $p1->{Visible} = 1;
This is just a WAG, but does this line make the PowerPoint window
visible? If so, why do you do this? Does the user really need to see
the document being edited for your program to work?
> $p1->Presentations->Open({FileName=>"b:\\perl\\test.ppt"});
Even without knowing anything about PowerPoint's OLE interface, it feels
very wrong to me to see any kind of "open" function used without the
return value being checked. What does Open do, and what does it return?
> foreach my $shape (in $p1->Slides(1)->Shapes()){
> if ($shape->{Type}==msoEmbeddedOLEObject()){
> $shape->Application->DataSheet->Range("AS1:AS1")=10};
> };
This needs whitespace to be readable to humans. Try writing it as:
foreach my $shape (in $p1->Slides(1)->Shapes()) {
if( $shape->{Type} == msoEmbeddedOLEObject() ) {
$shape->Application->DataSheet->Range("AS1:AS1") = 10
}
}
Seeing this, I notice that you have ...->Range(...) = 10. In general,
you cannot assign to method or subroutine calls. (Exceptions are the
builtin substr() and vec() subroutines, and user subs with the ":lvalue"
property).
As little as I know about PowerPoint, I seem to recall seeing an example
somewhere in the docs of Win32::OLE where something is stuck in the
results of ->Range(...). Hmm... Yes, it was:
# write a 2 rows by 3 columns range
$sheet->Range("A8:C9")->{Value} = [[ undef, 'Xyzzy', 'Plugh' ],
[ 42, 'Perl', 3.1415 ]];
Yes, that looks sensible -- even though you can't assign directly to
->Range(...), you can dereference it (in this example, it's a hash
element dereference) and then assign to that dereferenced result.
Why didn't you do that?
$shape->Application->DataSheet->Range("AS1:AS1")->{Value} = 10;
Hmm, just a few lines down, it shows that if you're only accessing a
single cell, don't need to give starting and ending cells. So:
$shape->Application->DataSheet->Range("AS1")->{Value} = 10;
--
$..='(?:(?{local$^C=$^C|'.(1<<$_).'})|)'for+a..4;
$..='(?{print+substr"\n !,$^C,1 if $^C<26})(?!)';
$.=~s'!'haktrsreltanPJ,r coeueh"';BEGIN{${"\cH"}
|=(1<<21)}""=~$.;qw(Just another Perl hacker,\n);
------------------------------
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 4316
***************************************
