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