Dar vieno analitiko svetainė

Petras Kudaras

lwpcook vertimas

lwpcook – libwww-perl bibliotekos receptai

Šiame dokumentacijos skyriuje galima rasti tipinius
libwww-perl naudojimo pavyzdžius. Išsamesnės informacijos

ieškokite individualių modulių dokumentacijose.

Visi šie pavyzdžiai yra pilnos programos.

GET

Naudojantis šia biblioteka labai lengva parsiųsti dokumentus iš
tinklo. LWP::Simple modulis turi funkciją

get(), kuri grąžina URL turinį:

use LWP::Simple;
$doc = get 'http://www.linpro.no/lwp/';

Arba tiesiai iš konsolės viena Perlo eilute:

perl -MLWP::Simple -e 'getprint "http://www.linpro.no/lwp/";'

O štai taip galima parsisiųsti naujausią Perl versiją:

perl -MLWP::Simple -e '
   getstore "ftp://ftp.sunet.se/pub/lang/perl/CPAN/src/latest.tar.gz",
            "perl.tar.gz";'

Be to galbūt jums norėsis sužinoti kur yra artimiausiais CPAN
veidrodis:

perl -MLWP::Simple -e 'getprint 
"http://www.perl.com/perl/CPAN/CPAN.html";'

Užteks šitų paprastų pavyzdžių! LWP objektinė sąsaja leidžia
kontroliuoti visą bendravimo su nutolusiu serveriu procesą.

Naudojantis šia sąsaja galite pilnai kontroliuoti headerius bei
nurodyti ką daryti su gautais duomenimis.

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$ua->agent("$0/0.1 " . $ua->agent);
# $ua->agent("Mozilla/8.0") # arba apsimetam, kad mes labai pažengusi 
naršyklė

$req = HTTP::Request->new(GET => 'http://www.linpro.no/lwp');
$req->header('Accept' => 'text/html');

# siunčiame užklausą
$res = $ua->request($req);

# patikriname ką gavome
if ($res->is_success) {
   print $res->content;
} else {
   print "Klaida: " . $res->status_line . "\n";
}

HEAD

Jei tik norite pažiūrėti ar dokumentas egzistuoja (t.y. ar geras URL)
pabandykite štai tokį kodą:

use LWP::Simple;

if (head($url)) {
   # ok, dokumentas egzistuoja
}

Iš tikrųjų head() funkcija grąžina sąrašą
meta-informacijos apie apie dokumentą. Pirmos trys šio sąrašo

reikšmės yra dokumento tipas, jo dydis ir amžius.

Norint turėti daugiau kontrolės bei pasiekti visus headerius
reikia naudoti objektinę sąsają, kuri buvo jau

aprašyta šiek tiek aukščiau GET metodui. Tiesiog visur
pakeiskite GET į POST.

POST

Procudūrinės sąsajos duomenų siuntimui POST metodu į www serverį
nėra. Tam reikai naudoti objektinę sąsają. Dažniausiai

pasitaikanti POST operacija yra WWW formos užpildymas:

use LWP::UserAgent;
$ua = LWP::UserAgent->new;

my $req = HTTP::Request->new(POST => 
'http://www.perl.com/cgi-bin/BugGlimpse');
$req->content_type('application/x-www-form-urlencoded');
$req->content('match=www&errors=0');

my $res = $ua->request($req);
print $res->as_string;

Tinginiai dažniausiai naudoja HTTP::Request::Common
modulį, kuris teisingai, su visomis išvengties sekomis,

suformuoja POST užklausos duomenis bei nustato reikiamą
content_type:

use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
my $req = POST 'http://www.perl.com/cgi-bin/BugGlimpse',
               [ search => 'www', errors => 0 ];
print $ua->request($req)->as_string;

Su libwww-perl biblioteka ateinanti POST programa irgi
gali būti naudojama duomenims siųsti POST

protokolu.

Proksiai

Proksiai kai kur naudojami dėl ugniasienių arba
kešavimo sumetimų. kartu naudojantis proksiais

galima pasiekti duomenis per libwww-perl nepalaikomus (arba prastai
palaikomus ;-) protokolus.

Prieš siunčiant užklausas jums reikia nurodyti proksių
nuostatas:

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$ua->env_proxy; # proxy nuostatos iš aplinkos kintamųjų
# arba
$ua->proxy(ftp  => 'http://proxy.myorg.com');
$ua->proxy(wais => 'http://proxy.myorg.com');
$ua->no_proxy(qw(no se fi));

my $req = HTTP::Request->new(GET => 'wais://xxx.com/');
print $ua->request($req)->as_string;

LWP::Simple modulis automatiškai išsikviečia ir
env_proxy(). Programos kurios jau naudoja

$ua->env_proxy() metodą dažniausiai nenaudos
$ua->proxy() ir $ua->no_proxy()

metodų.

kai kurie proksiai reikalauja, kad naudotumėte prisijungimo
vardą ir slaptažodį. Nesunku pridėti reikiamą

