File Coverage

lib/Data/Identifier/Cloudlet.pm

Criterion	Covered	Total	%
statement	55	109	50.4
branch	10	56	17.8
condition	5	45	11.1
subroutine	11	16	68.7
pod	10	10	100.0
total	91	236	38.5

# Copyright (c) 2023-2025 Philipp Schafft

# licensed under Artistic License 2.0 (see LICENSE file)

# ABSTRACT: format independent identifier object


package Data::Identifier::Cloudlet;

use v5.14;
use strict;
use warnings;

use parent qw(Data::Identifier::Interface::Userdata);

use Carp;

use Data::Identifier;

our $VERSION = v0.28;

my %_valid_new_opts = (
    db          => 'Data::TagDB',
    extractor   => 'Data::URIID',
    fii         => 'File::Information',
    store       => 'File::FStore',
);


sub new {
    my ($pkg, %opts) = @_;
    my $self = bless {}, $pkg;

    if (defined(my $from = delete($opts{from}))) {
        if (defined(delete($opts{root})) || defined(delete($opts{entry}))) {
            croak 'root and entry given with from';
        }

        if (eval {$from->isa(__PACKAGE__)}) {
            $opts{$_} //= $from->{$_} foreach keys %_valid_new_opts;

            $opts{root} = [$from->roots];
            $opts{entry} = [$from->entries];
        }

        if (!ref($from) || ref($from) eq 'ARRAY' || eval {$from->can('ise')}) {
            $opts{root} = $from;
        }

        croak 'Unknown/Unsupported from' unless defined $opts{root};
    }

    foreach my $key (keys %_valid_new_opts) {
        my $v = delete($opts{$key}) // next;

        croak 'Bad type for key '.$key unless $v->isa($_valid_new_opts{$key});

        $self->{$key} = $v;
    }

    foreach my $key (qw(root entry)) {
        my $v = delete($opts{$key}) // next;

        $v = [$v] unless ref($v) eq 'ARRAY';

        foreach my $s (@{$v}) {
            unless (eval {$s->can('ise')}) {
                $s = Data::Identifier->new(from => $s);
            }
        }

        $v = {map {$_->ise => $_} @{$v}};

        $self->{$key} = $v;
    }

    croak 'Stray options passed' if scalar keys %opts;

    croak 'No root given' unless defined $self->{root};

    $self->{entry} = {%{$self->{entry}//{}}, %{$self->{root}}};

    return $self;
}


sub as {
    my ($self, $as, %opts) = @_;
    my %extra = %opts{qw(db extractor fii store)};

    $as = $opts{rawtype} if $as eq 'raw' && defined($opts{rawtype});

    return $self if ($as =~ /^[A-Z]/ || $as =~ /::/) && eval {$self->isa($as)};

    if (eval {$self->isa(__PACKAGE__)}) {
        $extra{$_} //= $self->{$_} foreach qw(db extractor fii store);
    }

    if (!ref($self) || ref($self) eq 'ARRAY') {
        $self = __PACKAGE__->new(root => $self, %extra);
        return $self if ($as =~ /^[A-Z]/ || $as =~ /::/) && eval {$self->isa($as)};
    }

    return $opts{default} if exists $opts{default};
    croak 'Unknown/Unsupported as: '.$as;
}


sub roots {
    my ($self, %opts) = @_;

    if (defined $opts{as}) {
        my %extra = map {$_ => ($opts{$_} // $self->{$_})} qw(db extractor fii store);
        return map {$_->Data::Identifier::as(
            $opts{as},
            %extra,
            )} values %{$self->{root}};
    }

    return values %{$self->{root}};
}


sub entries {
    my ($self, %opts) = @_;

    if (defined $opts{as}) {
        my %extra = map {$_ => ($opts{$_} // $self->{$_})} qw(db extractor fii store);
        return map {$_->Data::Identifier::as(
            $opts{as},
            %extra,
            )} values %{$self->{root}};
    }

    return values %{$self->{entry}};
}


sub is_root {
    my ($self, $tag) = @_;
    $tag = Data::Identifier->new(from => $tag) unless eval {$tag->can('ise')};
    return exists $self->{root}{$tag->ise};
}


sub is_entry {
    my ($self, $tag) = @_;
    $tag = Data::Identifier->new(from => $tag) unless eval {$tag->can('ise')};
    return exists $self->{entry}{$tag->ise};
}


#@returns Data::TagDB
sub db {
    my ($self, %opts) = @_;
    return $self->{db} if defined $self->{db};
    return $opts{default} if exists $opts{default};
    croak 'No database known';
}

#@returns Data::URIID
sub extractor {
    my ($self, %opts) = @_;
    return $self->{extractor} if defined $self->{extractor};
    return $opts{default} if exists $opts{default};
    croak 'No extractor known';
}

#@returns File::Information
sub fii {
    my ($self, %opts) = @_;
    return $self->{fii} if defined $self->{fii};
    return $opts{default} if exists $opts{default};
    croak 'No fii known';
}

#@returns File::FStore
sub store {
    my ($self, %opts) = @_;
    return $self->{store} if defined $self->{store};
    return $opts{default} if exists $opts{default};
    croak 'No store known';
}

1;

__END__