Library WWW-Access in Perl wrapped

Anwendung für LWP vereinfacht infolge Aggregation und Delegation

Dieser kleine Artikel ist für alle die meinen, es gäbe in Perl nichts Neues in Sachen OOP. Von Wegen! Untenstehender Wrapper demonstriert wie der Umgang mit Perl's libwww extrem vereinfacht werden kann.

Einfache Anwendung mit wenig Code

use strict;
use warnings;
use myLWP;

print myLWP->quickreq( uri => 'http://example.com' ); # Gesamte Response samt Header

Weitere Beispiele mit diskreter Objekterstellung:

use strict;
use warnings;
use myLWP;

my $r = myLWP->new( 
    uri     => 'http://example.com',
    body    => 'Ein beliebiger Inhalt',
    method  => 'POST',
    enctype => 'text/plain'
);
$, = "\n==============\n";

print 
    $r->request->response_status, # 200
    $r->response_body,            # Serverantwort,
    $r->response_header;          # Header als String

Code für die Library Download

package myLWP;
# wrapper für HTTP::Request, LWP::UserAgent usw.

use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;

sub new{
    my $class = shift;
    my %param = (
        uri      => '',
        method   => 'GET',
        enctype  => 'application/x-www-form-urlencoded',
        body     => '',
        headers  => {},
    @_);
    %{$param{headers}} = (%{$param{headers}}, ("Content-Type" => $param{enctype}));
    return eval{
        my $self = bless{
            ua => LWP::UserAgent->new(),
            req => HTTP::Request->new(
                $param{method} => $param{uri},
            )
        }, $class;
        $self->{req}->header( %{$param{headers}} );
        $self->{req}->content($param{body});
        $self;
    }
}

# Quick Request, liefert die komplette Response
sub quickreq{
    my $class = shift;
    my $self = $class->new(@_);
    return $self->request->response;
}

# Methoden für Request-Objekt
# ua
sub request{
    my $self = shift;
    $self->{res} = $self->{ua}->request($self->{req});
    return $self;
}

# Methoden für Response-Objekt
sub response_status{
    my $self = shift;
    my ($code, $lit) = split /\s+/, $self->{res}->status_line;
    return $code;
}

# Gesamte Response mit Header
sub response{
    my $self = shift;
    return $self->{res}->as_string;
}

sub response_body{
    my $self = shift;
    return $self->{res}->content;
}

# Alle header der Response
sub response_header{
    my $self = shift;
    my $name = shift;
    if( $name ){
        return $self->{res}->header($name);
    }
    else{
        my ($hs, $body) = split(/\n\n/, $self->{res}->as_string, 2);
        return $hs;
    }
}
1;#########################################################################

Datenschutzerklärung: Diese Seite dient rein privaten Zwecken. Auf den für diese Domäne installierten Seiten werden grundsätzlich keine personenbezogenen Daten erhoben. Das Loggen der Zugriffe mit Ihrer Remote Adresse erfolgt beim Provider soweit das technisch erforderlich ist. sos@rolfrost.de.