headerį rašant šitaip:

use LWP::UserAgent;

$ua = LWP::UserAgent->new;
$ua->proxy(['http', 'ftp'] => 
'http://username:[email protected]');

$req = HTTP::Request->new('GET',"http://www.perl.com";);

$res = $ua->request($req);
print $res->content if $res->is_success;

Pakeiskite proxy.myorg.com, username ir
password kuo nors tinkančiu jums.

Apsaugotų dokumentų pasiekimas

Dokumentai apsaugoti paprasta autorizacija gali būti pasiekiami taip:

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$req = HTTP::Request->new(GET => 'http://www.linpro.no/secret/');
$req->authorization_basic('vardas', 'slaptazodis');
print $ua->request($req)->as_string;

Kita alternatyva yra pasirašyti LWP::UserAgent subklasę,
kuri perrašo get_basic_credentials()

metodą. Kaip pavyzdį pasižiūrėkite lwp-request programą.

Sausainiukai

Kai kurios svetainės mėgsta pasižaisti su sausainiukais
(cookies). Pagal nutylėjimą LWP ignoruoja

visus sausainiukus, kuriuos duoda serveriai. Bet jeigu nurodysite
sausainių dėžutę, tai LWP saugos ir naudos

sausainiukus kaip tikra naršyklė:

use LWP::UserAgent;
use HTTP::Cookies;

$ua = LWP::UserAgent->new;
$ua->cookie_jar(HTTP::Cookies->new(file => "lwpcookies.txt",
                                     autosave => 1));

# o po to siunčiam užklausas kaip ir iki šiol
$res = $ua->request(HTTP::Request->new(GET => 
"http://www.yahoo.no";));
print $res->status_line, "\n";

Byla lwpcookies.txt palaipsniui didės, besilankant
svetainėse, kurios duoda jums sausainiukų.

HTTPS

Dokumentai pasiekiami per SSL lygiai taip pat kaip ir per http, jeigu
tik SSL modulis yra tinkamai įdiegtas (žiūrėkite

README.SSL libwww-perl distribucijoje). Jei SSL sąsaja
neįdiegta, bandydami pasiekti dokumentus per

HTTPS gausite klaidos pranešimus „501 Protocol scheme
‘https’ is not supported“.

Štai SSL naudojimo pavyzdys:

use LWP::UserAgent;

my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(GET => 'https://www.helsinki.fi/');
my $res = $ua->request($req);
if ($res->is_success) {
    print $res->as_string;
} else {
    print "Failed: ", $res->status_line, "\n";
}

Veidrodžiai

Jeigu norite turėti veidrodines WWW serverio dokumentų kopijas,
bandykite paleisti panašią programėlę reguliariais

intervalais:

use LWP::Simple;

%mirrors = (
   'http://www.sn.no/'             => 'sn.html',
   'http://www.perl.com/'          => 'perl.html',
   'http://www.sn.no/libwww-perl/' => 'lwp.html',
   'gopher://gopher.sn.no/'        => 'gopher.html',
);

while (($url, $localfile) = each(%mirrors)) {
  mirror($url, $localfile);
}

Arba viena perlo eilute konsolėje:

perl -MLWP::Simple -e 'mirror("http://www.perl.com/", 
"perl.html")';

Jeigu dokumentas nebuvo nuo paskutinio karto nebuvo atnaujintas tai
jis ir nebus persiųstas.

Dideli dokumentai

Jei dokumentas kurį bandot gauti yra per didelis kad tilptų
atmintyje, tai turite du problemos sprendimo būdus. Galilte

liepti bibliotekai rašyti dokymento turinį į bylą (antras
$ua->request() argumentas yra byla):

use LWP::UserAgent;
$ua = LWP::UserAgent->new;

my $req = HTTP::Request->new(GET =>
              'http://www.linpro.no/lwp/libwww-perl-5.46.tar.gz');
$res = $ua->request($req, "libwww-perl.tar.gz");
if ($res->is_success) {
   print "ok\n";
}
else {
   print $res->status_line, "\n";
}

Arba galite apdoroti duomenis kai tik jie atvyksta (antras
$ua->request() argumentas yra nuroda į

kodą):

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$URL = 'ftp://ftp.unit.no/pub/rfc/rfc-index.txt';

my $expected_length;
my $bytes_received = 0;
my $res =
   $ua->request(HTTP::Request->new(GET => $URL),
             sub {
                 my($chunk, $res) = @_;
                 $bytes_received += length($chunk);
                 unless (defined $expected_length) {
                    $expected_length = $res->content_length || 0;
                 }
                 if ($expected_length) {
                      printf STDERR "%d%% - ",
                                100 * $bytes_received / $expected_length;
                 }
                 print STDERR "Gauta $bytes_received baitu\n";
                  # XXX Kažką reiktų daryti su gautu kąsniuku
                 # print $chunk;
             });
print $res->status_line, "\n";