[30451] in Perl-Users-Digest
Perl-Users Digest, Issue: 1694 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Jul 6 06:09:41 2008
Date: Sun, 6 Jul 2008 03: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 Sun, 6 Jul 2008 Volume: 11 Number: 1694
Today's topics:
Re: Elisp Lesson on file processing (make downloadable <xahlee@gmail.com>
Re: Formatting ASCII to be read by Windows NotePad <vron@byu.edu.invalid>
Re: Generating fancy/pretty documents <whynot@pozharski.name>
Re: Net::SMTP and Postfix mai considered spam by google <john@linuxNOSPAMlad.org>
new CPAN modules on Sun Jul 6 2008 (Randal Schwartz)
Re: Perl Script to be automated <grahamjfeeley@optusnet.com.au>
Re: Sed's N equivalent in Perl paragraph mode <ben@morrow.me.uk>
Re: Sed's N equivalent in Perl paragraph mode <sun_tong_001@users.sourceforge.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 6 Jul 2008 01:05:09 -0700 (PDT)
From: "xahlee@gmail.com" <xahlee@gmail.com>
Subject: Re: Elisp Lesson on file processing (make downloadable copy of a website)
Message-Id: <bb06ae49-4977-4769-99ef-d076c6976ace@c65g2000hsa.googlegroups.com>
In this week i wrote a emacs program and tutorial that does archiving
a website for offline reading.
(See http://xahlee.org/emacs/make_download_copy.html )
In the process, i ran into a problem with the unix =E2=80=9Ccp=E2=80=9D uti=
lity. I've
been a unix admin for Solaris during 1998-2004. Even the first time i
learned about cp, i noticed some pecularity. But only today, i thought
about it and wrote it out exactly what's going on.
Here's a excerpt from my emacs tutorial above regarding the issue.
------------------
Copying a bunch of directories seems a trivial operation, but it
actually took me a couple hours to arrive at the final code, due to
the exact requirement of directory paths, and the unix =E2=80=9Ccp=E2=80=9D=
tool's
lack of precision and flexibility.
Originally, i thought the code would be something simple like several
=E2=80=9C(shell-command (concat "cp -R " fromDir " " toDir))=E2=80=9D, one =
for each
source dir, where fromDir and toDir are full paths. However, it turns
out the problem is slightly more complex.
Suppose the source dir is =E2=80=9C/Users/xah/web/emacs=E2=80=9D and dest d=
ir is =E2=80=9C/
Users/xah/web/diklo/xahtut/emacs=E2=80=9D and i want all branches under the
source dir copied into the dest dir.
If you do =E2=80=9Ccp -R /Users/xah/web/emacs /Users/xah/web/diklo/xahtut/
emacs=E2=80=9D with both xahtut and xahtut/emacs doesn't exist, then this
error results: =E2=80=9Ccp: /Users/xah/web/diklo/xahtut/emacs: No such file=
or
directory=E2=80=9D.
If you do =E2=80=9Ccp -R /Users/xah/web/emacs /Users/xah/web/diklo/xahtut/
emacs=E2=80=9D with xahtut/emacs exists, then you got =E2=80=9C/Users/xah/w=
eb/diklo/
xahtut/emacs/emacs=E2=80=9D, which is not what i want.
If you do =E2=80=9Ccp -R /Users/xah/web/emacs /Users/xah/web/diklo/xahtut=
=E2=80=9D
with xahtut doesn't exist, it results in all branches of emacs in
xahtut, which is wrong.
Only when you do =E2=80=9Ccp -R /Users/xah/web/emacs /Users/xah/web/diklo/
xahtut=E2=80=9D with xahtut exists, you get the correct result with the new
dir =E2=80=9C/Users/xah/web/diklo/xahtut/emacs=E2=80=9D having all branches=
of the
original dir.
So, the solution is to first create all the parent dirs of the dest
dir, but without the dest dir node itself. Then, do a cp to the first
parent of dest dir.
Directories are abstractly a tree. Copying directories is like
grafting a tree from one branch into another branch. To begin, we are
given two spec: the source node and a destination node. The source
node by definition is a existing node (i.e. existing dir or file),
otherwise the copying won't make sense. However, the destination spec
can be a node that doesn't exist, or its parents doesn't exist, or
several levels of parents doesn't exist. When the destination spec has
missing nodes, we can consider creating them as part of the grafting
process, or we can consider it as a error.
The unix =E2=80=9Ccp=E2=80=9D tool's behavior is mathematically inconsisten=
t. When the
destination node exist, the source node will become new children of
destination node. When the destination node does not exist (but its
parent exists), =E2=80=9Ccp=E2=80=9D will create the node, and copy only th=
e children
of the source node to it. When the destination node doesn't exist and
its parent doesn't exist neither, then =E2=80=9Ccp=E2=80=9D considers it a =
error.
---------------
Related readings:
=E2=80=A2 The Nature of the =E2=80=9CUnix Philosophy=E2=80=9D
http://xahlee.org/UnixResource_dir/writ/unix_phil.html
Xah
=E2=88=91 http://xahlee.org/
=E2=98=84
------------------------------
Date: Sat, 5 Jul 2008 15:41:24 -0700
From: "Vernan R." <vron@byu.edu.invalid>
Subject: Re: Formatting ASCII to be read by Windows NotePad
Message-Id: <KKWdneyEUqoIZfLVnZ2dnUVZ_sbinZ2d@wavecable.com>
Sherman Pendley wrote:
> This is a technical forum. If you want sound, accurate advice about
> Perl, you can find it here.
Are you, sir, asserting that a technical news group
cannot have a friendly atmosphere? That participants
should not pay others the same respect that they
would desire in return?
> If you want warm fuzzy feelings and unquestioning
> devotion, adopt a puppy.
Is it not fair to say those who have rushed to your
defense are not, themselves, bestowing the same
"unquestioning devotion" you speak of, and if so,
why do you not ask them to refrain, given your
stance of being against it?
--
-Vern
------------------------------
Date: Sun, 06 Jul 2008 00:04:07 +0300
From: Eric Pozharski <whynot@pozharski.name>
Subject: Re: Generating fancy/pretty documents
Message-Id: <7745k5xokg.ln2@carpet.zombinet>
Bernie Cosell <bernie@fantasyfarm.com> wrote:
> Suggestions on how to produce "nice" text documents from Perl? Plain
> text is easy, of course, but I need to be able to do fancier/formatted
> stuff. What I've done in the past is generate HTML [with <tables>,
> <fonts>, etc] and then use an app like HTMLDOC to convert that to PDF
> (and, indeed, a long time back I used to generate troff input and use
> ghostscript to process *that*). That kind of approach sort of works,
> but the whole procedure is a bit klunky and fragile. Is there some
> way to produce "pretty" PDF or ODF document directly? I see there's a
> suite of modules PDF::API2 -- it looks pretty complicated....anyone
> used that? PDF::Create also seems complicated.
I would slightly disagree with Joost Diepenmaat -- any interface is no
more complicated than underlying structure. If you are familiar with
a structure then no braindamage in an interface would stop you. If a
structure is unknown, you would fail sooner or later. Even I would
stress that as much simple an interface is as harder and sooner you will
fail.
> Am I just being naive about this? As I say, in the past I've used
> troff and HTML as an intermediate "layout" format and things like
> fonts, titles, indenting, tables, simple drawing (e.g., putting a box
> around some text) etc were all relatively easy. Is that kind of thing
> easy/reasonable to do with one of the "direct to PDF" packages? In
> looking at the organization and methods for the PDF modules, using
> HTMLDOC (<http://www.htmldoc.org/>) starts looking more and more
> attractive...
Wait a moment. You have to make clear for yourself, either you want
convert HTML to PDF or you want to have nice PDF. Those are slightly
different beasts.
Once I've downloaded PDF made from SGML (LDP, HOWTO's, you know)... It
was awful. Typesetting was even worse than wordproccessors make. I was
sick of it. However it was no different from rendered HTML. So what's
the problem? That PDF can't be passed upstream. You can read it
(somewhat), you can sidenote it, you can discard it. But you can't give
it away. Giving away such an awful typesetting, would render you
incompetent.
If you want good quality PDF (or PostScript, which are somewhat the
same), then you don't need converter. You need a tool that specializes
on B<typesetting>. You B<must> not focus on making typesetting
yourself. And here you have an option.
=item LaTeX
Hmm,.. Let's be honest, LaTeX isn't my favorite tool for making
typesetting. It's my only tool for that. But here we have the first
pitfall: you have to be familiar with it. I would disagree with Joost
Diepenmaat again -- LaTeX isn't easy, it's fscking braindamage, but as
soon as you adapt to it, than the whole world of typesetting becomes
bright and shiny (I must admit, it's still dark for me). First of all,
forget about B<PerlTeX>; you have to get that out of sandbox first; if
you'd fail (I failed), than you get nothing more than a heavy calculator
inside LaTeX source.
I'm quite successful in making LaTeX-generators. Perl does all
calculations, then passes to LaTeX some source and points to F<.sty>
(style files are alike (not exactly) F<.pm>). Now I'm brave enough to
pass LaTeX output directly to printer without proofreading.
If you are still not afraid (and you are?), (looking at yours headers)
consider MikTeX -- if my guess is right it's something alike ActivePerl
but from LaTeX world.
=item openoffice.org
(not tested, any feedback is appreciated). There're at least 2
distributions about OO.org on CPAN. B<OpenOffice::OOBuilder> seems not
ready -- it declares that it works only with spreadsheets.
B<OpenOffice::OODoc> seems to be much better.
I believe, that if you go with OO.org (whatever interface you chose) it
would be just slightly different with LaTeX way. There's something
named B<Styles> inside; maybe that would allow some kind of templating;
maybe not.
=item some-trademark
And what I'm supposed to say here?
--
Torvalds' goal for Linux is very simple: World Domination
------------------------------
Date: Sat, 05 Jul 2008 15:40:38 -0700
From: -linux_lad <john@linuxNOSPAMlad.org>
Subject: Re: Net::SMTP and Postfix mai considered spam by googlemail
Message-Id: <f6ednfF92rL3ZfLVnZ2dnUVZ_rbinZ2d@giganews.com>
John wrote:
> "-linux_lad" <john@linuxNOSPAMlad.org> wrote in message
> news:W8adnc4FFsuNWfLVnZ2dnUVZ_szinZ2d@giganews.com...
>
> Hi
> I replaced the true adress with example.com
> My guess the problem is in the header but I cannot see it.
> Regards
> John
>
>
I'd suggest posting the full headers here, so we can see what is going
on. Remember that your domain must have a reverse DNS record for
whatever CNAME you are using. You can test by doing a reverse lookup on
the domain you are using. It should resolve to the IP address of your
server.
--
-linux_lad
------------------------------
Date: Sun, 6 Jul 2008 04:42:19 GMT
From: merlyn@stonehenge.com (Randal Schwartz)
Subject: new CPAN modules on Sun Jul 6 2008
Message-Id: <K3KIEJ.I6w@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.
Apache2-ASP-1.53
http://search.cpan.org/~johnd/Apache2-ASP-1.53/
Perl extension for ASP on mod_perl2.
----
App-Open-0.0.1
http://search.cpan.org/~erikh/App-Open-0.0.1/
Library to drive the 'openit' command line tool
----
CGI-Persistent-1.11
http://search.cpan.org/~vipul/CGI-Persistent-1.11/
Transparent state persistence for CGI applications.
----
CPAN-Reporter-1.1601
http://search.cpan.org/~dagolden/CPAN-Reporter-1.1601/
Adds CPAN Testers reporting to CPAN.pm
----
CSS-SAC-0.07
http://search.cpan.org/~bjoern/CSS-SAC-0.07/
SAC CSS parser
----
CSS-SAC-0.08
http://search.cpan.org/~bjoern/CSS-SAC-0.08/
SAC CSS parser
----
Cache-CacheFactory-1.04
http://search.cpan.org/~sgraham/Cache-CacheFactory-1.04/
factory class for Cache::Cache and other modules.
----
Catalyst-Authentication-Credential-OpenID-0.08
http://search.cpan.org/~ashley/Catalyst-Authentication-Credential-OpenID-0.08/
OpenID credential for Catalyst::Plugin::Authentication framework.
----
Class-Data-Localize-0.01
http://search.cpan.org/~sknpp/Class-Data-Localize-0.01/
Localizable, inheritable, overridable class data
----
Crypt-PBC-0.7.20.0.4.18
http://search.cpan.org/~jettero/Crypt-PBC-0.7.20.0.4.18/
OO interface for the Stanford PBC library
----
Data-HashArray-1.0
http://search.cpan.org/~aulusoy/Data-HashArray-1.0/
An array class of hashes that has magical properties via overloading and AUTOLOAD.
----
DateTimeX-Web-0.02
http://search.cpan.org/~ishigaki/DateTimeX-Web-0.02/
DateTime factory for web apps
----
Games-Solitaire-Verify-0.01
http://search.cpan.org/~shlomif/Games-Solitaire-Verify-0.01/
verify solutions for solitaire games.
----
HTTP-Client-Parallel-0.01
http://search.cpan.org/~adamk/HTTP-Client-Parallel-0.01/
A HTTP client that fetchs all URIs in parallel
----
HTTP-Client-Parallel-0.02
http://search.cpan.org/~adamk/HTTP-Client-Parallel-0.02/
A HTTP client that fetchs all URIs in parallel
----
I18N-Charset-1.392
http://search.cpan.org/~mthurn/I18N-Charset-1.392/
IANA Character Set Registry names and Unicode::MapUTF8 (et al.) conversion scheme names
----
LWP-Online-1.06
http://search.cpan.org/~adamk/LWP-Online-1.06/
Does your process have access to the web
----
Methods-CheckNames-0.03
http://search.cpan.org/~nuffin/Methods-CheckNames-0.03/
Statically check for named methods
----
Methods-CheckNames-0.04
http://search.cpan.org/~nuffin/Methods-CheckNames-0.04/
Statically check for named methods
----
Net-Flickr-Geo-0.71
http://search.cpan.org/~ascope/Net-Flickr-Geo-0.71/
tools for working with geotagged Flickr photos
----
Net-Flickr-Geo-0.711
http://search.cpan.org/~ascope/Net-Flickr-Geo-0.711/
tools for working with geotagged Flickr photos
----
Net-ModestMaps-1.0
http://search.cpan.org/~ascope/Net-ModestMaps-1.0/
Simple OOP wrapper for calling ModestMaps web services.
----
Nmap-Parser-1.16
http://search.cpan.org/~apersaud/Nmap-Parser-1.16/
parse nmap scan data with perl
----
POE-1.001
http://search.cpan.org/~rcaputo/POE-1.001/
portable multitasking and networking framework for Perl
----
POE-1.002
http://search.cpan.org/~rcaputo/POE-1.002/
portable multitasking and networking framework for Perl
----
POE-1.003
http://search.cpan.org/~rcaputo/POE-1.003/
portable multitasking and networking framework for Perl
----
POE-Test-Loops-1.002
http://search.cpan.org/~rcaputo/POE-Test-Loops-1.002/
Reusable tests for POE::Loop authors
----
Perl-Critic-Pulp-2
http://search.cpan.org/~kryde/Perl-Critic-Pulp-2/
some add-on perlcritic policies
----
Perl-Critic-Pulp-3
http://search.cpan.org/~kryde/Perl-Critic-Pulp-3/
some add-on perlcritic policies
----
PerlIO-code-0.01
http://search.cpan.org/~gfuji/PerlIO-code-0.01/
Makes a simple I/O filter
----
Pg-Pcurse-0.21
http://search.cpan.org/~ioannis/Pg-Pcurse-0.21/
Monitors a Postgres cluster
----
SVN-Class-0.08_01
http://search.cpan.org/~karman/SVN-Class-0.08_01/
manipulate Subversion workspaces with Perl objects
----
TAP-Filter-0.04
http://search.cpan.org/~andya/TAP-Filter-0.04/
Filter TAP stream within TAP::Harness
----
Variable-Magic-0.19
http://search.cpan.org/~vpit/Variable-Magic-0.19/
Associate user-defined magic to variables from Perl.
----
WWW-Curl-4.05
http://search.cpan.org/~szbalint/WWW-Curl-4.05/
Perl extension interface for libcurl
----
WWW-Spinn3r-2.00200002
http://search.cpan.org/~vipul/WWW-Spinn3r-2.00200002/
An interface to the Spinn3r API (http://www.spinn3r.com)
----
X3D-Debug-0.01_001
http://search.cpan.org/~hooo/X3D-Debug-0.01_001/
Perl extension for blah blah blah
----
XML-Pastor-0.54
http://search.cpan.org/~aulusoy/XML-Pastor-0.54/
Generate Perl classes with XML bindings starting from a W3C XSD Schema
----
mpp-1
http://search.cpan.org/~pfeiffer/mpp-1/
If you're an author of one of these modules, please submit a detailed
announcement to comp.lang.perl.announce, and we'll pass it along.
This message was generated by a Perl program described in my Linux
Magazine column, which can be found on-line (along with more than
200 other freely available past column articles) at
http://www.stonehenge.com/merlyn/LinuxMag/col82.html
print "Just another Perl hacker," # the original
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Smalltalk/Perl/Unix consulting, Technical writing, Comedy, etc. etc.
See http://methodsandmessages.vox.com/ for Smalltalk and Seaside discussion
------------------------------
Date: Sun, 6 Jul 2008 14:29:24 +1000
From: "Graham Feeley" <grahamjfeeley@optusnet.com.au>
Subject: Re: Perl Script to be automated
Message-Id: <48704a2b$0$13947$afc38c87@news.optusnet.com.au>
Hmmm, sorry I have not made myself clear.
Here is the site I am using with all pages to be scraped
http://www.ozeform.com/Default.aspx?pageid=e2632b85-fe1d-40fb-96b1-59d9800646e5&seldate=20080705
this is the script
#!/usr/bin/perl
# Web8.pl
# last updated 24/06/2007
# Purpose
# To extract horse result details for each race at a nominated race meet
# The ozeform site has an archive of race meetings going back several
years
# by date by meeting location. By submitting the date and the meet name
# the results for each race and each horse can be retrieved in html format
# The retrieved data is then processed to csv format for use by Excel or
MS Access
use diagnostics;
use sigtrap;
use strict;
use warnings;
use LWP::Simple;
print "\t$0 Starting ", scalar localtime, " \n";
print "\tOperating System\t$^O\n";
print "\tPerl version \t$] \n";
my $meet_code = "G"; # meet types are R or Greyhound or T
my $file_name_1 = 'web5.txt'; # Output file name
my $file_name_2 = 'web5.csv'; # Output excel file
my $fstype = Win32::FsType();
my $item_num = 4; # the element number within the
result array
my $race_num = 1;
my $result_count = 0;
my @result ;
my $suffix ;
my $test = 0; # 0 is the default and provides minimum
output
# 1 will provide extended
displays for debugging any problems
print "\tCurrent Active Drive Type is $fstype\n";
my $race_date = shift; # format CCyymmdd 20070117
unless (defined $race_date)
{
print "\n\tPROBLEM: Race Meet Date is missing \n";
usage();
}
my $meet_date = $race_date;
validate_meet_date();
my $meet_name = shift;
unless (defined $meet_name)
{
print "\n\tPROBLEM: Race Meet Name is missing \n";
usage();
}
$meet_name = uc($meet_name);
my $meet_type = shift;
$meet_type = "R" unless (defined($meet_type)) ;
# Thoroughbred Harness(Trotter) or Greyhound
if ($meet_type eq "T")
{ # Trotter
$suffix = '&grt=t';
$meet_code = $meet_type;
}
elsif ($meet_type eq "G")
{ # Greyhound
$suffix = '&grt=g';
$meet_code = $meet_type;
}
else
{ # Thoroughbreed
$suffix = '&grt=r';
$meet_code = "R";
}
# Save the Meet Name and Date into the result array
$result[0] = $meet_name;
$result[1] = $race_date;
get_url(); # Scrape the web page and store it in web5.txt file for further
processing
print "\tGetting $meet_name results for the meet held on $race_date ... \n";
open_file_1(); # Open the web5.txt file which holds the retrieved scrapped
web page
open_file_2(); # web5.csv
filter_results();
close_file_1();
close_file_2();
sub filter_results
{
# Start looking through web5.txt for race results
while (<INF>)
{
$_ =~ s/^\s+//;
chomp ;
# If record starts with
# Name
# Race
# <span
# <td class
# then we check further for selection
if (/^name:/i)
{ # Race name
print "$_\n" if ($test == 1);
if (m!^name:.nbsp.([A-Z0-9 \-'&/.]+)<!i)
{
print "$.\tRace Name :\t$1 \n" if ($test == 1);
$result[3] = $1;
next;
}
} # End race name
if (/^Race/i)
{ # Meet name and date
display_meet_name();
next;
} # End meet name
if (/^<span id/i)
{ # Winner place price
next if (/pbuc8/i);
next if (/pbuc9/i);
if (m!^<span id.+>([0-9.]*)<!i)
{
print "$.\tWinner place :\t$1\n" if ($test == 1);
print "$_\n" if ($test == 1);
store_data(1);
next;
}
} # End Winner place price
if (/^<td class/i)
{ # Place Number Horse name and payout for Super NSW UNI STAB
next unless (/Row/i);
next if (/Row2/i);
print "$_ \n" if ($test == 1);
if (m!^<td class.+Row1.+>Race no:.nbsp.(\d+).nbsp.-.nbsp!i)
{ # Race number
print "$.\tRace number :\t$1 \n" if ($test == 1);
if ($1 ne $race_num)
{ # If it is the next race number
write_record();
$item_num = 4;
$race_num = $1;
}
$result[2] = $1;
next;
} # End race number
if (m!^<td class.+Row..>([1-3dnrst]+)<\/td>!i)
{ # Horse result for 1st 2nd or 3rd
print "$.\tHorse result :\t$1\n" if ($test == 1);
store_data(1);
next;
} # End horse result
if (m!^<td class.+Row....+>(\d+)<\/span><\/td>!i)
{ # Horse number
print "$.\tHorse Number :\t$1\n" if ($test == 1);
store_data(1);
next;
} # End horse number
if (m!^<td class.+Row.+Name..>([A-Z '\&]+)<!i)
{ # Horse name
print "$.\tHorse name :\t$1\n" if ($test == 1);
store_data(1);
next;
} # End horse name
if ((m!^<td class.+Row.+first.+>([0-9.A_Z]*)<\/span>!i) ||
(m!^<td class.+Row.+econd.+>([0-9.A_Z]*)<\/span>!i) ||
(m!^<td class.+Row.+third.+>([0-9.A-Z]*)<\/span>!i))
{ # Result payout
print "$.\tResult payout :\t$1\n" if ($test == 1);
store_data(1);
next;
} # End result payout
# print "$_\n";
} # End td class
} # End while record processing
write_record();
} # End of sub filter_results
sub display_meet_name
{
if (m!.+Name.>([A-Za-z ]+)<.+Date.>([0-9A-Za-z ]+)<!i)
{
print "$.\tMeeting held at $1 on $2 \n" if ($test == 1);
}
} # End of sub display_meet_name
sub get_url
{ # Scrape the web page and store it in web5.txt file for further processing
my $criteria = '&track=';
my $scheme = 'http://';
my $server = 'www.ozeform.com/';
my $prefix =
'Default.aspx?pageid=e2632b85-fe1d-40fb-96b1-59d9800646e5&seldate=';
# Sample page ref
#
http://www.ozeform.com/Default.aspx?pageid=e2632b85-fe1d-40fb-96b1-59d9800646e5&seldate=20070310&track=ASCOT&grt=r
my $url =
$scheme.$server.$prefix.$meet_date.$criteria.$meet_name.$suffix;
print "\tSearching $url ...\n";
my $html = get($url)
or die "\tget_url : No reply from server : $!";
print "\tReceived ", length($html), " bytes of data\n";
print "\tOpening file $file_name_1 for output \n";
open FH1, ">", $file_name_1
or die "\tget_url : Cannot open file $file_name_1 : $!";
print FH1 $html
or die "\tget_url : Cannot write to $file_name_1 : $!";
print "\tClosing file $file_name_1 \n";
close FH1 || die "\tget_url : Cannot close file $file_name_1 : $!";
# print "$html \n" if ($test == 2);
} # End of sub get_url
sub store_data
{ # Store the matched data into the result array
my $select = shift;
unless (defined($select))
{
print "\tstore_data: Parameter missing from sub call\n";
die "\tstore_data: Internal program error : $!";
}
unless ($select == 1 || $select ==2)
{
print "store_data: Invalid sub call parameter $select\n";
die "store_data: Internal program error : $!";
}
my $data;
if ($select == 1)
{
$data = $1;
}
elsif ($select == 2)
{
$data = $2;
}
if (length($data) == 0)
{
$data = '0.00';
}
if ($data eq "NPP" || $data eq "npp" || $data eq "NTD" )
{
$data = '0.00';
}
print " $data " if ($test == 2);
$result[$item_num++] = $data;
} # End of sub store_data
sub write_record
{ # Extract the data from the result array and reformat to csv
$result_count++;
my $rcd = '"'.$meet_code.'",';
my $num_items = @result;
for (my $i = 0; $i < @result; $i++)
{
$rcd .= '"'.$result[$i].'",';
}
my $x = chop $rcd;
print OUF $rcd,"\n" ||
die "\twrite_record : Cannot write to file : $!";
} # End of sub write_record
sub open_file_1
{
# Open the input file
print "\tOpening file $file_name_1 for input \n";
open INF, "<", $file_name_1 ||
die "open_file_1 : Cannot open file $file_name_1 : $! ";
} # End of sub open_file_1
sub open_file_2
{
# Open the output file
print "\tOpening file $file_name_2 for output \n";
open OUF, ">>", $file_name_2 ||
die "open_file_2 : Cannot open file $file_name_2 : $! ";
} # End of sub open_file_2
sub close_file_1
{
print "\n\n\tClosing input file $file_name_1 $. records\n";
close INF || die "close_file_1 : Can't close $file_name_1: $!";
} # End of sub close_file_1
sub close_file_2
{
print "\tClosing output file $file_name_2 $result_count records\n";
close OUF || die "close_file_2 : Can't close $file_name_2 : $!";
} # End of sub close_file_2
sub validate_meet_date
{
# Check that the meet date submitted is valid
# ccyymmdd
# Re format the date to dd/mm/yyyy
my $error_code = 0;
my $century ;
my $year ;
my $cal_month ;
my $month_day ;
if (length($race_date) < 8)
{
$error_code = 1;
print "\n\tERROR $error_code: Meet date is less than 8 digits\n";
}
$century = substr($race_date,0,2);
if (int($century) != 20)
{
$error_code = 2;
print "\n\tERROR $error_code: Incorrect Century number\n" ;
}
$year = substr($race_date,2,2);
if (int($year) < 1 || int($year) > 99)
{
$error_code = 3;
print "\n\tERROR $error_code: Incorrect year number\n" ;
}
$cal_month = substr($race_date,4,2);
if (int($cal_month) < 1 || int($cal_month) > 12)
{
$error_code = 4;
print "\n\tERROR $error_code: Incorrect month number\n" ;
}
$month_day = substr($race_date,6,2);
if (int($month_day) < 1 || int($month_day) > 31)
{
$error_code = 5;
print "\n\tERROR $error_code: Incorrect day number\n" ;
}
$race_date = $month_day.'/'.$cal_month.'/'.$century.$year;
usage() if($error_code != 0);
} # End of sub validate_meet_date
sub usage
{
# Operating instructions
my $usage = <<'****';
USAGE:
perl web5.pl [race meeting date] [race meeting name]
Race meeting date is an 8 digit date in the format CCyymmdd
Example: 20070117 for 17th January 2007
Race meeting name is alphabetic with no numbers or special characters
Example: COLAC NEW ZEALAND ASCOT WARRNAMBOOL
****
print "$usage\n\n";
die;
} # End of sub usage
if ($test == 1)
{ # Print web5.csv for checking
open INF, "<", $file_name_2 ||
die "Cannot open file $file_name_2 : $! ";
while(<INF>)
{
print $_;
}
close INF || die "Cannot close file $file_name_2 : $!";
} # End of print web5.csv
my $num = @result;
print "\tNumber of items in result array is $num\n";
print "\t$0 Ended at ", scalar localtime, " \n";
"Graham Feeley" <grahamjfeeley@optusnet.com.au> wrote in message
news:486f84ce$0$30466$afc38c87@news.optusnet.com.au...
just need it to be automated really
in other words go through each venue automatically
Regards
Graham
------------------------------
Date: Sat, 5 Jul 2008 23:20:23 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: Sed's N equivalent in Perl paragraph mode
Message-Id: <7m85k5-9t61.ln1@osiris.mauzo.dyndns.org>
Quoth * Tong * <sun_tong_001@users.sourceforge.net>:
>
> I want to remove this and next paragraph when criteria is met in this
> paragraph. If expressed in sed, it'll be:
>
> sed -paragraph_mode '/criteria/{N; d; }'
>
> I tried the following in Perl, but neither works:
>
> perl -n000e 'if (/criteria/) { next; next; }'
This will output nothing. If you're using -n you need to print the lines
yourself.
The Perl equivalent of sed's 'N' (when using -n or -p) is '$_ .= <>'.
Since you are just throwing the line away, you don't need to append it
to $_. So that gives us
perl -n000e 'if (/criteria/) { <>; next; } print;'
I was going to suggest using 's2p', but it understands a rather limited
dialect of 'sed' and produces completely unreadable Perl, so, um, don't
:).
Ben
--
'Deserve [death]? I daresay he did. Many live that deserve death. And some die
that deserve life. Can you give it to them? Then do not be too eager to deal
out death in judgement. For even the very wise cannot see all ends.'
ben@morrow.me.uk
------------------------------
Date: Sat, 05 Jul 2008 21:29:55 -0500
From: * Tong * <sun_tong_001@users.sourceforge.net>
Subject: Re: Sed's N equivalent in Perl paragraph mode
Message-Id: <sIednd1AGtO-s-3VnZ2dnUVZ_oWdnZ2d@golden.net>
On Sat, 05 Jul 2008 23:20:23 +0100, Ben Morrow wrote:
>> I want to remove this and next paragraph when criteria is met in this
>> paragraph. If expressed in sed, it'll be:
>>
>> sed -paragraph_mode '/criteria/{N; d; }'
>>
>> . . .
>
> The Perl equivalent of sed's 'N' (when using -n or -p) is '$_ .= <>'.
> Since you are just throwing the line away, you don't need to append it
> to $_. So that gives us
>
> perl -n000e 'if (/criteria/) { <>; next; } print;'
Thanks a lot. It works great. (yeah, I was so focusing on isolating the
question out of my code that I forgot about to include the print).
Thanks
------------------------------
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 1694
***************************************
