File Coverage

lib/User/Information.pm

Criterion	Covered	Total	%
statement	29	46	63.0
branch	0	6	0.0
condition	0	6	0.0
subroutine	10	15	66.6
pod	4	4	100.0
total	43	77	55.8

# Copyright (c) 2025 Philipp Schafft

# licensed under Artistic License 2.0 (see LICENSE file)

# ABSTRACT: generic module for extracting information from user accounts


package User::Information;

use v5.20;
use strict;
use warnings;

use Carp;
use Data::Identifier;

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

use constant {
    SPECIAL_ME          => [],
    SPECIAL_CGI         => [],
    SPECIAL_LOCAL_NODE  => Data::Identifier->new(uuid => '081c3899-cc4f-4cbd-9590-c90d1321e24c')->register,
};

use constant PATH_ELEMENT_NS     => Data::Identifier->new(uuid => '533fd060-2b96-4aea-8b8d-56e0766e6e5d')->register;
use constant PATH_ELEMENT_TYPE   => Data::Identifier->new(
        uuid        => 'f1f59629-3237-4587-a365-7ce094806f6d',
        displayname => 'user-information-path-element',
        validate    => qr/^[0-9a-zA-Z_-]+$/,
        namespace   => PATH_ELEMENT_NS,
    )->register;

use User::Information::Base;

our $VERSION = v0.05;


#@returns User::Information::Base
sub lookup {
    my ($self, @args) = @_;
    my ($type, $request);

    if (scalar(@args) & 1) {
        $type = 'from';
    } else {
        $type = shift(@args) // croak 'No type given';
    }
    $request = shift(@args) // croak 'No request given';

    return User::Information::Base->_new($type => $request, @args);
}


#@returns User::Information::Base
sub me {
    my ($self, %opts) = @_;
    return $self->lookup(from => SPECIAL_ME, %opts);
}


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

    return $self->lookup(from => SPECIAL_CGI, %opts);
}


#@returns User::Information::Base
sub local_node {
    my ($self, %opts) = @_;
    return state $local_node = $self->lookup(from => SPECIAL_LOCAL_NODE, %opts);
}


# ---- Private helpers ----
sub _known_provider {
    my ($self, $class, %opts) = @_;

    croak 'Unsupported options passed' if scalar(keys %opts);

    return [SPECIAL_LOCAL_NODE, PATH_ELEMENT_NS, PATH_ELEMENT_TYPE], rawtype => 'Data::Identifier' if $class eq ':all';

    croak 'Unknown class';
}

1;

__END__