# Copyrights 2003-2016 by [Mark Overmeer <perl@overmeer.net>].
# For other contributors see Changes.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
package User::Identity::Item;
use vars '$VERSION';
$VERSION = '0.96';
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 find($$)
{ my $all = shift->{UI_col};
my $collname = shift;
my $collection
= ref $collname && $collname->isa('User::Identity::Collect') ? $collname
: ($all->{$collname} || $all->{$collname.'s'});
return () unless defined $collection;
$collection->find(shift);
}
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;
}
1;