r851 - in packages: . libuser-identity-perl
libuser-identity-perl/branches
libuser-identity-perl/branches/upstream
libuser-identity-perl/branches/upstream/current
libuser-identity-perl/branches/upstream/current/lib
libuser-identity-perl/branches/upstream/current/lib/Mail
libuser-identity-perl/branches/upstream/current/lib/User
libuser-identity-perl/branches/upstream/current/lib/User/Identity
libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive
libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection
libuser-identity-perl/branches/upstream/current/t
Gunnar Wolf
gwolf at costa.debian.org
Sun Jul 17 08:09:00 UTC 2005
Author: gwolf
Date: 2005-03-30 19:33:08 +0000 (Wed, 30 Mar 2005)
New Revision: 851
Added:
packages/libuser-identity-perl/
packages/libuser-identity-perl/branches/
packages/libuser-identity-perl/branches/upstream/
packages/libuser-identity-perl/branches/upstream/current/
packages/libuser-identity-perl/branches/upstream/current/Changes
packages/libuser-identity-perl/branches/upstream/current/MANIFEST
packages/libuser-identity-perl/branches/upstream/current/META.yml
packages/libuser-identity-perl/branches/upstream/current/Makefile.PL
packages/libuser-identity-perl/branches/upstream/current/README
packages/libuser-identity-perl/branches/upstream/current/lib/
packages/libuser-identity-perl/branches/upstream/current/lib/Mail/
packages/libuser-identity-perl/branches/upstream/current/lib/Mail/Identity.pm
packages/libuser-identity-perl/branches/upstream/current/lib/Mail/Identity.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive/
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive/Plain.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive/Plain.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Emails.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Emails.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Locations.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Locations.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Systems.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Systems.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Users.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Users.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Item.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Item.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Location.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Location.pod
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/System.pm
packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/System.pod
packages/libuser-identity-perl/branches/upstream/current/t/
packages/libuser-identity-perl/branches/upstream/current/t/10userid.t
packages/libuser-identity-perl/branches/upstream/current/t/20loc.t
packages/libuser-identity-perl/branches/upstream/current/t/30col.t
packages/libuser-identity-perl/tags/
Log:
[svn-inject] Installing original source of libuser-identity-perl
Added: packages/libuser-identity-perl/branches/upstream/current/Changes
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/Changes 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/Changes 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,118 @@
+
+Revision history for module User::Identity.
+All changes are made by Mark Overmeer <userid at overmeer.net> unless
+explicitly stated differently.
+
+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
+
Added: packages/libuser-identity-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/MANIFEST 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/MANIFEST 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,32 @@
+Changes
+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
+META.yml Module meta-data (added by MakeMaker)
Added: packages/libuser-identity-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/META.yml 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/META.yml 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: User-Identity
+version: 0.90
+version_from: lib/User/Identity.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: packages/libuser-identity-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/Makefile.PL 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/Makefile.PL 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,34 @@
+use 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;
+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_FROM => 'lib/User/Identity.pm'
+ , PREREQ_PM => \%prereq
+ , ABSTRACT => 'Define a user'
+ , AUTHOR => 'Mark Overmeer <markov at cpan.org>'
+);
Added: packages/libuser-identity-perl/branches/upstream/current/README
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/README 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/README 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,38 @@
+User/Identity version 0.01
+==========================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2003 Mark Overmeer
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/Mail/Identity.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/Mail/Identity.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/Mail/Identity.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,166 @@
+package Mail::Identity;
+use vars '$VERSION';
+$VERSION = '0.90';
+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) = @_;
+ 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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/Mail/Identity.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/Mail/Identity.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/Mail/Identity.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,379 @@
+
+=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 at y');
+ $me->add(email => $addr);
+
+ # Simpler
+
+ use User::Identity;
+ my $me = User::Identity->new(...);
+ my $addr = $me->add(email => 'x at y');
+ my $addr = $me->add( email => 'home'
+ , address => 'x at y');
+
+ # Conversion
+ my $ma = Mail::Address->new(...);
+ my $mi = Mail::Identity->coerce($ma);
+
+
+=head1 DESCRIPTION
+
+The C<Mail::Identity> 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<Mail::Identity> 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<Mail::Identity> is therefore the smart cousine of the Mail::Address
+object.
+
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+$obj-E<gt>B<from>(OBJECT)
+
+=over 4
+
+Convert an OBJECT into a C<Mail::Identity>. On the moment, you can
+specify Mail::Address and L<User::Identity|User::Identity> objects. In the
+former case, a new C<Mail::Identity> is created containing the same
+information. In the latter, the first address of the user is picked
+and returned.
+
+=back
+
+Mail::Identity-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+ Option Defined in Default
+ address <username at domain or name>
+ charset <user's charset>
+ comment <user's fullname if phrase is different>
+ description L<User::Identity::Item> undef
+ domain <from email or localhost>
+ language <from user>
+ location <random user's location>
+ name L<User::Identity::Item> <phrase or user's fullName>
+ organization <location's organization>
+ parent L<User::Identity::Item> C<undef>
+ pgp_key undef
+ phrase <user's fullName>
+ signature undef
+ username <from address or user's nickname>
+
+. address STRING
+
+=over 4
+
+The e-mail address is constructed from the username/domain, but
+when both do not exist, the name is taken.
+
+=back
+
+. charset STRING
+
+. comment STRING
+
+. description STRING
+
+. domain STRING
+
+. language STRING
+
+. location NAME|OBJECT
+
+=over 4
+
+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<User::Identity::Location|User::Identity::Location> object.
+
+=back
+
+. name STRING
+
+. organization STRING
+
+=over 4
+
+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<Organization> header field of messages.
+
+=back
+
+. parent OBJECT
+
+. pgp_key STRING|FILENAME
+
+. phrase STRING
+
+. signature STRING
+
+. username STRING
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<address>
+
+=over 4
+
+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<name()|User::Identity::Item/"Attributes"> is used when it contains a C<@>, else the
+user's nickname is taken.
+
+=back
+
+$obj-E<gt>B<charset>
+
+=over 4
+
+Returns the character set used in comment and phrase. When set to
+C<undef>, 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.
+
+=back
+
+$obj-E<gt>B<comment>([STRING])
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<domain>
+
+=over 4
+
+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<address()|Mail::Identity/"Attributes">). If nothing is known, C<localhost> is returned.
+
+=back
+
+$obj-E<gt>B<language>
+
+=over 4
+
+Returns the language which is used for the description fields of this
+e-mail address, which defaults to the user's language.
+
+=back
+
+$obj-E<gt>B<location>
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<organization>
+
+=over 4
+
+Returns the organization which relates to this e-mail identity. If not
+explicitly specified, it is tried to be found via the location.
+
+=back
+
+$obj-E<gt>B<phrase>
+
+=over 4
+
+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!
+
+=back
+
+$obj-E<gt>B<username>
+
+=over 4
+
+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
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<find>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+Mail::Identity-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive/Plain.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive/Plain.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive/Plain.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,257 @@
+
+package User::Identity::Archive::Plain;
+use vars '$VERSION';
+$VERSION = '0.90';
+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 = <IN>;
+ }
+ 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;
+ 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";
+ }
+
+ $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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive/Plain.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive/Plain.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive/Plain.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,406 @@
+
+=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<User::Identity::Archive|User::Identity::Archive>, uses a very
+simple plain text file to store the information of users. The syntax
+is described in the DETAILS section, below.
+
+
+=head1 OVERLOADED
+
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity::Archive::Plain-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+ Option Defined in Default
+ abbreviations []
+ description L<User::Identity::Item> undef
+ from L<User::Identity::Archive> C<undef>
+ name L<User::Identity::Item> <required>
+ only []
+ parent L<User::Identity::Item> C<undef>
+ tabstop 8
+
+. abbreviations HASH|ARRAY
+
+=over 4
+
+Adds a set of abbreviations for collections to the syntax of the
+plain text archiver. See section L</Simplified class names> for
+a list of predefined names.
+
+=back
+
+. description STRING
+
+. from FILEHANDLE|FILENAME
+
+. name STRING
+
+. only ARRAY|ABBREV
+
+=over 4
+
+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.
+
+=back
+
+. parent OBJECT
+
+. tabstop INTEGER
+
+=over 4
+
+Sets the default tab-stop width.
+
+=back
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<abbreviation>(NAME, [CLASS])
+
+=over 4
+
+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<undef>, then the abbreviation is deleted. The class
+name which is deleted is returned.
+
+=back
+
+$obj-E<gt>B<abbreviations>
+
+=over 4
+
+Returns a sorted list of all names which are known as abbreviations.
+
+=back
+
+$obj-E<gt>B<defaultTabStop>([INTEGER])
+
+=over 4
+
+Returns the width of a tab, optionally after setting it. This must be
+the same as set in your editor.
+
+=back
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+=head2 Collections
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<find>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity::Archive::Plain-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+=head2 Access to the archive
+
+
+$obj-E<gt>B<from>(FILEHANDLE|FILENAME|ARRAY, OPTIONS)
+
+=over 4
+
+Read the plain text information from the specified FILEHANDLE, FILENAME,
+STRING, or ARRAY of lines.
+
+ Option Defined in Default
+ tabstop <default from object>
+ verbose 0
+
+. tabstop INTEGER
+
+. verbose INTEGER
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<Warning:> Cannot read archive from $source
+
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+
+=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<new(abbreviations)|User::Identity::Archive::Plain/"METHODS"> or L<abbreviations()|User::Identity::Archive::Plain/"Attributes"> 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<person> in stead of a I<user>,
+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 at overmeer.net
+ location home
+ email work
+ address solutions at overmeer.bet
+
+ email tux
+ address tux at fish.net
+
+The above defines two items: one L<User::Identity|User::Identity> named C<markov>, and
+an e-mail address C<tux>. The user has two collections: one contains
+a single location, and one stores two e-mail addresses.
+
+To add to the confusion: the C<location> is defined as field in C<email>
+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 at 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 at fish.aq
+
+The fields C<comment> and C<address> 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<not allowed> 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 at fish.aq
+ location #mind_the_hash
+
+is equivalent to:
+
+ user markov
+ email home
+ address tux at 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 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,29 @@
+
+package User::Identity::Archive;
+use vars '$VERSION';
+$VERSION = '0.90';
+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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Archive.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,221 @@
+
+=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.
+
+
+=head1 OVERLOADED
+
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity::Archive-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+ Option Defined in Default
+ description L<User::Identity::Item> undef
+ from C<undef>
+ name L<User::Identity::Item> <required>
+ parent L<User::Identity::Item> C<undef>
+
+. description STRING
+
+. from FILEHANDLE|FILENAME
+
+. name STRING
+
+. parent OBJECT
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+=head2 Collections
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<find>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity::Archive-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+=head2 Access to the archive
+
+
+$obj-E<gt>B<from>(SOURCE, OPTIONS)
+
+=over 4
+
+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<from()>, so you may want to check with
+C<UNIVERSAL::can()> beforehand.
+
+I<Example:>
+
+ use User::Identity::Archive::Some;
+ my $a = User::Identity::Archive::Some->new('xyz');
+ $a->from(\*STDIN) if $a->can('from');
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Emails.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Emails.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Emails.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,27 @@
+package User::Identity::Collection::Emails;
+use vars '$VERSION';
+$VERSION = '0.90';
+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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Emails.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Emails.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Emails.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,282 @@
+
+=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<User::Identity::Collection::Emails> object maintains a set
+L<Mail::Identity|Mail::Identity> objects, each describing a role which the user has
+in e-mail traffic.
+
+
+=head1 OVERLOADED
+
+
+overload: B<@{}>
+
+=over 4
+
+See L<User::Identity::Collection/"OVERLOADED">
+
+=back
+
+overload: B<stringification>
+
+=over 4
+
+See L<User::Identity::Collection/"OVERLOADED">
+
+=back
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity::Collection::Emails-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+ Option Defined in Default
+ description L<User::Identity::Item> undef
+ item_type L<User::Identity::Collection> L<Mail::Identity|Mail::Identity>
+ name L<User::Identity::Item> C<'emails'>
+ parent L<User::Identity::Item> C<undef>
+ roles L<User::Identity::Collection> undef
+
+. description STRING
+
+. item_type CLASS
+
+. name STRING
+
+. parent OBJECT
+
+. roles ROLE|ARRAY
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<itemType>
+
+=over 4
+
+See L<User::Identity::Collection/"Attributes">
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<roles>
+
+=over 4
+
+See L<User::Identity::Collection/"Attributes">
+
+=back
+
+=head2 Collections
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity::Collection::Emails-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+=head2 Maintaining roles
+
+
+$obj-E<gt>B<addRole>(ROLE| ( [NAME],OPTIONS ) | ARRAY-OF-OPTIONS)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<removeRole>(ROLE|NAME)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<renameRole>(ROLE|OLDNAME, NEWNAME)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<sorted>
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+=head2 Searching
+
+
+$obj-E<gt>B<find>(NAME|CODE|undef)
+
+=over 4
+
+See L<User::Identity::Collection/"Searching">
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<Error:> Cannot rename $name into $newname: already exists
+
+
+I<Error:> Cannot rename $name into $newname: doesn't exist
+
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+I<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.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Locations.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Locations.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Locations.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,31 @@
+package User::Identity::Collection::Locations;
+use vars '$VERSION';
+$VERSION = '0.90';
+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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Locations.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Locations.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Locations.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,281 @@
+
+=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<User::Identity::Collection::Location> object maintains a set
+L<User::Identity::Location|User::Identity::Location> objects, each describing a physical location.
+
+
+=head1 OVERLOADED
+
+
+overload: B<@{}>
+
+=over 4
+
+See L<User::Identity::Collection/"OVERLOADED">
+
+=back
+
+overload: B<stringification>
+
+=over 4
+
+See L<User::Identity::Collection/"OVERLOADED">
+
+=back
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity::Collection::Locations-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+ Option Defined in Default
+ description L<User::Identity::Item> undef
+ item_type L<User::Identity::Collection> L<User::Identity::Location|User::Identity::Location>
+ name L<User::Identity::Item> C<'locations'>
+ parent L<User::Identity::Item> C<undef>
+ roles L<User::Identity::Collection> undef
+
+. description STRING
+
+. item_type CLASS
+
+. name STRING
+
+. parent OBJECT
+
+. roles ROLE|ARRAY
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<itemType>
+
+=over 4
+
+See L<User::Identity::Collection/"Attributes">
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<roles>
+
+=over 4
+
+See L<User::Identity::Collection/"Attributes">
+
+=back
+
+=head2 Collections
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity::Collection::Locations-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+=head2 Maintaining roles
+
+
+$obj-E<gt>B<addRole>(ROLE| ( [NAME],OPTIONS ) | ARRAY-OF-OPTIONS)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<removeRole>(ROLE|NAME)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<renameRole>(ROLE|OLDNAME, NEWNAME)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<sorted>
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+=head2 Searching
+
+
+$obj-E<gt>B<find>(NAME|CODE|undef)
+
+=over 4
+
+See L<User::Identity::Collection/"Searching">
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<Error:> Cannot rename $name into $newname: already exists
+
+
+I<Error:> Cannot rename $name into $newname: doesn't exist
+
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+I<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.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Systems.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Systems.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Systems.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,29 @@
+package User::Identity::Collection::Systems;
+use vars '$VERSION';
+$VERSION = '0.90';
+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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Systems.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Systems.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Systems.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,282 @@
+
+=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<User::Identity::Collection::Systems|User::Identity::Collection::Systems> object maintains a set
+L<User::Identity::System|User::Identity::System> objects, each describing a login for the
+user on some system.
+
+
+=head1 OVERLOADED
+
+
+overload: B<@{}>
+
+=over 4
+
+See L<User::Identity::Collection/"OVERLOADED">
+
+=back
+
+overload: B<stringification>
+
+=over 4
+
+See L<User::Identity::Collection/"OVERLOADED">
+
+=back
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity::Collection::Systems-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+ Option Defined in Default
+ description L<User::Identity::Item> undef
+ item_type L<User::Identity::Collection> L<User::Identity::System|User::Identity::System>
+ name L<User::Identity::Item> C<'systems'>
+ parent L<User::Identity::Item> C<undef>
+ roles L<User::Identity::Collection> undef
+
+. description STRING
+
+. item_type CLASS
+
+. name STRING
+
+. parent OBJECT
+
+. roles ROLE|ARRAY
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<itemType>
+
+=over 4
+
+See L<User::Identity::Collection/"Attributes">
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<roles>
+
+=over 4
+
+See L<User::Identity::Collection/"Attributes">
+
+=back
+
+=head2 Collections
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity::Collection::Systems-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+=head2 Maintaining roles
+
+
+$obj-E<gt>B<addRole>(ROLE| ( [NAME],OPTIONS ) | ARRAY-OF-OPTIONS)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<removeRole>(ROLE|NAME)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<renameRole>(ROLE|OLDNAME, NEWNAME)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<sorted>
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+=head2 Searching
+
+
+$obj-E<gt>B<find>(NAME|CODE|undef)
+
+=over 4
+
+See L<User::Identity::Collection/"Searching">
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<Error:> Cannot rename $name into $newname: already exists
+
+
+I<Error:> Cannot rename $name into $newname: doesn't exist
+
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+I<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.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Users.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Users.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Users.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,29 @@
+package User::Identity::Collection::Users;
+use vars '$VERSION';
+$VERSION = '0.90';
+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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Users.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Users.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection/Users.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,281 @@
+
+=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<User::Identity::Collection::Users|User::Identity::Collection::Users> object maintains a set
+L<User::Identity|User::Identity> objects, each describing a user.
+
+
+=head1 OVERLOADED
+
+
+overload: B<@{}>
+
+=over 4
+
+See L<User::Identity::Collection/"OVERLOADED">
+
+=back
+
+overload: B<stringification>
+
+=over 4
+
+See L<User::Identity::Collection/"OVERLOADED">
+
+=back
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity::Collection::Users-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+ Option Defined in Default
+ description L<User::Identity::Item> undef
+ item_type L<User::Identity::Collection> L<User::Identity|User::Identity>
+ name L<User::Identity::Item> C<'people'>
+ parent L<User::Identity::Item> C<undef>
+ roles L<User::Identity::Collection> undef
+
+. description STRING
+
+. item_type CLASS
+
+. name STRING
+
+. parent OBJECT
+
+. roles ROLE|ARRAY
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<itemType>
+
+=over 4
+
+See L<User::Identity::Collection/"Attributes">
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<roles>
+
+=over 4
+
+See L<User::Identity::Collection/"Attributes">
+
+=back
+
+=head2 Collections
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity::Collection::Users-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+=head2 Maintaining roles
+
+
+$obj-E<gt>B<addRole>(ROLE| ( [NAME],OPTIONS ) | ARRAY-OF-OPTIONS)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<removeRole>(ROLE|NAME)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<renameRole>(ROLE|OLDNAME, NEWNAME)
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+$obj-E<gt>B<sorted>
+
+=over 4
+
+See L<User::Identity::Collection/"Maintaining roles">
+
+=back
+
+=head2 Searching
+
+
+$obj-E<gt>B<find>(NAME|CODE|undef)
+
+=over 4
+
+See L<User::Identity::Collection/"Searching">
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<Error:> Cannot rename $name into $newname: already exists
+
+
+I<Error:> Cannot rename $name into $newname: doesn't exist
+
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+I<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.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,134 @@
+package User::Identity::Collection;
+use vars '$VERSION';
+$VERSION = '0.90';
+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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Collection.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,395 @@
+
+=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<User::Identity::Collection> 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<people> is a L<collection of users|User::Identity::Collection::Users>
+
+=item * I<whereabouts> are L<locations|User::Identity::Collection::Locations>
+=item * a I<mailinglist> is a
+
+L<collection of email addresses|User::Identity::Collection::Emails>
+=item * a I<network> contains
+
+L<groups of systems|User::Identity::Collection::Systems>
+=back
+
+
+=head1 OVERLOADED
+
+
+overload: B<@{}>
+
+=over 4
+
+When the reference to a collection object is used as array-reference, it
+will be shown as list of roles.
+
+I<Example:>
+
+ my $locations = $ui->collection('location');
+ foreach my $loc (@$location) ...
+ print $location->[0];
+
+=back
+
+overload: B<stringification>
+
+=over 4
+
+Returns the name of the collection and a sorted list of defined items.
+
+I<Example:>
+
+ print "$collection\n"; # location: home, work
+
+=back
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity::Collection-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+ Option Defined in Default
+ description L<User::Identity::Item> undef
+ item_type <required>
+ name L<User::Identity::Item> <required>
+ parent L<User::Identity::Item> C<undef>
+ roles undef
+
+. description STRING
+
+. item_type CLASS
+
+=over 4
+
+The CLASS which is used to store the information for each of the maintained
+objects within this collection.
+
+=back
+
+. name STRING
+
+. parent OBJECT
+
+. roles ROLE|ARRAY
+
+=over 4
+
+Immediately add some roles to this collection. In case of an ARRAY,
+each element of the array is passed separately to L<addRole()|User::Identity::Collection/"Maintaining roles">. So,
+you may end-up with an ARRAY of arrays each grouping a set of options
+to create a role.
+
+=back
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<itemType>
+
+=over 4
+
+Returns the type of the items collected.
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<roles>
+
+=over 4
+
+Returns all defined roles within this collection. Be warned: the rules
+are returned in random (hash) order.
+
+=back
+
+=head2 Collections
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity::Collection-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+=head2 Maintaining roles
+
+
+$obj-E<gt>B<addRole>(ROLE| ( [NAME],OPTIONS ) | ARRAY-OF-OPTIONS)
+
+=over 4
+
+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.
+
+I<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' ] );
+
+=back
+
+$obj-E<gt>B<removeRole>(ROLE|NAME)
+
+=over 4
+
+The deleted role is returned (if it existed).
+
+=back
+
+$obj-E<gt>B<renameRole>(ROLE|OLDNAME, NEWNAME)
+
+=over 4
+
+Give the role a different name, and move it in the collection.
+
+=back
+
+$obj-E<gt>B<sorted>
+
+=over 4
+
+Returns the roles sorted by name, alphabetically and case-sensitive.
+
+=back
+
+=head2 Searching
+
+
+$obj-E<gt>B<find>(NAME|CODE|undef)
+
+=over 4
+
+Find the object with the specified NAME in this collection. With C<undef>,
+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.
+
+I<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
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<Error:> Cannot rename $name into $newname: already exists
+
+
+I<Error:> Cannot rename $name into $newname: doesn't exist
+
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+I<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.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Item.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Item.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Item.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,172 @@
+package User::Identity::Item;
+use vars '$VERSION';
+$VERSION = '0.90';
+
+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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Item.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Item.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Item.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,296 @@
+
+=head1 NAME
+
+User::Identity::Item - general base class for User::Identity
+
+
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+The C<User::Identity::Item> base class is extended into useful modules: it
+has no use by its own.
+
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity::Item-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+ Option Defined in Default
+ description undef
+ name <required>
+ parent C<undef>
+
+. description STRING
+
+=over 4
+
+Free format description on the collected item.
+
+=back
+
+. name STRING
+
+=over 4
+
+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.
+
+=back
+
+. parent OBJECT
+
+=over 4
+
+The encapsulating object: the object which collects this one.
+
+=back
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<description>
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+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<User::Identity::Collection::renameRole()|User::Identity::Collection/"Maintaining roles"> instead.
+
+=back
+
+=head2 Collections
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+The ROLE is added to the COLLECTION. The COLLECTION is the name of a
+collection, which will be created automatically with L<addCollection()|User::Identity::Item/"Collections"> if
+needed. The COLLECTION can also be specified as existing collection object.
+
+The ROLE is anything what is acceptable to
+L<User::Identity::Collection::addRole()|User::Identity::Collection/"Maintaining roles"> 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.
+
+I<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');
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+Add a new collection of roles to an item. This can be achieved in two ways:
+either create an L<User::Identity::Collection|User::Identity::Collection> 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 Defined in Default
+ type <required>
+
+. type STRING|CLASS
+
+=over 4
+
+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<email>, C<system>, and C<location>.
+
+=back
+
+I<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');
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+In scalar context the collection object with the NAME is returned.
+In list context, all the roles within the collection are returned.
+
+I<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
+
+=back
+
+$obj-E<gt>B<find>(COLLECTION, ROLE)
+
+=over 4
+
+Returns the object with the specified ROLE within the named collection.
+The collection can be specified as name or object.
+
+I<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
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+Returns the parent of an Item (the enclosing item). This may return C<undef>
+if the object is stand-alone.
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity::Item-E<gt>B<type>
+
+=over 4
+
+Returns a nice symbolic name for the type.
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+Go from this object to its parent, to its parent, and so on, until a
+L<User::Identity|User::Identity> is found or the top of the object tree has been
+reached.
+
+I<Example:>
+
+ print $email->user->fullName;
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+I<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.
+
+I<Warning:> Unknown options @names for a $class
+
+More than one option is not defined.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Location.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Location.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Location.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,125 @@
+
+package User::Identity::Location;
+use vars '$VERSION';
+$VERSION = '0.90';
+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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Location.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Location.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/Location.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,357 @@
+
+=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<User::Identity::Location> object contains the description of a physical
+location of a person: home, work, travel. The locations are collected
+by a L<User::Identity::Collection::Locations|User::Identity::Collection::Locations> object.
+
+Nearly all methods can return C<undef>. Some methods produce language or
+country specific output.
+
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity::Location-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+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 L<User::Identity::Item> undef
+ fax undef
+ name L<User::Identity::Item> <required>
+ organization undef
+ parent L<User::Identity::Item> C<undef>
+ pc C<undef>
+ phone undef
+ pobox undef
+ pobox_pc undef
+ postal_code <value of option pc>
+ state undef
+ street undef
+
+. country STRING
+
+. country_code STRING
+
+. description STRING
+
+. fax STRING|ARRAY
+
+. name STRING
+
+. organization STRING
+
+. parent OBJECT
+
+. pc STRING
+
+=over 4
+
+Short name for C<postal_code>.
+
+=back
+
+. phone STRING|ARRAY
+
+. pobox STRING
+
+. pobox_pc STRING
+
+. postal_code STRING
+
+. state STRING
+
+. street STRING
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<city>
+
+=over 4
+
+The city where the address is located.
+
+=back
+
+$obj-E<gt>B<country>
+
+=over 4
+
+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).
+
+=back
+
+$obj-E<gt>B<countryCode>
+
+=over 4
+
+Each country has an ISO standard abbreviation. Specify the country or the
+country code, and the other will be filled in automatically.
+
+=back
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<fax>
+
+=over 4
+
+One or more fax numbers, like L<phone()|User::Identity::Location/"Attributes">.
+
+=back
+
+$obj-E<gt>B<fullAddress>
+
+=over 4
+
+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.
+
+I<Example:>
+
+ print $uil->fullAddress;
+ print $user->find(location => 'home')->fullAddress;
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<organization>
+
+=over 4
+
+The organization (for instance company) which is related to this location.
+
+=back
+
+$obj-E<gt>B<phone>
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<pobox>
+
+=over 4
+
+Post Office mail box specification. Use C<"P.O.Box 314">, not simple C<314>.
+
+=back
+
+$obj-E<gt>B<poboxPostalCode>
+
+=over 4
+
+The postal code related to the Post-Office mail box. Defined by new() option
+C<pobox_pc>.
+
+=back
+
+$obj-E<gt>B<postalCode>
+
+=over 4
+
+The postal code is very country dependent. Also, the location of the
+code within the formatted string is country dependent.
+
+=back
+
+$obj-E<gt>B<state>
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<street>
+
+=over 4
+
+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
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<find>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity::Location-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/System.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/System.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/System.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,53 @@
+package User::Identity::System;
+use vars '$VERSION';
+$VERSION = '0.90';
+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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/System.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/System.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity/System.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,289 @@
+
+=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<User::Identity::System> object contains the description of the
+user's presence on a system. The systems are collected
+by an L<User::Identity::Collection::Systems|User::Identity::Collection::Systems> object.
+
+Nearly all methods can return undef.
+
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity::System-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+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 L<User::Identity::Item> undef
+ hostname C<'localhost'>
+ location undef
+ name L<User::Identity::Item> <required>
+ os undef
+ parent L<User::Identity::Item> C<undef>
+ password undef
+ username undef
+
+. description STRING
+
+. hostname DOMAIN
+
+=over 4
+
+The hostname of the described system. It is prefered to use full
+system names, not abbreviations. For instance, you can better use
+C<www.tux.aq> than C<www> to avoid confusion.
+
+=back
+
+. location NICKNAME|OBJECT
+
+=over 4
+
+The NICKNAME of a location which is defined for the same user. You can
+also specify a L<User::Identity::Location|User::Identity::Location> OBJECT.
+
+=back
+
+. name STRING
+
+. os STRING
+
+=over 4
+
+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.
+
+=back
+
+. parent OBJECT
+
+. password STRING
+
+=over 4
+
+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.
+
+=back
+
+. username STRING
+
+=over 4
+
+The username to be used to login to this host.
+
+=back
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<hostname>
+
+=over 4
+
+=back
+
+$obj-E<gt>B<location>
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<os>
+
+=over 4
+
+=back
+
+$obj-E<gt>B<password>
+
+=over 4
+
+=back
+
+$obj-E<gt>B<username>
+
+=over 4
+
+=back
+
+=head2 Collections
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<find>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity::System-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity.pm
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity.pm 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity.pm 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,256 @@
+package User::Identity;
+use vars '$VERSION';
+$VERSION = '0.90';
+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;
+
Added: packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity.pod
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity.pod 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/lib/User/Identity.pod 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,431 @@
+
+=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<User::Identity> object is created to maintain a set of informational
+objects which are related to one user. The C<User::Identity> 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.
+
+
+=head1 OVERLOADED
+
+
+$obj-E<gt>B<stringification>
+
+=over 4
+
+When an C<User::Identity> is used as string, it is automatically
+translated into the fullName() of the user involved.
+
+I<Example:>
+
+ my $me = User::Identity->new(...)
+ print $me; # same as print $me->fullName
+ print "I am $me\n"; # also stringification
+
+=back
+
+
+=head1 METHODS
+
+
+=head2 Constructors
+
+
+User::Identity-E<gt>B<new>([NAME], OPTIONS)
+
+=over 4
+
+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 L<User::Identity::Item> undef
+ firstname undef
+ formal_name undef
+ full_name undef
+ gender undef
+ initials undef
+ language 'en'
+ name L<User::Identity::Item> <required>
+ nickname undef
+ parent L<User::Identity::Item> C<undef>
+ prefix undef
+ surname undef
+ titles undef
+
+. birth DATE
+
+. charset STRING
+
+. courtesy STRING
+
+. description STRING
+
+. firstname STRING
+
+. formal_name STRING
+
+. full_name STRING
+
+. gender STRING
+
+. initials STRING
+
+. language STRING
+
+. name STRING
+
+. nickname STRING
+
+. parent OBJECT
+
+. prefix STRING
+
+. surname STRING
+
+. titles STRING
+
+=back
+
+=head2 Attributes
+
+
+$obj-E<gt>B<age>
+
+=over 4
+
+Calcuted from the datge of birth to the current moment, as integer. On the
+birthday, the number is incremented already.
+
+=back
+
+$obj-E<gt>B<birth>
+
+=over 4
+
+Returns the date in standardized format: YYYYMMDD, easy to sort and
+select. This may return C<undef>, even if the L<dateOfBirth()|User::Identity/"Attributes"> 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.
+
+=back
+
+$obj-E<gt>B<charset>
+
+=over 4
+
+The user's prefered character set, which defaults to the value of
+LC_CTYPE environment variable.
+
+=back
+
+$obj-E<gt>B<courtesy>
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<dateOfBirth>
+
+=over 4
+
+Returns the date of birth, as specified during instantiation.
+
+=back
+
+$obj-E<gt>B<description>
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<firstname>
+
+=over 4
+
+Returns the first name of the user. If it is not defined explicitly, it
+is derived from the nickname, and than capitalized if needed.
+
+=back
+
+$obj-E<gt>B<formalName>
+
+=over 4
+
+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".
+
+=back
+
+$obj-E<gt>B<fullName>
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<gender>
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<initials>
+
+=over 4
+
+The initials, which may be derived from the first letters of the
+firstname.
+
+=back
+
+$obj-E<gt>B<isFemale>
+
+=over 4
+
+See isMale(): return true if we are sure the user is a woman.
+
+=back
+
+$obj-E<gt>B<isMale>
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<language>
+
+=over 4
+
+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).
+
+=back
+
+$obj-E<gt>B<name>([NEWNAME])
+
+=over 4
+
+See L<User::Identity::Item/"Attributes">
+
+=back
+
+$obj-E<gt>B<nickname>
+
+=over 4
+
+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.
+
+=back
+
+$obj-E<gt>B<prefix>
+
+=over 4
+
+The words which are between the firstname (or initials) and the surname.
+
+=back
+
+$obj-E<gt>B<surname>
+
+=over 4
+
+Returns the surname of person, or C<undef> if that is not known.
+
+=back
+
+$obj-E<gt>B<titles>
+
+=over 4
+
+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
+
+
+$obj-E<gt>B<add>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<addCollection>(OBJECT | ([TYPE], OPTIONS))
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<collection>(NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<find>(COLLECTION, ROLE)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<parent>([PARENT])
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<removeCollection>(OBJECT|NAME)
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<type>
+
+User::Identity-E<gt>B<type>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+$obj-E<gt>B<user>
+
+=over 4
+
+See L<User::Identity::Item/"Collections">
+
+=back
+
+
+
+=head1 DIAGNOSTICS
+
+I<Error:> $object is not a collection.
+
+The first argument is an object, but not of a class which extends
+L<User::Identity::Collection|User::Identity::Collection>.
+
+I<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.
+
+I<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.
+
+I<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.
+
+I<Warning:> No collection $name
+
+The collection with $name does not exist and can not be created.
+
+
+
+
+
+
+=head1 REFERENCES
+
+See the User::Identity website at L<http://perl.overmeer.net/userid/> for more details.
+
+=head1 COPYRIGHTS
+
+User::Identity version 0.90.
+Written by Mark Overmeer (mark at overmeer.net). See the ChangeLog for
+other contributors.
+
+Copyright (c) 2003 by the author(s). All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+
Added: packages/libuser-identity-perl/branches/upstream/current/t/10userid.t
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/t/10userid.t 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/t/10userid.t 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,84 @@
+use 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");
Added: packages/libuser-identity-perl/branches/upstream/current/t/20loc.t
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/t/20loc.t 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/t/20loc.t 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,103 @@
+use 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, <<NL);
+MARKOV Solutions
+Postbus 12
+3412 YY XYZ
+$country
+NL
Added: packages/libuser-identity-perl/branches/upstream/current/t/30col.t
===================================================================
--- packages/libuser-identity-perl/branches/upstream/current/t/30col.t 2005-03-30 19:06:28 UTC (rev 850)
+++ packages/libuser-identity-perl/branches/upstream/current/t/30col.t 2005-03-30 19:33:08 UTC (rev 851)
@@ -0,0 +1,138 @@
+#!/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 at 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");
More information about the Pkg-perl-cvs-commits
mailing list