#!/usr/bin/perl -w
package Data::Fallback::Client;
use strict;
use Carp qw(confess);
use IO::Socket;
use Time::HiRes qw(gettimeofday);
use Data::Fallback;
use vars qw(@ISA);
@ISA = qw(Data::Fallback);
sub new {
my $type = shift;
my $class = ref($type) || $type || __PACKAGE__;
my @PASSED_ARGS = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
my @DEFAULT_ARGS = (
reverse_lookup => '',
host => 'localhost',
port => '20203',
);
my %ARGS = (@DEFAULT_ARGS, @PASSED_ARGS);
return $class->SUPER::new(\%ARGS);
}
sub get {
my $self = shift;
$self->{get_this} = shift;
die "need a \$self->{get_this} on the get" unless($self->{get_this});
my $start = gettimeofday;
$self->get_socket;
print "" . (gettimeofday - $start) . "\n";
$self->make_block;
$self->post_block;
$self->get_response;
return $self->parse_response;
}
sub get_socket {
my $self = shift;
unless($self->{socket}) {
$self->{socket} = new IO::Socket::INET (
Proto => "tcp",
PeerAddr => $self->{host},
PeerPort => $self->{port},
);
}
}
sub make_block {
my $self = shift;
$self->{block} = "GET $self->{get_this}\n";
$self->append_cookies;
$self->{block} .= "\n";
}
sub append_cookies {
my $self = shift;
return unless($self->{cookies} && scalar keys %{$self->{cookies}});
foreach(keys %{$self->{cookies}}) {
$self->{block} .= "Cookie: $_=$self->{cookies}{$_}\n";
}
}
sub post_block {
my $self = shift;
$self->{block} =~ s/([^\r\n]?)\n/$1\r\n/g;
my $socket = $self->{socket};
print $socket $self->{block};
}
sub get_response {
my $self = shift;
$self->{response} = {};
$self->{response}{body} = "";
my $socket = $self->{socket};
$self->{response}{header} = "";
for(1 .. 3) {
$self->{response}{header} .= <$socket>;
}
while(<$socket>) {
s/\r//;
$self->{response}{body} .= $_;
}
}
sub parse_response {
my $self = shift;
my ($type) = $self->{response}{body} =~ m@^(\w+)@;
my $return;
if($type eq 'scalar') {
($return) = $self->{response}{body} =~ m@(.+?)@s;
} elsif($type eq 'array') {
$return = [];
while($self->{response}{body} =~ m@(.+?)@sg) {
push @{$return}, $1;
}
}
return $return;
}
=head1 NAME
Data::Fallback::Client - a client for Data::Fallback
=head1 DESCRIPTION
Data::Fallback::Client is a simple client to interact with an active Data::Fallback::Daemon.
=head1 EXAMPLE
#!/usr/bin/perl -w
use strict;
use Data::Fallback::Client;
my $self = Data::Fallback::Client->new({
# point to the Data::Fallback::Daemon that is running
host => 'localhost',
port => '20203',
});
my $value = $self->get("/list_name/primary_key/column");
=head1 A SIMPLE WARNING
I plan on eventually supporting XML, but I am not sure when. My protocol is not written in stone, so please be agile when updating
to new versions.
=head1 THANKS
Thanks to Paul Seamons for Net::Server and for helping me set up this simple client.
=head1 AUTHOR
Copyright 2001-2002, Earl J. Cahill. All rights reserved.
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
Address bug reports and comments to: cpan@spack.net.
When sending bug reports, please provide the version of Data::Fallback, the version of Perl, and the name and version of the operating
system you are using.
=cut
1;