[29176] in Perl-Users-Digest
Perl-Users Digest, Issue: 420 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed May 9 11:10:08 2007
Date: Wed, 9 May 2007 08:09:06 -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, 9 May 2007 Volume: 11 Number: 420
Today's topics:
Re: A question about lists (hymie!)
Re: Can not add a scalar variable of path into @INC? <chris@ccobb.net>
Re: Click link to go to routine <paduille.4061.mumia.w+nospam@earthlink.net>
Re: Click link to go to routine <sykigh@trist.com>
document/literal style SOAP:Lite service <efimfurman@gmail.com>
Re: document/literal style SOAP:Lite service <scobloke2@infotop.co.uk>
Re: Link Matching <taras.di@gmail.com>
Re: parsing a variable length record from a mixed forma chadmay@hotmail.com
Re: parsing a variable length record from a mixed forma chadmay@hotmail.com
Please give me a good "rule-of-thumb" for back-slashing <MisterPerl@gmail.com>
SOAP::Lite, encode and special characters <stefan@braun.name>
temp file creation in perl 5.0 <desiaashik@gmail.com>
Re: temp file creation in perl 5.0 <someone@example.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Wed, 09 May 2007 07:31:32 -0500
From: hymie_@_lactose.homelinux.net (hymie!)
Subject: Re: A question about lists
Message-Id: <lcGdnUoKCMi5ItzbnZ2dnUVZ_uejnZ2d@comcast.com>
In our last episode, the evil Dr. Lacto had captured our hero,
Sherm Pendley <spamtrap@dot-app.org>, who said:
>Web Hosting by West Virginians, for West Virginians: http://wv-www.net
Now *there's* a phone call I want to hear...
"Just check our web site. it's doubleyou doubleyou doubleyou dot doubleyou
vee dash doubleyou doubleyou doubleyou ... no no, doubleyou vee dash
doubleyou doubleyou doubleyou ... "
--hymie! http://lactose.homelinux.net/~hymie hymie@lactose.homelinux.net
------------------------ Without caffeine for 190 days ------------------------
------------------------------
Date: 9 May 2007 06:14:21 -0700
From: "c.cobb" <chris@ccobb.net>
Subject: Re: Can not add a scalar variable of path into @INC?
Message-Id: <1178716461.363182.124420@y80g2000hsf.googlegroups.com>
On May 8, 10:57 pm, Michael Yang <Michael....@gmail.com> wrote
> > Why do you need to use this scalar variable instead of hard-coded
> > absolute path?
>
> To make my toolkit portable to different machines.
Here's one way to create relocatable scripts that
never need any changes to directory paths no matter
where in the directory tree you move them. This also
works when running a Perl script across NFS mount
points, network share drives and/or as a CGI script.
http://search.cpan.org/search?query=ptools::local
FYI,
------------------------------
Date: Wed, 09 May 2007 11:52:06 GMT
From: "Mumia W." <paduille.4061.mumia.w+nospam@earthlink.net>
Subject: Re: Click link to go to routine
Message-Id: <GBi0i.5228$296.2893@newsread4.news.pas.earthlink.net>
On 05/08/2007 03:27 PM, Sykigh A Trist wrote:
> (attribution restored) Xicheng Jia wrote:
>>> print "<center><a href=\"http://www.scripts.net/\" target=\"_top\">Go
>>> Back</a>\n";
>>
>> If the routine "return_this" resides in your web server, you can wrap
>> it into a CGI script or some Perl templating system files, then:
>>
>> print '<center><a href="/path/to/return_this.pl?name=skyhigh"
>> target="_top">Go Back</a>\n';
>
> Thanks for the replies, guys. I guess I'm not being very clear. When I say
> routine I mean a subroutine that is in the same file as the print
> statement.
> All of the code below and what I'm referring to is in the same file
> (shortened for this post). When clicking this link "a
> href=\"http://www.scripts.net/\" I want to change it and have it go to "sub
> return_this." Hope I'm being more clear. Thanks again.
>
This is impossible to do directly, but it's possible indirectly. When
programming in CGI, typically you have two different contexts to deal
with. Your Perl program operates in the server context on the web
server, and the HTML code you create operates in the browser context in
the client's web browser. It's not possible for HTML code on one machine
to call Perl functions on another machine--at least not directly.
> print "<center><a href=\"http://www.scripts.net/\" target=\"_top\">Go
> Back</a>\n";
>
> sub return_this {
> my($numchoice,$ncinfile,$check,$totals,@totals,$i);
>
> sub error {
> print "Content-type: text/html","\n\n";
> print "ERROR!! $_[0]";
> exit;
> }
>
> sub decode_form {
> read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
>
Xicheng Jia gave you some hints of what you need to do; it's slightly
complicated. Search for CGI tutorials on the web, for there are many.
Also, it seems like you're trying to decode the FORM data yourself.
Please don't do that. CGI.pm can do it better and more consistently than
you ever could (especially if you're a newbie); you can read the docs
for CGI.pm by typing "perldoc CGI" at a command prompt.
HTH
------------------------------
Date: Wed, 09 May 2007 12:28:41 GMT
From: "Sykigh A Trist" <sykigh@trist.com>
Subject: Re: Click link to go to routine
Message-Id: <Z7j0i.5235$296.1313@newsread4.news.pas.earthlink.net>
Thanks to all that replied. Some helpful tips from you. I will try to put to
use what you have given me. And about my tirade (see below from my first
post).
>>Can this be done within this code and does anyone mind showing me how to
>>do it? Thanks
The reason I put the words above in my first post is because it is hard to
get any answers from a few in this newsgroup. I've been here before. Same
thing, last time I was here. Some people, instead of trying to help, like to
point out how wrong you are in every aspect of your question. It was a very
simple question - I want to click on a link and go to a subroutine in the
code and not to a webpage. Again, thanks to all that helped.
------------------------------
Date: 9 May 2007 06:27:29 -0700
From: Fima Furman <efimfurman@gmail.com>
Subject: document/literal style SOAP:Lite service
Message-Id: <1178717248.976916.166830@q75g2000hsh.googlegroups.com>
Folks, this seems like a pretty basic question, but I couldn't find a
direct answer, only hints in documentation and other people's article.
Can Soap:Lite implement a service which would work with Document/
literal requests? In my testing I was only able to get it to work with
rpc/encoded style. I would very much appreciate if someone could shed
some light on this.
If Soap:lite is incompatible with document/literal, are there
alternatives out there which would allow to implement document/literal
SOAP service in Pearl? I've asked the same question in Soap:Lite yahoo
group and total silence was my answer.
Thanks!
------------------------------
Date: Wed, 09 May 2007 15:28:04 +0100
From: Ian Wilson <scobloke2@infotop.co.uk>
Subject: Re: document/literal style SOAP:Lite service
Message-Id: <4641da78$0$19260$da0feed9@news.zen.co.uk>
Fima Furman wrote:
> Folks, this seems like a pretty basic question, but I couldn't find a
> direct answer, only hints in documentation and other people's article.
> Can Soap:Lite implement a service which would work with Document/
> literal requests? In my testing I was only able to get it to work with
> rpc/encoded style. I would very much appreciate if someone could shed
> some light on this.
SOAP::Lite really only supports RPC/Encoded. The SOAP::Lite
documentation mentions partial support for Doc/Literal but I believe
this never advanced beyond some rudimentary and partial support.
> If Soap:lite is incompatible with document/literal, are there
> alternatives out there which would allow to implement document/literal
> SOAP service in Pearl? I've asked the same question in Soap:Lite yahoo
> group and total silence was my answer.
AFAIK There are no alternative modules that do what you want.
I'd love to hear if I am wrong about either of the above!
The good news is that the following process works beautifully:
* Create a SOAP::Lite service in the usual way.
* If you receive or send complex data structures,
Use Perl objects
Return references to arrays instead of arrays
Do not use perl data structures like HoH
Do not use SOAP::Data to construct params or return values.
* Mark up your Perl objects following the instructions
in the POD::WSDL documentation
* Use POD::WSDL to create WSDL for the service
* Use that WSDL to create stubs in technologies that
normally only like Doc/Literal
e.g. C# .NET
I downloaded mono and used it's wsdl.exe to create a
C# stub from the WSDL created by POD::WSDL
* Use those stubs in the normal way.
I could write normal C# code, constructing C# objects and passing
them as params to Perl SOAP::Lite services via methods of a stub
service object. Perl objects emerge as C# objects and vice-versa.
* The receiving Perl service receives full Perl objects
and you can invoke instance methods using those
objects!
I have done this with moderately complex parameters such as an array of
objects where each object contains various fields and an array of
another type of object.
Note that the C# programmer does not have to even know about the
distinction between RPC/Encoded and Doc/Literal. Everything just works.
I haven't tried this with Perl's inside-out objects, just the original
traditional hash based objects. The C# classes created in the stub for
the parameter and return objects obviously lack methods and accessors,
you just refer to public variables (fields) using object.field notation
Perl service
my @things;
my $thing = new Thing(1,99.9,"aha");
$thing->addWhatsit("foo", 23.3); # inner array of Whatsit objects
$thing->addWhatist("bar", 23.3);
push @things $thing;
$thing = new Thing(2,34.2,"oho");
return \@things;
C# client
// stub gen from WSDL defines ThingService, Thing and Whatsit.
ThingService service = new ThingService();
Thing[] things = service.method(params);
for (int i = 0; i < things.Length; i++) {
Whatsit[] whatsits = things[i].whatsits;
for (int j = 0; j < whatsits.Length; j++) {
Console.WriteLine("This Things contains a Whatsit with name "
+ whatsits[j].name);
}
}
No hint of RPC/Encoded or Doc/Literal anywhere in the code you have to
write.
------------------------------
Date: 9 May 2007 05:21:18 -0700
From: Taras_96 <taras.di@gmail.com>
Subject: Re: Link Matching
Message-Id: <1178713278.269503.218030@u30g2000hsc.googlegroups.com>
>
> You can do that if you want to match one particular string.
>
> If you want code that will work on different data, we would
> need to understand what could be different...
>
Should have explained my question a bit more (I thought with the
previous discussion about HTML it would be clear).
Part 1)
How do I construct a regex that matches any text that is in between
<open> and </close> strings, but the *shortest* (non-greedy matching)
such string?
So in the above example, the strings 'one' and 'two' can be
theoretically anything.
Part 2)
Once we have the non-greedy matching, how can I construct a regex that
would return any text in between <open> and </close>, but the text in
between the tags must itself match a regex?
eg: a search for o(.)* would return 'one' using my previous example,
but not 'two'.
------------------------------
Date: 9 May 2007 07:19:26 -0700
From: chadmay@hotmail.com
Subject: Re: parsing a variable length record from a mixed format file
Message-Id: <1178720366.473398.110340@e65g2000hsc.googlegroups.com>
On May 9, 2:06 am, Brian McCauley <nobul...@gmail.com> wrote:
> On May 8, 4:41 pm, chad...@hotmail.com wrote:
>
> > I have a flat file that had a mix of fixed length and variable length
> > records. I am parsing through each record and determining if each
> > field is accurate compared to the document. Dealing with the fixed
> > length records was easy, but I'm having difficulting with the variable
> > length records. Here is a snippet of my code and record 3
> > (ACCT_CLUS_NM) is a variable length record. Since the record in my
> > test file isn't 45 chars, my output file is incorrect. Since I know
> > that the largest that record 3 will be is 45 chars, how do I code for
> > it??
>
> You cannot code for something you can't even describe. If you have a
> record with a mix of fixed length and variable length fields you need
> some property of the record that lets you determine how wide the
> variable fields are. Since you've not described how you (a human)
> could tell how long the ACCT_CLUS_NM field is in a given record
> there's no way you can convert that lack of knowledge into working
> code.
>
> Sorry - I've just re-read this thread and realised this is a simple
> tab delimited record, so you should simply split() it. (I was going to
> tell you about unpack() and m//gc as approaches to mixed fixed/
> variable with fields but neither of these are now relevant).
>
>
>
> > #!/usr/bin/perl
>
> > $loop=57;
> > $ifname=$ARGV[0];
> > $ofname=$ARGV[1];
>
> > if("${ifname}" eq "" | "${ofname}" eq "")
> > {
> > print "\nUsage: $0 input_file output_file\n";
> > exit;}
>
> Please see other people's comments on cleaning up your Perl. In
> particular decalre all variables as lexically scoped in the smallest
> applicable scope unless there is a reason not to (this is not specific
> to Perl). You can then tell perl to insist on explicit declaration. It
> really will save you a lot of pain in future. When learning to climb
> all those ropes do get in the way but after the first couple of slips
> the effort pays off.
>
> > if(!-f "$ifname" | !-r "$ifname")
> > {
> > print "$ifname doesn't exist or you do not have permission to read
> > it.\n";
> > exit 1;}
>
> Remove that block of code - the error handling on open() already does
> a better job of telling the user what's actually wrong.
>
> > if(-f "$ofname")
> > {
> > print "$ofname already exists.\n";
> > exit 1;
>
> > }
> > open(FBATCHF, ">> $ofname") or die "Open failed: $!\n";
>
> Why are you trying to append to a file that you've just checked does
> not already exist? This won't confuse the computer but it sure does
> confuse any human who looks at your code.
>
> > if($cnt==1){$reclength=4;$field="ACCOUNT_TYPE"};
> > if($cnt==2){$reclength=1;$field="TAB"};
> > if($cnt==56){$reclength=1;$field="TAB"};
> > if($cnt==57){$reclength=10;$field="TIER_TYPE"};
>
> If you are doing the same thing 3 times you are probably doing it
> wrong. You are doing the same thing 57 times. The word "array" should
> be burning so brightly in your mind's eye that smoke should be issuing
> from your ears.
------------------------------
Date: 9 May 2007 07:26:01 -0700
From: chadmay@hotmail.com
Subject: Re: parsing a variable length record from a mixed format file
Message-Id: <1178720761.187680.257300@o5g2000hsb.googlegroups.com>
On May 8, 2:43 pm, "John W. Krahn" <some...@example.com> wrote:
> chad...@hotmail.com wrote:
> > I have a flat file that had a mix of fixed length and variable length
> > records. I am parsing through each record and determining if each
> > field is accurate compared to the document. Dealing with the fixed
> > length records was easy, but I'm having difficulting with the variable
> > length records. Here is a snippet of my code and record 3
> > (ACCT_CLUS_NM) is a variable length record. Since the record in my
> > test file isn't 45 chars, my output file is incorrect. Since I know
> > that the largest that record 3 will be is 45 chars, how do I code for
> > it??
>
> It looks like this may be close to what you want:
>
> #!/usr/bin/perl
> use warnings;
> use strict;
>
> @ARGV == 2 or die "\nUsage: $0 input_file output_file\n";
>
> my ( $ifname, $ofname ) = @ARGV;
>
> my @fields = qw(
> ACCOUNT_TYPE
> ACCT_CLUS_NM
> ACCT_NBR
> CORP_ENT_CD
> CUSTOMER_NO
> D_BEN_AGMT_DESC
> D_BEN_AGMT_EFF_DT
> D_FUND_TYP_CD
> D_PROD_TYP_CD
> FOLDED_FUNDING_TYPE
> GROUP_NAME
> GROUP_NO
> GRP_CAN_CD
> GRP_CAN_DT
> GS_ORIGL_EFF_DT
> H_BEN_AGMT_DESC
> H_BEN_AGMT_EFF_DT
> H_FUND_TYP_CD
> H_PROD_TYP_CD
> LOAD_DT
> LST_UPDT_DT
> MKT_SEG_CD
> NAME
> ROW_EFFECTIVE_DT
> ROW_END_DT
> SECT_NBR
> SECT_NM
> SIC_CD
> TIER_TYPE
> );
>
> open BATCHF, '<', $ifname or die "Open '$ifname' failed: $!\n";
> open FBATCHF, '>>', $ofname or die "Open '$ofname' failed: $!\n";
>
> while ( my $RECIN = <BATCHF> ) {
> chomp $RECIN;
> @records = split /\t/, $RECIN, -1;
> print FBATCHF map( "$fields[$_] " . length( $records[ $_ ] ) . "
> |$records[$_]|\n", 0 .. $#fields ), '-' x 48, "\n";
> }
>
> close BATCHF;
> close FBATCHF;
>
>
>
>
>
>
>
> > #!/usr/bin/perl
>
> > $loop=57;
> > $ifname=$ARGV[0];
> > $ofname=$ARGV[1];
>
> > if("${ifname}" eq "" | "${ofname}" eq "")
> > {
> > print "\nUsage: $0 input_file output_file\n";
> > exit;
> > }
> > if(!-f "$ifname" | !-r "$ifname")
> > {
> > print "$ifname doesn't exist or you do not have permission to read
> > it.\n";
> > exit 1;
> > }
> > if(-f "$ofname")
> > {
> > print "$ofname already exists.\n";
> > exit 1;
> > }
>
> > open(BATCHF, "$ifname") or die "Open failed: $!\n";
> > open(FBATCHF, ">> $ofname") or die "Open failed: $!\n";
>
> > while (<BATCHF>)
> > {
> > $RECIN=$_;
> > $fpos=0;
> > for ($cnt=1;$cnt<=$loop;$cnt++)
> > {
> > if($cnt==1){$reclength=4;$field="ACCOUNT_TYPE"};
> > if($cnt==2){$reclength=1;$field="TAB"};
> > if($cnt==3){$reclength=45;$field="ACCT_CLUS_NM"};
> > if($cnt==4){$reclength=1;$field="TAB"};
> > if($cnt==5){$reclength=9;$field="ACCT_NBR"};
> > if($cnt==6){$reclength=1;$field="TAB"};
> > if($cnt==7){$reclength=3;$field="CORP_ENT_CD"};
> > if($cnt==8){$reclength=1;$field="TAB"};
> > if($cnt==9){$reclength=9;$field="CUSTOMER_NO"};
> > if($cnt==10){$reclength=1;$field="TAB"};
> > if($cnt==11){$reclength=20;$field="D_BEN_AGMT_DESC"};
> > if($cnt==12){$reclength=1;$field="TAB"};
> > if($cnt==13){$reclength=10;$field="D_BEN_AGMT_EFF_DT"};
> > if($cnt==14){$reclength=1;$field="TAB"};
> > if($cnt==15){$reclength=8;$field="D_FUND_TYP_CD"};
> > if($cnt==16){$reclength=1;$field="TAB"};
> > if($cnt==17){$reclength=6;$field="D_PROD_TYP_CD"};
> > if($cnt==18){$reclength=1;$field="TAB"};
> > if($cnt==19){$reclength=8;$field="FOLDED_FUNDING_TYPE"};
> > if($cnt==20){$reclength=1;$field="TAB"};
> > if($cnt==21){$reclength=40;$field="GROUP_NAME"};
> > if($cnt==22){$reclength=1;$field="TAB"};
> > if($cnt==23){$reclength=9;$field="GROUP_NO"};
> > if($cnt==24){$reclength=1;$field="TAB"};
> > if($cnt==25){$reclength=2;$field="GRP_CAN_CD"};
> > if($cnt==26){$reclength=1;$field="TAB"};
> > if($cnt==27){$reclength=10;$field="GRP_CAN_DT"};
> > if($cnt==28){$reclength=1;$field="TAB"};
> > if($cnt==29){$reclength=10;$field="GS_ORIGL_EFF_DT"};
> > if($cnt==30){$reclength=1;$field="TAB"};
> > if($cnt==31){$reclength=20;$field="H_BEN_AGMT_DESC"};
> > if($cnt==32){$reclength=1;$field="TAB"};
> > if($cnt==33){$reclength=10;$field="H_BEN_AGMT_EFF_DT"};
> > if($cnt==34){$reclength=1;$field="TAB"};
> > if($cnt==35){$reclength=8;$field="H_FUND_TYP_CD"};
> > if($cnt==36){$reclength=1;$field="TAB"};
> > if($cnt==37){$reclength=6;$field="H_PROD_TYP_CD"};
> > if($cnt==38){$reclength=1;$field="TAB"};
> > if($cnt==39){$reclength=10;$field="LOAD_DT"};
> > if($cnt==40){$reclength=1;$field="TAB"};
> > if($cnt==41){$reclength=10;$field="LST_UPDT_DT"};
> > if($cnt==42){$reclength=1;$field="TAB"};
> > if($cnt==43){$reclength=4;$field="MKT_SEG_CD"};
> > if($cnt==44){$reclength=1;$field="TAB"};
> > if($cnt==45){$reclength=45;$field="NAME"};
> > if($cnt==46){$reclength=1;$field="TAB"};
> > if($cnt==47){$reclength=10;$field="ROW_EFFECTIVE_DT"};
> > if($cnt==48){$reclength=1;$field="TAB"};
> > if($cnt==49){$reclength=10;$field="ROW_END_DT"};
> > if($cnt==50){$reclength=1;$field="TAB"};
> > if($cnt==51){$reclength=5;$field="SECT_NBR"};
> > if($cnt==52){$reclength=1;$field="TAB"};
> > if($cnt==53){$reclength=40;$field="SECT_NM"};
> > if($cnt==54){$reclength=1;$field="TAB"};
> > if($cnt==55){$reclength=4;$field="SIC_CD"};
> > if($cnt==56){$reclength=1;$field="TAB"};
> > if($cnt==57){$reclength=10;$field="TIER_TYPE"};
> > chomp($RECIN);
> > $RECOUT=substr($RECIN,$fpos,$reclength);
> > $fpos=$reclength + $fpos;
> > print FBATCHF "$field $reclength |$RECOUT|\n";
> > }
> > print FBATCHF "------------------------------------------------\n";
> > }
> > close BATCHF;
> > close FBATCHF;
>
> John
> --
> Perl isn't a toolbox, but a small machine shop where you can special-order
> certain sorts of tools at low cost and in short order. -- Larry Wall- Hide quoted text -
>
> - Show quoted text -
Problem is solved now, Thanks John!
------------------------------
Date: 9 May 2007 08:06:32 -0700
From: Mr P <MisterPerl@gmail.com>
Subject: Please give me a good "rule-of-thumb" for back-slashing in character classes
Message-Id: <1178723192.645442.41390@o5g2000hsb.googlegroups.com>
It *seems like* any character other than "]" or "\", or in some cases
"-", in a character class, would be interpreted "in-situ", as that
exact character. But I get confusing error messages so often, that I
usual just revert to a policy of "backslash everything" when in-doubt.
I would appreciate a (hopefully one-sentance so I can remember it)
guide/rule on what/when to backslash within character classes?
[\$\#\@\*\=\-\)]
or
[$#Q*=-)]
?
Sort of along the lines of : AIEOU and sometimes Y and W (is there
really a case when W is a vowel I never did see one, but I digress)..
Gracias,
MP
------------------------------
Date: Wed, 9 May 2007 12:19:53 +0200
From: "Stefan Braun" <stefan@braun.name>
Subject: SOAP::Lite, encode and special characters
Message-Id: <5adliaF2m409cU1@mid.individual.net>
Hello,
I transmit German city names over SOAP::Lite to a webservice. If there is a
special character like "Ü" on the Server arrives a "Ã?".
In my code I define the encoding as: iso-8859-1:
$soap = SOAP::Lite
-> uri('http://services.uabo.tnw.ch/')
-> on_action( sub{ join '/', 'http://tnw.ch', $_[1]})
-> encoding('iso-8859-1')
-> proxy('http://services.uabo.tnw.ch/service.asmx');
I encode the variable too with iso-8859-1:
my $testcity = Encode::encode("iso-8859-1",$city);
the call is:
SOAP::Data->name(City => $testcity)->type('string')
If I start the equal script from the shell it works fine, on the webserver
it doesn't work.
I sniffed the traffic. If it works the "Ü" is transmitted as "dc" in oct, if
it doesn't work it's transmitted as "c3 9c".
What's my mistake?
Regards and many thanks
Stefan
------------------------------
Date: 9 May 2007 07:05:29 -0700
From: KP <desiaashik@gmail.com>
Subject: temp file creation in perl 5.0
Message-Id: <1178719528.663205.314560@w5g2000hsg.googlegroups.com>
Hi,
I have this perl code that is written in 5.8 but want to run in 5.0.
The issue is that 5.0 don't have File::Temp module so, it fails. Here
is the code.. Please let me know what to comment and what to change so
that the script can be run smoothly. Instead of using standard Perl
Temp module, I want to specify a path to create a temp file and then
cleanup later in the process.
#!/usr/bin/perl -w
use File::Temp qw/ tempdir /;
use Time::HiRes qw/tv_interval gettimeofday/;
use POSIX qw(strftime);
#---------------------------------------
# wget related Variable declarations
#---------------------------------------
# number of seconds to wait for before each wget request times out
use constant WGET_TIMEOUT => 1;
# number of retries to wait for before wget give up
use constant WGET_RETRIES => 1;
# current run timestamp
use constant TIMESTAMP => strftime('%Y-%m-%d %H:%M:%S', localtime());
# subject for the warning mail
use constant SUBJECT => "open file failed ";
# recipient of the warning mail
use constant RECIPIENT => 'support@user.com';
#---------------------------------------
# trims a string
#---------------------------------------
sub trim
{
$_ =~ s/^\s+//;
$_ =~ s/\s+$//;
return $_;
}
#---------------------------------------
# open a file
#---------------------------------------
sub open_or_die
{
# if @_ contains 1 element only then $#_ == 0
# in that case, ($fh, $fn) is initialized to be (undef, @_)
# in the first case,
# open_or_die opens $fn in the specified handled $fh
# in the second case, $fh is not specified, but will be returned
through the return value of the function
my($fh, $fn) = $#_ ? @_ : (undef, @_);
open($fh, $fn) or (`mail -s "${SUBJECT}: ${fn}" ${RECIPIENT} < /dev/
null` and die "cannot open: $fn\n");
return $fh;
}
#------------------------------------------------------------------------------
# make a set of urls given the input file handle $fh and
# the transformer $to_url which transforms each line of the input file
into a url
#------------------------------------------------------------------------------
sub make_urls
{
my($fh, $to_url) = @_;
my(@definitions) = <$fh>; #@definitions now contains the lines from
fh
# each line of definition is trimed (remove starting/trailing
spaces) then processed by the custom to_url function
my(@reduced) = ();
for (@definitions)
{
$_ = trim($_);
if ($_)
{
push @reduced, ($_);
}
}
return map {$to_url->($_)} @reduced;
}
#----------------------------------------------------
# processes the given url $url with $id, and
# record the result using the transformer $to_record
#----------------------------------------------------
sub process_url
{
my($id, $url, $to_record) = @_;
# time a url fetch, returns NULL if no files were downloaded
sub time_url
{
my($url) = @_;
my($cmdline) = "wget -H -p -t" . WGET_RETRIES . " -T" .
WGET_TIMEOUT . " -P\"" . $TEMPDIR . "\" \"$url\" 2>&1";
# @start time accurate to milliseconds
my(@start) = gettimeofday();
my($results) = "" . `$cmdline`;
# @end time accurate to millisecodns
my(@finish) = gettimeofday();
# if $results contains the text Downloaded: 0 Bytes...
# or $results does not contain the text Downloaded
# then download must have failed somehow.
# "NULL" value is returned
# otherwise, assume download to have succeeded,
# the time interval between @start and @finish is returned using
tv_interval
return (($results =~ /Downloaded: 0 bytes in 0 files/) ||
($results !~ /Downloaded/)) ? "0" : sprintf("%0.2f", tv_inter$
}
# prints the result transformed by the to_record transformer to the
$RESULT handle
print $RESULT $to_record->($id, $url, time_url($url)) . "\n";
}
#-----------------------------------------------------------------------------------
# process all urls, given the input file name $fn, and
# transformers $to_url which converts each input line of the input
file to a url and
# $to_record which converts the output data to a valid line of csv
record
#-----------------------------------------------------------------------------------
sub process_urls
{
my($fn, $to_url, $to_record) = @_;
my %urls = make_urls(open_or_die($fn), $to_url);
while (($id, $url) = each(%urls))
{
process_url($id, $url, $to_record);
}
close($fn);
}
{
#------------------------------------------------------------------------------------
# the script can take two or three paramters depending
# the first two params are the filename for the surveys and static
urls respectively
# if only two parameters are passed to the script, then stdout is
used for output,
# otherwise the third parameter specifies the result file
#------------------------------------------------------------------------------------
$#ARGV >= 1 or print("usage: urltimer.pl survey.txt static.txt
[result.txt]") and exit();
my($survey_fn, $static_fn) = @ARGV[0..1];
# context sensitive constants
#$RESULT = ($#ARGV == 1 ? STDOUT : open_or_die($ARGV[2]));
$RESULT = STDOUT;
$TEMPDIR = tempdir(CLEANUP => 1);
# process the server urls
process_urls($survey_fn,
# to_url for survey urls
sub {
return $_ => "http://www.website.com/sitereport/servlet/web.Reg?
websiteid=${_}";
},
# to_record for survey urls
sub {
my($id, $url, $time) = @_;
join(",", $id, '', $time, TIMESTAMP);
});
# process static urls
process_urls($static_fn,
# to_url for static urls
sub {
my($id, $url) = split(/\s+/, $_, 2);
return $id => $url;
},
# to_record for static urls
sub {
my($id, $url, $time) = @_;
join(",",'' , $id, $time, TIMESTAMP);
});
}
------------------------------
Date: Wed, 09 May 2007 14:57:31 GMT
From: "John W. Krahn" <someone@example.com>
Subject: Re: temp file creation in perl 5.0
Message-Id: <vjl0i.21178$au6.10168@edtnps90>
KP wrote:
>
> I have this perl code that is written in 5.8 but want to run in 5.0.
> The issue is that 5.0 don't have File::Temp module so, it fails.
perldoc -q "How do I make a temporary file name"
John
--
Perl isn't a toolbox, but a small machine shop where you can special-order
certain sorts of tools at low cost and in short order. -- Larry Wall
------------------------------
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 420
**************************************
