File Coverage

lib/Data/Identifier/Interface/Subobjects.pm
Criterion Covered Total %
statement 17 47 36.1
branch 0 22 0.0
condition 0 5 0.0
subroutine 6 10 60.0
pod 3 3 100.0
total 26 87 29.8


line stmt bran cond sub pod time code
1             # Copyright (c) 2023-2025 Philipp Schafft
2              
3             # licensed under Artistic License 2.0 (see LICENSE file)
4              
5             # ABSTRACT: format independent identifier object
6              
7              
8             package Data::Identifier::Interface::Subobjects;
9              
10 2     2   2170 use v5.20;
  2         8  
11 2     2   11 use strict;
  2         3  
  2         65  
12 2     2   8 use warnings;
  2         3  
  2         122  
13              
14 2     2   8 use parent 'Data::Identifier::Interface::Userdata';
  2         4  
  2         14  
15              
16 2     2   177 use Carp;
  2         4  
  2         143  
17 2     2   12 use Scalar::Util qw(weaken);
  2         6  
  2         1019  
18              
19             our $VERSION = v0.28;
20              
21             my %_types = (
22             db => 'Data::TagDB',
23             extractor => 'Data::URIID',
24             tagmap => 'Data::TagMap',
25             fii => 'File::Information',
26             store => 'File::FStore',
27             parent => __PACKAGE__,
28             );
29              
30              
31             sub so_attach {
32 0     0 1   my ($self, %opts) = @_;
33 0           my $storage = $self->_subobject_provider;
34 0           my $weak = delete $opts{weak};
35              
36 0           delete $opts{allow_registered}; # for future use, not yet documented.
37              
38 0           foreach my $key (keys %_types) {
39 0           my $v = delete $opts{$key};
40 0 0         next unless defined $v;
41 0 0         croak 'Invalid type for key: '.$key unless eval {$v->isa($_types{$key})};
  0            
42 0   0       $storage->{$key} //= $v;
43 0 0         croak 'Missmatch for key: '.$key unless $storage->{$key} == $v;
44 0 0         weaken($storage->{$key}) if $weak;
45             }
46              
47 0 0         croak 'Stray options passed' if scalar keys %opts;
48              
49 0           return $self;
50             }
51              
52              
53             sub so_get {
54 0     0 1   my ($self, $name, %opts) = @_;
55 0           my $storage = $self->_subobject_provider;
56              
57 0 0         return $storage->{$name} if defined $storage->{$name};
58              
59 0           foreach my $value (values %{$storage}) {
  0            
60 0 0         next unless defined $value;
61 0 0         return $value if $value->isa($name);
62             }
63              
64 0 0         if (defined(my $parent = $storage->{parent})) {
65 0           local $storage->{parent} = undef;
66 0           my $v = $parent->so_get($name, default => undef);
67 0 0         return $v if defined $v;
68             }
69              
70 0 0         return $opts{default} if exists $opts{default};
71 0           croak 'No such subobject attached';
72             }
73              
74              
75             sub _subobject_provider {
76 0     0     my ($self) = @_;
77 0   0       return $self->{subobjects} //= {};
78             }
79              
80              
81              
82             sub KEYS {
83 0     0 1   return keys %_types;
84             }
85              
86             1;
87              
88             __END__