File Coverage

lib/User/Information/Base.pm

Criterion	Covered	Total	%
statement	29	204	14.2
branch	0	122	0.0
condition	0	62	0.0
subroutine	10	23	43.4
pod	5	5	100.0
total	44	416	10.5

# 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::Base;

use v5.20;
use strict;
use warnings;

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

use File::Spec;

use User::Information;
use User::Information::Path;
use User::Information::Source;

use Carp;

our $VERSION = v0.05;

use constant {
    PATH_LOCAL_SYSAPI   => User::Information::Path->new([qw(local sysapi)]),
    PATH_LOCAL_ISLOCAL  => User::Information::Path->new([qw(local islocal)]),
};

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

my %_aux_sources = map {$_ => 1} qw(User::Information::Source::Aggregate User::Information::Source::Tagpool User::Information::Source::Defaults);


sub attach {
    my ($self, %opts) = @_;
    my $weak = delete $opts{weak};

    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})};
        $self->{$key} //= $v;
        croak 'Missmatch for key: '.$key unless $self->{$key} == $v;
        weaken($self->{$key}) if $weak;
    }

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

    return $self;
}


sub get {
    my ($self, $key, %opts) = @_;
    my $o_has_default   = exists $opts{default};
    my $o_default       = delete $opts{default};
    my $o_list          = delete $opts{list};
    my $o_as            = delete $opts{as};
    my $info;
    my $values;
    my @res;

    unless (eval {$key->isa('User::Information::Path')}) {
        $key = User::Information::Path->new($key);
    }

    delete $opts{no_defaults};
    croak 'Stray options passed' if scalar keys %opts;

    $values = $self->{data}{$key->_hashkey};

    unless (defined $values) {
        $info //= eval { $self->_key_info($key) };
        if (defined($info)) {
            my $loadpath = $info->{loadpath} // $key;
            $loadpath = $loadpath->_hashkey;
            unless ($self->{loaded}{$loadpath}) {
                $self->{loaded}{$loadpath} = 1;

                if (defined($info->{loader})) {
                    $values = eval { $info->{loader}->($self, $info, $key) };
                    if (defined $values) {
                        $self->{data}{$key->_hashkey} = $values;
                    }
                }

                $self->_value_add($key, @{$info->{values}}) if ref($info->{values}) eq 'ARRAY';
                $self->_value_add($key,   $info->{values} ) if ref($info->{values}) eq 'HASH';

                $values //= $self->{data}{$key->_hashkey};
            }
        }
    }

    unless (defined $values) {
        if ($o_has_default) {
            if ($o_list) {
                return @{$o_default};
            } else {
                return $o_default;
            }
        } else {
            croak 'No value found';
        }
    }

    unless (defined($o_as)) {
        $info //= eval { $self->_key_info($key) };

        $o_as = $info->{rawtype} if defined $info;

        $o_as //= 'raw';
    }

    foreach my $v (@{$values}) {
        if (defined($v->{$o_as})) {
            push(@res, $v->{$o_as});
        } else {
            my $converted;

            $info //= $self->_key_info($key);

            if (defined($v->{raw}) && defined($info->{rawtype}) && $info->{rawtype} eq $o_as) {
                $converted = $v->{raw};
            }

            if (!defined($converted) && $o_as eq 'raw' && defined($info->{rawtype}) && defined($v->{$info->{rawtype}})) {
                $converted = $v->{$info->{rawtype}};
            }

            if (!defined($converted) && defined($info->{converter})) {
                $converted = $info->{converter}->($self, $info, $key, $v, $o_as);
            }

            if (defined $converted) {
                push(@res, $converted);
                $v->{$o_as} = $converted;
            } else {
                croak 'Converting types is currently not supported';
            }
        }
    }

    return @res if $o_list;
    if (scalar(@res) != 1) {
        croak 'Wrong number of results and not in list mode';
    }
    return $res[0];
}


sub node {
    my ($self, %opts) = @_;
    my $o_has_default   = exists $opts{default};
    my $o_default       = delete $opts{default};

    delete $opts{no_defaults};
    croak 'Stray options passed' if scalar keys %opts;

    return $self->{node} if defined $self->{node};
    return $self->{node} = User::Information->local_node if $self->_is_local;
    return $o_default if $o_has_default;
    croak 'No node known';
}


sub displayname {
    my ($self, %opts) = @_;
    $opts{default} //= 'no name' unless $opts{no_defaults};
    return $self->get(['aggregate' => 'displayname'], %opts);
}


