The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

NAME

lwpcook - libwww-perl bibliotekos receptai

DESCRIPTION

Š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";
    }

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

Procedū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:password@proxy.myorg.com');

    $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. Galite 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";