=encoding iso-8859-13

=head1 NAME

lwpcook - libwww-perl bibliotekos receptai

=head1 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.

=head2 GET

Naudojantis šia biblioteka labai lengva parsiųsti dokumentus iš tinklo. LWP::Simple modulis turi funkciją C<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";
    }

=head2 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ų C<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.

=head2 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 B<HTTP::Request::Common> modulį, kuris teisingai, su visomis išvengties sekomis, suformuoja C<POST> užklausos duomenis bei nustato reikiamą C<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 C<POST> programa irgi gali būti naudojama duomenims siųsti C<POST> protokolu.

=head2 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;

B<LWP::Simple> modulis automatiškai išsikviečia ir C<env_proxy()>. Programos kurios jau naudoja C<$ua-E<gt>env_proxy()> metodą dažniausiai nenaudos C<$ua-E<gt>proxy()> ir C<$ua-E<gt>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 I<proxy.myorg.com>, I<username> ir I<password> kuo nors tinkančiu jums.

=head2 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 B<LWP::UserAgent> subklasę, kuri perrašo C<get_basic_credentials()> metodą. Kaip pavyzdį pasižiūrėkite C<lwp-request> programą.

=head2 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 C<lwpcookies.txt> palaipsniui didės, besilankant svetainėse, kurios duoda jums sausainiukų.

=head2 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 "C<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";
    }

=head2 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.

=head2 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 C<$ua-E<gt>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 C<$ua-E<gt>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";

=cut

