[11483] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 5083 Volume: 8

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Mar 7 22:07:18 1999

Date: Sun, 7 Mar 99 19:00:16 -0800
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, 7 Mar 1999     Volume: 8 Number: 5083

Today's topics:
    Re: 'chmod 755 xxx.pl' <amwalker@gate.net>
    Re: ADO, OLE on WinNT (Jan Dubois)
        background process module - STDIN/STDOUT/STDERR? eldridge@graphics.stanford.edu
    Re: background process module - STDIN/STDOUT/STDERR? (Mads Toftum)
        Combining Files golfer@usa.net
    Re: Combining Files (Ronald J Kimball)
    Re: command line arguments (Ronald J Kimball)
        Datatrack <arbustus@jps.net>
    Re: deletion problem (brian d foy)
        FAQ 2.15: Archives of comp.lang.perl.misc   <perlfaq-suggestions@perl.com>
        FAQ 2.16: Where can I buy a commercial version of Perl? <perlfaq-suggestions@perl.com>
        Help with an array <steve@NOSPAMcyber-distributors.com>
    Re: HELP: howto get local_IP under Win9x <metcher@spider.herston.uq.edu.au>
    Re: How to run Perl program as NT service? <--- perl.ex pault12@postoffice.pacbell.net
    Re: mySQL Default Field Question (brian d foy)
        newbie problem with *s (regular expression matching in  (Scott Carpenter)
        perlcc <msholund@bigfoot.com>
        POST bug in latest LWP/libwww (1.82) <jbattikha@highsynth.com>
    Re: Serial Communications using Perl (Andrew M. Langmead)
        Special: Digest Administrivia (Last modified: 12 Dec 98 (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Sun, 07 Mar 1999 19:48:36 -0500
From: Aaron Walker <amwalker@gate.net>
To: battles@flash.net
Subject: Re: 'chmod 755 xxx.pl'
Message-Id: <36E31E64.499BCD7D@gate.net>

Is this on your own server, or an ISP/hosted server?
If it's on your own server, just issue the command at the command prompt.
If it's on the latter, then you will have to find out from them how to go
about doing
it.  If you have a shell account for your server, then just telnet into it,
and then issue the command.

hope this helps,
Aaron

John wrote:

> I am at a complete loss as to how to do this:
>
> I have been told to change the permission of a xxx.pl module that I have
> placed in my cgi-bin with this..
>
> chmod 755 xxx.pl
>
> which sets the script as executable, otherwise the instructions say that
> I am going to get server errors all day long, which is what is
> happening.
>   Could someone explain exactly how I go about executing this
> instruction/technique?  - Thanks.



------------------------------

Date: Mon, 08 Mar 1999 01:20:03 +0100
From: jan.dubois@ibm.net (Jan Dubois)
Subject: Re: ADO, OLE on WinNT
Message-Id: <36ee1136.148310409@news3.ibm.net>

[mailed & posted]

Bon So <bon@boomhq.com> wrote:

>I have just installed perl5.00402-bindist04-bc.zip & libwin32-0_14.zip.
>Then I tried the piece of Perl (quoted at below)  which (ideally!!) use
>ADO / OLE to connect to db (a SQL 6.5)
>however, what it returns
>---------- start of capture ---------------
>Win32::OLE(0.10): GetOleObject() Not a Win32::OLE object at
>C:\perl\lib\site/OLE.pm line 113.
>Win32::OLE(0.10): GetOleObject() Not a Win32::OLE object at
>C:\perl\lib\site/OLE.pm line 113.
>Can't call method "Fields" without a package or object reference at
>ado.pl line 13.
>Win32::OLE(0.10): GetOleObject() Not a Win32::OLE object during global
>destruction.
>---------- end of capture ---------------

I've seen this now a couple of times. The Win32::OLE module from libwin32-0.14
doesn't seem to work with the Borland compiled 5.004_02 distribution. I've
compiled both 5.004_02 and libwin32-0.14 with MS VC++ and everything works
fine. I did send a bug report to Sarathy about it, but I guess it is on low
priority for him.

The best way would be to switch to ActivePerl. It is based on a recent version
of Perl and also already includes the latest Win32::OLE module.

-Jan


------------------------------

Date: Sun, 07 Mar 1999 23:13:12 GMT
From: eldridge@graphics.stanford.edu
Subject: background process module - STDIN/STDOUT/STDERR?
Message-Id: <7bv161$ne2$1@nnrp1.dejanews.com>

Hi-

I'm working on a system independent background process module to handle
parallel program runs.  Initially this is for a make-style build system,
but I've got a lot of simulation stuff that will benefit from a system
that can manage parallelism.

I looked over the various process modules in CPAN, and all of them missed
on the functionality I was trying to get.  Perhaps most importantly, the
module will support both Unix and Win32, which means a fork/exec model
for starting processes isn't always available.

The model of operation is:

   # start a job
   $handle = Subproc::Create( @args, %env );

   # reap any available child
   $handle = Subproc::Wait( );

   # reap a specific child
   $handle = Subproc::WaitPid( $handle );

In general I'd like to let STDIN/STDOUT/STDERR "take care of itself", but it
doesn't seem to be.  My test.pl script runs "/bin/ls -l" and waits for it
to finish, all of which works quite nicely.  However, after the first
Subproc::Create(), STDOUT seems to be screwed - output gets swallowed,
and just before the test finishes a "11" is barfed out on stdout.  If I do
all my perl printing to STDERR, that works fine.  I've tried using
$|, but to no avail.

Any suggestions?  The module itself is living in

   http://graphics.stanford.edu/~eldridge/temp/subproc-0.01.tar.gz

Thanks,

-Matthew

-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/       Search, Read, Discuss, or Start Your Own    


------------------------------

Date: Mon, 08 Mar 1999 00:01:35 GMT
From: mt@dev.null (Mads Toftum)
Subject: Re: background process module - STDIN/STDOUT/STDERR?
Message-Id: <36e312ff.64190625@news.inet.tele.dk>

It really looks like you're trying to do Proc::Background again - from
the man page:

use Proc::Background;
timeout_system('seconds', 'path_to_program', 'arg1');
my $proc = Proc::Background->new('path_to_program', 'arg1', 'arg2');
$proc->alive;
$proc->die;
$proc->wait;
$time = $proc->start_time;
$time = $proc->end_time;

And it supports both Win and Unix.


vh

Mads Toftum, QDPH
som pe USENET reprfsenterer sig selv og ingen andre.


------------------------------

Date: Mon, 08 Mar 1999 00:01:49 GMT
From: golfer@usa.net
Subject: Combining Files
Message-Id: <36e31147.4434897@news.flash.net>

I am stumped!  I have 50 text tab delimited files that I am trying to
combine into one file based upon the username variable.

File 1:
mike	100
joe	90
pete	35

File 2:
larry	87
joe	15
sam	20

File 3:
sam	15
joe	12
pete	21

etc,; what I need to do is combine these files into a single file
resulting in (order is not important):
mike	100
larry	87
joe	90	15	12
pete	35	21
sam	20	15

I can do it if the names are present in all files but each file may or
may not have that person's name.  I have looked at the FAQ's but
didn't have any luck.  Any help is greatly appreciated.  Thanks...


------------------------------

Date: Sun, 7 Mar 1999 21:56:20 -0500
From: rjk@linguist.dartmouth.edu (Ronald J Kimball)
Subject: Re: Combining Files
Message-Id: <1dobgpz.1gqqygx1yvfxa8N@bay3-379.quincy.ziplink.net>

<golfer@usa.net> wrote:

> I am stumped!  I have 50 text tab delimited files that I am trying to
> combine into one file based upon the username variable.

> [...]
 
> I can do it if the names are present in all files but each file may or
> may not have that person's name.

How do you do it when all the names are present in all files?

Maybe we could look at your code and point out some simple changes to
make it work with the non-comprehensive input files.

-- 
 _ / '  _      /         - aka -          rjk@linguist.dartmouth.edu
( /)//)//)(//)/(     Ronald J Kimball      chipmunk@m-net.arbornet.org
    /                                  http://www.ziplink.net/~rjk/
        "It's funny 'cause it's true ... and vice versa."


------------------------------

Date: Sun, 7 Mar 1999 18:07:34 -0500
From: rjk@linguist.dartmouth.edu (Ronald J Kimball)
Subject: Re: command line arguments
Message-Id: <1dob4lu.1njz5481acytisN@bay3-259.quincy.ziplink.net>

Aaron Walker <amwalker@gate.net> wrote:

> how do you setup command line arguments in perl?

The Getopt modules might answer your question.

perldoc Getopt::Std
perldoc Getopt::Long

There are others, but those are the main two.


Oh, there's also Perl's -s command line option:

-- 
#!/usr/bin/sh -- chipmunk (aka Ronald J Kimball)
    perl -e'for(sort keys%main::){print if $$_ eq 1}
        ' -s  -- -' Just' -' another ' -'Perl ' -'hacker 
' http://www.ziplink.net/~rjk/  [rjk@linguist.dartmouth.edu]


------------------------------

Date: Sun, 07 Mar 1999 14:25:53 -0800
From: "James F. Pine" <arbustus@jps.net>
Subject: Datatrack
Message-Id: <36E2FCF1.101601CE@jps.net>

Hi, I have been asked by a messaging company (simmilar to UPS) to make a
web interface using CGI to their Datatrack system. Datatrak is a barcode
database used also by UPS to keep track of where their packages are
going, when they arrived, who picked them up, etc. I can't seem to find
any information about hot to connect to the Datatrack system via CGI and
was just wondering if anyone here knew where I could find some
information.
Thanx

JAMES


------------------------------

Date: Sun, 07 Mar 1999 20:05:51 -0500
From: comdog@computerdog.com (brian d foy)
Subject: Re: deletion problem
Message-Id: <comdog-ya02408000R0703992005510001@news.panix.com>

In article <7bsgtj$p9t$1@nnrp1.dejanews.com>, @l@ <aqumsieh@matrox.com> posted:


> --Ala
> $monger->{montreal}->[0];

why are you signing your posts with Nicolas Bertrand's 
monger designation?

-- 
brian d foy                    
CGI Meta FAQ <URL:http://www.smithrenaud.com/public/CGI_MetaFAQ.html>


------------------------------

Date: 7 Mar 1999 16:12:32 -0700
From: Tom Christiansen <perlfaq-suggestions@perl.com>
Subject: FAQ 2.15: Archives of comp.lang.perl.misc  
Message-Id: <36e307e0@csnews>

(This excerpt from perlfaq2 - Obtaining and Learning about Perl 
    ($Revision: 1.30 $, $Date: 1998/12/29 19:43:32 $)
part of the standard set of documentation included with every 
valid Perl distribution, like the one on your system.
See also http://language.perl.com/newdocs/pod/perlfaq2.html
if your negligent system adminstrator has been remiss in his duties.)

  Archives of comp.lang.perl.misc

    Have you tried Deja News or Alta Vista? Those are the best
    archives. Just look up "*perl*" as a newsgroup.

        http://www.dejanews.com/dnquery.xp?QRY=&DBS=2&ST=PS&defaultOp=AND&LNG=ALL&format=terse&showsort=date&maxhits=25&subjects=&groups=*perl*&authors=&fromdate=&todate=

    You'll probably want to trim that down a bit, though.

    ftp.cis.ufl.edu:/pub/perl/comp.lang.perl.*/monthly has an almost
    complete collection dating back to 12/89 (missing 08/91 through
    12/93). They are kept as one large file for each month.

    You'll probably want more a sophisticated query and retrieval
    mechanism than a file listing, preferably one that allows you to
    retrieve articles using a fast-access indices, keyed on at least
    author, date, subject, thread (as in "trn") and probably
    keywords. The best solution the FAQ authors know of is the MH
    pick command, but it is very slow to select on 18000 articles.

    If you have, or know where can be found, the missing sections,
    please let perlfaq-suggestions@perl.com know.

-- 
    "You can only measure the size of your head from the inside." --Larry Wall


------------------------------

Date: 7 Mar 1999 18:42:40 -0700
From: Tom Christiansen <perlfaq-suggestions@perl.com>
Subject: FAQ 2.16: Where can I buy a commercial version of Perl?  
Message-Id: <36e32b10@csnews>

(This excerpt from perlfaq2 - Obtaining and Learning about Perl 
    ($Revision: 1.30 $, $Date: 1998/12/29 19:43:32 $)
part of the standard set of documentation included with every 
valid Perl distribution, like the one on your system.
See also http://language.perl.com/newdocs/pod/perlfaq2.html
if your negligent system adminstrator has been remiss in his duties.)

  Where can I buy a commercial version of Perl?

    In a real sense, Perl already *is* commercial software: It has a
    licence that you can grab and carefully read to your manager. It
    is distributed in releases and comes in well-defined packages.
    There is a very large user community and an extensive literature.
    The comp.lang.perl.* newsgroups and several of the mailing lists
    provide free answers to your questions in near real-time. Perl
    has traditionally been supported by Larry, scores of software
    designers and developers, and myriads of programmers, all working
    for free to create a useful thing to make life better for
    everyone.

    However, these answers may not suffice for managers who require a
    purchase order from a company whom they can sue should anything
    go awry. Or maybe they need very serious hand-holding and
    contractual obligations. Shrink-wrapped CDs with perl on them are
    available from several sources if that will help. For example,
    many perl books carry a perl distribution on them, as do the
    O'Reily Perl Resource Kits (in both the Unix flavor and in the
    proprietary Microsoft flavor); the free Unix distributions also
    all come with Perl.

    Or you can purchase a real support contract. Although Cygnus
    historically provided this service, they no longer sell support
    contracts for Perl. Instead, the Paul Ingram Group will be taking
    up the slack through The Perl Clinic. The following is a
    commercial from them:

    "Do you need professional support for Perl and/or Oraperl? Do you
    need a support contract with defined levels of service? Do you
    want to pay only for what you need?

    "The Paul Ingram Group has provided quality software development
    and support services to some of the world's largest corporations
    for ten years. We are now offering the same quality support
    services for Perl at The Perl Clinic. This service is led by Tim
    Bunce, an active perl porter since 1994 and well known as the
    author and maintainer of the DBI, DBD::Oracle, and Oraperl
    modules and author/co-maintainer of The Perl 5 Module List. We
    also offer Oracle users support for Perl5 Oraperl and related
    modules (which Oracle is planning to ship as part of Oracle Web
    Server 3). 20% of the profit from our Perl support work will be
    donated to The Perl Institute."

    For more information, contact The Perl Clinic:

        Tel:    +44 1483 424424
        Fax:    +44 1483 419419
        Web:    http://www.perl.co.uk/
        Email:  perl-support-info@perl.co.uk or Tim.Bunce@ig.co.uk

    See also www.perl.com for updates on tutorials, training, and
    support.

-- 
    "If it makes goo on the windshield, we'll call it a bug." --Larry Wall


------------------------------

Date: 8 Mar 1999 00:28:18 GMT
From: "Steve Jackson" <steve@NOSPAMcyber-distributors.com>
Subject: Help with an array
Message-Id: <01be68fa$ea1af320$aef110d1@acer-desktop>


Ok I thought I could do it - but can't figure one line out.
basically i want to take a variable $allenter (inside that is
a varable called $item3) and replace the existing line in @c1.

Here's a snip of the code (simplified) basically all rems taken out:

(There is an incoming variable called $in{'itemnum'})

sub editrev{
	#this is the new information
	$allenter = $all3;

	open(FILE,"all.txt");
	@c1 = <FILE>;
	close(FILE);
	$try=0;	
	
	foreach $thing(@c1) {
		@stuffy = split(/\(\(/, $thing);

		$item1 = $stuffy[0];
		$item2 = $stuffy[1];
		$item3 = $stuffy[2];
		$item4 = $stuffy[3];
		$item5 = $stuffy[4];
		$item6 = $stuffy[5];
		$item7 = $stuffy[6];
		$item8 = $stuffy[7];
		$item9 = $stuffy[8];

		if ($in{'itemnum'} eq $item3) {
			
			$c1[$try] = $allenter;     <-- doesnt work ??
		}
		
}
	
		open(FILE,">all.txt");
		print FILE @c1;
		close(FILE);
		print "Content-type: text/html\n\n";
		print "DONE...\n";
		exit;
}



Thanks!

Steve


------------------------------

Date: Mon, 08 Mar 1999 11:42:21 +1000
From: Jaime Metcher <metcher@spider.herston.uq.edu.au>
Subject: Re: HELP: howto get local_IP under Win9x
Message-Id: <36E32AFD.22868B9B@spider.herston.uq.edu.au>

($localhost) = `net config` =~ /Computer name\s+\\\\(\S+)\n/;

-- 
Jaime Metcher

Adrian Fiorinni wrote:
> 
> Hello people,
> i'm using this code below to make a TCP/IP connection
> between my client and a server; but this was written
> to run on a Unix ( fix IP ) system. Now i'm trying
> to translate to Win9x ( dynamic IP ), and, guess what,
> i have *no idea* how to work the line "3" ( $localhost
> = `hostname`)...
> 
> ***any help would be most appreciated***
> thx.
> 
> sub connect_socket
> {
>   my($machine, $port) = @_;#print "1\n";
>   my($sockaddr) = 'S n a4 x8';#print "2\n";
> 
> chop($localhost = `hostname`);#print "3\n";  ### get
> the localhost
> 
> my($name0, $aliases0, $proto) =
> getprotobyname('tcp');#print "4\n";
>   my($name1, $aliases1, $type1, $len1, $localaddr) =
> gethostbyname($localhost);#print "5\n";
>   my($name2, $aliases2, $type2, $len2, $remaddr) =
> gethostbyname($machine);#print "6\n";
>   my($local_pack)  = pack($sockaddr, &AF_INET, 0,
> $localaddr);#print "7\n";
>   my($remote_pack) = pack($sockaddr, &AF_INET, $port,
> $remaddr);#print "8\n";
>   socket(S, &PF_INET, &SOCK_STREAM, $proto) || die
> "Socket: $!";#print "9\n";
>   bind(S, $local_pack) || die "Bind: $!";#print "10\n";
>   connect(S, $remote_pack) || die "Connect: $!";#print
> "11\n";
>   select(S); $| = 1; select(STDOUT);#print "12\n";
> }
> 
> *** Posted from RemarQ - http://www.remarq.com - Discussions Start Here (tm) ***


------------------------------

Date: Sun, 07 Mar 1999 17:15:38 -0800
From: pault12@postoffice.pacbell.net
Subject: Re: How to run Perl program as NT service? <--- perl.exe persistance
Message-Id: <36E324BA.171B8829@postoffice.pacbell.net>

Jonathan Stowe wrote:

> <comp.lang.perl is a former newsgroup>
>
> In comp.lang.perl.misc thomas <rawkrawl@rednecks.com> wrote:
> > Hiya,
> >
> > Alongside this thread,a thought just struck me;
> > wouldnt it be a performance boost having the perl interpreter
> > loaded as a service.
> > Having it already loaded, straying the memory,should make the script
> > shoot faster,right. I mean,you dont have to load perl.exe and all its'
> > autoload stuff
> > every time you run your tiny 5000 bytes script.
>

You may take a look at http://www.pault.com -> Perl Application
Server. The design is that there is perl script  running forever
(server) and there are clients ( perl scripts, java or c programs,
e t.c. -) , that can ask server to invoke any (preloaded) perl function,
re-reading  those functions on-fly when the'r changed ( allows easy
debugging ). Works on any UNIX and Windows as well. Pure perl
solution.

> > ...kinda like the Apache >>> mod_perl companionship...
>

For many tasks fast-cgi is better than mod_perl. With mod_perlyou have perl
executable / script running with each instance of
Apache ( eating resources, hard to sync e t.c.) Perl Application
server is closer to fast-cgi, but is _much_ more flexible.

> > Would this be an approach in words of performance ???

Sure. Not only invoking perl executable eats the preformance,
but perl's compilation to bytecode, re-opening database
connections / handelrs e t.c. usualy causes significant
slowdown. It's why fast-cgi and similiar solutions are
so popular.

About running perl interpreter as a service is not a big
deal with srvany or similiar stuff. I wrote my own trivial
'cron' for NT  in 2 days, using MS example of the service.
The problem is resanoble API with such perl service.
I don't understand the advantages of such solution for
the real life. If you want fast CGI's - use existing solutions.
If you want 'fast perl script but not CGI on NT box' ...
Can't imagine the real task ...

Rgds.Paul.

paul@qub.com
www.pault.com

Perl Application Server : XML Tube : ...




------------------------------

Date: Sun, 07 Mar 1999 20:02:12 -0500
From: comdog@computerdog.com (brian d foy)
Subject: Re: mySQL Default Field Question
Message-Id: <comdog-ya02408000R0703992002120001@news.panix.com>

In article <36E220BA.49E2@cmp.com>, Alan Schneider <aschneid@cmp.com> posted:

> Any idea how you can default the date field for today upon create table
> or alter table using mysql.

this is explained in the mysql docs in the section that talks about 
date field types.

-- 
brian d foy                    
CGI Meta FAQ <URL:http://www.smithrenaud.com/public/CGI_MetaFAQ.html>


------------------------------

Date: Sun, 07 Mar 1999 23:39:41 GMT
From: Sorry@No.Reply.Due.To.Spam (Scott Carpenter)
Subject: newbie problem with *s (regular expression matching in win32)
Message-Id: <36e3072d.180341868@enews.newsguy.com>

In "Learning Perl" (The llama book), there is an exercise in chapter 7
that says to create a regular expression that matches "any number of
backslashes followed by any number of asterisks (any number might be
zero)"

I thought to use /\\*\**/ which is also the answer given in the book.
When I tested it I didn't quite get what I expected:

$_ = 'fff\\\\****';
/\\*\**/;
print $&;

There wasn't a match.  The f's are just thrown in as filler.

If I tried /\\+\*+/ the print statement returned the expected match:
\\****

I took out the f's,  and then suddenly it worked correctly with the *
pattern.  It also didn't matter if there were f's or a's or my name,
scott, at the beginning of the string  -- the * grouping pattern
didn't work.

I saw similar results when playing around with expressions like a|b*;
that didn't work but a|b+ did.

I'm using 503 and downloading 509 to give that a try, but I think the
problem may be more due to my rudimentary understanding of Perl than a
bug in win32 Perl.

Can anyone tell me what I'm doing wrong?

Thanks,

Scott Carpenter



------------------------------

Date: Sun, 07 Mar 1999 20:45:08 -0500
From: "Mark D. Sholund" <msholund@bigfoot.com>
Subject: perlcc
Message-Id: <36E32BA3.5AFEB1E3@bigfoot.com>

I have written some scripts which I've tried to compile with perlcc on a
Linux system.  When I run the resultant executable, I keep getting an
error saying that I am trying to modify a read-only value on line #...
The line in question consists of

while (<STDIN>){

Does anybody have any idea about why I get this error?  The script runs
fine as a script.  Even though perlcc is in it's first release form (as
far as I know), I guess it's understandable that there will be some
bugs, but I would expect that this is a common line to have and that the
compiler would handle it correctly.
--
in accordance with prophecy.

        "Computer, install a recursive algorithm."
                                        - Ensign Harry Kim




------------------------------

Date: Sun, 07 Mar 1999 21:46:22 -0500
From: Jihad Battikha <jbattikha@highsynth.com>
Subject: POST bug in latest LWP/libwww (1.82)
Message-Id: <36E339FE.ED3C0B7D@highsynth.com>

There's probably a better place to post this but all I can do is
reproduce the error, I have no idea why the latest libwww bundle
chokes.  LWP::Debug is only telling me what I already know - something
is messed up somewhere in the response handling.  I'm testing this on
multiple Win32 systems but I have a suspicion the problem will repeat on
other platforms.  I've tried both the GS and AS ports of Perl, the only
thing that works is reverting to an older bundle of libwww.  None of the
documentation or FAQs was of any help and a search on DejaNews and
various mailing list archives turned up squat.

I'd really like to use the latest libwww bundle but I am not able to
because of this annoying issue.

#!/usr/bin/perl -w

# This script works fine on earlier releases of libwww bundle
# but fails on the latest release. Although I'm not keen
# enough to figure out exactly why, it either has to do with
# generic handling of chained redirects on POSTs or poor
# header response handling on subsequent redirected POSTs.
# 
# works with LWP bundle release 1.52
# fails on LWP bundle release 1.82
#
# There are too many other files involved to track their
# version numbers - all I know is that the latest version of
# the LWP modules choke on this script while older versions
# work just as expected.
#
# NOTE: This script is run via CGI

# set up agent subclass
my $AGENT;
BEGIN {
  use LWP::UserAgent;
  @MyAgent::ISA = qw(LWP::UserAgent);
  $AGENT = MyAgent->new;
  $AGENT->agent("Botzilla - just testing");
  $AGENT->timeout([60]);
}

# sub MyAgent::redirect_ok { 1 } # doesn't help...
# sub MyAgent::redirect_ok { 0 } # doesn't help...

use CGI::Carp qw(fatalsToBrowser);
use LWP::Debug qw(+ -conns);
use URI::Escape;
use HTTP::Cookies;

select ((select(STDOUT), $| = 1)[0]);

print "Content-type: text/html\n\n";

# process form data
if (lc($ENV{'REQUEST_METHOD'}) eq "post") {
  read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  @pairs = split(/&/, $buffer);
  foreach $pair (@pairs) {
    ($name, $value) = split(/=/, $pair);
    $name =~ tr/+/ /;
    $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $form{$name} = $value;
  }
  if (!$form{'search'}) {
    &form;
  }
} else {
  &form;
}

$maxredirects = 10;

$jar = HTTP::Cookies->new;

&get('http://www.reel.com/');

&post('http://www.reel.com/cgi-bin/search/nph-movie.exe',
      'TYPE=ACTOR&Go=Go&STRING=' . uri_escape($form{'search'}));

print "$result\n";

exit(0);

# GET routine
sub get {
  my ($url, $request, $response);
  $url = $_[0];
  $request = new HTTP::Request(GET, $url);
  $jar->add_cookie_header($request);
  $response=$AGENT->request($request);
  $jar->extract_cookies($response);
  if ($response->is_redirect) {
    $redir++;
    $location = $response->header("Location");
    print "\n<br>\n<nobr><b>GET BEING REDIRECTED TO:
$location</b></nobr>\n<br>\n";
    if ($redir < $maxredirects) {
      &get($location);
    } else {
      $result = "\n<br>\n<nobr><b>Too many redirects for
$url</b></nobr>\n<br>\n";
    }
    undef $redir;
  } elsif ($response->is_success) {
    $result = $response->content;
    $result =~ s/(src\s*=\s*[\"\'])http(s)?:\/\/[^\s]*?\//$1\//gi;
  } else {
    $result = "\n<br>\n<nobr><b>GET error for $url</b></nobr>\n<br>\n";
  }
}

# POST routine
sub post {
  my ($url, $encoded, $request, $response, $location, $getswitch);
  $url = $_[0];
  $encoded = $_[1];
  $request = new HTTP::Request(POST, $url);
  $request->content_type('application/x-www-form-urlencoded');
  $request->content($encoded);
  $jar->add_cookie_header($request);
  $response = $AGENT->request($request);
  $jar->extract_cookies($response);
  # THIS IS WHERE THE TROUBLES ARE...
  if ($response->is_redirect) {
    $redir++;
    $location = $response->header("Location");
    print "\n<br>\n<nobr><b>POST BEING REDIRECTED TO:
$location</b></nobr>\n<br>\n";
    if ($redir < $maxredirects) {
      &post($location);
    } else {
      $result = "\n<br>\n<nobr><b>Too many redirects for
$url</b></nobr>\n<br>\n";
    }
    undef $redir;
  } elsif ($response->is_success) {
    $result = $response->content;
    $result =~ s/(src\s*=\s*[\"\'])http(s)?:\/\/[^\s]*?\//$1\//gi;
  } else {
    $result = "\n<br>\n<nobr><b>POST error for $url</b></nobr>\n<br>\n";
  }
}

# generate submit form
sub form {
  ($default=<<'DEFAULT') =~ s/^\s\s\s\s//gm;
    <html>
    <head>
    <title>lwp tests</title>
    </head>
    <body bgcolor="#ffffff">
    <form method="POST" action="[ENV_SCRIPT]">
      <div align="center"><center><p>
      search for videos with actor: <input type="text" name="search"
size="30"><br>
      <input type="submit" value="submit" name="submit"></p>
      </center></div>
    </form>
    </body>
    </html>
DEFAULT
  $default =~ s/\[ENV_SCRIPT\]/$ENV{'SCRIPT_NAME'}/;
  print $default;
  exit(0);
}
# end script

~jihad

-- 
<>>>===========================================================<<<>
 Jihad Battikha <jbattikha@highsynth.com> http://www.highsynth.com
 -=< graphics . 2d/3d animation . illustration . web authoring >=-
<>>>===========================================================<<<>
 Before sending me commercial e-mail, the sender must first agree
 to my LEGAL NOTICE located at: http://www.highsynth.com/sig.html.
<>>>===========================================================<<<>


------------------------------

Date: Mon, 8 Mar 1999 00:56:55 GMT
From: aml@world.std.com (Andrew M. Langmead)
Subject: Re: Serial Communications using Perl
Message-Id: <F893yv.LrA@world.std.com>

wrnelson@my-dejanews.com writes:

> Also, I'd like to use an I80X86 running Linux if possible.  Is
>there a way to handle serial communication under perl?	Where could I find
>more information on this?  Thanks!

Look for documentation on Unix termios library. In Perl, it is part of
the standard POSIX module. If the termios man page makes little sense,
take a look at the book "Advanced Unix Programming", by W R Stevens.

<URL:http://cseng.aw.com/bookdetail.qry?ISBN=0-201-56317-7&ptype=1090>

The examples are in C, so you've have to translate its concepts to
perl yourself.
-- 
Andrew Langmead


------------------------------

Date: 12 Dec 98 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Special: Digest Administrivia (Last modified: 12 Dec 98)
Message-Id: <null>


Administrivia:

Well, after 6 months, here's the answer to the quiz: what do we do about
comp.lang.perl.moderated. Answer: nothing. 

]From: Russ Allbery <rra@stanford.edu>
]Date: 21 Sep 1998 19:53:43 -0700
]Subject: comp.lang.perl.moderated available via e-mail
]
]It is possible to subscribe to comp.lang.perl.moderated as a mailing list.
]To do so, send mail to majordomo@eyrie.org with "subscribe clpm" in the
]body.  Majordomo will then send you instructions on how to confirm your
]subscription.  This is provided as a general service for those people who
]cannot receive the newsgroup for whatever reason or who just prefer to
]receive messages via e-mail.

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.misc (and this Digest), send your
article to perl-users@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.

The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.

The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.

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 V8 Issue 5083
**************************************

home help back first fref pref prev next nref lref last post