[22806] in Perl-Users-Digest
Perl-Users Digest, Issue: 5027 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu May 22 18:05:43 2003
Date: Thu, 22 May 2003 15:05:11 -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 Thu, 22 May 2003 Volume: 10 Number: 5027
Today's topics:
32 bits checksum calculation <dmn@box43.pl>
Re: 32 bits checksum calculation <nobull@mail.com>
Re: day of week <garry@ifr.zvolve.net>
Help strange bug: "panic: utf8_length: unaligned end at <recycle@bin.com>
Re: is flock() needed when reading a DB ? <garry@ifr.zvolve.net>
Parse all xml tags and put them in an array (Jacob Larsen)
perl search script (Terry Carter)
Re: perl search script (Tad McClellan)
Safe use of floor function (Jan Fure)
Re: Safe use of floor function <ddunham@redwood.taos.com>
Re: Safe use of floor function <TruthXayer@yahoo.com>
Re: Safe use of floor function <nobull@mail.com>
Re: skipping lines based on a condition <krahnj@acm.org>
Re: trying to create spaces <chris_12003@yahoo.com>
Re: trying to create spaces <chris_12003@yahoo.com>
Re: trying to create spaces (Sam Holden)
Re: trying to create spaces <abigail@abigail.nl>
Re: trying to create spaces <nobull@mail.com>
Re: Win32::OLE <nobull@mail.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 22 May 2003 22:12:12 +0200
From: "Dariusz Nowak" <dmn@box43.pl>
Subject: 32 bits checksum calculation
Message-Id: <bajapf$sun$1@nemesis.news.tpi.pl>
Could you help me to find the best way to calculate a 32 bits checksum,
on a data file.
Lets say I have filehandle $fh, to data file:
------------------------------------------------------------
#!/usr/bin/perl
use FileHandle;
my $fh = new IO::FileHandle;
open($fh,">/tmp/data.bin");
my $data = '';
my $file_size = (stat $file)[7]
my $bytes_read = read($fh, $data, $file_size);
unless ($bytes_read == $file_size) {
print "Only $bytes_read read";
exit;
}
-----------------------------------------------------------
Darek
------------------------------
Date: 22 May 2003 21:26:02 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: 32 bits checksum calculation
Message-Id: <u9fzn6zq1x.fsf@wcl-l.bham.ac.uk>
"Dariusz Nowak" <dmn@box43.pl> writes:
> Could you help me to find the best way to calculate a 32 bits checksum,
> on a data file.
What sort of checksum algorithm to you want?
> Lets say I have filehandle $fh, to data file:
>
> ------------------------------------------------------------
> #!/usr/bin/perl
>
> use FileHandle;
> my $fh = new IO::FileHandle;
Is it IO::File or IO::Handle or FileHandle?
Choose one.
Better still choose none. Just then open() autovivify.
> open($fh,">/tmp/data.bin");
I suspect you wanted to open for reading.
> my $data = '';
> my $file_size = (stat $file)[7]
> my $bytes_read = read($fh, $data, $file_size);
Well if you've already decided that you are going to slurp the file
then your question not how to calculate the checksum of a file but
rather the checksum of a string.
So which is it?
Personally for a simple XOR checksum of a file:
my $sum = '';
{
local $/ = \4;
$sum ^= $_ while <$fh>;
}
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Thu, 22 May 2003 18:26:32 -0000
From: Garry Williams <garry@ifr.zvolve.net>
Subject: Re: day of week
Message-Id: <slrnbcq5ir.pbr.garry@zfw.zvolve.net>
On Thu, 22 May 2003 17:52:33 -0000, Garry Williams
<garry@ifr.zvolve.net> wrote:
> On Thu, 22 May 2003 14:35:37 GMT, Jeff Thies
><cyberjeff@sprintmail.com> wrote:
[snip]
>
> #!/usr/local/bin/perl
> use strict;
> use warnings;
> use Time::Local;
>
> my %dow = ( 0 => 'Sunday', 1 => 'Monday', 2 => 'Tuesday',
> 3 => 'Wednesday', 4 => 'Thursday', 5 => 'Friday',
> 6 => 'Saturday' );
>
> my $date = '05/21/03';
>
> my ($mm, $da, $yr) = split m#/#, $date;
>
> my $then = timelocal 0, 0, 0, $da, $mm - 1, $yr + 1900;
Oops, that should be (for your format):
my $then = timelocal 0, 0, 0, $da, $mm - 1, $yr + 2000;
> print "day of week is ", $dow{(localtime $then)[6]}, "\n";
>
> __END__
--
Garry Williams
------------------------------
Date: Thu, 22 May 2003 20:20:30 +0200
From: "Craig Manley" <recycle@bin.com>
Subject: Help strange bug: "panic: utf8_length: unaligned end at ....."
Message-Id: <3ecd150b$0$154$e4fe514c@dreader7.news.xs4all.nl>
Hi,
I've got a chat application that is now being used by french speakers. Since
french people use a lot if non-ascii characters, my code often die's with
this unexpected error when checking the length() of the string:
panic: utf8_length: unaligned end at ....... line 21.
all that line does is check the length of the string like this:
if (length($s)) { .....
where $s = "Jannot s'est connecté." (for example).
I can't simulate this error by copying and pasting the string + code into a
new script, so I hope somebody can figure it out for me.
I'm using Perl 5.6.1 on Linux.
-Craig Manley
------------------------------
Date: Thu, 22 May 2003 19:47:48 -0000
From: Garry Williams <garry@ifr.zvolve.net>
Subject: Re: is flock() needed when reading a DB ?
Message-Id: <slrnbcqab8.pbr.garry@zfw.zvolve.net>
On 21 May 2003 14:32:39 -0700, dan baker <botfood@yahoo.com> wrote:
> I have a DB to manage some member addresses and such... most writes
> will be really quick and either creating or updating a single record.
> I understand the need to lock the file prior to write.... but I am
> wondering if locking is required prior to a read?
Yes. Readers will want shared locks and writers will want exclusive
locks.
> There are report
> generators that will spend a couple seconds reading, and I would like
> to know if I need to lock the DB during these processes to prevent
> corruption if a write comes in from another user while I am generating
> reports.
>
> I am using tie() with DB_File
>
> Related to this seems to be the relative difficulty in locking a
> tie()ed hash filesince flock() typically works on open filehandles. It
> looks like most people create a separate lockfile, and use it rather
> than locking the tie()ed hash directly.
That's because of the underlying implementation. See the manual page
for DB_File for why you do not want to lock the Berkeley DB file. Use
another file as a semaphore.
> I am wondering if there any
> other really simple examples of creating or locking a flag file, doing
> my DB write, and then unlocking or unlinking the flag file in whatever
> manner will protect the DB during writes....
# writers use this:
use Fcntl qw/:flock/;
open(my $fh, ">>", "/path/to/semaphore/file")
or die "can't open /path/to/semaphore/file: $!\n";
flock $fh, LOCK_EX or die "flock: $!\n";
# tie, update and untie db
close($fh);
#------------------------------------
# readers use this:
use Fcntl qw/:flock/;
open(my $fh, "/path/to/semaphore/file")
or die "can't open /path/to/semaphore/file: $!\n";
flock $fh, LOCK_SH or die "flock: $!\n";
# tie, read and untie db
close($fh);
--
Garry Williams
------------------------------
Date: 22 May 2003 14:43:40 -0700
From: post@jfl.dk (Jacob Larsen)
Subject: Parse all xml tags and put them in an array
Message-Id: <b0ec2425.0305221343.73424525@posting.google.com>
Would it be possible to create a regular expression that can parse all
xml tags and put them in an array?
If so, how should I do that for the following tags?
<wl id="tableA" title="A" type="table">
<wl id="tableB" title="B" type="table">
<wl id="itemBA" title="BA" type="text"></wl>
<wl id="itemBB" title="BB" type="text"></wl>
</wl>
</wl>
Here is how far I got:
tags: /<wl(.*)(?<!\\\)>/isU
parameters: /\s+(id|title|type)\s?\=\s?(["|\'|"|])(.*)(?<!\\\)\\2/isU
As a result I would like to have an array like this:
array['tableA'] = '
<wl id="tableB" title="B" type="table">
<wl id="itemBA" title="BA" type="text"></wl>
<wl id="itemBB" title="BB" type="text"></wl>
</wl>
'
array['tableB'] = '
<wl id="itemBA" title="BA" type="text"></wl>
<wl id="itemBB" title="BB" type="text"></wl>
'
If someone could help me with this I'd be happy to even pay you via
www.sharksforum.com
Regards Jacob
------------------------------
Date: 22 May 2003 13:37:49 -0700
From: tcarter@entigo.com (Terry Carter)
Subject: perl search script
Message-Id: <690cae38.0305221237.1dff9982@posting.google.com>
I have a large log file to search that looks like this:
[05/22/2003] Start New Trans!
.......
.......
.......
.......
[05/22/2003] End Trans
[05/22/2003] Start New Trans!
.......
.......
.......
.......
[05/22/2003] End Trans
[05/22/2003] Start New Trans!
.......
.......
.......
.......
[05/22/2003] Start New Trans!
.......
.......
.......
.......
[05/22/2003] End Trans
as you can see that are times when a new trans starts without an
ending tag. I'd like to search for 2 start tags without an ending tag
and display the start tag line so I can search for it in the log.
Can this be done in perl and can someone give me an example?
Thanks
------------------------------
Date: Thu, 22 May 2003 16:33:22 -0500
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: perl search script
Message-Id: <slrnbcqgh2.370.tadmc@magna.augustmail.com>
Terry Carter <tcarter@entigo.com> wrote:
> as you can see that are times when a new trans starts without an
> ending tag. I'd like to search for 2 start tags without an ending tag
> and display the start tag line so I can search for it in the log.
Wouldn't it be nicer to just recognize and process each record?
> Can this be done in perl and can someone give me an example?
I can give an example of recognizing each record:
------------------------------------------------
#!/usr/bin/perl
use strict;
use warnings;
my $rec = '';
while ( <DATA> ) {
if ( /End Trans/ ) {
$rec .= $_;
print "processing this record:\n$rec----\n";
$rec = ''; # reset record buffer
}
elsif ( $rec and /Start New Trans/ ) {
print "processing unterminated record:\n$rec----\n";
$rec = $_;
}
else
{ $rec .= $_ }
}
if ( $rec ) { # in case the very last record is unterminated
print "processing unterminated record:\n$rec----\n";
}
__DATA__
[05/22/2003] Start New Trans!
.......
.......
.......
.......
[05/22/2003] End Trans
[05/22/2003] Start New Trans!
.......
.......
.......
.......
[05/22/2003] Start New Trans!
.......
.......
.......
.......
[05/22/2003] End Trans
[05/22/2003] Start New Trans!
.......
.......
.......
------------------------------------------------
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 22 May 2003 12:27:55 -0700
From: jan_may2002_fure@attbi.com (Jan Fure)
Subject: Safe use of floor function
Message-Id: <e47a84bf.0305221127.2cbbd36@posting.google.com>
Hi;
I have some code where using the floor function seems easiest, but I
fear the floating point nature of Perl scalars might cause some
unintended consequences.
The function I am trying to implement is the extraction of column
number (x-coordinate) from the number ($M) in a geometrical arangement
like:
9,10,11,12,
5,6,7,8,
1,2,3,4
I have code which does this using floor, and my concern is whether
floor applied to an integer (n) might sometimes return 'n', and
sometimes 'n-1'.
In the intended final application, the floor function will operate on
a scalar like '1,2,3.....n', but I would like to make the function
robust enough that it could accept input like '1.0,2.0,3.0.....n'. Any
suggestions?
I appologize in advance if this is a faq, I did read through perfaq4,
but it does not seem to answer this question.
Code below:
#!/usr/local/bin/perl
use strict;
use warnings;
use POSIX;
my $M=1;
while($M<13){
my $x=4*((($M-1)/4)-(floor(($M-1)/4)));
print "$M\t$x\n";
$M++;
}
Jan Fure
------------------------------
Date: Thu, 22 May 2003 19:54:21 GMT
From: Darren Dunham <ddunham@redwood.taos.com>
Subject: Re: Safe use of floor function
Message-Id: <NV9za.48$XN6.5629150@newssvr13.news.prodigy.com>
Jan Fure <jan_may2002_fure@attbi.com> wrote:
> Hi;
> I have code which does this using floor, and my concern is whether
> floor applied to an integer (n) might sometimes return 'n', and
> sometimes 'n-1'.
If it's truly an integer, then there's no danger about using floor.
Integers can be exactly represented. It's floating point numbers that
cannot.
> In the intended final application, the floor function will operate on
> a scalar like '1,2,3.....n', but I would like to make the function
> robust enough that it could accept input like '1.0,2.0,3.0.....n'. Any
> suggestions?
Perhaps you just want to add a small amount (say 0.001) to each figure
before applying floor.
> I appologize in advance if this is a faq, I did read through perfaq4,
> but it does not seem to answer this question.
> Code below:
> #!/usr/local/bin/perl
> use strict;
> use warnings;
> use POSIX;
> my $M=1;
> while($M<13){
> my $x=4*((($M-1)/4)-(floor(($M-1)/4)));
> print "$M\t$x\n";
> $M++;
> }
Well that looks like some sort of rewrite of 'mod' to me. You'll note
that you're not calling floor on integers at all. You're calling floor
on the result of a division. Now it should all work fine in this case,
but I might change some things around.
You could change that to use integer arithmetic and not do any floating
point division at all...
Perhaps this?
use integer;
foreach my $M ( 1 .. 12 )
{
my $x = ($M - 1) % 4;
print "$M\t$x\n";
}
--
Darren Dunham ddunham@taos.com
Unix System Administrator Taos - The SysAdmin Company
Got some Dr Pepper? San Francisco, CA bay area
< This line left intentionally blank to confuse you. >
------------------------------
Date: Thu, 22 May 2003 12:59:39 -0700
From: TruthXayer <TruthXayer@yahoo.com>
Subject: Re: Safe use of floor function
Message-Id: <3ECD2C2B.3E793964@yahoo.com>
Jan Fure wrote:
>
> Hi;
>
> I have some code where using the floor function seems easiest, but I
> fear the floating point nature of Perl scalars might cause some
> unintended consequences.
> In the intended final application, the floor function will operate on
> a scalar like '1,2,3.....n', but I would like to make the function
> robust enough that it could accept input like '1.0,2.0,3.0.....n'. Any
> suggestions?
You should be fine with floor but for the below points when
the number passed to floor is NaN,Inf,+-0. Again it is
overkill , just do sprintf to finetune the input.
The floor() function computes the largest integral value
not
greater than x. Upon successful completion, floor()
returns the largest
integral value not greater than x, expressed as a double.
If x is NaN, NaN is returned.
>my $M=1;
>floor(($M-1)/4))
If x is +Inf or +0, x is returned.
------------------------------
Date: 22 May 2003 21:09:35 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Safe use of floor function
Message-Id: <u9k7cizqtc.fsf@wcl-l.bham.ac.uk>
jan_may2002_fure@attbi.com (Jan Fure) writes:
> I have some code where using the floor function seems easiest,
> my $x=4*((($M-1)/4)-(floor(($M-1)/4)));
Personally since Perl has a builin modulo operator that would seem
easiest just to use it:
my $x = ($M-1) % 4;
If you want to reconstruct it using floor avoid ever multiplying
fractions:
my $x=$M-1-4*floor(($M-1)/4);
That said 1/4 does have an exact representation in binary so you'd
probably have been ok.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Thu, 22 May 2003 19:13:30 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: skipping lines based on a condition
Message-Id: <3ECD2125.7520C1E7@acm.org>
david wrote:
>
> I have a data file that has alternating lines in a comma seperated
> format like this:
> 8,00000000,xxxx,yyyyy etc etc. (There are 37 fields in records
> starting with '8')
> 37,0000000,bbbbb,ccccc,12345
> 8,00000000,ddddd,eeeeee, etcetc
> 37,0000000,fffff,gggggg,45678
>
> I want to parse only records starting with 8, and leave the 37's
> alone. I can't seem to find a way to do this. Here is what I have so
> far. (which removes the 37 lines from the output file entirely. I want
> to rewrite the file in the exact format that it is in now, without
> touching '37' records:
>
> use strict;
> my @out;
>
> if (@ARGV ne 1) {
You should use numerical comparison operators when comparing numbers:
if ( @ARGV != 1 ) {
Or:
unless ( @ARGV == 1 ) {
> print "Not enough ARGVS\n";
> exit 0
> }
> open (IN, "<$ARGV[0]") || die "Cannot open input file\!\n";
> open (OUT, ">Import52.txt") || die "Cannot open output file\!\n";
You should include the file name and the $! variable so you know why
open failed.
open IN, $ARGV[0] or die "Cannot open $ARGV[0] $!";
open OUT, '>Import52.txt' or die "Cannot open Import52.txt $!";
> while ( <IN> ) {
> if (/^8\,00000000.*?/) {
> # Split fields by ;
> my @comments = split (/,/);
> if ($comments[8] =~ m/(.*)?/) {
That test is completely useless.
> my $new = $1;
> $new =~ s/\//\-/g;
> ( $comments[8], $new ) = ( $new, $comments[8]
> );
> push (@out, join(",", @comments));
> }
> }
next unless /^8,/;
my @comments = split /,/, $_, 10;
$comments[8] =~ tr!/!-!;
push @out, join ',', @comments;
> }
> print OUT @out;
> close(IN);
> close(OUT);
John
--
use Perl;
program
fulfillment
------------------------------
Date: Thu, 22 May 2003 13:27:57 -0700
From: "Chris" <chris_12003@yahoo.com>
Subject: Re: trying to create spaces
Message-Id: <vcqadu5hkm6iaf@corp.supernews.com>
I'm trying to put spaces on a line to appear on my webpage. I currently
have:
$temp_desc = "a
b";
but when I do
print qq~
$temp_desc
~;
it displays
a b
and I want
a
b
- Chris
"Abigail" <abigail@abigail.nl> wrote in message
news:slrnbco7lt.kuj.abigail@alexandra.abigail.nl...
> Chris (chris_12003@yahoo.com) wrote on MMMDLI September MCMXCIII in
> <URL:news:f5Vya.674928$OV.634214@rwcrnsc54>:
> {} nl~~nl will give me a blank line. Is there something that will give
me
> {} extra white space between characters. Right now if I type "a
> {} b", it gets displayed as "a b".
>
>
> What on earth is your question?
>
>
> Abigail
> --
> sub camel
(^#87=i@J&&&#]u'^^s]#'#={123{#}7890t[0.9]9@+*`"'***}A&&&}n2o}00}t324i;
> h[{e
**###{r{+P={**{e^^^#'#i@{r'^=^{l+{#}H***i[0.9]&@a5`"':&^;&^,*&^$43##@@####;
>
c}^^^&&&k}&&&}#=e*****[]}'r####'`=437*{#};::'1[0.9]2@43`"'*#==[[.{{],,,1278@
#@);
> print+((($llama=prototype'camel')=~y|+{#}$=^*&[0-9]i@:;`"',.|
|d)&&$llama."\n");
------------------------------
Date: Thu, 22 May 2003 13:29:33 -0700
From: "Chris" <chris_12003@yahoo.com>
Subject: Re: trying to create spaces
Message-Id: <vcqah0mjqb1626@corp.supernews.com>
Shoot it wrapped, it was suppose to display a b on the same line.
- Chris
"Chris" <chris_12003@yahoo.com> wrote in message
news:vcqadu5hkm6iaf@corp.supernews.com...
> I'm trying to put spaces on a line to appear on my webpage. I currently
> have:
>
> $temp_desc = "a
> b";
>
> but when I do
> print qq~
> $temp_desc
> ~;
>
> it displays
> a b
>
> and I want
> a
> b
>
> - Chris
>
>
> "Abigail" <abigail@abigail.nl> wrote in message
> news:slrnbco7lt.kuj.abigail@alexandra.abigail.nl...
> > Chris (chris_12003@yahoo.com) wrote on MMMDLI September MCMXCIII in
> > <URL:news:f5Vya.674928$OV.634214@rwcrnsc54>:
> > {} nl~~nl will give me a blank line. Is there something that will give
> me
> > {} extra white space between characters. Right now if I type "a
> > {} b", it gets displayed as "a b".
> >
> >
> > What on earth is your question?
> >
> >
> > Abigail
> > --
> > sub camel
> (^#87=i@J&&&#]u'^^s]#'#={123{#}7890t[0.9]9@+*`"'***}A&&&}n2o}00}t324i;
> > h[{e
>
**###{r{+P={**{e^^^#'#i@{r'^=^{l+{#}H***i[0.9]&@a5`"':&^;&^,*&^$43##@@####;
> >
>
c}^^^&&&k}&&&}#=e*****[]}'r####'`=437*{#};::'1[0.9]2@43`"'*#==[[.{{],,,1278@
> #@);
> > print+((($llama=prototype'camel')=~y|+{#}$=^*&[0-9]i@:;`"',.|
> |d)&&$llama."\n");
>
>
------------------------------
Date: 22 May 2003 20:04:00 GMT
From: sholden@flexal.cs.usyd.edu.au (Sam Holden)
Subject: Re: trying to create spaces
Message-Id: <slrnbcqb9g.isd.sholden@flexal.cs.usyd.edu.au>
On Thu, 22 May 2003 13:27:57 -0700, Chris <chris_12003@yahoo.com> wrote:
> I'm trying to put spaces on a line to appear on my webpage. I currently
> have:
>
> $temp_desc = "a
> b";
>
> but when I do
> print qq~
> $temp_desc
> ~;
>
> it displays
> a b
>
> and I want
> a
> b
Learn HTML.
And ask in an HTML group as to how to actually do it...
And finally, top posting it a great way to get yourself ignored by
a significant number of the most knowledgable people here.
[snip complete quote with a sig]
--
Sam Holden
------------------------------
Date: 22 May 2003 20:04:41 GMT
From: Abigail <abigail@abigail.nl>
Subject: Re: trying to create spaces
Message-Id: <slrnbcqbap.kuj.abigail@alexandra.abigail.nl>
Chris (chris_12003@yahoo.com) wrote on MMMDLI September MCMXCIII in
<URL:news:vcqadu5hkm6iaf@corp.supernews.com>:
.. I'm trying to put spaces on a line to appear on my webpage. I currently
.. have:
Please don't top post.
And ask your question in a group about HTML. Your problem has nothing
to do with Perl, because Perl will print that newline.
Abigail
--
srand 123456;$-=rand$_--=>@[[$-,$_]=@[[$_,$-]for(reverse+1..(@[=split
//=>"IGrACVGQ\x02GJCWVhP\x02PL\x02jNMP"));print+(map{$_^q^"^}@[),"\n"
------------------------------
Date: 22 May 2003 20:58:58 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: trying to create spaces
Message-Id: <u9of1uzrb1.fsf@wcl-l.bham.ac.uk>
"Chris" <chris_12003@yahoo.com> rudely vomits TOFU in our faces:
[ Please stop being so rude. Being rude tends to predispose people
not to want to help you. ]
> I'm trying to put spaces on a line to appear on my webpage. I
> currently have...
Whould this be an HTML (or XML for that matter) web page by any
chance?
Your problem has nothing whatever, in the slightest, to do with Perl.
Try generating an HTML page with a simple test editor and you'll
observe exactly the same.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: 22 May 2003 19:57:02 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Win32::OLE
Message-Id: <u9u1bmzu69.fsf@wcl-l.bham.ac.uk>
grehom@ntlworld.com (Graham Smith) writes:
> I am trying to use OLE to automate plotting points in DesignCAD to
> save laboriously typing in each coordinate and have got stuck
> translating the following bit of Visual Basic
>
> DcPts.GetUserPoint X, Y, Z
>
> I have tried the following:
>
> my $x = Variant(VT_R8, 0.0);
> my $y = Variant(VT_R8, 0.0);
> my $z = Variant(VT_R8, 0.0);
>
> $DcPts->GetUserPoint($x, $y, $z)
> or die( "Unable to get user point ", Win32::OLE->LastError() );
> print "x=$x, y=$y, z=$z\n";
>
Since you are trying to get values back you need VT_BYREF in there.
> The problem is when the code runs it returns the following error:
>
> C:\perlSrcs\DesignCad>perl -w draw_points_rel.pl u 5 r 5 d 5 l 5
> Win32::OLE(0.1603) error 0x80020005: "Type mismatch"
> in METHOD/PROPERTYGET "GetUserPoint" argument 1 at
> draw_points_rel.pl line 91
>
> The OLE Browser documents the function as follows:
>
> Function GetUserPoint(dX As Double, dY As Double, dZ As Double) As
> Boolean Member of DesignCAD.CmdPoints
Well double should ve VT_R8 alright, so try VT_BYREF|VT_R8
Note I have an unpolished module that simplifies the
Win32::OLE::Variant interface:.
$DcPts->GetUserPoint(ByRef([VT_R8], my($x, $y, $z) = (0,0,0)));
# $x, $y, $z are now plain numbers not Win32::OLE::Variant
-------------------
package Local::Win32::OLE::Varients;
use strict;
use warnings;
use Carp;
use Win32::OLE::Variant;
require Exporter;
our(@ISA) = qw(Exporter);
our(@EXPORT) = qw(ByRef Variants);
# We can't subclass Win32::OLE::Variant so we must hook into its
# destructor
my $oDESTROY = \&Win32::OLE::Variant::DESTROY;
my %tie;
sub ByRef {
unshift @_ => [ VT_DISPATCH ]
unless ref $_[0] eq 'ARRAY';
unshift @_ => VT_BYREF;
&_variants;
}
sub Variants {
unshift @_ => 0;
&_variants;
}
sub _variants {
my $byref = shift;
my $types = shift;
my @result;
for my $arg ( \ (@_) ) {
my $type = $types->[0] | $byref;
my $variant = Variant( $type, $$arg);
$tie{overload::StrVal $variant} = $arg
if $type & $byref;
push @result => $variant;
shift @$types if @$types > 1;
}
unless (wantarray) {
croak((caller 0)[3] . "() in scalar context with multiple arguments")
if @result > 1;
return $result[0];
}
@result;
};
no warnings 'redefine';
*Win32::OLE::Variant::DESTROY = sub {
if ( my $var = delete $tie{overload::StrVal $_[0]} ) {
$$var = $_[0]->Value;
}
&$oDESTROY;
};
1;
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
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 5027
***************************************
