Perl SVN hook with czech characters - perl

I downloaded the sample SVN post-commit hook provided by Slack integration.
#!/usr/bin/perl
use warnings;
use strict;
use HTTP::Request::Common qw(POST);
use HTTP::Status qw(is_client_error);
use LWP::UserAgent;
use JSON;
my $repository = "myrepo";
my $websvn = "websvn.mydomain.com";
my $opt_domain = "myteam.slack.com";
my $opt_token = "mytoken";
my $log = qx|export LC_ALL="cs_CZ.UTF-8"; /usr/bin/svnlook log -r $ARGV[1] $ARGV[0]|;
my $log = $log." ".unpack('H*',$log);
my $who = `/usr/bin/svnlook author -r $ARGV[1] $ARGV[0]`;
my $url = "http://${websvn}/revision.php?repname=${repository}&rev=$ARGV[1]";
chomp $who;
my $payload = {
'revision' => $ARGV[1],
'url' => $url,
'author' => $who,
'log' => $log,
};
my $ua = LWP::UserAgent->new;
$ua->timeout(15);
my $req = POST( "https://${opt_domain}/services/hooks/subversion?token=${opt_token}", ['payload' => encode_json($payload)] );
my $s = $req->as_string;
print STDERR "Request:\n$s\n";
my $resp = $ua->request($req);
$s = $resp->as_string;
print STDERR "Response:\n$s\n";
(full file here: https://github.com/tinyspeck/services-examples/blob/master/subversion.pl)
Now the problem is, that if I want to commit message containing special characters (Czech), the string is unable to translate properly and the resulting message in slack channel looks like this:
25: falnyr - ÅeÅicha
c59865c5996963686120746573746f766163c3ad20636f6d6d69740a
I have read about the isolated (vacuum) SVN hook environment, so I assume I need to declare the locale inside the script, but since I am untouched by Perl, I really don`t know how.
My commit attempt:
falnyr#cap:test $ export LC_ALL="cs_CZ.UTF-8"
falnyr#cap:test $ touch file.txt
falnyr#cap:test $ svn add file.txt
A file.txt
falnyr#cap:test $ svn commit -m "Řeřicha"
Store password unencrypted (yes/no)? no
Adding file.txt
Transmitting file data .
Committed revision x.
falnyr#cap:test $

Add the following lines to your hook. Slack should now be able to talk Czech. :)
use Encode qw(decode_utf8);
...
my $log = qx|export LC_ALL="cs_CZ.UTF-8"; /usr/bin/svnlook log -r $ARGV[1] $ARGV[0]|;
$log = decode_utf8($log);

Related

How I can use a text file in LWP?

I need to send requests to an HTTP server using LWP. For example, I have a file with data, and I must send requests to server foobar.baz.
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$ua->agent("$0/0.1 " . $ua->agent);
$ua->agent("Mozilla/8.0")
$req = HTTP::Request->new(GET => 'http://www.foobar.baz');
$req->header('Accept' => 'text/html');
$res = $ua->request($req);
How I can use file.txt in
$req = HTTP::Request->new(GET => 'http://www.foobar.baz')
for every request?
For example file.txt contains
aaaa
bbbb
cccc
dddd
eeee
I need to send a request to
aaaa.foobar.baz
bbbb.foobar.baz
cccc.foobar.baz
and so on.
How can I do it?
This is a very simple question, and I wonder why you can't even attempt it yourself
It's just a matter of reading the file and building the complete URL from each line of text
use strict;
use warnings 'all';
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent("$0/0.1 " . $ua->agent);
$ua->agent("Mozilla/8.0");
open my $fh, '<', 'file.txt' or die $!;
while ( <$fh> ) {
next unless /\S/;
chomp;
my $res = $ua->get( "$_.foobar.baz" );
}
You might find App::SimpleScan on CPAN to be useful. I wrote it for just such an application back at Yahoo! in 2005. It handles combinatorial specifications of URLs, lets you snapshot the output, etc. Plugin-based with a fairly good set of plugins, so if it won't do exactly what you want out of the box, it shouldn't be hard for you to make it work.

log4perl run from within another package not firing messages sent through email

I'm seeing behavior that I can't explain when using log4perl to send a message by email.
So the following test script works just fine and an email is sent without problems:
#!/usr/bin/perl
use strict;
use warnings;
use Log::Log4perl qw(:easy);
use Log::Dispatch;
my $appender_email = Log::Log4perl::Appender->new(
"Log::Dispatch::Email::SSMTP",
threshold => "INFO",
to => 'myemail#mail.com',
subject => 'Perl script message'
);
my $email_logger = get_logger();
$email_logger->level($INFO);
$email_logger->add_appender($appender_email);
$email_logger->info('hi');
The Log::Dispatch::Email::SSMTP is a module I wrote to send emails using the ssmtp command.
The weirdness begins when this same exact code is moved to another package in another file in the same directory as my original script. When I do that and use that package from within my original script, no email gets sent and there are no errors thrown.
However, if I change:
Log::Dispatch::Email::SSMTP
to
Log::Log4perl::Appender::Screen
It prints out "hi" to the screen just fine when I run my script.
So if log4perl works when sending the message to the screen, why doesn't it work when trying to send an email? And why does the same code fire an email from within the original script and not from a package? Again, there are no errors getting thrown or any kind of indication that something went wrong. And I have verified that my module gets loaded with print statements. So my module's code is definitely getting loaded but the email is still not firing.
UPDATE
Here is the code when it's not working per request in comments.
maillog.pl
#!/usr/bin/perl
BEGIN { unshift #INC, "/home/steve/perl/perl-lib" }
use strict;
use warnings;
use Testy;
print 'start' . "\n";
Here is the Testy.pm package:
package Testy;
BEGIN { unshift #INC, "/home/steve/perl/perl-lib" }
use strict;
use warnings;
use Log::Log4perl qw(:easy);
use Log::Dispatch;
print 'end' . "\n";
my $appender_email = Log::Log4perl::Appender->new(
"Log::Dispatch::Email::SSMTP",
#"Log::Log4perl::Appender::Screen",
threshold => "INFO",
to => 'myemail#mail.com',
subject => 'Perl script message'
);
my $email_logger = get_logger();
$email_logger->level($INFO);
$email_logger->add_appender($appender_email);
$email_logger->info('hi');
1;
And here is my SSMTP module located in /home/steve/perl/perl-lib/Log/Dispatch/Email/SSMTP:
package Log::Dispatch::Email::SSMTP;
use strict;
use warnings;
use Log::Dispatch::Email;
use Data::Dumper;
use base qw( Log::Dispatch::Email );
print "hi, i'm here!\n";
sub send_email {
my $self = shift;
my %p = #_;
my $to = escape ( join ',', #{$self->{to}} );
my $subject = $self->{subject};
my $message = $p{message};
$message =~ s/'/'\\''/g;
print $to . "\n";
print $subject . "\n";
print $message . "\n";
print "I'm working!";
system("echo 'To: $to\nFrom: \'Me\' <myemail\#gmail.com>\nSubject:$subject\n\n$message' | /usr/sbin/ssmtp $to");
}
sub escape {
my $address = shift;
$address =~ s/#/\\#/g;
return $address;
}
1;
When I run ./maillog.pl no email is sent when using the code in the Testy package (the same code works when in maillog.pl file. However, if I uncomment Log::Dispatch::Email::SSMTP and replace with Log::Log4perl::Appender::Screen it works.
UPDATE #2
If I change Log::Log4perl::Appender::Screen to Log::Dispatch::Screen it works as well. So maybe come kind of bug in Log::Dispatch::Email?
Found the problem with some help from the FAQ at click here
Apparently, there is some buffering going on so emails do not get sent out immediately until some threshold for the number of messages generated is reached. Though it's still a mystery to me as to why emails are sent immediately when the code is in the main package.
So here is the code that works with the buffered property set to 0:
my $appender_email = Log::Log4perl::Appender->new(
"Log::Dispatch::Email::SSMTP",
threshold => "INFO",
to => 'me#mymail.com',
buffered => 0,
subject => 'Perl script message'
);

Adding a .zip file to the body of an LWP::UserAgent POST request

I believe I have a general Perl problem, rather than an LWP::UserAgent problem... however its somewhat complex.
The task is to write a test-script that does a SWORD deposit.
I create tests by first writing code to prove the thing works, then add in the Test::More wrappers to make it a test.
BACKGROUND
A SWORD deposit is simply an http post request with a bunch of defined headers, and the content of the body being the thing to be ingested. This all works fine, I can perform the actions through CURL, and I've written scripts to do this.... but within a a larger application environment (that'll be EPrints.)
CODE
My problem, I believe, comes when I try to attach the contents of the file on the disk.
#!/home/cpan/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
##use WWW::Mechanize;
use File::Slurp;
use MIME::Base64;
my $auth = 'username:password';
my $domain = 'devel.example.com';
my $ua = LWP::UserAgent->new();
my $basedir = "./test_files";
my $package = 'http://opendepot.org/europePMC/2.0';
my $filename = "$basedir/PMC165035.zip";
my $mime = 'application/zip';
print "filename: $filename\n";
my $deposit_url = $domain . '/sword-app/deposit/archive';
my $file = read_file( $filename, { binmode => ':raw' } );
# Set up the SWORD deposit
my $autho = "Basic " . MIME::Base64::encode( $auth, '' );
my %headers = (
'X-Packaging' => $package,
'X-No-Op' => 'false',
'X-Verbose' => 'true',
'Content-Disposition' => "filename=$filename",
'Content-Type' => $mime,
'User-Agent' => 'Broker Test Harness',
'Authorization' => $autho,
);
my $r = $ua->post( $deposit_url, %headers, Content => $file );
# DEBUG TEST
write_file('foo.zip', $file);
my $ret = $r->decoded_content;
print "Content: $ret\n";
if ( $r->is_success ) { print "Deposited $package successfully" }
WHAT WORKS, WHAT DOESN'T
This code is lifted pretty much directly from working code I have - the only difference is that the working code gets the content for $file via an object-call within EPrints.
I know the file exists on the disk, if I do an ls -l on the filename printed, I can see the file, and its readable
In the code above, there is a line write_file('foo.zip', $file); - that writes a file which unzip -l foo.zip happily tells me has 3 files in it.
The line print "Content: $ret\n"; should print an atom response - for me, it prints nothing....
The Access log reports an error 500, but there's diddly-squat in the error-log.
The help
What I need to know is how I get the actual contents of the .zip file into the content part of the LWP::UserAgent post request...
(I'm going to spend much time not trying to dig into EPrints, to track where the error-500 is coming from, and why nothing appears in the log file.... but that's probably going to be down to an issue with what's been posted)
The solution lies in realizing what LWP POST is doing.
my $filename = "$basedir/PMC165035.zip";
my $file = read_file( $filename, { binmode => ':raw' } );
my %headers = (
'X-Packaging' => $package,
'X-No-Op' => 'false',
'X-Verbose' => 'true',
'Content-Disposition' => "filename=$filename",
'Content-Type' => $mime,
'User-Agent' => 'Broker Test Harness',
'Authorization' => $autho,
);
All work by setting $filename to be something like /home/services/foo/testing/test_files/PMC165035.zip, and passing this (full) filename to the server example.com.
The problem is that the server is looking for a filename, not a filename-with-path... so when the service does its thing with the file by dumping the content into its temporary upload location, and then it looks for ~~~temp_location/home/services/foo/testing/test_files/PMC165035.zip, it can't find it!
The solution is to read in the file, but ensure that the filename given in the headers is just the filename, not with-a-path

using Perl to scrape a website

I am interested in writing a perl script that goes to the following link and extracts the number 1975: https://familysearch.org/search/collection/results#count=20&query=%2Bevent_place_level_1%3ACalifornia%20%2Bevent_place_level_2%3A%22San%20Diego%22%20%2Bbirth_year%3A1923-1923~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219
That website is the amount of white men born in the year 1923 who live in San Diego County, California in 1940. I am trying to do this in a loop structure to generalize over multiple counties and birth years.
In the file, locations.txt, I put the list of counties, such as San Diego County.
The current code runs, but instead of the # 1975, it displays unknown. The number 1975 should be in $val\n.
I would very much appreciate any help!
#!/usr/bin/perl
use strict;
use LWP::Simple;
open(L, "locations26.txt");
my $url = 'https://familysearch.org/search/collection/results#count=20&query=%2Bevent_place_level_1%3A%22California%22%20%2Bevent_place_level_2%3A%22%LOCATION%%22%20%2Bbirth_year%3A%YEAR%-%YEAR%~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219';
open(O, ">out26.txt");
my $oldh = select(O);
$| = 1;
select($oldh);
while (my $location = <L>) {
chomp($location);
$location =~ s/ /+/g;
foreach my $year (1923..1923) {
my $u = $url;
$u =~ s/%LOCATION%/$location/;
$u =~ s/%YEAR%/$year/;
#print "$u\n";
my $content = get($u);
my $val = 'unknown';
if ($content =~ / of .strong.([0-9,]+)..strong. /) {
$val = $1;
}
$val =~ s/,//g;
$location =~ s/\+/ /g;
print "'$location',$year,$val\n";
print O "'$location',$year,$val\n";
}
}
Update: API is not a viable solution. I have been in contact with the site developer. The API does not apply to that part of the webpage. Hence, any solution pertaining to JSON will not be applicbale.
It would appear that your data is generated by Javascript and thus LWP cannot help you. That said, it seems that the site you are interested in has a developer API: https://familysearch.org/developers/
I recommend using Mojo::URL to construct your query and either Mojo::DOM or Mojo::JSON to parse XML or JSON results respectively. Of course other modules will work too, but these tools are very nicely integrated and let you get started quickly.
You could use WWW::Mechanize::Firefox to process any site that could be loaded by Firefox.
http://metacpan.org/pod/WWW::Mechanize::Firefox::Examples
You have to install the Mozrepl plugin and you will be able to process the web page contant via this module. Basically you will "remotly control" the browser.
Here is an example (maybe working)
use strict;
use warnings;
use WWW::Mechanize::Firefox;
my $mech = WWW::Mechanize::Firefox->new(
activate => 1, # bring the tab to the foreground
);
$mech->get('https://familysearch.org/search/collection/results#count=20&query=%2Bevent_place_level_1%3ACalifornia%20%2Bevent_place_level_2%3A%22San%20Diego%22%20%2Bbirth_year%3A1923-1923~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219',':content_file' => 'main.html');
my $retries = 10;
while ($retries-- and ! $mech->is_visible( xpath => '//*[#class="form-submit"]' )) {
print "Sleep until we find the thing\n";
sleep 2;
};
die "Timeout" if 0 > $retries;
#fill out the search form
my #forms = $mech->forms();
#<input id="census_bp" name="birth_place" type="text" tabindex="0"/>
#A selector prefixed with '#' must match the id attribute of the input. A selector prefixed with '.' matches the class attribute. A selector prefixed with '^' or with no prefix matches the name attribute.
$mech->field( birth_place => 'value_for_birth_place' );
# Click on the submit
$mech->click({xpath => '//*[#class="form-submit"]'});
If you use your browser's development tools, you can clearly see the JSON request that the page you link to uses to get the data you're looking for.
This program should do what you want. I've added a bunch of comments for readability and explanation, as well as made a few other changes.
use warnings;
use strict;
use LWP::UserAgent;
use JSON;
use CGI qw/escape/;
# Create an LWP User-Agent object for sending HTTP requests.
my $ua = LWP::UserAgent->new;
# Open data files
open(L, 'locations26.txt') or die "Can't open locations: $!";
open(O, '>', 'out26.txt') or die "Can't open output file: $!";
# Enable autoflush on the output file handle
my $oldh = select(O);
$| = 1;
select($oldh);
while (my $location = <L>) {
# This regular expression is like chomp, but removes both Windows and
# *nix line-endings, regardless of the system the script is running on.
$location =~ s/[\r\n]//g;
foreach my $year (1923..1923) {
# If you need to add quotes around the location, use "\"$location\"".
my %args = (LOCATION => $location, YEAR => $year);
my $url = 'https://familysearch.org/proxy?uri=https%3A%2F%2Ffamilysearch.org%2Fsearch%2Frecords%3Fcount%3D20%26query%3D%252Bevent_place_level_1%253ACalifornia%2520%252Bevent_place_level_2%253A^LOCATION^%2520%252Bbirth_year%253A^YEAR^-^YEAR^~%2520%252Bgender%253AM%2520%252Brace%253AWhite%26collection_id%3D2000219';
# Note that values need to be doubly-escaped because of the
# weird way their website is set up (the "/proxy" URL we're
# requesting is subsequently loading some *other* URL which
# is provided to "/proxy" as a URL-encoded URL).
#
# This regular expression replaces any ^WHATEVER^ in the URL
# with the double-URL-encoded value of WHATEVER in %args.
# The /e flag causes the replacement to be evaluated as Perl
# code. This way I can look data up in a hash and do URL-encoding
# as part of the regular expression without an extra step.
$url =~ s/\^([A-Z]+)\^/escape(escape($args{$1}))/ge;
#print "$url\n";
# Create an HTTP request object for this URL.
my $request = HTTP::Request->new(GET => $url);
# This HTTP header is required. The server outputs garbage if
# it's not present.
$request->push_header('Content-Type' => 'application/json');
# Send the request and check for an error from the server.
my $response = $ua->request($request);
die "Error ".$response->code if !$response->is_success;
# The response should be JSON.
my $obj = from_json($response->content);
my $str = "$args{LOCATION},$args{YEAR},$obj->{totalHits}\n";
print O $str;
print $str;
}
}
What about this simple script without firefox ? I had investigated the site a bit to understand how it works, and I saw some JSON requests with firebug firefox addon, so I know which URL to query to get the relevant stuff. Here is the code :
use strict; use warnings;
use JSON::XS;
use LWP::UserAgent;
use HTTP::Request;
my $ua = LWP::UserAgent->new();
open my $fh, '<', 'locations2.txt' or die $!;
open my $fh2, '>>', 'out2.txt' or die $!;
# iterate over locations from locations2.txt file
while (my $place = <$fh>) {
# remove line ending
chomp $place;
# iterate over years
foreach my $year (1923..1925) {
# building URL with the variables
my $url = "https://familysearch.org/proxy?uri=https%3A%2F%2Ffamilysearch.org%2Fsearch%2Frecords%3Fcount%3D20%26query%3D%252Bevent_place_level_1%253ACalifornia%2520%252Bevent_place_level_2%253A%2522$place%2522%2520%252Bbirth_year%253A$year-$year~%2520%252Bgender%253AM%2520%252Brace%253AWhite%26collection_id%3D2000219";
my $request = HTTP::Request->new(GET => $url);
# faking referer (where we comes from)
$request->header('Referer', 'https://familysearch.org/search/collection/results');
# setting expected format header for response as JSON
$request->header('content_type', 'application/json');
my $response = $ua->request($request);
if ($response->code == 200) {
# this line convert a JSON to Perl HASH
my $hash = decode_json $response->content;
my $val = $hash->{totalHits};
print $fh2 "year $year, place $place : $val\n";
}
else {
die $response->status_line;
}
}
}
END{ close $fh; close $fh2; }
This seems to do what you need. Instead of waiting for the disappearance of the hourglass it waits - more obviously I think - for the appearance of the text node you're interested in.
use 5.010;
use warnings;
use WWW::Mechanize::Firefox;
STDOUT->autoflush;
my $url = 'https://familysearch.org/search/collection/results#count=20&query=%2Bevent_place_level_1%3ACalifornia%20%2Bevent_place_level_2%3A%22San%20Diego%22%20%2Bbirth_year%3A1923-1923~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219';
my $mech = WWW::Mechanize::Firefox->new(tab => qr/FamilySearch\.org/, create => 1, activate => 1);
$mech->autoclose_tab(0);
$mech->get('about:blank');
$mech->get($url);
my $text;
while () {
sleep 1;
$text = $mech->xpath('//p[#class="num-search-results"]/text()', maybe => 1);
last if defined $text;
}
my $results = $text->{nodeValue};
say $results;
if ($results =~ /([\d,]+)\s+results/) {
(my $n = $1) =~ tr/,//d;
say $n;
}
output
1-20 of 1,975 results
1975
Update
This update is with special thanks to #nandhp, who inspired me to look at the underlying data server that produces the data in JSON format.
Rather than making a request via the superfluous https://familysearch.org/proxy this code accesses the server directly at https://familysearch.org/search/records, reencodes the JSON and dumps the required data out of the resulting structure. This has the advantage of both speed (the requests are served about once a second - more than ten times faster than with the equivalent request from the basic web site) and stability (as you note, the site is very flaky - in contrast I have never seen an error using this method).
use strict;
use warnings;
use LWP::UserAgent;
use URI;
use JSON;
use autodie;
STDOUT->autoflush;
open my $fh, '<', 'locations26.txt';
my #locations = <$fh>;
chomp #locations;
open my $outfh, '>', 'out26.txt';
my $ua = LWP::UserAgent->new;
for my $county (#locations[36, 0..2]) {
for my $year (1923 .. 1926) {
my $total = familysearch_info($county, $year);
print STDOUT "$county,$year,$total\n";
print $outfh "$county,$year,$total\n";
}
print "\n";
}
sub familysearch_info {
my ($county, $year) = #_;
my $query = join ' ', (
'+event_place_level_1:California',
sprintf('+event_place_level_2:"%s"', $county),
sprintf('+birth_year:%1$d-%1$d~', $year),
'+gender:M',
'+race:White',
);
my $url = URI->new('https://familysearch.org/search/records');
$url->query_form(
collection_id => 2000219,
count => 20,
query => $query);
my $resp = $ua->get($url, 'Content-Type'=> 'application/json');
my $data = decode_json($resp->decoded_content);
return $data->{totalHits};
}
output
San Diego,1923,1975
San Diego,1924,2004
San Diego,1925,1871
San Diego,1926,1908
Alameda,1923,3577
Alameda,1924,3617
Alameda,1925,3567
Alameda,1926,3464
Alpine,1923,1
Alpine,1924,2
Alpine,1925,0
Alpine,1926,1
Amador,1923,222
Amador,1924,248
Amador,1925,134
Amador,1926,67
I do not know how to post revised code from the solution above.
This code does not (yet) compile correctly. However, I have made some essential update to definitely head in that direction.
I would very much appreciate help on this updated code. I do not know how to post this code and this follow up such that it appease the lords who run this sight.
It get stuck at the sleep line. Any advice on how to proceed past it would be much appreciated!
use strict;
use warnings;
use WWW::Mechanize::Firefox;
my $mech = WWW::Mechanize::Firefox->new(
activate => 1, # bring the tab to the foreground
);
$mech->get('https://familysearch.org/search/collection/results#count=20&query=%2Bevent_place_level_1%3ACalifornia%20%2Bevent_place_level_2%3A%22San%20Diego%22%20%2Bbirth_year%3A1923-1923~%20%2Bgender%3AM%20%2Brace%3AWhite&collection_id=2000219',':content_file' => 'main.html', synchronize => 0);
my $retries = 10;
while ($retries-- and $mech->is_visible( xpath => '//*[#id="hourglass"]' )) {
print "Sleep until we find the thing\n";
sleep 2;
};
die "Timeout while waiting for application" if 0 > $retries;
# Now the hourglass is not visible anymore
#fill out the search form
my #forms = $mech->forms();
#<input id="census_bp" name="birth_place" type="text" tabindex="0"/>
#A selector prefixed with '#' must match the id attribute of the input. A selector prefixed with '.' matches the class attribute. A selector prefixed with '^' or with no prefix matches the name attribute.
$mech->field( birth_place => 'value_for_birth_place' );
# Click on the submit
$mech->click({xpath => '//*[#class="form-submit"]'});
You should set the current form before accessing a field:
"Given the name of a field, set its value to the value specified. This applies to the current form (as set by the "form_name()" or "form_number()" method or defaulting to the first form on the page)."
$mech->form_name( 'census-search' );
$mech->field( birth_place => 'value_for_birth_place' );
Sorry, I am not able too try this code out and thanks for open a question for a new question.

Adding an Include Path for a Module in a Simple Perl Tutorial

I'm trying to do a simple tutorial but I'm having trouble getting started. My problem seems to be installing and getting the correct path to the modules.
**1. Here is the original code:*****
#!/usr/bin/perl -w
use strict;
use LWP 5.64;
my $browser = LWP::UserAgent->new;
my $url = 'http://www.cspan.org/RECENT.html';
my $response = $browser->get($url);
die "Can't get $url -- ", $response->status_line
unless $response->is_success;
my $html = $response->content;
while( $html =~m/<A HREF=\"(.*?)\"/g ) {
print "$1\n";
2. But in Host Gator they say this:
Location of Your Perl Module(s)
Path: /home/d********n/perl
Using Your Perl Module(s)
You will need to add /home/d********n/perl to the include path. You can do this by adding the following code to your script:
BEGIN {
my $base_module_dir = (-d '/home/d********n/perl' ? '/home/d********n/perl' : ( getpwuid($>) )[7] . '/perl/');
unshift #INC, map { $base_module_dir . $_ } #INC;
}
3. So I added the code but have no idea if I added it in the correct spot.
#!/usr/bin/perl -w
use strict;
use LWP 5.64;
BEGIN {
my $base_module_dir = (-d '/home/d********n/perl' ?
'/home/d********n/perl' : ( getpwuid($>) )[7] . '/perl/');
unshift #INC, map { $base_module_dir . $_ } #INC;
}
my $browser = LWP::UserAgent->new;
my $url = 'http://www.cspan.org/RECENT.html';
my $response = $browser->get($url);
die "Can't get $url -- ", $response->status_line
unless $response->is_success;
my $html = $response->content;
while( $html =~m/<A HREF=\"(.*?)\"/g ) {
print "$1\n";
Any help would be greatly appreciated.
FYI, I already made sure the file has the needed permissions 755
Also the LWP::UserAgent has a number of 5.835 in Host Gator. Does that mean I have to change
use LWP 5.64;
to
use LWP 5.835
Assuming you've got LWP installed in your local module directory, put the BEGIN block before you try to load LWP (right after use strict).
The version number in the original code indicates that it's the minimum required version. Since you've got a newer version and LWP's interface is stable, a simple use LWP; will suffice.
The solution Host Gator seems a bit complicated. I would use the lib module :
use strict ;
use lib '/home/d********n/perl' ;
use LWP ;
If you are running the script from a command line there are two ways you can run it unchanged.
Set it as an environment variable by typing following at command line :
export PERL5LIB=/home/d********n/perl
myscript.pl
or add it as an option to the perl commaind
perl -I/home/d********n/perl myscript.pl
Or directly on the command line using perl option parameter flag -I for eg. multiple directories/projects also with a general module
perl -I'../project/lib' -I'../otherProject/lib' -I'lib' -M'Test::Doctest' -e run lib/MyOwnModule.pm