[29195] in Perl-Users-Digest
Perl-Users Digest, Issue: 439 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed May 16 09:10:07 2007
Date: Wed, 16 May 2007 06:09:05 -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 Wed, 16 May 2007 Volume: 11 Number: 439
Today's topics:
Apache+Perl Net::SMTP Strange problem zhaoningli@gmail.com
Re: Apache+Perl Net::SMTP Strange problem zhaoningli@gmail.com
copy help. <rajendra.prasad@in.bosch.com>
Re: copy help. <spamtrap@dot-app.org>
Re: Creating Packages <whoami@whereami.net>
Re: Creating Packages <sisyphus1@nomail.afraid.org>
How move figure entity to splited files <sahoo.byomokesh@gmail.com>
Re: How move figure entity to splited files <mirod@xmltwig.com>
Re: how to create multiple zip files that are no larger xhoster@gmail.com
Re: how to create multiple zip files that are no larger <wyzelli@yahoo.com>
Re: how to create multiple zip files that are no larger <joe@inwap.com>
new CPAN modules on Wed May 16 2007 (Randal Schwartz)
Re: Parsing a text file line-by-line: skipping badly-fo <bart.lateur@pandora.be>
Perl initiated SSL handshake using MSWindows key storag vdpopov@gmail.com
Re: The Pure Joy of Receiving PayPal Money <ignoramus10518@NOSPAM.10518.invalid>
Re: Using "Perl Best Practices" inside-out objects <Peter@PSDT.com>
Re: Using "Perl Best Practices" inside-out objects <bik.mido@tiscalinet.it>
Re: Using "Perl Best Practices" inside-out objects <mritty@gmail.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 15 May 2007 23:07:10 -0700
From: zhaoningli@gmail.com
Subject: Apache+Perl Net::SMTP Strange problem
Message-Id: <1179295630.227337.91790@u30g2000hsc.googlegroups.com>
I am setting up a web application using apache 2.2 + perl v5.8.8 on
FC5. The application needs to send out email using a SMTP server as
mail relay (MTA). I wrote a test perl script test.cgi. Run the script
as CGI, it always return with errors. The code fails at:
my $smtp=new Net::SMTP($smtpserver, Timeout =>60) || die 'Cannot
connect to smtp server';
The apache server is configured to run at apache:apache. The above
script works well if I use
bash# sudo -u apache perl test.cgi.
Please advise how to fix this. Thanks a lot.
------------------------------
Date: 15 May 2007 23:41:15 -0700
From: zhaoningli@gmail.com
Subject: Re: Apache+Perl Net::SMTP Strange problem
Message-Id: <1179297675.110803.25480@p77g2000hsh.googlegroups.com>
The full script I wrote is as the following:
#!/usr/bin/perl
use Net::SMTP;
use MIME::Base64;
print "Content-Type: text/html; charset=UTF-8\n\n\n";
print "\n\n<html><body>Hello</body></html>\n\n";
MessageToMTA();
exit;
sub trim {
my ($str) = @_;
if ($str) {
$str =~ s/^\s+//g;
$str =~ s/\s+$//g;
}
return $str;
}
sub MessageToMTA {
my $rcpt_to = trim('test@abc.com');
my $smtp_server = '192.168.1.100';
my $smtp_user = 'test@abc.com';
my $smtp_pass = '123';
my $encode_smtpuser = trim(encode_base64($smtp_user));
my $encode_smtppass = trim(encode_base64($smtp_pass));
my $smtp = Net::SMTP->new($smtp_server, Timeout => 60, Debug
=> 1) || die 'Cannot connect to smtp server';
my $result = $smtp->command('AUTH', 'LOGIN');
my $answer = $smtp->getline();
$result = $smtp->command($encode_smtpuser);
$answer = $smtp->getline();
$result = $smtp->command($encode_smtppass);
$answer = $smtp->getline();
$smtp->mail($smtp_user);
$smtp->to($rcpt_to);
$smtp->data();
$smtp->datasend('here');
$smtp->dataend();
$smtp->quit;
}
On May 16, 2:07 pm, zhaonin...@gmail.com wrote:
> I am setting up a web application using apache 2.2 + perl v5.8.8 on
> FC5. The application needs to send out email using a SMTP server as
> mail relay (MTA). I wrote a test perl script test.cgi. Run the script
> as CGI, it always return with errors. The code fails at:
>
> my $smtp=new Net::SMTP($smtpserver, Timeout =>60) || die 'Cannot
> connect to smtp server';
>
> The apache server is configured to run at apache:apache. The above
> script works well if I use
>
> bash# sudo -u apache perl test.cgi.
>
> Please advise how to fix this. Thanks a lot.
------------------------------
Date: Wed, 16 May 2007 11:03:34 +0530
From: "rajendra" <rajendra.prasad@in.bosch.com>
Subject: copy help.
Message-Id: <f2e4d9$b9h$1@news4.fe.internet.bosch.com>
Hello All,
I want to copy multiple files in a single "copy" DOS command to same
destination.
Can I do this?. If this is possible, what is the syntax.
With Rgds,
Raj
------------------------------
Date: Wed, 16 May 2007 01:58:25 -0400
From: Sherm Pendley <spamtrap@dot-app.org>
Subject: Re: copy help.
Message-Id: <m2tzudfgxq.fsf@local.wv-www.com>
"rajendra" <rajendra.prasad@in.bosch.com> writes:
> I want to copy multiple files in a single "copy" DOS command to same
> destination.
> Can I do this?. If this is possible, what is the syntax.
Your question is too vague to answer precisely. Here are some potential
clues:
The syntax for the DOS command is the same as it would be if you were
running it manually, or by way of a batch or Python script. Ask in a DOS
or Windows group if you need help with that part.
To run the DOS command from Perl, have a look at "perldoc -f system". Or
if you want to capture its output, have a look at the `` or qx operators
in "perldoc perlop". You can also open it with open() and read its output
that way - see "perldoc perlopentut" and "perldoc -f open".
You can also copy files without using external commands - far better if
you're looking for portability. Have a look at "File::Copy".
sherm--
--
Web Hosting by West Virginians, for West Virginians: http://wv-www.net
Cocoa programming in Perl: http://camelbones.sourceforge.net
------------------------------
Date: Tue, 15 May 2007 23:35:45 +0100
From: "IanW" <whoami@whereami.net>
Subject: Re: Creating Packages
Message-Id: <f2dcjt$1avc$1@energise.enta.net>
"Christian Winter" <thepoet_nospam@arcor.de> wrote in message
news:4649a5f8$0$20283$9b4e6d93@newsspool3.arcor-online.net...
[..]
> numbers used should be version objects and make use of "long"
> version numbers, i.e. xxx.yyy.zzz or xxx.yyyzzz notation.
>
> As to the question of version numbering schemes (just what I think
> is a practicable approach):
>
> - Usually, if it has a leading zero it's considered not hundred
> percent error-proof. If you're sure the module has been reasonably
> tested and is unlikely to carry errors, it should be > 0.
>
> - The second part is best increased when new features are implemented
> or compatibility with other modules or Perl versions can't be assured
> anymore. If a second level increment occurs, one best checks the
> CHANGES document before installing it.
>
> - Third level numbers are then left to indicate fixes or simple feature
> enhancements which should be installable without having to change
> the environment or the code that uses the module.
A few of the more recent packages seem to be using the new numbering scheme
(http://search.cpan.org/recent). I am starting to think maybe I ought to
number my package 0.9.0, as while I *think* it's bug free, I haven't tested
it on any other machine and haven't tried particularly hard to break it.
Regards
Ian
------------------------------
Date: Wed, 16 May 2007 10:14:31 +1000
From: "Sisyphus" <sisyphus1@nomail.afraid.org>
Subject: Re: Creating Packages
Message-Id: <464a4cd1$0$7570$afc38c87@news.optusnet.com.au>
"IanW" <whoami@whereami.net> wrote in message
news:f2dang$17it$1@energise.enta.net...
>
.
> It does look like most people run at least ExtUtils::MakeMaker because
> there's a file META.yml that is apparently generated automatically by it.
>
If I understand the MakeMaker docs correctly, the META.yml gets
automatically created (and automatically added to the MANIFEST) when you run
'make distdir' or 'make dist'. (I've never bothered with it, though clearly
it has merit in the opinions of some.) See the "Distribution Support"
section of 'perldoc ExtUtils::MakeMaker' for that and other make targets
that you might like to use.
Cheers,
Rob
------------------------------
Date: 15 May 2007 23:47:43 -0700
From: Rahul <sahoo.byomokesh@gmail.com>
Subject: How move figure entity to splited files
Message-Id: <1179298063.689098.168850@u30g2000hsc.googlegroups.com>
Hi All,
I have one xml file. My task is split xml file in Chapter wise and
Figure entity notation also move to same chapter. My problem is how
move entity notation.
My input xml
-------------
<!DOCTYPE document SYSTEM "rr.dtd"[
<!ENTITY A3_11_f01 SYSTEM "A3_11_f01.tif" NDATA tif>
<!ENTITY A3_12_f01 SYSTEM "A3_12_f01.tif" NDATA tif>
]>
<document>
<chapter id="ch11"><title>chapter 11</title>
<p>some test</p>
<figure>
<graphic picfile="A3_11_f01"/>
<caption>adjkf</caption>
</figure>
</chapter>
<chapter id="ch12"><title>chapter 12</title>
<p>some test</p>
<figure>
<graphic picfile="A3_12_f01"/>
<caption>adjkf</caption>
</figure>
</chapter>
</document>
I want my output
-----------------
chapter11.xml
_____________
<!DOCTYPE document SYSTEM "rr.dtd"[
<!ENTITY A3_11_f01 SYSTEM "A3_11_f01.tif" NDATA tif>
]>
<document>
<chapter id="ch11"><title>chapter 11</title>
<p>some test</p>
<figure>
<graphic picfile="A3_11_f01"/>
<caption>adjkf</caption>
</figure>
</chapter>
</document>
================
chapter12.xml
___________
<!DOCTYPE document SYSTEM "rr.dtd"[
<!ENTITY A3_12_f01 SYSTEM "A3_12_f01.tif" NDATA tif>
]>
<document>
<chapter id="ch12"><title>chapter 12</title>
<p>some test</p>
<figure>
<graphic picfile="A3_12_f01"/>
<caption>adjkf</caption>
</figure>
</chapter>
I am using window base perl. Please anyone help.
Thanks
Byomokesh
------------------------------
Date: Wed, 16 May 2007 11:11:36 +0200
From: mirod <mirod@xmltwig.com>
Subject: Re: How move figure entity to splited files
Message-Id: <464acad1$0$16037$5fc30a8@news.tiscali.it>
Rahul wrote:
> I have one xml file. My task is split xml file in Chapter wise and
> Figure entity notation also move to same chapter. My problem is how
> move entity notation.
> ...
Here is a solution using XML::Twig. Note that the file names are
generated from the id attribute of the file (as ch11.xml, ch12.xml...)
which may or may not be a good idea.
OTH
#!/usr/bin/perl
use strict;
use warnings;
use XML::Twig;
my @graphics_in_chapter; # global, could be passed around, but in
# such a short script I did not see the point
XML::Twig->new( twig_handlers => { chapter => \&dump_chapter ,
graphic => \&store_graphic,
},
pretty_print => 'indented',
)
->parsefile( shift( @ARGV));
# store the entity name
sub store_graphic
{ my( $t, $graphic)= @_;
push @graphics_in_chapter, $graphic->att( 'picfile');
}
sub dump_chapter
{ my( $t, $chapter)= @_;
my $id= $chapter->id;
open( my $out, '>:utf8', "$id.xml") or die "cannot create '$id.xml':
$!";
# output the doctype, including the entities found in the chapter
printf {$out} qq{<!DOCTYPE %s SYSTEM "%s" [ \n%s\n]>\n},
$t->doctype_name, $t->system_id,
entities( $t, @graphics_in_chapter);
$t->root->print( $out); # printing the root outputs the document tag
$chapter->delete; # so we have at most 1 chapter in memory
@graphics_in_chapter=(); # reset the global
}
# return the text of entity declarations in @entity_names
sub entities
{ my( $t, @entity_names)= @_;
# list of entity objects found in the chapter
my @entities= map { $t->entity( $_)->sprint } @entity_names;
return join "\n", @entities;
}
--
mirod
------------------------------
Date: 15 May 2007 22:27:17 GMT
From: xhoster@gmail.com
Subject: Re: how to create multiple zip files that are no larger than 2 Gb each
Message-Id: <20070515182719.710$9I@newsreader.com>
texasreddog <texasreddog@yahoo.com> wrote:
> I have an interesting problem, where I am zipping up a large archive
> of jpg images. The zip file can be no larger than 2 Gb. If I try to
> zip up n number of images, where n can vary a lot, and if the zip file
> gets to 2Gb, the zip process fails.
>
> Would there be some way that I could track the .zip file as it is
> being zipped, so when it reaches 2 Gb in size, a new zip file could be
> created and the zip process could continue?
I wouldn't expect jpgs to compress by any meaningful amount, so you could
probably assume the size of the archive will be slightly more than the sum
of the sizes of the original files.
> I don't think the split
> command will work, because that runs after zip finishes.
>
> Or, is there a way to possibly start another zip file, when the first
> one fails, and then somehow force the zip to pick up where it left
> off?
I don't know the answer, but I expect it will depend on what program/module
you are using to do the zipping.
Xho
--
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service $9.95/Month 30GB
------------------------------
Date: Wed, 16 May 2007 12:18:55 GMT
From: "Peter Wyzl" <wyzelli@yahoo.com>
Subject: Re: how to create multiple zip files that are no larger than 2 Gb each
Message-Id: <PEC2i.38767$M.14499@news-server.bigpond.net.au>
"texasreddog" <texasreddog@yahoo.com> wrote in message
news:1179258055.493419.325110@e51g2000hsg.googlegroups.com...
>I have an interesting problem, where I am zipping up a large archive
> of jpg images. The zip file can be no larger than 2 Gb. If I try to
> zip up n number of images, where n can vary a lot, and if the zip file
> gets to 2Gb, the zip process fails.
>
> Would there be some way that I could track the .zip file as it is
> being zipped, so when it reaches 2 Gb in size, a new zip file could be
> created and the zip process could continue? I don't think the split
> command will work, because that runs after zip finishes.
>
> Or, is there a way to possibly start another zip file, when the first
> one fails, and then somehow force the zip to pick up where it left
> off?
>
> Any suggestions/ideas/tips are much appreciated! Thanks!
You probably need to update your Perl to a more recent version if you can't
create files over 2Gb in size.
P
------------------------------
Date: Wed, 16 May 2007 04:34:09 -0700
From: Joe Smith <joe@inwap.com>
Subject: Re: how to create multiple zip files that are no larger than 2 Gb each
Message-Id: <qrqdnbnkUt6kcdfbnZ2dnUVZ_o2vnZ2d@comcast.com>
texasreddog wrote:
> I have an interesting problem, where I am zipping up a large archive
> of jpg images. The zip file can be no larger than 2 Gb. If I try to
> zip up n number of images, where n can vary a lot, and if the zip file
> gets to 2Gb, the zip process fails.
>
> Would there be some way that I could track the .zip file as it is
> being zipped, so when it reaches 2 Gb in size, a new zip file could be
> created and the zip process could continue?
Here is what I am currently using for that purpose.
-Joe
our $MAXSIZE = 2047 * 1024 * 1024; # Just less than 2 GB
sub create_zip {
my($out_file,@files) = @_;
for (my $N='a'; @files; $N++) {
my $zip_file = "$out_file$N.zip";
my $name = shift @files; # Always do at least one file per zip
my @names = ($name);
my $bytes = -s $name or next;
while (@files and $bytes < $MAXSIZE) {
$name = shift @files;
$bytes += -s $name || 0; # Cumulative uncompressed size
if ($bytes < $MAXSIZE) {
push @names, $name; # OK to add this one
} else {
unshift @files,$name; # Put it back on list of files to do
}
}
my $cmd = '|zip ' . (-f $zip_file ? '-yu' : '-y ') . " $zip_file -@";
print "$cmd (" . @names . " files)\n"; # Number of files being zipped
print " ",join("\n ",@names),"\n" if $verbose;
if (open ZIP,$cmd) {
print ZIP join "\n",@names,'' or warn "print(ZIP): $! ($?)";
close ZIP;
my ($err,$sig) = ($? >> 8, $? & 0xff); # 12 = "No changes"
warn "zip returned error code $err\n" if $err and $err != 12;
warn "At least one file is in use; cannot be backed up\n" if $err == 18;
next if $err == 12;
print "$zip_file = " . bytes_count(-s $zip_file) . "\n\n";
sleep 1;
} else {
warn "open('$cmd') failed: $! ($?)";
}
}
}
------------------------------
Date: Wed, 16 May 2007 04:42:14 GMT
From: merlyn@stonehenge.com (Randal Schwartz)
Subject: new CPAN modules on Wed May 16 2007
Message-Id: <JI4AEE.1GzH@zorch.sf-bay.org>
The following modules have recently been added to or updated in the
Comprehensive Perl Archive Network (CPAN). You can install them using the
instructions in the 'perlmodinstall' page included with your Perl
distribution.
Algorithm-Scale2x-0.02
http://search.cpan.org/~bricas/Algorithm-Scale2x-0.02/
Generic implementation of the Scale2x algorithm
----
Astro-SpaceTrack-0.028
http://search.cpan.org/~wyant/Astro-SpaceTrack-0.028/
Retrieve orbital data from www.space-track.org.
----
Business-PayPal-API-0.41
http://search.cpan.org/~scottw/Business-PayPal-API-0.41/
PayPal API
----
Catalyst-Engine-Apache-1.10
http://search.cpan.org/~agrundma/Catalyst-Engine-Apache-1.10/
Catalyst Apache Engines
----
DMI-Decode-2.05
http://search.cpan.org/~russellp/DMI-Decode-2.05/
Perl extension for extracting DMI Information
----
Data-StackedMap-0.03
http://search.cpan.org/~claesjac/Data-StackedMap-0.03/
An object that stores key/value pairs in a stacked fashion
----
Devel-Fail-Make-1.009
http://search.cpan.org/~mthurn/Devel-Fail-Make-1.009/
a distro that always fails the `make` stage
----
Devel-Fail-MakeTest-1.008
http://search.cpan.org/~mthurn/Devel-Fail-MakeTest-1.008/
a distro that always fails the `make test` stage
----
Games-RolePlay-MapGen-0.31.2
http://search.cpan.org/~jettero/Games-RolePlay-MapGen-0.31.2/
The base object for generating dungeons and maps
----
Gtk2-TrayIcon-0.06
http://search.cpan.org/~borup/Gtk2-TrayIcon-0.06/
Perl interface to the EggTrayIcon library
----
Gungho-0.08001
http://search.cpan.org/~dmaki/Gungho-0.08001/
Yet Another High Performance Web Crawler Framework
----
Gungho-0.08002
http://search.cpan.org/~dmaki/Gungho-0.08002/
Yet Another High Performance Web Crawler Framework
----
LWP-ConnCache-Resolving-0.01
http://search.cpan.org/~sergeyche/LWP-ConnCache-Resolving-0.01/
resolving connection cache.
----
LWP-ConnCache-Resolving-0.02
http://search.cpan.org/~sergeyche/LWP-ConnCache-Resolving-0.02/
resolving connection cache.
----
Linux-Bootloader-1.3
http://search.cpan.org/~bryce/Linux-Bootloader-1.3/
Base class interacting with Linux bootloaders
----
Math-Random-MT-Auto-6.01
http://search.cpan.org/~jdhedden/Math-Random-MT-Auto-6.01/
Auto-seeded Mersenne Twister PRNGs
----
Math-Random-MT-Auto-6.02
http://search.cpan.org/~jdhedden/Math-Random-MT-Auto-6.02/
Auto-seeded Mersenne Twister PRNGs
----
Module-List-Pluggable-0.01
http://search.cpan.org/~doom/Module-List-Pluggable-0.01/
list or require sub-sets of modules
----
Net-CascadeCopy-v0.1.0
http://search.cpan.org/~vvu/Net-CascadeCopy-v0.1.0/
scalable file propagation using ssh and rsync
----
Net-FPing-0.9
http://search.cpan.org/~mlehmann/Net-FPing-0.9/
quickly ping a large number of hosts
----
Pod-Xhtml-1.56
http://search.cpan.org/~bbc/Pod-Xhtml-1.56/
Generate well-formed XHTML documents from POD format documentation
----
SVN-Notify-Mirror-0.03603
http://search.cpan.org/~jpeacock/SVN-Notify-Mirror-0.03603/
Keep a mirrored working copy of a repository path
----
Test-YAML-Meta-0.04
http://search.cpan.org/~barbie/Test-YAML-Meta-0.04/
Validation of the META.yml file in a distribution.
----
Text-CSV_XS-0.26
http://search.cpan.org/~hmbrand/Text-CSV_XS-0.26/
comma-separated values manipulation routines
----
UNIVERSAL-which-0.05
http://search.cpan.org/~dankogai/UNIVERSAL-which-0.05/
tells fully qualified name of the method
----
UNIVERSAL-which-0.06
http://search.cpan.org/~dankogai/UNIVERSAL-which-0.06/
tells fully qualified name of the method
----
WWW-Domain-Registry-VeriSign-0.02
http://search.cpan.org/~masahito/WWW-Domain-Registry-VeriSign-0.02/
VeriSign NDS (https://www.verisign-grs.com/) Registrar Tool
----
Win32-0.27_02
http://search.cpan.org/~jdb/Win32-0.27_02/
Interfaces to some Win32 API Functions
----
YAML-LibYAML-0.02
http://search.cpan.org/~ingy/YAML-LibYAML-0.02/
LibYAML bindings for Perl
----
YAML-Tiny-1.07
http://search.cpan.org/~adamk/YAML-Tiny-1.07/
Read/Write YAML files with as little code as possible
If you're an author of one of these modules, please submit a detailed
announcement to comp.lang.perl.announce, and we'll pass it along.
This message was generated by a Perl program described in my Linux
Magazine column, which can be found on-line (along with more than
200 other freely available past column articles) at
http://www.stonehenge.com/merlyn/LinuxMag/col82.html
print "Just another Perl hacker," # the original
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
------------------------------
Date: Wed, 16 May 2007 05:39:19 GMT
From: Bart Lateur <bart.lateur@pandora.be>
Subject: Re: Parsing a text file line-by-line: skipping badly-formed lines?
Message-Id: <n36l4314vo5rm77cbaiu69p81ni1vb7p97@4ax.com>
denis.papathanasiou@gmail.com wrote:
>But the problem seems to be perl's <> construct: regardless of how I
>define $/ (I used both the default and Josef's suggestion), if there's
>an i/o error of any kind, the "$ln=<IN>" evaluates to false and the
>loop ends.
Check to see if that last line contains a chr(26). If that's the case
and you're on Windows, use binmode on the handle. Text mode treats a
chr(26) (AKA ctrl-Z, "\cZ") as an end of line marker, while binary mode
does not.
Of course, then, you'll have to convert the line ends to "\n" by hand...
but you're already doing that.
--
Bart.
------------------------------
Date: 16 May 2007 02:17:47 -0700
From: vdpopov@gmail.com
Subject: Perl initiated SSL handshake using MSWindows key storage certificate
Message-Id: <1179307066.934935.74580@n59g2000hsh.googlegroups.com>
Hi all,
We have the following problem:
We are trying to open a SSL socket connection using Perl on MSWindows
environment. The server side have provided us with a certificate, that
is stored on a smart card, so it is in Windows key storage. And we
didn't find a way to do this. The problem is how to initiate a SSL
handshake to the server using such kind a certificate storage. If a
certificate is on a separate file - its OK, but the situation is
different.
Can anyone help us?
Thanks in advance,
Vasko.
------------------------------
Date: Tue, 15 May 2007 21:07:07 -0500
From: Ignoramus10518 <ignoramus10518@NOSPAM.10518.invalid>
Subject: Re: The Pure Joy of Receiving PayPal Money
Message-Id: <94ydnWAJb9TW-tfbnZ2dnUVZ_jKdnZ2d@giganews.com>
Here is my script to download all paypal transactions.
#!/usr/bin/perl
use Business::PayPal::API qw( TransactionSearch GetTransactionDetails );
use Data::Dumper;
use Getopt::Long;
use DateTime::Precise;
# has my password and userid
require "$ENV{HOME}/.paypal.pl";
my ($daterange, $id, $verbose, $detail, $analyzefile);
my $argresult = GetOptions( "daterange=s" => \$daterange,
"id=s" => \$id,
"detail" => \$detail,
"verbose" => \$verbose,
"analyzefile=s" => \$analyzefile,
);
sub run_weird_method {
my ($sub, @args) = @_;
my @mystery = &$sub( @args );
if ( @mystery == 1 ) {
# normal processing
return { success => 1, result => $mystery[0] };
}
# Failure
my %hash = @mystery;
return { success => 0, result => \%hash };
}
my $pp = &my_paypal;
$| = 1;
if( $daterange ) {
my ($date1, $date2) = split( /,/, $daterange );
my $dt = new DateTime::Precise( $date1 );
my $dt2 = new DateTime::Precise( $date2 );
while( $dt <= $dt2 ) {
#print STDERR "Doing " . $dt->dprintf( '%^Y-%M-%DT00:00:00Z' ) . "\n";
my $result = run_weird_method( sub { $pp->TransactionSearch(
StartDate => $dt->dprintf( '%^Y-%M-%DT00:00:00Z' ),
EndDate => $dt->dprintf( '%^Y-%M-%DT23:59:59Z' ),
);
}
);
#exit 0;
if( $result->{success} ) {
#print Dumper( $response );
my $response = $result->{result};
print Dumper( $response ) if $verbose;
my $junk = {
'Timezone' => 'GMT',
'Payer' => 'dmwithcli @sbcglobal.net',
'Status' => 'Completed',
'NetAmount' => '181.76',
'PayerDisplayName' => 'Consolidated Logistics, Inc.',
'Timestamp' => '2006-01-23T19:33:31Z',
'Type' => 'Payment',
'GrossAmount' => '187.50',
'TransactionID' => '47H61356L2563612S',
'FeeAmount' => '-5.74'
};
foreach my $t (@$response) {
print "$t->{Type}\t$t->{Timestamp}\t$t->{TransactionID}\t$t->{Payer}\t$t->{PayerDisplayName}\t$t->{GrossAmount}\t$t->{FeeAmount}\t$t->{Status}\n";
if( $detail ) {
my %result = $pp->GetTransactionDetails( TransactionID => $t->{TransactionID} );
my ($key, $value);
print "Detail: ";
while (($key, $value) = (each %result) ) {
print "$key $value\t";
}
print "\n";
}
}
} else {
print Dumper( $result );
}
$dt->inc_day( 1 );
}
} elsif( $detail && $id ) {
my %result = $pp->GetTransactionDetails( TransactionID => $id );
print Dumper( \%result );
if( 0 ) {
my $result = run_weird_method( sub { $pp->GetTransactionDetails( TransactionID => $id ) } );
if( $result->{success} ) {
print Dumper( $result-{result} );
} else {
print STDERR "Failed.\n" . Dumper( $result );
}
}
} elsif( $analyzefile ) {
open( A, $analyzefile ) || die "Cannot open $analyzefile ";
my ($totaltransfer, $totalpaid, $totalfee, $totalreceived, $totalwithdrawn, $totalship) = (0, 0, 0, 0, 0, 0);
while( my $l = <A> ) {
my ($type, $time, $id, $payer, $name, $gross, $fee, $status) = split( /\t/, $l );
if( $type eq 'Payment') {
if( $gross > 0 ) {
$totalreceived += $gross;
$totalfee += $fee;
} else {
$totalpaid += $gross;
}
} elsif( $type eq 'Refund') {
if( $gross < 0 ) {
$totalreceived += $gross;
$totalfee += $fee;
} else {
$totalpaid += $gross;
}
} elsif( $type eq 'Transfer' || $type eq 'ATM Withdrawal' ) {
$totaltransfer += $gross;
} elsif ( $type =~ /PayPal Services/ ) {
$totalship += $gross;
} elsif ( $type eq 'Cash Back Bonus' ) {
$totalpaid -= $gross;
} elsif ( $type eq 'Dividend' ) {
$totalreceived += $gross;
} elsif ( $type =~ /(Debit Card|Reversal)/ ) {
$totalpaid -= $gross;
} elsif ( $type eq 'Bill' ) {
} else {
print $l;
}
}
close( A );
my $change = $totalreceived + $totalfees + $totalpaid + $totaltransfer + $totalship;
print "Received: $totalreceived
Fees: $totalfee
Paid: $totalpaid
Widthrawal: $totaltransfer
Shipping: $totalship
Balance Change: $change
";
} else {
die "bad usage"
}
------------------------------
Date: Wed, 16 May 2007 09:45:59 GMT
From: Peter Scott <Peter@PSDT.com>
Subject: Re: Using "Perl Best Practices" inside-out objects
Message-Id: <pan.2007.05.16.09.45.58.269242@PSDT.com>
On Tue, 15 May 2007 12:35:18 -0700, Paul Lalli wrote:
> On May 15, 3:17 pm, "mhearne808[insert-at-sign-here]gmail[insert-dot-
> here]com" <mhearne...@gmail.com> wrote:
>> All: I'm having trouble returning an array from a class implemented
>> using Damian Conway's inside-out object approach.
>>
>> Below are two snippets of code:
>> 1) The test script where I am attempting to retrieve an array from an
>> inside-out attribute from an object.
>> 2) The test class.
>>
>> I think the main problem is on the line where I am assigning an array
>> to one of these inside out attributes. Somehow I think the attribute
>> is only getting the last element of the array that I am attempting to
>> assign it to.
>
> I snipped the class structure, because inside-out objects have nothing
> at all to do with this problem. Giant Red Herring.
[snip]
So is the implementation. I presume the OP is working through PBP, but
they may be unaware that they've only reached an intermediate stage of
inside-out object construction and that Conway is working toward using his
CPAN module Class::Std, where it won't be necessary for the user to write
a new() method, accessors, or destructor. Then an implementation of an
array-based attribute looks like:
#!perl
use strict;
use warnings;
package Foo;
use Class::Std;
my %thing :ATTR( :name<thing> :default<[]> );
sub things {
my $self = shift;
@{ $self->get_thing };
}
package main;
my $foo = Foo->new( { thing => [ qw(a b c) ] } );
print "$_\n" for $foo->things;
__END__
But as you later point out, the OP may need to master some more basic
concepts first.
--
Peter Scott
http://www.perlmedic.com/
http://www.perldebugged.com/
------------------------------
Date: Wed, 16 May 2007 12:53:20 +0200
From: Michele Dondi <bik.mido@tiscalinet.it>
Subject: Re: Using "Perl Best Practices" inside-out objects
Message-Id: <qfol43ltdk16tlofv5mo7n05nfdlsau597@4ax.com>
On Wed, 16 May 2007 09:45:59 GMT, Peter Scott <Peter@PSDT.com> wrote:
>my %thing :ATTR( :name<thing> :default<[]> );
I briefly heard about attributes, and I know I could read the docs,
but I hadn't seen that syntax yet: that is, angular parens. When were
they introduced? Where are they documented? (I know about their use in
Perl 6, but that's a whole another story.)
Michele
--
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
.'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
------------------------------
Date: 16 May 2007 04:35:29 -0700
From: Paul Lalli <mritty@gmail.com>
Subject: Re: Using "Perl Best Practices" inside-out objects
Message-Id: <1179315329.654168.282520@q23g2000hsg.googlegroups.com>
On May 16, 5:45 am, Peter Scott <P...@PSDT.com> wrote:
> use Class::Std;
>
> my %thing :ATTR( :name<thing> :default<[]> );
I'm 99% sure that doesn't work, as I tried it (albeit with standard
Perl 5 syntax) only last week. The default attribute can only take
strings. Array refs don't work. You need to provide a BUILD
subroutine in which you assign name to [].
Paul Lalli
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc. For subscription or unsubscription requests, send
#the single line:
#
# subscribe perl-users
#or:
# unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.
#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V11 Issue 439
**************************************
