Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
Archive	[ DIR ]	drwxr-xr-x
Collection	[ DIR ]	drwxr-xr-x
Archive.pm	801 B	-rw-r--r--
Archive.pod	4.59 KB	-rw-r--r--
Collection.pm	3.09 KB	-rw-r--r--
Collection.pod	8.69 KB	-rw-r--r--
Item.pm	4 KB	-rw-r--r--
Item.pod	7.12 KB	-rw-r--r--
Location.pm	2.8 KB	-rw-r--r--
Location.pod	7.2 KB	-rw-r--r--
System.pm	1.25 KB	-rw-r--r--
System.pod	5.71 KB	-rw-r--r--

Code Editor : Item.pm

# Copyrights 2003-2022 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.
# This code is part of distribution User-Identity.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package User::Identity::Item;
use vars '$VERSION';
$VERSION = '1.01';

use strict;
use warnings;

use Scalar::Util qw/weaken/;
use Carp;

sub new(@)
{   my $class = shift;
    return undef unless @_;       # no empty users.

unshift @_, 'name' if @_ %2;  # odd-length list: starts with nick

my %args = @_;
    my $self = (bless {}, $class)->init(\%args);

if(my @missing = keys %args)
    {   local $" = '", "';
        warn "WARNING: Unknown ".(@missing==1? 'option' : 'options' )
           . " \"@missing\" for a $class\n";
    }

$self;
}

sub init($)
{   my ($self, $args) = @_;

unless(defined($self->{UII_name} = delete $args->{name}))
    {   croak "ERROR: Each item requires a name";
    }

$self->{UII_description} = delete $args->{description};
    $self;
}

#-----------------------------------------

sub name(;$)
{   my $self = shift;
    @_ ? ($self->{UII_name} = shift) : $self->{UII_name};
}

#-----------------------------------------

sub description() {shift->{UII_description}}

#-----------------------------------------

our %collectors =
 ( emails      => 'User::Identity::Collection::Emails'
 , locations   => 'User::Identity::Collection::Locations'
 , systems     => 'User::Identity::Collection::Systems'
 , users       => 'User::Identity::Collection::Users'
 );  # *s is tried as well, so email, system, and location will work

sub addCollection(@)
{   my $self = shift;
    return unless @_;

my $object;
    if(ref $_[0])
    {   $object = shift;
        croak "ERROR: $object is not a collection"
           unless $object->isa('User::Identity::Collection');
    }
    else
    {   unshift @_, 'type' if @_ % 2;
        my %args  = @_;
        my $type  = delete $args{type};

croak "ERROR: Don't know what type of collection you want to add"
           unless $type;

my $class = $collectors{$type} || $collectors{$type.'s'} || $type;
        eval "require $class";
        croak "ERROR: Cannot load collection module $type ($class); $@\n"
           if $@;

$object = $class->new(%args);
        croak "ERROR: Creation of a collection via $class failed\n"
           unless defined $object;
    }

$object->parent($self);
    $self->{UI_col}{$object->name} = $object;
}

sub removeCollection($)
{   my $self = shift;
    my $name = ref $_[0] ? $_[0]->name : $_[0];

delete $self->{UI_col}{$name}
    || delete $self->{UI_col}{$name.'s'};
}

sub collection($;$)
{   my $self       = shift;
    my $collname   = shift;
    my $collection
      = $self->{UI_col}{$collname} || $self->{UI_col}{$collname.'s'} || return;

wantarray ? $collection->roles : $collection;
}

sub add($$)
{   my ($self, $collname) = (shift, shift);
    my $collection
     = ref $collname && $collname->isa('User::Identity::Collection')
     ? $collname
     : ($self->collection($collname) || $self->addCollection($collname));

unless($collection)
    {   carp "No collection $collname";
        return;
    }

$collection->addRole(@_);
}

sub type { "item" }

sub parent(;$)
{   my $self = shift;
    return $self->{UII_parent} unless @_;

$self->{UII_parent} = shift;
    weaken($self->{UII_parent});
    $self->{UII_parent};
}

sub user()
{   my $self   = shift;
    my $parent = $self->parent;
    defined $parent ? $parent->user : undef;
}

#-----------------------------------------

sub find($$)
{   my $all        = shift->{UI_col};
    my $collname   = shift;
    my $collection
     = ref $collname && $collname->isa('User::Identity::Collection') ? $collname
     : ($all->{$collname} || $all->{$collname.'s'});

defined $collection ? $collection->find(shift) : ();
}

${this.title}

Code Editor : Item.pm