56 lines
988 B
Perl
56 lines
988 B
Perl
|
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} }
|