From 302ec269d516de9052cab5e76c24d5818e868383 Mon Sep 17 00:00:00 2001
From: Lucas <lucas@domain.invalid>
Date: Sun, 5 Mar 2023 17:23:13 +0000
Subject: [PATCH] Add a barebones SeaweedFS client library

---
 lib/SeaweedFS/Client.pm | 54 ++++++++++++++++++++++++++++++++++++++++
 lib/SeaweedFS/FID.pm    | 55 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 109 insertions(+)
 create mode 100644 lib/SeaweedFS/Client.pm
 create mode 100644 lib/SeaweedFS/FID.pm

diff --git a/lib/SeaweedFS/Client.pm b/lib/SeaweedFS/Client.pm
new file mode 100644
index 0000000..a97924e
--- /dev/null
+++ b/lib/SeaweedFS/Client.pm
@@ -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;
diff --git a/lib/SeaweedFS/FID.pm b/lib/SeaweedFS/FID.pm
new file mode 100644
index 0000000..cb4b191
--- /dev/null
+++ b/lib/SeaweedFS/FID.pm
@@ -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} }