view release on metacpan or  search on metacpan

lib/Data/Identifier/Interface/Subobjects.pm  view on Meta::CPAN

# Copyright (c) 2023-2025 Philipp Schafft

# licensed under Artistic License 2.0 (see LICENSE file)

# ABSTRACT: format independent identifier object


package Data::Identifier::Interface::Subobjects;

use v5.20;
use strict;
use warnings;

use parent 'Data::Identifier::Interface::Userdata';

use Carp;
use Scalar::Util qw(weaken);

our $VERSION = v0.28;

my %_types = (
    db          => 'Data::TagDB',
    extractor   => 'Data::URIID',
    tagmap      => 'Data::TagMap',
    fii         => 'File::Information',
    store       => 'File::FStore',
    parent      => __PACKAGE__,
);


sub so_attach {
    my ($self, %opts) = @_;
    my $storage = $self->_subobject_provider;
    my $weak = delete $opts{weak};

    delete $opts{allow_registered}; # for future use, not yet documented.

    foreach my $key (keys %_types) {
        my $v = delete $opts{$key};
        next unless defined $v;
        croak 'Invalid type for key: '.$key unless eval {$v->isa($_types{$key})};
        $storage->{$key} //= $v;
        croak 'Missmatch for key: '.$key unless $storage->{$key} == $v;
        weaken($storage->{$key}) if $weak;
    }

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

    return $self;
}


sub so_get {
    my ($self, $name, %opts) = @_;
    my $storage = $self->_subobject_provider;

    return $storage->{$name} if defined $storage->{$name};

    foreach my $value (values %{$storage}) {
        next unless defined $value;
        return $value if $value->isa($name);
    }

    if (defined(my $parent = $storage->{parent})) {
        local $storage->{parent} = undef;
        my $v = $parent->so_get($name, default => undef);
        return $v if defined $v;
    }

    return $opts{default} if exists $opts{default};
    croak 'No such subobject attached';
}


sub _subobject_provider {
    my ($self) = @_;
    return $self->{subobjects} //= {};
}



sub KEYS {
    return keys %_types;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Data::Identifier::Interface::Subobjects - format independent identifier object

=head1 VERSION

version v0.28

=head1 SYNOPSIS

    use parent 'Data::Identifier::Interface::Subobjects';