Add a barebones SeaweedFS client library
This commit is contained in:
parent
c9ffa62be8
commit
302ec269d5
54
lib/SeaweedFS/Client.pm
Normal file
54
lib/SeaweedFS/Client.pm
Normal file
@ -0,0 +1,54 @@
|
|||||||
|
package SeaweedFS::Client;
|
||||||
|
use v5.16;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Carp;
|
||||||
|
use List::Util qw(sample);
|
||||||
|
use Scalar::Util qw(openhandle);
|
||||||
|
|
||||||
|
use Mojo::UserAgent;
|
||||||
|
use SeaweedFS::FID;
|
||||||
|
|
||||||
|
our $VERSION = v0.0.1;
|
||||||
|
|
||||||
|
sub new
|
||||||
|
{
|
||||||
|
my ($class, $murl) = @_;
|
||||||
|
return bless {
|
||||||
|
_murl => $murl,
|
||||||
|
_ua => Mojo::UserAgent->new,
|
||||||
|
_vurls => {},
|
||||||
|
}, $class;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get
|
||||||
|
{
|
||||||
|
my ($self, $target_fid) = @_;
|
||||||
|
return $self->{_ua}->get($self->url_for($target_fid));
|
||||||
|
}
|
||||||
|
|
||||||
|
sub url_for
|
||||||
|
{
|
||||||
|
my ($self, $fid) = @_;
|
||||||
|
|
||||||
|
my $vid = $fid->volume_id;
|
||||||
|
|
||||||
|
if (!defined($self->{_vurls}{$vid}) || @{$self->{_vurls}{$vid}} == 0) {
|
||||||
|
my $res = $self->{_ua}
|
||||||
|
->get("$self->{_murl}/dir/lookup?fileId=$fid&read=yes")
|
||||||
|
->result;
|
||||||
|
|
||||||
|
$self->{_vurls}{$vid} = [
|
||||||
|
map { $_->{publicUrl} } @{$res->json->{locations}}
|
||||||
|
];
|
||||||
|
}
|
||||||
|
|
||||||
|
my $url = sample(1, @{$self->{_vurls}{$vid}});
|
||||||
|
return undef unless defined $url;
|
||||||
|
|
||||||
|
$url = "http://$url" if $url !~ m{^https?://};
|
||||||
|
return "$url/$fid";
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
55
lib/SeaweedFS/FID.pm
Normal file
55
lib/SeaweedFS/FID.pm
Normal file
@ -0,0 +1,55 @@
|
|||||||
|
package SeaweedFS::FID;
|
||||||
|
use v5.16;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Carp;
|
||||||
|
|
||||||
|
use overload '""' => \&to_string;
|
||||||
|
|
||||||
|
our $VERSION = v0.0.1;
|
||||||
|
|
||||||
|
my $FID_REGEX = qr/([1-9][0-9]*),((?:[0-9a-f]{2})+)([0-9a-f]{8})/;
|
||||||
|
|
||||||
|
sub new
|
||||||
|
{
|
||||||
|
my ($class, $vid, $key, $cookie) = @_;
|
||||||
|
|
||||||
|
my ($k, $w) = ($key, 0);
|
||||||
|
while ($k != 0) {
|
||||||
|
$k >>= 8;
|
||||||
|
$w += 2;
|
||||||
|
}
|
||||||
|
|
||||||
|
return bless {
|
||||||
|
_vid => $vid,
|
||||||
|
_key => $key,
|
||||||
|
_cookie => $cookie,
|
||||||
|
_width => $w,
|
||||||
|
}, $class;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub from_bin
|
||||||
|
{
|
||||||
|
my ($class, $b) = @_;
|
||||||
|
my ($vid, $key, $cookie) = unpack("(LQL)>", $b);
|
||||||
|
return $class->new($vid, $key, $cookie);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub from_string
|
||||||
|
{
|
||||||
|
my ($class, $s) = @_;
|
||||||
|
croak "Invalid format" if $s !~ /^$FID_REGEX$/;
|
||||||
|
return $class->new($1, hex($2), hex($3));
|
||||||
|
}
|
||||||
|
|
||||||
|
sub to_bin { pack "(LQL)>", $_[0]->{_vid}, $_[0]->{_key}, $_[0]->{_cookie} }
|
||||||
|
|
||||||
|
sub to_string
|
||||||
|
{
|
||||||
|
sprintf "%u,%0*x%08x", $_[0]->{_vid}, $_[0]->{_width}, $_[0]->{_key},
|
||||||
|
$_[0]->{_cookie}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub volume_id { $_[0]->{_vid} }
|
||||||
|
sub key { $_[0]->{_key} }
|
||||||
|
sub cookie { $_[0]->{_cookie} }
|
Loading…
Reference in New Issue
Block a user