sub file {
    my ($self, $key, %opts) = @_;
    my @filename = $self->get($key, as => 'filename', list => 1);
    my $o_extra = delete $opts{extra};
    my $o_directory = delete $opts{directory};
    my $o_open = delete $opts{open};
    my $o_binmode = delete $opts{binmode};

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

    foreach my $filename (@filename) {
        if (defined $o_extra) {
            my @extra = ref($o_extra) ? @{$o_extra} : ($o_extra);
            $filename = $o_directory ? File::Spec->catdir($filename, @extra) : File::Spec->catfile($filename, @extra);
        }

        if (defined $o_open) {
            my $mode;

            croak 'Invalid open mode: '.$o_open unless $o_open =~ /^[abrw]+$/;

            if ($o_open =~ /w/) {
                $mode = '>';
            } elsif ($o_open =~ /a/) {
                $mode = '>>';
            } else {
                $mode = '<';
            }

            $o_binmode //= 1 if $o_open =~ /b/;

            if ($o_directory) {
                if (opendir(my $fh, $filename)) {
                    return $fh;
                }
            } else {
                if (open(my $fh, $mode, $filename)) {
                    $fh->binmode if $o_binmode;
                    return $fh;
                }
            }
        }

        return $filename if -e $filename;
    }

    croak 'No file found';
}

# ---- Private helpers ----
sub _new {
    my ($pkg, $type, $request, %opts) = @_;
    my $self = bless {data => {}, discovered => {}, loaded => {}, sources => {}}, $pkg;

    # Attach subobjects:
    $self->attach(map {$_ => delete $opts{$_}} keys(%_types), 'weak');

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

    $self->_load('User::Information::Source::Aggregate');
    if ($type eq 'from') {
        if ($request eq User::Information->SPECIAL_ME) {
            $self->_load('User::Information::Source::Local');
            $self->_load('User::Information::Source::Env');
            $self->_load('User::Information::Source::POSIX', data => {real_user => $<, effective_user => $>, real_group => $(, effective_group => $)}) if $self->_is_sysapi('posix');
            $self->_load('User::Information::Source::XDG', me => 1);
        } elsif ($request eq User::Information->SPECIAL_CGI) {
            $self->_load('User::Information::Source::CGI');
            $self->_load('User::Information::Source::Env', cgi => 1);
        } elsif (User::Information->SPECIAL_LOCAL_NODE->eq($request)) {
            $self->_load('User::Information::Source::Local');
            $self->_load('User::Information::Source::VFS');
            $self->_load('User::Information::Source::POSIX', data => {uname => undef});
            $self->_load('User::Information::Source::LocalNodeMisc');
        }
    } elsif ($type eq 'sysuid') {
        $self->_load('User::Information::Source::Local');
        $self->_load('User::Information::Source::POSIX', data => {user => $request}) if $self->_is_sysapi('posix');
    } elsif ($type eq 'sysgid') {
        $self->_load('User::Information::Source::Local');
        $self->_load('User::Information::Source::POSIX', data => {group => $request}) if $self->_is_sysapi('posix');
    }
    if (!$self->{sources}{'User::Information::Source::XDG'} && $self->_is_local && defined(my $username = $self->get(['aggregate', 'username'], default => undef))) {
        $self->_load('User::Information::Source::XDG', username => $username);
    }
    if ($self->_is_local) {
        $self->_load('User::Information::Source::Git');
        $self->_load('User::Information::Source::Tagpool');
    }
    $self->_load('User::Information::Source::Defaults');

    croak 'No matching data sources found for type/request' unless scalar(grep {!$_aux_sources{$_}} keys %{$self->{sources}});

    return $self;
}

sub _key_info {
    my ($self, $key) = @_;
    return $self->{discovered}{$key->_hashkey} // croak 'Unknown key';
}

sub _key_add {
    my ($self, @info) = @_;
    my $discovered = $self->{discovered};

    foreach my $ent (@info) {
        $discovered->{$ent->{path}->_hashkey} //= $ent;
    }
}

sub _load {
    my ($self, $source, %opts) = @_;
    $self->{sources}{$source} = undef;
    $self->_key_add(User::Information::Source->_load($source, $self, %opts));
}

sub _is_sysapi {
    my ($self, $api) = @_;
    my $sysapi = $self->{sysapi} //= $self->get(PATH_LOCAL_SYSAPI, default => '');
    return $sysapi eq $api;
}

sub _is_local {
    my ($self) = @_;
    return $self->{islocal} //= $self->get(PATH_LOCAL_ISLOCAL, default => '', as => 'bool');
}

sub _value_add {
    my ($self, $key, @values) = @_;
    my $d;

    @values = grep {defined} @values;

    return unless scalar @values;

    $d = $self->{data}{$key->_hashkey} //= [];
    push(@{$d}, @values);
    $self->{loaded}{$key->_hashkey} = 1;
}

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

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

    return [map {$_->{path}} values %{$self->{discovered}}], not_identifiers => 1 if $class eq 'paths';

    croak 'Unknown class';
}

1;

__END__