User-Identity-0.94/0000755000175000001440000000000012270434610014670 5ustar00markovusers00000000000000User-Identity-0.94/Changes0000644000175000001440000000712312270434554016175 0ustar00markovusers00000000000000 Revision history for module User::Identity. All changes are made by Mark Overmeer unless explicitly stated differently. version 0.94: Fri Jan 24 10:55:26 CET 2014 Improvements: - changed documentation style version 0.93: Thu Dec 24 11:09:49 CET 2009 Fixes: - Mail::Identity->from(Mail::Address) produced error rt.cpan.org#52115 [Dmitry Bigunyak] Improvements: - do not run t/pod.t in devel environment. version 0.92: Wed Jul 25 08:50:51 CEST 2007 Improvements: - add t/pod.t and distribution clean-ups. version 0.91: Mon Jan 8 10:52:59 CET 2007 The module hasn't seen changes for some time now, but that is because it works as expected. Improvements: - produced with newest OODoc, thereby could remove version, mkdoc and mkdist - removed useless README version 0.90: Thu Aug 26 14:30:51 CEST 2004 Improvements: - Geography::Countries is not required, but optional so [Nick Ing-Simmons] has installed too much. - Cleaned the docs on many spots. - new methods User::Identity::Collection::itemType() User::Identity::Collection::removeRole() - new methods User::Identity::Item::removeCollection() - METHODS section Initiation renamed to "Constructors" version 0.07: Mon Sep 29 13:34:47 CEST 2003 Interface breaking changes: - User::Identity date_of_birth became birth... name was too long. - User::Identity telephone became phone... same reason. - For collections, new(user) was changed into new(parent). Improvements: - All items can now have their collections. It's to the user not to make a mess of it. You can create collections of collections, if you want to. - User::Identity::Collect::Item is useless when everything is collectable. - Even collections can be collected. - Added base class for long-term storage: User::Identity::Archive - Added User::Identity::Archive::Plain, which is a very simple text based way to specify items. - Added User::Identity::Collection::Users, a group of people. version 0.06: Wed Aug 6 10:41:23 CEST 2003 Released because of version mistake in MailBox version 0.05: Mon Jul 28 18:34:49 CEST 2003 Interface breaking: - Mail::Identity::email() renamed to Mail::Identity::address(), otherwise some very confusion options would appear. - Mail::Identity::domainname() renamed to Mail::Identity::domain(), which feels better. - Mail::Identity::address() defaults to Mail::Identity::name() if no username or domainname are present. Improvements: - Added charset to Mail::Identity - Moved all modules to the lib sub-directory, which makes the */Makefile.PL helpers redundant. - Added Mail::Identity->from(Mail::Address or User::Identity) - Added enough options to OODoc::processFiles() to be able to join multiple distributions into one set of documentation pages. version 0.04: Tue Mar 25 08:19:13 CET 2003 Fixes: - [Jorg Krieger] found typo's and saw that the ::System module was not correctly produced via copy-paste: too many things refered to e-mail i.s.o. systems. version 0.03: Fri Mar 7 23:26:25 CET 2003 Improvements: - implemented new classes: User::Identity::Item User::Identity::System User::Identity::Collection User::Identity::Collection::Systems - Everything is now derived from User::Identity::Item - User::Identity requires a name (not nickname). version 0.02 Improvements: - extended User::Identity with collection handling. - implemented new classes: Mail::Identity User::Identity::Collection User::Identity::Collection::Item User::Identity::Collection::Emails version 0.01 Thu Jan 30 17:22:28 CET 2003 - original version User-Identity-0.94/META.yml0000644000175000001440000000075512270434610016150 0ustar00markovusers00000000000000--- abstract: 'Collect information about a user' author: - 'Mark Overmeer ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120630' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: User-Identity no_index: directory: - t - inc requires: Test::Pod: 1 version: 0.94 User-Identity-0.94/Makefile.PL0000644000175000001440000000231512270434554016652 0ustar00markovusers00000000000000use 5.006; use ExtUtils::MakeMaker; # # The following is needed, because User::Identity does gracefully handle # a missing Geography::Countries, but is incompatible with older releases. # my %prereq = (Test::Pod => 1.00); my ($gc, $gc_version) = (Geography::Countries => 1.4); eval "require $gc"; if($@ =~ m/^Can't locate/) { # Not installed, but it is optional... } elsif($@) { # Other error message warn "Found problems compiling $gc:\n$@"; $prereq{$gc} = $gc_version; } elsif($gc->VERSION < $gc_version) { warn "$gc is too old (",$gc->VERSION,"), and needs to be reinstalled\n"; $prereq{$gc} = $gc_version; } WriteMakefile ( NAME => 'User::Identity' , VERSION => 0.94 , PREREQ_PM => \%prereq , ABSTRACT => 'Collect information about a user' , AUTHOR => 'Mark Overmeer ' , LICENSE => 'perl' ); ### used by oodist during production of distribution sub MY::postamble { <<'__POSTAMBLE' } # for DIST RAWDIR = ../public_html/userid/raw DISTDIR = ../public_html/userid/source LICENSE = artistic # for POD FIRST_YEAR = 2003 EMAIL = perl@overmeer.net WEBSITE = http://perl.overmeer.net/userid/ __POSTAMBLE User-Identity-0.94/README0000644000175000001440000000144612270434554015564 0ustar00markovusers00000000000000=== README for User-Identity version 0.94 = Generated on Fri Jan 24 10:59:08 2014 by OODoc 2.01 There are various ways to install this module: (1) if you have a command-line, you can do: perl -MCPAN -e 'install ' (2) if you use Windows, have a look at http://ppm.activestate.com/ (3) if you have downloaded this module manually (as root/administrator) gzip -d User-Identity-0.94.tar.gz tar -xf User-Identity-0.94.tar cd User-Identity-0.94 perl Makefile.PL make # optional make test # optional make install For usage, see the included manual-pages or http://search.cpan.org/dist/User-Identity-0.94/ Please report problems to http://rt.cpan.org/Dist/Display.html?Queue=User-Identity User-Identity-0.94/lib/0000755000175000001440000000000012270434610015436 5ustar00markovusers00000000000000User-Identity-0.94/lib/Mail/0000755000175000001440000000000012270434610016320 5ustar00markovusers00000000000000User-Identity-0.94/lib/Mail/Identity.pm0000644000175000001440000000717012270434607020462 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package Mail::Identity; our $VERSION = '0.94'; use base 'User::Identity::Item'; use strict; use warnings; use User::Identity; use Scalar::Util 'weaken'; sub type() { "email" } sub init($) { my ($self, $args) = @_; $args->{name} ||= '-x-'; $self->SUPER::init($args); exists $args->{$_} && ($self->{'MI_'.$_} = delete $args->{$_}) foreach qw/address charset comment domain language location organization pgp_key phrase signature username/; $self->{UII_name} = $self->phrase || $self->address if $self->{UII_name} eq '-x-'; $self; } sub from($) { my ($class, $other) = (shift, shift); return $other if $other->isa(__PACKAGE__); if($other->isa('Mail::Address')) { return $class->new ( phrase => $other->phrase , address => $other->address , comment => $other->comment , @_); } if($other->isa('User::Identity')) { my $emails = $other->collection('emails') or next; my @roles = $emails->roles or return (); return $roles[0]; # first Mail::Identity } undef; } sub comment($) { my $self = shift; return $self->{MI_comment} = shift if @_; return $self->{MI_comment} if defined $self->{MI_comment}; my $user = $self->user or return undef; my $full = $user->fullName or return undef; $self->phrase eq $full ? undef : $full; } sub charset() { my $self = shift; return $self->{MI_charset} if defined $self->{MI_charset}; my $user = $self->user or return undef; $user->charset; } sub language() { my $self = shift; return $self->{MI_language} if defined $self->{MI_language}; my $user = $self->user or return undef; $user->language; } sub domain() { my $self = shift; return $self->{MI_domain} if defined $self->{MI_domain}; my $address = $self->{MI_address} or return 'localhost'; $address =~ s/.*?\@// ? $address : undef; } sub address() { my $self = shift; return $self->{MI_address} if defined $self->{MI_address}; return $self->username .'@'. $self->domain if $self->{MI_username} || $self->{MI_domain}; my $name = $self->name; return $name if index($name, '@') >= 0; my $user = $self->user; defined $user ? $user->nickname : $name; } sub location() { my $self = shift; my $location = $self->{MI_location}; if(! defined $location) { my $user = $self->user or return; my @locs = $user->collection('locations'); $location = @locs ? $locs[0] : undef; } elsif(! ref $location) { my $user = $self->user or return; $location = $user->find(location => $location); } $location; } sub organization() { my $self = shift; return $self->{MI_organization} if defined $self->{MI_organization}; my $location = $self->location or return; $location->organization; } #pgp_key sub phrase() { my $self = shift; return $self->{MI_phrase} if defined $self->{MI_phrase}; my $user = $self->user or return undef; my $full = $user->fullName or return undef; $full; } #signature sub username() { my $self = shift; return $self->{MI_username} if defined $self->{MI_username}; if(my $address = $self->{MI_address}) { $address =~ s/\@.*$//; # strip domain part if present return $address; } my $user = $self->user or return; $user->nickname; } 1; User-Identity-0.94/lib/Mail/Identity.pod0000644000175000001440000002074412270434607020632 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Identity - an e-mail role =head1 INHERITANCE Mail::Identity is a User::Identity::Item =head1 SYNOPSIS use User::Identity; use Mail::Identity; my $me = User::Identity->new(...); my $addr = Mail::Identity->new(address => 'x@y'); $me->add(email => $addr); # Simpler use User::Identity; my $me = User::Identity->new(...); my $addr = $me->add(email => 'x@y'); my $addr = $me->add( email => 'home' , address => 'x@y'); # Conversion my $ma = Mail::Address->new(...); my $mi = Mail::Identity->coerce($ma); =head1 DESCRIPTION The C object contains the description of role played by a human when sending e-mail. Most people have more than one role these days: for instance, a private and a company role with different e-mail addresses. An C object combines an e-mail address, user description ("phrase"), a signature, pgp-key, and so on. All fields are optional, and some fields are smart. One such set of data represents one role. C is therefore the smart cousine of the Mail::Address object. Extends L<"DESCRIPTION" in User::Identity::Item|User::Identity::Item/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in User::Identity::Item|User::Identity::Item/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Item|User::Identity::Item/"Constructors">. =over 4 =item Mail::Identity-EB( [NAME], OPTIONS ) -Option --Defined in --Default address charset comment description User::Identity::Item undef domain language location name User::Identity::Item organization parent User::Identity::Item undef pgp_key undef phrase signature undef username =over 2 =item address => STRING The e-mail address is constructed from the username/domain, but when both do not exist, the name is taken. =item charset => STRING =item comment => STRING =item description => STRING =item domain => STRING =item language => STRING =item location => NAME|OBJECT The user's location which relates to this mail identity. This can be specified as location name (which will be looked-up when needed), or as L object. =item name => STRING =item organization => STRING Usually defined for e-mail addresses which are used by a company or other organization, but less common for personal addresses. This value will be used to fill the C header field of messages. =item parent => OBJECT =item pgp_key => STRING|FILENAME =item phrase => STRING =item signature => STRING =item username => STRING =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Item|User::Identity::Item/"Attributes">. =over 4 =item $obj-EB
() Returns the e-mail address for this role. If none was specified, it will be constructed from the username and domain. If those are not present as well, then the L is used when it contains a C<@>, else the user's nickname is taken. =item $obj-EB() Returns the character set used in comment and phrase. When set to C, the strings (are already encoded to) contain only ASCII characters. This defaults to the value of the user's charset, if a user is defined. =item $obj-EB( [STRING] ) E-mail address -when included in message MIME headers- can contain a comment. The RFCs advice not to store useful information in these comments, but it you really want to, you can do it. The comment defaults to the user's fullname if the phrase is not the fullname and there is a user defined. Comments will be enclosed in parenthesis when used. Parenthesis (matching) or non-matching) which are already in the string will carefully escaped when needed. You do not need to worry. =item $obj-EB() Inherited, see L =item $obj-EB() The domain is the part of the e-mail address after the C<@>-sign. When this is not defined, it can be deducted from the email address (see L). If nothing is known, C is returned. =item $obj-EB() Returns the language which is used for the description fields of this e-mail address, which defaults to the user's language. =item $obj-EB() Returns the object which describes to which location this mail address relates. The location may be used to find the name of the organization involved, or to create a signature. If no location is specified, but a user is defined which has locations, one of those is randomly chosen. =item $obj-EB( [NEWNAME] ) Inherited, see L =item $obj-EB() Returns the organization which relates to this e-mail identity. If not explicitly specified, it is tried to be found via the location. =item $obj-EB() The phrase is used in an e-mail address to explain who is sending the message. This usually is the fullname (the user's fullname is used by default), description of your function (Webmaster), or any other text. When an email string is produced, the phase will be quoted if needed. Quotes which are within the string will automatically be escaped, so you do no need to worry: input cannot break the outcome! =item $obj-EB() Returns the username of this e-mail address. If none is specified, first it is tried to extract it from the specified e-mail address. If there is also no username in the e-mail address, the user identity's nickname is taken. =back =head2 Collections Extends L<"Collections" in User::Identity::Item|User::Identity::Item/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item Mail::Identity-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/0000755000175000001440000000000012270434610016354 5ustar00markovusers00000000000000User-Identity-0.94/lib/User/Identity.pm0000644000175000001440000001264712270434607020523 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity; our $VERSION = '0.94'; use base 'User::Identity::Item'; use strict; use warnings; use Carp; use overload '""' => 'fullName'; #----------------------------------------- my @attributes = qw/charset courtesy birth full_name formal_name firstname gender initials language nickname prefix surname titles /; sub init($) { my ($self, $args) = @_; exists $args->{$_} && ($self->{'UI_'.$_} = delete $args->{$_}) foreach @attributes; $self->SUPER::init($args); } sub type() { 'user' } sub user() { shift } sub charset() { shift->{UI_charset} || $ENV{LC_CTYPE} } sub nickname() { my $self = shift; $self->{UI_nickname} || $self->name; # TBI: If OS-specific info exists, then username } sub firstname() { my $self = shift; $self->{UI_firstname} || ucfirst $self->nickname; } sub initials() { my $self = shift; return $self->{UI_initials} if defined $self->{UI_initials}; if(my $firstname = $self->firstname) { my $i = ''; while( $firstname =~ m/(\w+)(\-)?/g ) { my ($part, $connect) = ($1,$2); $connect ||= '.'; $part =~ m/^(chr|th|\w)/i; $i .= ucfirst(lc $1).$connect; } return $i; } } sub prefix() { shift->{UI_prefix} } sub surname() { shift->{UI_surname} } sub fullName() { my $self = shift; return $self->{UI_full_name} if defined $self->{UI_full_name}; my ($first, $prefix, $surname) = @$self{ qw/UI_firstname UI_prefix UI_surname/}; $surname = ucfirst $self->nickname if defined $first && ! defined $surname; $first = $self->firstname if !defined $first && defined $surname; my $full = join ' ', grep {defined $_} ($first,$prefix,$surname); $full = $self->firstname unless length $full; # TBI: if OS-specific knowledge, then unix GCOS? $full; } sub formalName() { my $self = shift; return $self->{UI_formal_name} if defined $self->{UI_formal_name}; my $initials = $self->initials; my $firstname = $self->{UI_firstname}; $firstname = "($firstname)" if defined $firstname; my $full = join ' ', grep {defined $_} $self->courtesy, $initials , @$self{ qw/UI_prefix UI_surname UI_titles/ }; } my %male_courtesy = ( mister => 'en' , mr => 'en' , sir => 'en' , 'de heer' => 'nl' , mijnheer => 'nl' , dhr => 'nl' , herr => 'de' ); my %male_courtesy_default = ( en => 'Mr.' , nl => 'De heer' , de => 'Herr' ); my %female_courtesy = ( miss => 'en' , ms => 'en' , mrs => 'en' , madam => 'en' , mevr => 'nl' , mevrouw => 'nl' , frau => 'de' ); my %female_courtesy_default = ( en => 'Madam' , nl => 'Mevrouw' , de => 'Frau' ); sub courtesy() { my $self = shift; return $self->{UI_courtesy} if defined $self->{UI_courtesy}; my $table = $self->isMale ? \%male_courtesy_default : $self->isFemale ? \%female_courtesy_default : return undef; my $lang = lc $self->language; return $table->{$lang} if exists $table->{$lang}; $lang =~ s/\..*//; # "en_GB.utf8" --> "en-GB" and retry return $table->{$lang} if exists $table->{$lang}; $lang =~ s/[-_].*//; # "en_GB.utf8" --> "en" and retry $table->{$lang}; } # TBI: if we have a courtesy, we may detect the language. # TBI: when we have a postal address, we may derive the language from # the country. # TBI: if we have an e-mail addres, we may derive the language from # that. sub language() { shift->{UI_language} || 'en' } sub gender() { shift->{UI_gender} } sub isMale() { my $self = shift; if(my $gender = $self->{UI_gender}) { return $gender =~ m/^[mh]/i; } if(my $courtesy = $self->{UI_courtesy}) { $courtesy = lc $courtesy; $courtesy =~ s/[^\s\w]//g; return 1 if exists $male_courtesy{$courtesy}; } undef; } sub isFemale() { my $self = shift; if(my $gender = $self->{UI_gender}) { return $gender =~ m/^[vf]/i; } if(my $courtesy = $self->{UI_courtesy}) { $courtesy = lc $courtesy; $courtesy =~ s/[^\s\w]//g; return 1 if exists $female_courtesy{$courtesy}; } undef; } sub dateOfBirth() { shift->{UI_birth} } sub birth() { my $birth = shift->dateOfBirth; my $time; if($birth =~ m/^\s*(\d{4})[-\s]*(\d{2})[-\s]*(\d{2})\s*$/) { # Pre-formatted. return sprintf "%04d%02d%02d", $1, $2, $3; } eval "require Date::Parse"; unless($@) { my ($day,$month,$year) = (Date::Parse::strptime($birth))[3,4,5]; if(defined $year) { return sprintf "%04d%02d%02d" , ($year + 1900) , (defined $month ? $month+1 : 0) , ($day || 0); } } # TBI: Other date parsers undef; } sub age() { my $birth = shift->birth or return; my ($year, $month, $day) = $birth =~ m/^(\d{4})(\d\d)(\d\d)$/; my ($today, $tomonth, $toyear) = (localtime)[3,4,5]; $tomonth++; my $age = $toyear+1900 - $year; $age-- if $month > $tomonth || ($month == $tomonth && $day >= $today); $age; } sub titles() { shift->{UI_titles} } 1; User-Identity-0.94/lib/User/Identity.pod0000644000175000001440000002214612270434607020664 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity - maintains info about a physical person =head1 INHERITANCE User::Identity is a User::Identity::Item =head1 SYNOPSIS use User::Identity; my $me = User::Identity->new ( 'john' , firstname => 'John' , surname => 'Doe' ); print $me->fullName # prints "John Doe" print $me; # same =head1 DESCRIPTION The C object is created to maintain a set of informational objects which are related to one user. The C module tries to be smart providing defaults, conversions and often required combinations. The identities are not implementing any kind of storage, and can therefore be created by any simple or complex Perl program. This way, it is more flexible than an XML file to store the data. For instance, you can decide to store the data with Data::Dumper, Storable, DBI, AddressBook or whatever. Extension to simplify this task are still to be developed. If you need more kinds of user information, then please contact the module author. Extends L<"DESCRIPTION" in User::Identity::Item|User::Identity::Item/"DESCRIPTION">. =head1 OVERLOADED =over 4 =item $obj-EB() When an C is used as string, it is automatically translated into the fullName() of the user involved. example: my $me = User::Identity->new(...) print $me; # same as print $me->fullName print "I am $me\n"; # also stringification =back =head1 METHODS Extends L<"METHODS" in User::Identity::Item|User::Identity::Item/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Item|User::Identity::Item/"Constructors">. =over 4 =item User::Identity-EB( [NAME], OPTIONS ) Create a new user identity, which will contain all data related to a single physical human being. Most user data can only be specified at object construction, because they should never change. A NAME may be specified as first argument, but also as option, one way or the other is required. -Option --Defined in --Default birth undef charset $ENV{LC_CTYPE} courtesy undef description User::Identity::Item undef firstname undef formal_name undef full_name undef gender undef initials undef language 'en' name User::Identity::Item nickname undef parent User::Identity::Item undef prefix undef surname undef titles undef =over 2 =item birth => DATE =item charset => STRING =item courtesy => STRING =item description => STRING =item firstname => STRING =item formal_name => STRING =item full_name => STRING =item gender => STRING =item initials => STRING =item language => STRING =item name => STRING =item nickname => STRING =item parent => OBJECT =item prefix => STRING =item surname => STRING =item titles => STRING =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Item|User::Identity::Item/"Attributes">. =over 4 =item $obj-EB() Calcuted from the datge of birth to the current moment, as integer. On the birthday, the number is incremented already. =item $obj-EB() Returns the date in standardized format: YYYYMMDD, easy to sort and select. This may return C, even if the L contains a value, simply because the format is not understood. Month or day may contain C<'00'> to indicate that those values are not known. =item $obj-EB() The user's prefered character set, which defaults to the value of LC_CTYPE environment variable. =item $obj-EB() The courtesy is used to address people in a very formal way. Values are like "Mr.", "Mrs.", "Sir", "Frau", "Heer", "de heer", "mevrouw". This often provides a way to find the gender of someone addressed. =item $obj-EB() Returns the date of birth, as specified during instantiation. =item $obj-EB() Inherited, see L =item $obj-EB() Returns the first name of the user. If it is not defined explicitly, it is derived from the nickname, and than capitalized if needed. =item $obj-EB() Returns a formal name for the user. If not defined as instantiation parameter (see new()), it is constructed from other available information, which may result in an incorrect or an incomplete name. The result is built from "courtesy initials prefix surname title". =item $obj-EB() If this is not specified as value during object construction, it is guessed based on other known values like "firstname prefix surname". If a surname is provided without firstname, the nickname is taken as firstname. When a firstname is provided without surname, the nickname is taken as surname. If both are not provided, then the nickname is used as fullname. =item $obj-EB() Returns the specified gender of the person, as specified during instantiation, which could be like 'Male', 'm', 'homme', 'man'. There is no smart behavior on this: the exact specified value is returned. Methods isMale(), isFemale(), and courtesy() are smart. =item $obj-EB() The initials, which may be derived from the first letters of the firstname. =item $obj-EB() See isMale(): return true if we are sure the user is a woman. =item $obj-EB() Returns true if we are sure that the user is male. This is specified as gender at instantiation, or derived from the courtesy value. Methods isMale and isFemale are not complementatory: they can both return false for the same user, in which case the gender is undertermined. =item $obj-EB() Can contain a list or a single language name, as defined by the RFC Examples are 'en', 'en-GB', 'nl-BE'. The default language is 'en' (English). =item $obj-EB( [NEWNAME] ) Inherited, see L =item $obj-EB() Returns the user's nickname, which could be used as username, e-mail alias, or such. When no nickname was explicitly specified, the name is used. =item $obj-EB() The words which are between the firstname (or initials) and the surname. =item $obj-EB() Returns the surname of person, or C if that is not known. =item $obj-EB() The titles, degrees in education or of other kind. If these are complex, you may need to specify the formal name of the users as well, because smart formatting probably failes. =back =head2 Collections Extends L<"Collections" in User::Identity::Item|User::Identity::Item/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item User::Identity-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/Identity/0000755000175000001440000000000012270434610020145 5ustar00markovusers00000000000000User-Identity-0.94/lib/User/Identity/Location.pm0000644000175000001440000000512412270434607022263 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity::Location; our $VERSION = '0.94'; use base 'User::Identity::Item'; use strict; use warnings; use User::Identity; use Scalar::Util 'weaken'; sub type { "location" } sub init($) { my ($self, $args) = @_; $args->{postal_code} ||= delete $args->{pc}; $self->SUPER::init($args); exists $args->{$_} && ($self->{'UIL_'.$_} = delete $args->{$_}) foreach qw/city country country_code fax organization pobox pobox_pc postal_code state street phone/; $self; } sub street() { shift->{UIL_street} } sub postalCode() { shift->{UIL_postal_code} } sub pobox() { shift->{UIL_pobox} } sub poboxPostalCode() { shift->{UIL_pobox_pc} } #----------------------------------------- sub city() { shift->{UIL_city} } sub state() { shift->{UIL_state} } sub country() { my $self = shift; return $self->{UIL_country} if defined $self->{UIL_country}; my $cc = $self->countryCode or return; eval 'require Geography::Countries'; return if $@; scalar Geography::Countries::country($cc); } sub countryCode() { shift->{UIL_country_code} } sub organization() { shift->{UIL_organization} } #----------------------------------------- sub phone() { my $self = shift; my $phone = $self->{UIL_phone} or return (); my @phone = ref $phone ? @$phone : $phone; wantarray ? @phone : $phone[0]; } sub fax() { my $self = shift; my $fax = $self->{UIL_fax} or return (); my @fax = ref $fax ? @$fax : $fax; wantarray ? @fax : $fax[0]; } #----------------------------------------- sub fullAddress() { my $self = shift; my $cc = $self->countryCode || 'en'; my ($address, $pc); if($address = $self->pobox) { $pc = $self->poboxPostalCode } else { $address = $self->street; $pc = $self->postalCode } my ($org, $city, $state) = @$self{ qw/UIL_organization UIL_city UIL_state/ }; return unless defined $city && defined $address; my $country = $self->country; $country = defined $country ? "\n$country" : defined $cc ? "\n".uc($cc) : ''; if(defined $org) {$org .= "\n"} else {$org = ''}; if($cc eq 'nl') { $pc = "$1 ".uc($2)." " if defined $pc && $pc =~ m/(\d{4})\s*([a-zA-Z]{2})/; return "$org$address\n$pc$city$country\n"; } else { $state ||= ''; return "$org$address\n$city$state$country\n$pc"; } } 1; User-Identity-0.94/lib/User/Identity/Archive/0000755000175000001440000000000012270434610021526 5ustar00markovusers00000000000000User-Identity-0.94/lib/User/Identity/Archive/Plain.pm0000644000175000001440000001525012270434607023140 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity::Archive::Plain; our $VERSION = '0.94'; use base 'User::Identity::Archive'; use strict; use warnings; use Carp; my %abbreviations = ( user => 'User::Identity' , email => 'Mail::Identity' , location => 'User::Identity::Location' , system => 'User::Identity::System' , list => 'User::Identity::Collection::Emails' ); sub init($) { my ($self, $args) = @_; $self->SUPER::init($args) or return; # Define the keywords. my %only; if(my $only = delete $args->{only}) { my @only = ref $only ? @$only : $only; $only{$_}++ for @only; } while( my($k,$v) = each %abbreviations) { $self->abbreviation($k, $v) unless keys %only && !$only{$k}; } if(my $abbrevs = delete $args->{abbreviations}) { $abbrevs = { @$abbrevs } if ref $abbrevs eq 'ARRAY'; while( my($k,$v) = each %$abbrevs) { $self->abbreviation($k, $v) unless keys %only && !$only{$k}; } } foreach (keys %only) { warn "Option 'only' specifies undefined abbreviation '$_'\n" unless defined $self->abbreviation($_); } $self->{UIAP_items} = {}; $self->{UIAP_tabstop} = delete $args->{tabstop} || 8; $self; } sub from($@) { my ($self, $in, %args) = @_; my $verbose = $args{verbose} || 0; my ($source, @lines); if(ref $in) { ($source, @lines) = ref $in eq 'ARRAY' ? ('array', @$in) : ref $in eq 'GLOB' ? ('GLOB', <$in>) : $in->isa('IO::Handle') ? (ref $in, $in->getlines) : confess "Cannot read from a ", ref $in, "\n"; } elsif(open IN, "<", $in) { $source = "file $in"; @lines = ; } else { warn "Cannot read archive from file $in: $!\n"; return $self; } print "reading data from $source\n" if $verbose; return $self unless @lines; my $tabstop = $args{tabstop} || $self->defaultTabStop; $self->_set_lines($source, \@lines, $tabstop); while(my $starter = $self->_get_line) { $self->_accept_line; #warn "$verbose: $starter\n"; my $indent = $self->_indentation($starter); print " adding $starter" if $verbose > 1; my $item = $self->_collectItem($starter, $indent); $self->add($item->type => $item) if defined $item; } $self; } sub _set_lines($$$) { my ($self, $source, $lines, $tab) = @_; $self->{UIAP_lines} = $lines; $self->{UIAP_source} = $source; $self->{UIAP_curtab} = $tab; $self->{UIAP_linenr} = 0; $self; } sub _get_line() { my $self = shift; my ($lines, $linenr, $line) = @$self{ qw/UIAP_lines UIAP_linenr UIAP_line/}; # Accept old read line, if it was not accepted. return $line if defined $line; # Need to read a new line; $line = ''; while($linenr < @$lines) { my $reading = $lines->[$linenr]; $linenr++, next if $reading =~ m/^\s*\#/; # skip comments $linenr++, next unless $reading =~ m/\S/; # skip blanks $line .= $reading; if($line =~ s/\\\s*$//) { $linenr++; next; } if($line =~ m/^\s*tabstop\s*\=\s*(\d+)/ ) { $self->{UIAP_curtab} = $1; $line = ''; next; } last; } return () unless length $line || $linenr < @$lines; $self->{UIAP_linenr} = $linenr; $self->{UIAP_line} = $line; $line; } sub _accept_line() { my $self = shift; delete $self->{UIAP_line}; $self->{UIAP_linenr}++; } sub _location() { @{ (shift) }{ qw/UIAP_source UIAP_linenr/ } } sub _indentation($) { my ($self, $line) = @_; return -1 unless defined $line; my ($indent) = $line =~ m/^(\s*)/; return length($indent) unless index($indent, "\t") >= 0; my $column = 0; my $tab = $self->{UIAP_curtab}; my @chars = split //, $indent; while(my $char = shift @chars) { $column++, next if $char eq ' '; $column = (int($column/$tab+0.0001)+1)*$tab; } $column; } sub _collectItem($$) { my ($self, $starter, $indent) = @_; my ($type, $name) = $starter =~ m/(\w+)\s*(.*?)\s*$/; my $class = $abbreviations{$type}; my $skip = ! defined $class; #warn "Skipping type $type\n" if $skip; my (@fields, @items); while(1) { my $line = $self->_get_line; my $this_indent = $self->_indentation($line); last if $this_indent <= $indent; $self->_accept_line; $line =~ s/[\r\n]+$//; #warn "Skipping line $line\n" if $skip; next if $skip; my $next_line = $self->_get_line; my $next_indent = $self->_indentation($next_line); if($this_indent < $next_indent) { # start a collectable item #warn "Accepting item $line, $this_indent\n"; my $item = $self->_collectItem($line, $this_indent); push @items, $item if defined $item; #warn "Item ready $line\n"; } elsif( $this_indent==$next_indent && $line =~ m/^\s*(\w*)\s*(\w+)\s*\=\s*(.*)/ ) { # Lookup! my ($group, $name, $lookup) = ($1,$2,$3); #warn "Lookup ($group, $name, $lookup)"; my $item; # not implemented yet push @items, $item if defined $item; } else { # defined a field #warn "Accepting field $line\n"; my ($group, $name) = $line =~ m/(\w+)\s*(.*)/; $name =~ s/\s*$//; push @fields, $group => $name; next; } } return () unless @fields || @items; #warn "$class NAME=$name"; my $warn = 0; my $warn_sub = $SIG{__WARN__}; $SIG{__WARN__} = sub {$warn++; $warn_sub ? $warn_sub->(@_) : print STDERR @_}; my $item = $class->new(name => $name, @fields); $SIG{__WARN__} = $warn_sub; if($warn) { my ($source, $linenr) = $self->_location; $linenr -= 1; warn " found in $source around line $linenr\n"; } #warn $_->type foreach @items; $item->add($_->type => $_) foreach @items; $item; } sub defaultTabStop(;$) { my $self = shift; @_ ? ($self->{UIAP_tabstop} = shift) : $self->{UIAP_tabstop}; } sub abbreviation($;$) { my ($self, $name) = (shift, shift); return $self->{UIAP_abbrev}{$name} unless @_; my $class = shift; return delete $self->{UIAP_abbrev}{$name} unless defined $class; eval "require $class"; die "Class $class is not usable, because of errors:\n$@" if $@; $self->{UIAP_abbrev}{$name} = $class; } sub abbreviations() { sort keys %{shift->{UIAP_abbrev}} } 1; User-Identity-0.94/lib/User/Identity/Archive/Plain.pod0000644000175000001440000002264112270434607023310 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity::Archive::Plain - simple, plain text archiver =head1 INHERITANCE User::Identity::Archive::Plain is a User::Identity::Archive is a User::Identity::Item =head1 SYNOPSIS use User::Identity::Archive::Plain; my $friends = User::Identity::Archive::Plain->new('friends'); $friends->from(\*FH); $friends->from('.friends'); =head1 DESCRIPTION This archiver, which extends L, uses a very simple plain text file to store the information of users. The syntax is described in the DETAILS section, below. Extends L<"DESCRIPTION" in User::Identity::Archive|User::Identity::Archive/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in User::Identity::Archive|User::Identity::Archive/"OVERLOADED">. =head1 METHODS Extends L<"METHODS" in User::Identity::Archive|User::Identity::Archive/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Archive|User::Identity::Archive/"Constructors">. =over 4 =item User::Identity::Archive::Plain-EB( [NAME], OPTIONS ) -Option --Defined in --Default abbreviations [] description User::Identity::Item undef from User::Identity::Archive undef name User::Identity::Item only [] parent User::Identity::Item undef tabstop 8 =over 2 =item abbreviations => HASH|ARRAY Adds a set of abbreviations for collections to the syntax of the plain text archiver. See section L for a list of predefined names. =item description => STRING =item from => FILEHANDLE|FILENAME =item name => STRING =item only => ARRAY|ABBREV Lists the only information (as (list of) abbreviations) which should be read. Other information is removed before even checking whether it is a valid abbreviation or not. =item parent => OBJECT =item tabstop => INTEGER Sets the default tab-stop width. =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Archive|User::Identity::Archive/"Attributes">. =over 4 =item $obj-EB( NAME, [CLASS] ) Returns the class which is capable of storing information which is grouped as NAME. With CLASS argument, you add (or overrule) the definitions of an abbreviation. The CLASS is automatically loaded. If CLASS is C, then the abbreviation is deleted. The class name which is deleted is returned. =item $obj-EB() Returns a sorted list of all names which are known as abbreviations. =item $obj-EB( [INTEGER] ) Returns the width of a tab, optionally after setting it. This must be the same as set in your editor. =item $obj-EB() Inherited, see L =item $obj-EB( [NEWNAME] ) Inherited, see L =back =head2 Collections Extends L<"Collections" in User::Identity::Archive|User::Identity::Archive/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item User::Identity::Archive::Plain-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the archive Extends L<"Access to the archive" in User::Identity::Archive|User::Identity::Archive/"Access to the archive">. =over 4 =item $obj-EB( , OPTIONS ) Read the plain text information from the specified FILEHANDLE, FILENAME, STRING, or ARRAY of lines. -Option --Default tabstop verbose 0 =over 2 =item tabstop => INTEGER =item verbose => INTEGER =back =back =head1 DETAILS =head2 The Plain Archiver Format =head3 Simplified class names It is too much work to specify full class named on each spot where you want to create a new object with data. Therefore, abbreviations are introduced. Use L or L to add extra abbreviations or to overrule some predefined. Predefined names: user User::Identity email Mail::Identity location User::Identity::Location system User::Identity::System list User::Identity::Collection::Emails It would have been nicer to refer to a I in stead of a I, however that would add to the confusion with the name-space. =head3 Indentation says all The syntax is as simple as possible. An extra indentation on a line means that the variable or class is a collection within the class on the line before. user markov location home country NL email home address mark@overmeer.net location home email work address solutions@overmeer.bet email tux address tux@fish.net The above defines two items: one L named C, and an e-mail address C. The user has two collections: one contains a single location, and one stores two e-mail addresses. To add to the confusion: the C is defined as field in C and as collection. The difference is easily detected: if there are indented fields following the line it is a collection. Mistakes will in most cases result in an error message. =head3 Long lines If you want to continue on the next line, because your content is too large, then add a backslash to the end, like this: email home description This is my home address, \ But I sometimes use this for \ work as well address tux@fish.aq Continuations do not play the game of indentation, so what you also can do is: email home description \ This is my home address, \ But I sometimes use this for \ work as well address tux@fish.aq The fields C and C
must be correctly indented. The line terminations are lost, which is useful for most fields. However, if you need them, you have to check the description of the applicable field. =head3 Comments You may add comments and white spaces. Comments start with a C<'#'> as first non-blank character on the line. Comments are B on the same line as real data, as some languages (like Perl) permit. You can insert comments and blank lines on all places where you need them: user markov # my home address email home # useless comment statement address tux@fish.aq location #mind_the_hash is equivalent to: user markov email home address tux@fish.aq location #mind_the_hash =head3 References Often you will have the need to add the same information to two items, for instance, multiple people share the same address. In this case, you can create a reference. However, this is only permitted for whole items: you can refer to someone's location, but not to the person's street. To create a reference to an item of someone else, use user markov location home = user(cleo).location(home) location work organization MARKOV Solutions =head3 Configuration parameters You can add some configuration lines as well. On the moment, the only one defined is tabstop = 4 which can be used to change the meaning of tabs in the file. The default setting is 8, but some people prefer 4 (or other values). =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Warning: Cannot read archive from $source =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/Identity/Collection.pod0000644000175000001440000002114612270434607022756 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity::Collection - base class for collecting roles of a user =head1 INHERITANCE User::Identity::Collection is a User::Identity::Item User::Identity::Collection is extended by User::Identity::Collection::Emails User::Identity::Collection::Locations User::Identity::Collection::Systems User::Identity::Collection::Users =head1 SYNOPSIS use User::Identity; use User::Identity::Collection; my $me = User::Identity->new(...); my $set = User::Identity::Collection::Emails->new(...); $me->addCollection($set); # Simpler use User::Identity; my $me = User::Identity->new(...); my $set = $me->addCollection(type => 'email', ...) my $set = $me->addCollection('email', ...) my @roles = $me->collection('email'); # list of collected items my $coll = $me->collection('email'); # a User::Identity::Collection my @roles = $coll->roles; my @roles = @$coll; # same, by overloading my $role = $me->collection('email')->find($coderef); my $role = $me->collection('location')->find('work'); my $role = $me->find(location => 'work'); =head1 DESCRIPTION The C object maintains a set user related objects. It helps selecting these objects, which is partially common to all collections (for instance, each object has a name so you can search on names), and sometimes specific to the extension of this collection. Currently imlemented extensions are =over 4 =item * I is a L =item * I are L =item * a I is a L =item * a I contains L =back Extends L<"DESCRIPTION" in User::Identity::Item|User::Identity::Item/"DESCRIPTION">. =head1 OVERLOADED =over 4 =item overload: B<@{}> When the reference to a collection object is used as array-reference, it will be shown as list of roles. example: my $locations = $ui->collection('location'); foreach my $loc (@$location) ... print $location->[0]; =item overload: B Returns the name of the collection and a sorted list of defined items. example: print "$collection\n"; # location: home, work =back =head1 METHODS Extends L<"METHODS" in User::Identity::Item|User::Identity::Item/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Item|User::Identity::Item/"Constructors">. =over 4 =item User::Identity::Collection-EB( [NAME], OPTIONS ) -Option --Defined in --Default description User::Identity::Item undef item_type name User::Identity::Item parent User::Identity::Item undef roles undef =over 2 =item description => STRING =item item_type => CLASS The CLASS which is used to store the information for each of the maintained objects within this collection. =item name => STRING =item parent => OBJECT =item roles => ROLE|ARRAY Immediately add some roles to this collection. In case of an ARRAY, each element of the array is passed separately to L. So, you may end-up with an ARRAY of arrays each grouping a set of options to create a role. =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Item|User::Identity::Item/"Attributes">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Returns the type of the items collected. =item $obj-EB( [NEWNAME] ) Inherited, see L =item $obj-EB() Returns all defined roles within this collection. Be warned: the rules are returned in random (hash) order. =back =head2 Collections Extends L<"Collections" in User::Identity::Item|User::Identity::Item/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item User::Identity::Collection-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Maintaining roles =over 4 =item $obj-EB(ROLE| ([NAME],OPTIONS) | ARRAY) Adds a new role to this collection. ROLE is an object of the right type (depends on the extension of this module which type that is) or a list of OPTIONS which are used to create such role. The options can also be passed as reference to an ARRAY. The added role is returned. example: my $uicl = User::Identity::Collection::Locations->new; my $uil = User::Identity::Location->new(home => ...); $uicl->addRole($uil); $uicl->addRole( home => address => 'street 32' ); $uicl->addRole( [home => address => 'street 32'] ); Easier $ui = User::Identity; $ui->add(location => 'home', address => 'street 32' ); $ui->add(location => [ 'home', address => 'street 32' ] ); =item $obj-EB(ROLE|NAME) The deleted role is returned (if it existed). =item $obj-EB( , NEWNAME ) Give the role a different name, and move it in the collection. =item $obj-EB() Returns the roles sorted by name, alphabetically and case-sensitive. =back =head2 Searching =over 4 =item $obj-EB(NAME|CODE|undef) Find the object with the specified NAME in this collection. With C, a randomly selected role is returned. When a code reference is specified, all collected roles are scanned one after the other (in unknown order). For each role, CODE->($object, $collection) is called. When the CODE returns true, the role is selected. In list context, all selected roles are returned. In scalar context, the first match is returned and the scan is aborted immediately. example: my $emails = $ui->collection('emails'); $emails->find('work'); sub find_work($$) { my ($mail, $emails) = @_; $mail->location->name eq 'work'; } my @at_work = $emails->find(\&find_work); my @at_work = $ui->find(location => \&find_work); my $any = $ui->find(location => undef ); =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot create a $type to add this to my collection. Some options are specified to create a $type object, which is native to this collection. However, for some reason this failed. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Cannot rename $name into $newname: already exists =item Error: Cannot rename $name into $newname: doesn't exist =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =item Error: Wrong type of role for $collection: requires a $expect but got a $type Each $collection groups sets of roles of one specific type ($expect). You cannot add objects of a different $type. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/Identity/System.pod0000644000175000001440000001314512270434607022147 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity::System - physical system of a person =head1 INHERITANCE User::Identity::System is a User::Identity::Item =head1 SYNOPSIS use User::Identity; use User::Identity::System; my $me = User::Identity->new(...); my $server = User::Identity::System->new(...); $me->add(system => $server); # Simpler use User::Identity; my $me = User::Identity->new(...); my $addr = $me->add(system => ...); =head1 DESCRIPTION The C object contains the description of the user's presence on a system. The systems are collected by an L object. Nearly all methods can return undef. Extends L<"DESCRIPTION" in User::Identity::Item|User::Identity::Item/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in User::Identity::Item|User::Identity::Item/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Item|User::Identity::Item/"Constructors">. =over 4 =item User::Identity::System-EB( [NAME], OPTIONS ) Create a new system. You can specify a name as first argument, or in the OPTION list. Without a specific name, the organization is used as name. -Option --Defined in --Default description User::Identity::Item undef hostname 'localhost' location undef name User::Identity::Item os undef parent User::Identity::Item undef password undef username undef =over 2 =item description => STRING =item hostname => DOMAIN The hostname of the described system. It is prefered to use full system names, not abbreviations. For instance, you can better use C than C to avoid confusion. =item location => NICKNAME|OBJECT The NICKNAME of a location which is defined for the same user. You can also specify a L OBJECT. =item name => STRING =item os => STRING The name of the operating system which is run on the server. It is adviced to use the names as used by Perl's C<$^O> variable. See the perlvar man-page for this variable, and perlport for the possible values. =item parent => OBJECT =item password => STRING The password to be used to login. This password must be un-encoded: directly usable. Be warned that storing un-encoded passwords is a high security list. =item username => STRING The username to be used to login to this host. =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Item|User::Identity::Item/"Attributes">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() =item $obj-EB() Returns the object which describes to which location this system relates. The location may be used to find the name of the organization involved, or to create a signature. If no location is specified, undef is returned. =item $obj-EB( [NEWNAME] ) Inherited, see L =item $obj-EB() =item $obj-EB() =item $obj-EB() =back =head2 Collections Extends L<"Collections" in User::Identity::Item|User::Identity::Item/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item User::Identity::System-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/Identity/Collection/0000755000175000001440000000000012270434610022240 5ustar00markovusers00000000000000User-Identity-0.94/lib/User/Identity/Collection/Systems.pod0000644000175000001440000001340612270434607024425 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity::Collection::Systems - a collection of system descriptions =head1 INHERITANCE User::Identity::Collection::Systems is a User::Identity::Collection is a User::Identity::Item =head1 SYNOPSIS =head1 DESCRIPTION The L object maintains a set L objects, each describing a login for the user on some system. Extends L<"DESCRIPTION" in User::Identity::Collection|User::Identity::Collection/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in User::Identity::Collection|User::Identity::Collection/"OVERLOADED">. =over 4 =item overload: B<@{}> Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in User::Identity::Collection|User::Identity::Collection/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Collection|User::Identity::Collection/"Constructors">. =over 4 =item User::Identity::Collection::Systems-EB( [NAME], OPTIONS ) -Option --Defined in --Default description User::Identity::Item undef item_type User::Identity::Collection User::Identity::System name User::Identity::Item 'systems' parent User::Identity::Item undef roles User::Identity::Collection undef =over 2 =item description => STRING =item item_type => CLASS =item name => STRING =item parent => OBJECT =item roles => ROLE|ARRAY =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Collection|User::Identity::Collection/"Attributes">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [NEWNAME] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Collections Extends L<"Collections" in User::Identity::Collection|User::Identity::Collection/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item User::Identity::Collection::Systems-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Maintaining roles Extends L<"Maintaining roles" in User::Identity::Collection|User::Identity::Collection/"Maintaining roles">. =over 4 =item $obj-EB(ROLE| ([NAME],OPTIONS) | ARRAY) Inherited, see L =item $obj-EB(ROLE|NAME) Inherited, see L =item $obj-EB( , NEWNAME ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Searching Extends L<"Searching" in User::Identity::Collection|User::Identity::Collection/"Searching">. =over 4 =item $obj-EB(NAME|CODE|undef) Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot create a $type to add this to my collection. Some options are specified to create a $type object, which is native to this collection. However, for some reason this failed. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Cannot rename $name into $newname: already exists =item Error: Cannot rename $name into $newname: doesn't exist =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =item Error: Wrong type of role for $collection: requires a $expect but got a $type Each $collection groups sets of roles of one specific type ($expect). You cannot add objects of a different $type. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/Identity/Collection/Emails.pod0000644000175000001440000001330412270434607024165 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity::Collection::Emails - a collection of email roles =head1 INHERITANCE User::Identity::Collection::Emails is a User::Identity::Collection is a User::Identity::Item =head1 SYNOPSIS =head1 DESCRIPTION The C object maintains a set L objects, each describing a role which the user has in e-mail traffic. Extends L<"DESCRIPTION" in User::Identity::Collection|User::Identity::Collection/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in User::Identity::Collection|User::Identity::Collection/"OVERLOADED">. =over 4 =item overload: B<@{}> Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in User::Identity::Collection|User::Identity::Collection/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Collection|User::Identity::Collection/"Constructors">. =over 4 =item User::Identity::Collection::Emails-EB( [NAME], OPTIONS ) -Option --Defined in --Default description User::Identity::Item undef item_type User::Identity::Collection Mail::Identity name User::Identity::Item 'emails' parent User::Identity::Item undef roles User::Identity::Collection undef =over 2 =item description => STRING =item item_type => CLASS =item name => STRING =item parent => OBJECT =item roles => ROLE|ARRAY =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Collection|User::Identity::Collection/"Attributes">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [NEWNAME] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Collections Extends L<"Collections" in User::Identity::Collection|User::Identity::Collection/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item User::Identity::Collection::Emails-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Maintaining roles Extends L<"Maintaining roles" in User::Identity::Collection|User::Identity::Collection/"Maintaining roles">. =over 4 =item $obj-EB(ROLE| ([NAME],OPTIONS) | ARRAY) Inherited, see L =item $obj-EB(ROLE|NAME) Inherited, see L =item $obj-EB( , NEWNAME ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Searching Extends L<"Searching" in User::Identity::Collection|User::Identity::Collection/"Searching">. =over 4 =item $obj-EB(NAME|CODE|undef) Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot create a $type to add this to my collection. Some options are specified to create a $type object, which is native to this collection. However, for some reason this failed. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Cannot rename $name into $newname: already exists =item Error: Cannot rename $name into $newname: doesn't exist =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =item Error: Wrong type of role for $collection: requires a $expect but got a $type Each $collection groups sets of roles of one specific type ($expect). You cannot add objects of a different $type. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/Identity/Collection/Emails.pm0000644000175000001440000000112412270434607024014 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity::Collection::Emails; our $VERSION = '0.94'; use base 'User::Identity::Collection'; use strict; use warnings; use Mail::Identity; sub new(@) { my $class = shift; $class->SUPER::new(name => 'emails', @_); } sub init($) { my ($self, $args) = @_; $args->{item_type} ||= 'Mail::Identity'; $self->SUPER::init($args); } sub type() { 'mailgroup' } 1; User-Identity-0.94/lib/User/Identity/Collection/Users.pod0000644000175000001440000001326612270434607024063 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity::Collection::Users - a collection of users =head1 INHERITANCE User::Identity::Collection::Users is a User::Identity::Collection is a User::Identity::Item =head1 SYNOPSIS =head1 DESCRIPTION The L object maintains a set L objects, each describing a user. Extends L<"DESCRIPTION" in User::Identity::Collection|User::Identity::Collection/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in User::Identity::Collection|User::Identity::Collection/"OVERLOADED">. =over 4 =item overload: B<@{}> Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in User::Identity::Collection|User::Identity::Collection/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Collection|User::Identity::Collection/"Constructors">. =over 4 =item User::Identity::Collection::Users-EB( [NAME], OPTIONS ) -Option --Defined in --Default description User::Identity::Item undef item_type User::Identity::Collection User::Identity name User::Identity::Item 'people' parent User::Identity::Item undef roles User::Identity::Collection undef =over 2 =item description => STRING =item item_type => CLASS =item name => STRING =item parent => OBJECT =item roles => ROLE|ARRAY =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Collection|User::Identity::Collection/"Attributes">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [NEWNAME] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Collections Extends L<"Collections" in User::Identity::Collection|User::Identity::Collection/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item User::Identity::Collection::Users-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Maintaining roles Extends L<"Maintaining roles" in User::Identity::Collection|User::Identity::Collection/"Maintaining roles">. =over 4 =item $obj-EB(ROLE| ([NAME],OPTIONS) | ARRAY) Inherited, see L =item $obj-EB(ROLE|NAME) Inherited, see L =item $obj-EB( , NEWNAME ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Searching Extends L<"Searching" in User::Identity::Collection|User::Identity::Collection/"Searching">. =over 4 =item $obj-EB(NAME|CODE|undef) Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot create a $type to add this to my collection. Some options are specified to create a $type object, which is native to this collection. However, for some reason this failed. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Cannot rename $name into $newname: already exists =item Error: Cannot rename $name into $newname: doesn't exist =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =item Error: Wrong type of role for $collection: requires a $expect but got a $type Each $collection groups sets of roles of one specific type ($expect). You cannot add objects of a different $type. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/Identity/Collection/Locations.pod0000644000175000001440000001333112270434607024706 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity::Collection::Locations - a collection of locations =head1 INHERITANCE User::Identity::Collection::Locations is a User::Identity::Collection is a User::Identity::Item =head1 SYNOPSIS =head1 DESCRIPTION The C object maintains a set L objects, each describing a physical location. Extends L<"DESCRIPTION" in User::Identity::Collection|User::Identity::Collection/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in User::Identity::Collection|User::Identity::Collection/"OVERLOADED">. =over 4 =item overload: B<@{}> Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in User::Identity::Collection|User::Identity::Collection/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Collection|User::Identity::Collection/"Constructors">. =over 4 =item User::Identity::Collection::Locations-EB( [NAME], OPTIONS ) -Option --Defined in --Default description User::Identity::Item undef item_type User::Identity::Collection User::Identity::Location name User::Identity::Item 'locations' parent User::Identity::Item undef roles User::Identity::Collection undef =over 2 =item description => STRING =item item_type => CLASS =item name => STRING =item parent => OBJECT =item roles => ROLE|ARRAY =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Collection|User::Identity::Collection/"Attributes">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [NEWNAME] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Collections Extends L<"Collections" in User::Identity::Collection|User::Identity::Collection/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item User::Identity::Collection::Locations-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Maintaining roles Extends L<"Maintaining roles" in User::Identity::Collection|User::Identity::Collection/"Maintaining roles">. =over 4 =item $obj-EB(ROLE| ([NAME],OPTIONS) | ARRAY) Inherited, see L =item $obj-EB(ROLE|NAME) Inherited, see L =item $obj-EB( , NEWNAME ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Searching Extends L<"Searching" in User::Identity::Collection|User::Identity::Collection/"Searching">. =over 4 =item $obj-EB(NAME|CODE|undef) Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot create a $type to add this to my collection. Some options are specified to create a $type object, which is native to this collection. However, for some reason this failed. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Cannot rename $name into $newname: already exists =item Error: Cannot rename $name into $newname: doesn't exist =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =item Error: Wrong type of role for $collection: requires a $expect but got a $type Each $collection groups sets of roles of one specific type ($expect). You cannot add objects of a different $type. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/Identity/Collection/Users.pm0000644000175000001440000000112512270434607023704 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity::Collection::Users; our $VERSION = '0.94'; use base 'User::Identity::Collection'; use strict; use warnings; use User::Identity; sub new(@) { my $class = shift; $class->SUPER::new(systems => @_); } sub init($) { my ($self, $args) = @_; $args->{item_type} ||= 'User::Identity'; $self->SUPER::init($args); $self; } sub type() { 'people' } 1; User-Identity-0.94/lib/User/Identity/Collection/Locations.pm0000644000175000001440000000121112270434607024532 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity::Collection::Locations; our $VERSION = '0.94'; use base 'User::Identity::Collection'; use strict; use warnings; use User::Identity::Location; use Carp qw/croak/; sub new(@) { my $class = shift; $class->SUPER::new(locations => @_); } sub init($) { my ($self, $args) = @_; $args->{item_type} ||= 'User::Identity::Location'; $self->SUPER::init($args); $self; } sub type() { 'whereabouts' } 1; User-Identity-0.94/lib/User/Identity/Collection/Systems.pm0000644000175000001440000000115012270434607024250 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity::Collection::Systems; our $VERSION = '0.94'; use base 'User::Identity::Collection'; use strict; use warnings; use User::Identity::System; sub new(@) { my $class = shift; $class->SUPER::new(systems => @_); } sub init($) { my ($self, $args) = @_; $args->{item_type} ||= 'User::Identity::System'; $self->SUPER::init($args); $self; } sub type() { 'network' } 1; User-Identity-0.94/lib/User/Identity/Item.pod0000644000175000001440000001611212270434607021556 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity::Item - general base class for User::Identity =head1 INHERITANCE User::Identity::Item is extended by Mail::Identity User::Identity User::Identity::Archive User::Identity::Collection User::Identity::Location User::Identity::System =head1 SYNOPSIS =head1 DESCRIPTION The C base class is extended into useful modules: it has no use by its own. =head1 METHODS =head2 Constructors =over 4 =item User::Identity::Item-EB( [NAME], OPTIONS ) -Option --Default description undef name parent undef =over 2 =item description => STRING Free format description on the collected item. =item name => STRING A simple name for this item. Try to give a useful name in the context of the item time. Each time when you lookup items, you need to specify this name, so it should be unique and not to hard to handle in your program. For instance, when a person is addressed, you usually will give him/her this a nickname. =item parent => OBJECT The encapsulating object: the object which collects this one. =back =back =head2 Attributes =over 4 =item $obj-EB() Free format description on this item. Please do not add any significance to the content of this field: if you are in need for an extra attribute, please contact the author of the module to implement it, or extend the object to suit your needs. =item $obj-EB( [NEWNAME] ) The name of this item. Names are unique within a collection... a second object with the same name within any collection will destroy the already existing object with that name. Changing the name of an item is quite dangerous. You probably want to call L instead. =back =head2 Collections =over 4 =item $obj-EB(COLLECTION, ROLE) The ROLE is added to the COLLECTION. The COLLECTION is the name of a collection, which will be created automatically with L if needed. The COLLECTION can also be specified as existing collection object. The ROLE is anything what is acceptable to L of the collection at hand, and is returned. ROLE typically is a list of parameters for one role, or a reference to an array containing these values. example: my $ui = User::Identity->new(...); my $home = $ui->add(location => [home => street => '27 Roadstreet', ...] ); my $work = $ui->add(location => work, tel => '+31-2231-342-13', ... ); my $travel = User::Identity::Location->new(travel => ...); $ui->add(location => $travel); my $system = User::Identity::Collection::System->new(...); $ui->add($system => 'localhost'); =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Add a new collection of roles to an item. This can be achieved in two ways: either create an L OBJECT yourself and then pass that to this method, or supply all the OPTIONS needed to create such an object and it will be created for you. The object which is added is returned, and can be used for many methods directly. For OPTIONS, see the specific type of collection. Additional options are listed below. -Option--Default type =over 2 =item type => STRING|CLASS The nickname of a collection class or the CLASS name itself of the object to be created. Required if an object has to be created. Predefined type nicknames are C, C, and C. =back example: my $me = User::Identity->new(...); my $locs = User::Identity::Collection::Locations->new(); $me->addCollection($locs); my $email = $me->addCollection(type => 'email'); my $email = $me->addCollection('email'); =item $obj-EB(NAME) In scalar context the collection object with the NAME is returned. In list context, all the roles within the collection are returned. example: my @roles = $me->collection('email'); # list of collected items my @roles = $me->collection('email')->roles; # same of collected items my $coll = $me->collection('email'); # a User::Identity::Collection =item $obj-EB(COLLECTION, ROLE) Returns the object with the specified ROLE within the named collection. The collection can be specified as name or object. example: my $role = $me->find(location => 'work'); # one location my $role = $me->collection('location')->find('work'); # same my $email = $me->addCollection('email'); $me->find($email => 'work'); $email->find('work'); # same =item $obj-EB( [PARENT] ) Returns the parent of an Item (the enclosing item). This may return C if the object is stand-alone. =item $obj-EB(OBJECT|NAME) =item $obj-EB() =item User::Identity::Item-EB() Returns a nice symbolic name for the type. =item $obj-EB() Go from this object to its parent, to its parent, and so on, until a L is found or the top of the object tree has been reached. example: print $email->user->fullName; =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Error: Each item requires a name You have to specify a name for each item. These names need to be unique within one collection, but feel free to give the same name to an e-mail address and a location. =item Warning: No collection $name The collection with $name does not exist and can not be created. =item Warning: Unknown option $name for a $class One used option is not defined. Check the manual page of the class to see which options are accepted. =item Warning: Unknown options @names for a $class More than one option is not defined. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/Identity/Archive.pm0000644000175000001440000000110312270434607022065 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity::Archive; our $VERSION = '0.94'; use base 'User::Identity::Item'; use strict; use warnings; sub type { "archive" } sub init($) { my ($self, $args) = @_; $self->SUPER::init($args) or return; if(my $from = delete $args->{from}) { $self->from($from) or return; } $self; } #----------------------------------------- 1; User-Identity-0.94/lib/User/Identity/Collection.pm0000644000175000001440000000560212270434607022607 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity::Collection; our $VERSION = '0.94'; use base 'User::Identity::Item'; use strict; use warnings; use User::Identity; use Carp; use List::Util qw/first/; use overload '""' => sub { my $self = shift; $self->name . ": " . join(", ", sort map {$_->name} $self->roles); }; use overload '@{}' => sub { [ shift->roles ] }; #----------------------------------------- sub type { "people" } sub init($) { my ($self, $args) = @_; defined($self->SUPER::init($args)) or return; $self->{UIC_itype} = delete $args->{item_type} or die; $self->{UIC_roles} = { }; my $roles = $args->{roles}; my @roles = ! defined $roles ? () : ref $roles eq 'ARRAY' ? @$roles : $roles; $self->addRole($_) foreach @roles; $self; } #----------------------------------------- sub roles() { values %{shift->{UIC_roles}} } sub itemType { shift->{UIC_itype} } #----------------------------------------- sub addRole(@) { my $self = shift; my $maintains = $self->itemType; my $role; if(ref $_[0] && ref $_[0] ne 'ARRAY') { $role = shift; croak "ERROR: Wrong type of role for ".ref($self) . ": requires a $maintains but got a ". ref($role) unless $role->isa($maintains); } else { $role = $maintains->new(ref $_[0] ? @{$_[0]} : @_); croak "ERROR: Cannot create a $maintains to add this to my collection." unless defined $role; } $role->parent($self); $self->{UIC_roles}{$role->name} = $role; $role; } sub removeRole($) { my ($self, $which) = @_; my $name = ref $which ? $which->name : $which; my $role = delete $self->{UIC_roles}{$name} or return (); $role->parent(undef); $role; } sub renameRole($$$) { my ($self, $which, $newname) = @_; my $name = ref $which ? $which->name : $which; if(exists $self->{UIC_roles}{$newname}) { $self->log(ERROR=>"Cannot rename $name into $newname: already exists"); return (); } my $role = delete $self->{UIC_roles}{$name}; unless(defined $role) { $self->log(ERROR => "Cannot rename $name into $newname: doesn't exist"); return (); } $role->name($newname); # may imply change other attributes. $self->{UIC_roles}{$newname} = $role; } sub sorted() { sort {$a->name cmp $b->name} shift->roles} #----------------------------------------- sub find($) { my ($self, $select) = @_; !defined $select ? ($self->roles)[0] : !ref $select ? $self->{UIC_roles}{$select} : wantarray ? grep ({ $select->($_, $self) } $self->roles) : first { $select->($_, $self) } $self->roles; } 1; User-Identity-0.94/lib/User/Identity/System.pm0000644000175000001440000000204512270434607021776 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity::System; our $VERSION = '0.94'; use base 'User::Identity::Item'; use strict; use warnings; use User::Identity; use Scalar::Util 'weaken'; sub type { "network" } sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); exists $args->{$_} && ($self->{'UIS_'.$_} = delete $args->{$_}) foreach qw/hostname location os password username/; $self->{UIS_hostname} ||= 'localhost'; $self; } sub hostname() { shift->{UIS_hostname} } sub username() { shift->{UIS_username} } sub os() { shift->{UIS_os} } sub password() { shift->{UIS_password} } sub location() { my $self = shift; my $location = $self->{MI_location} or return; unless(ref $location) { my $user = $self->user or return; $location = $user->find(location => $location); } $location; } 1; User-Identity-0.94/lib/User/Identity/Location.pod0000644000175000001440000001612512270434607022434 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity::Location - physical location of a person =head1 INHERITANCE User::Identity::Location is a User::Identity::Item =head1 SYNOPSIS use User::Identity; use User::Identity::Location; my $me = User::Identity->new(...); my $addr = User::Identity::Location->new(...); $me->add(location => $addr); # Simpler use User::Identity; my $me = User::Identity->new(...); my $addr = $me->add(location => ...); =head1 DESCRIPTION The C object contains the description of a physical location of a person: home, work, travel. The locations are collected by a L object. Nearly all methods can return C. Some methods produce language or country specific output. Extends L<"DESCRIPTION" in User::Identity::Item|User::Identity::Item/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in User::Identity::Item|User::Identity::Item/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Item|User::Identity::Item/"Constructors">. =over 4 =item User::Identity::Location-EB( [NAME], OPTIONS ) Create a new location. You can specify a name as first argument, or in the OPTION list. Without a specific name, the organization is used as name. -Option --Defined in --Default country undef country_code undef description User::Identity::Item undef fax undef name User::Identity::Item organization undef parent User::Identity::Item undef pc undef phone undef pobox undef pobox_pc undef postal_code state undef street undef =over 2 =item country => STRING =item country_code => STRING =item description => STRING =item fax => STRING|ARRAY =item name => STRING =item organization => STRING =item parent => OBJECT =item pc => STRING Short name for C. =item phone => STRING|ARRAY =item pobox => STRING =item pobox_pc => STRING =item postal_code => STRING =item state => STRING =item street => STRING =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Item|User::Identity::Item/"Attributes">. =over 4 =item $obj-EB() The city where the address is located. =item $obj-EB() The country where the address is located. If the name of the country is not known but a country code is defined, the name will be looked-up using Geography::Countries (if installed). =item $obj-EB() Each country has an ISO standard abbreviation. Specify the country or the country code, and the other will be filled in automatically. =item $obj-EB() Inherited, see L =item $obj-EB() One or more fax numbers, like L. =item $obj-EB() Create an address to put on a postal mailing, in the format as normal in the country where it must go to. To be able to achieve that, the country code must be known. If the city is not specified or no street or pobox is given, undef will be returned: an incomplete address. example: print $uil->fullAddress; print $user->find(location => 'home')->fullAddress; =item $obj-EB( [NEWNAME] ) Inherited, see L =item $obj-EB() The organization (for instance company) which is related to this location. =item $obj-EB() One or more phone numbers. Please use the internation notation, which starts with C<'+'>, for instance C<+31-26-12131>. In scalar context, only the first number is produced. In list context, all numbers are presented. =item $obj-EB() Post Office mail box specification. Use C<"P.O.Box 314">, not simple C<314>. =item $obj-EB() The postal code related to the Post-Office mail box. Defined by new() option C. =item $obj-EB() The postal code is very country dependent. Also, the location of the code within the formatted string is country dependent. =item $obj-EB() The state, which is important for some contries but certainly not for the smaller ones. Only set this value when you state has to appear on printed addresses. =item $obj-EB() Returns the address of this location. Since Perl 5.7.3, you can use unicode in strings, so why not format the address nicely? =back =head2 Collections Extends L<"Collections" in User::Identity::Item|User::Identity::Item/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item User::Identity::Location-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/lib/User/Identity/Item.pm0000644000175000001440000000766012270434607021420 0ustar00markovusers00000000000000# Copyrights 2003-2014 by [Mark Overmeer ]. # For other contributors see Changes. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. package User::Identity::Item; our $VERSION = '0.94'; 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; User-Identity-0.94/lib/User/Identity/Archive.pod0000644000175000001440000001074412270434607022246 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME User::Identity::Archive - base class for archiving user information =head1 INHERITANCE User::Identity::Archive is a User::Identity::Item User::Identity::Archive is extended by User::Identity::Archive::Plain =head1 SYNOPSIS use User::Identity::Archive::Plain; my $friends = User::Identity::Archive::Plain->new('friends'); $friends->from(\*FH); $friends->from('.friends'); =head1 DESCRIPTION An archive stores collections. It depends on the type of archive how and where that is done. Some archivers may limit the kinds of selections which can be stored. Extends L<"DESCRIPTION" in User::Identity::Item|User::Identity::Item/"DESCRIPTION">. =head1 OVERLOADED =head1 METHODS Extends L<"METHODS" in User::Identity::Item|User::Identity::Item/"METHODS">. =head2 Constructors Extends L<"Constructors" in User::Identity::Item|User::Identity::Item/"Constructors">. =over 4 =item User::Identity::Archive-EB( [NAME], OPTIONS ) -Option --Defined in --Default description User::Identity::Item undef from undef name User::Identity::Item parent User::Identity::Item undef =over 2 =item description => STRING =item from => FILEHANDLE|FILENAME =item name => STRING =item parent => OBJECT =back =back =head2 Attributes Extends L<"Attributes" in User::Identity::Item|User::Identity::Item/"Attributes">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB( [NEWNAME] ) Inherited, see L =back =head2 Collections Extends L<"Collections" in User::Identity::Item|User::Identity::Item/"Collections">. =over 4 =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB(OBJECT | ([TYPE], OPTIONS)) Inherited, see L =item $obj-EB(NAME) Inherited, see L =item $obj-EB(COLLECTION, ROLE) Inherited, see L =item $obj-EB( [PARENT] ) Inherited, see L =item $obj-EB(OBJECT|NAME) Inherited, see L =item $obj-EB() =item User::Identity::Archive-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the archive =over 4 =item $obj-EB(SOURCE, OPTIONS) Read definitions from the specified SOURCE, which usually can be a filehandle or filename. The syntax used in the information SOURCE is archiver dependent. Not all archivers implement C, so you may want to check with C beforehand. example: use User::Identity::Archive::Some; my $a = User::Identity::Archive::Some->new('xyz'); $a->from(\*STDIN) if $a->can('from'); =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =back =head1 SEE ALSO This module is part of User-Identity distribution version 0.94, built on January 24, 2014. Website: F =head1 LICENSE Copyrights 2003-2014 by [Mark Overmeer ]. For other contributors see Changes. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F User-Identity-0.94/MANIFEST0000644000175000001440000000177512270434610016033 0ustar00markovusers00000000000000Changes MANIFEST Makefile.PL README lib/Mail/Identity.pm lib/Mail/Identity.pod lib/User/Identity.pm lib/User/Identity.pod lib/User/Identity/Archive.pm lib/User/Identity/Archive.pod lib/User/Identity/Archive/Plain.pm lib/User/Identity/Archive/Plain.pod lib/User/Identity/Collection.pm lib/User/Identity/Collection.pod lib/User/Identity/Collection/Emails.pm lib/User/Identity/Collection/Emails.pod lib/User/Identity/Collection/Locations.pm lib/User/Identity/Collection/Locations.pod lib/User/Identity/Collection/Systems.pm lib/User/Identity/Collection/Systems.pod lib/User/Identity/Collection/Users.pm lib/User/Identity/Collection/Users.pod lib/User/Identity/Item.pm lib/User/Identity/Item.pod lib/User/Identity/Location.pm lib/User/Identity/Location.pod lib/User/Identity/System.pm lib/User/Identity/System.pod t/10userid.t t/20loc.t t/30col.t t/99pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) User-Identity-0.94/t/0000755000175000001440000000000012270434610015133 5ustar00markovusers00000000000000User-Identity-0.94/t/20loc.t0000644000175000001440000000414012270434554016245 0ustar00markovusers00000000000000use warnings; use strict; # Test User::Identity::Location use Test::More tests => 30; BEGIN { use_ok('User::Identity::Location') }; my $ui = 'User::Identity'; my $uil = 'User::Identity::Location'; # # We need a user to test with # my $a = $ui->new('markov' , firstname => 'Mark', surname => 'Overmeer' , titles => 'drs.', initials => 'M.A.C.J.' , language => 'nl-NL', charset => 'iso-8859-15' , gender => 'male', birth => 'April 5, 1966' ); ok(defined $a, "Create a"); # # Now an location # my $b = $uil->new ( 'home' , street => 'Pad 12' , postal_code => '66341 XA' , city => 'Arnhem' , country => 'Nederland' , country_code => 'nl' , phone => '+18-12-2344556' , fax => '+11-11-2344556' ); ok(defined $b); isa_ok($b, $uil, "Create b"); is($b->street, 'Pad 12'); is($b->postalCode, '66341 XA'); is($b->city, 'Arnhem'); is($b->country, 'Nederland'); is($b->countryCode, 'nl'); is($b->phone, '+18-12-2344556'); is($b->fax, '+11-11-2344556'); ok(defined $b->parent($a), "Add location to user"); isa_ok($b->parent, $ui); is($b->user->firstname, 'Mark'); is($b->fullAddress, <<'NL'); Pad 12 6341 XA Arnhem Nederland NL # # more complex situations # my $c = $uil->new ( 'work' , organization => 'MARKOV Solutions' , pobox => 'Postbus 12' , pobox_pc => '3412YY' , city => 'XYZ' , country_code => 'nl' , phone => [ '1', '2' ] , fax => [ '3', '4', '5', '6' ] ); ok(defined $c, "Created c"); is($c->countryCode, 'nl'); is($c->organization, 'MARKOV Solutions'); is($c->pobox, 'Postbus 12'); is($c->poboxPostalCode, '3412YY'); is($c->city, 'XYZ'); is(scalar $c->phone, '1'); my @ct = $c->phone; cmp_ok(scalar @ct, '==', 2); is($ct[0], '1'); is($ct[1], '2'); is(scalar $c->fax, '3'); my @cf = $c->fax; cmp_ok(scalar @cf, '==', 4); is($cf[0], '3'); is($cf[3], '6'); eval 'require Geography::Countries'; my $country = $@ ? 'NL' : 'Netherlands'; is($c->fullAddress, < "Test::Pod 1.00 required for testing POD" if $@; plan skip_all => "devel home uses OODoc" if $ENV{MARKOV_DEVEL}; } all_pod_files_ok(); User-Identity-0.94/t/10userid.t0000644000175000001440000000535412270434554016772 0ustar00markovusers00000000000000use warnings; use strict; use Test::More tests => 40; BEGIN { use_ok('User::Identity') }; my $ui = 'User::Identity'; # # Empty user # my $a = $ui->new(); ok(! defined $a, "No empty users"); # # Test names # my $b = $ui->new('mark'); ok(defined $b, "Create b"); isa_ok($b, $ui); is($b->name, 'mark', "Check b nick"); is($b->fullName, 'Mark', "Check b fullname"); my $c = $ui->new(name => 'mark'); ok(defined $c, "Create c"); isa_ok($c, $ui); is($c->nickname, 'mark', "Check c nick"); is($c->fullName, 'Mark', "Check c fullname"); ok(!defined $c->gender); ok(!$c->isMale); ok(!$c->isFemale); my $d = $ui->new('mark', firstname => 'Mark', surname => 'Overmeer', gender => 'male'); ok(defined $d, "Create d"); is($d->gender, 'male', "Check d gender"); ok($d->isMale); ok(!$d->isFemale); is($d->nickname, 'mark', "Check d nick"); is($d->firstname, 'Mark', "Check d first"); is($d->fullName, 'Mark Overmeer', "Check d full"); is($d->formalName, 'Mr. M. Overmeer', "Check d formal"); is($d->initials, 'M.', "Check d initials"); my $e = $ui->new('markov' , firstname => 'Mark', surname => 'Overmeer' , titles => 'drs.', initials => 'M.A.C.J.' , language => 'nl-NL', charset => 'iso-8859-15' , gender => 'male', birth => 'April 5, 1966' ); ok(defined $e, "Create e"); is($e->nickname, 'markov', "Check e nick"); is($e->firstname, 'Mark', "Check e first"); is($e->initials, 'M.A.C.J.', "Check e initials"); is($e->charset, 'iso-8859-15', "Check e charset"); is($e->fullName, 'Mark Overmeer', "Check e full"); is($e->formalName, 'De heer M.A.C.J. Overmeer drs.', "Check e fullname"); is($e->dateOfBirth, 'April 5, 1966', "check e birthday"); eval "require Date::Parse"; if($@) {ok(1);ok(1)} else { is($e->birth, "19660405", "check e birth"); cmp_ok($e->age, '>=', 36, "check e age"); } my $f = $ui->new('am' , firstname => 'Anne-Marie Christina Theodora Pluk' , prefix => 'van', surname => 'Voorst tot Voorst' , gender => 'vrouw' ); ok(defined $e, "Create e"); is($f->initials, 'A-M.Chr.Th.P.'); is($f->gender, 'vrouw', "Check gender"); is($f->prefix, 'van', "Check prefix"); is($f->surname, 'Voorst tot Voorst', "Check surname"); ok($f->isFemale); ok(!$f->isMale); is($f->formalName, "Madam A-M.Chr.Th.P. van Voorst tot Voorst"); User-Identity-0.94/t/30col.t0000644000175000001440000001010612270434554016245 0ustar00markovusers00000000000000#!/usr/bin/perl use warnings; use strict; # Test User::Identity::Collection use lib qw/. ../; use Test::More tests => 44; BEGIN { use_ok('User::Identity::Collection::Locations'); use_ok('User::Identity'); } my $ui = 'User::Identity'; my $uil = 'User::Identity::Location'; my $uic = 'User::Identity::Collection'; my $uicl = 'User::Identity::Collection::Locations'; sub same_obj($$$) { my ($l, $r, $msg) = @_; is("$l", "$r", $msg); } # # We need a user to test with # my $user = $ui->new('markov' , firstname => 'Mark', surname => 'Overmeer' , titles => 'drs.', initials => 'M.A.C.J.' , language => 'nl-NL', charset => 'iso-8859-15' ); ok(defined $user, "Created a user"); # # Now an location # my $loc = $uil->new ( 'home' , street => 'Pad 12' , postal_code => '66341 XA' , city => 'Arnhem' , country => 'Nederland' , country_code => 'nl' , phone => '+18-12-2344556' , fax => '+11-11-2344556' ); ok(defined $loc, "Created a location"); ok(!defined $loc->user, "User-less location"); # # Now a location collection # my $col = $uicl->new; ok(defined $col, "Created a location collection"); isa_ok($col, $uic, "Is a collection"); isa_ok($col, $uicl, "Correct collection"); cmp_ok($col->roles, '==', 0, "No roles yet"); cmp_ok(scalar @$col, '==', 0, "No overloaded roles yet"); ok(! defined $loc->parent, "Role has no parent yet"); same_obj($loc, $col->addRole($loc), "Add prepared role"); cmp_ok($col->roles, '==', 1, "First role in collection"); same_obj($loc->parent, $col, "Role's parent is collection"); cmp_ok(scalar @$col, '==', 1, "One overloaded role"); same_obj($col->[0], $loc, "The role is there"); is("$col", "locations: home"); ok(!defined $loc->user, "User-less location"); same_obj($user->addCollection($col), $col, "Adding collection to a user"); same_obj($col->user, $user, "User of collection"); same_obj($col->[0]->user, $user, "User of collection item"); # # find collection in ui # my $l = $user->collection('locations'); ok(defined $l, "Find locations"); isa_ok($l, $uicl); my $l2 = $user->collection('location'); ok(defined $l, "Find location"); same_obj($l, $l2, "location==locations"); my $e = $user->collection('email'); ok(! defined $e, "Not available email"); # # Fast forward location # my $w = $user->add(location => [ work => street => 'at home' ]); ok(defined $w, "Work location created"); isa_ok($w, $uil); same_obj($w->user, $user, "Knows about user"); cmp_ok(scalar $col->roles, '==', 2, "Found pre-defined collection"); cmp_ok(@$col, '==', 2, "Visible in overload as well"); is("$col", "locations: home, work", "Stringification"); # # Find # my $f = $user->find(location => 'work'); ok(defined $f, "Found anything"); same_obj($w, $f, "Found work back"); $f = $user->find(location => 'unknown'); ok(! defined $f, "Unknown role"); $f = $user->find(unknown => 'work'); ok(! defined $f, "Unknown collection"); # # Add a whole new group at once # ok(! $user->find(email => 'private')); $w = $user->add(email => [ private => address => 'markov@cpan.org' ]); ok(defined $w, "Private email created"); $col = $user->collection('email'); ok(defined $col, "Email collection created"); isa_ok($col, $uic); isa_ok($col, "${uic}::Emails"); $f = $user->find(email => 'private'); ok(defined $f, "Found anything"); isa_ok($f, "${ui}::Item"); isa_ok($f, "Mail::Identity"); User-Identity-0.94/META.json0000644000175000001440000000156112270434610016314 0ustar00markovusers00000000000000{ "abstract" : "Collect information about a user", "author" : [ "Mark Overmeer " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120630", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "User-Identity", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Test::Pod" : "1" } } }, "release_status" : "stable", "version" : "0.94" }