r5845 - in /packages/libset-nestedgroups-perl: ./ libset-nestedgroups-perl/ libset-nestedgroups-perl/branches/ libset-nestedgroups-perl/branches/upstream/ libset-nestedgroups-perl/branches/upstream/current/ libset-nestedgroups-perl/branches/upstream/current/NestedGroups/ libset-nestedgroups-perl/branches/upstream/current/t/ libset-nestedgroups-perl/tags/
gwolf at users.alioth.debian.org
gwolf at users.alioth.debian.org
Tue Jul 17 18:59:08 UTC 2007
Author: gwolf
Date: Tue Jul 17 18:59:07 2007
New Revision: 5845
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=5845
Log:
[svn-inject] Installing original source of libset-nestedgroups-perl
Added:
packages/libset-nestedgroups-perl/
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/Changes
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/MANIFEST
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/Makefile.PL
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups/
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups.pm
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups/Member.pm
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/README
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/t/
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/t/basic.t
packages/libset-nestedgroups-perl/libset-nestedgroups-perl/tags/
Added: packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/Changes?rev=5845&op=file
==============================================================================
--- packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/Changes (added)
+++ packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/Changes Tue Jul 17 18:59:07 2007
@@ -1,0 +1,5 @@
+Revision history for Perl extension ACL.
+
+0.01 Fri Oct 23 19:25:33 1998
+ - original version; created by h2xs 1.18
+
Added: packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/MANIFEST?rev=5845&op=file
==============================================================================
--- packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/MANIFEST Tue Jul 17 18:59:07 2007
@@ -1,0 +1,7 @@
+NestedGroups.pm
+NestedGroups/Member.pm
+Changes
+MANIFEST
+Makefile.PL
+README
+t/basic.t
Added: packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/Makefile.PL?rev=5845&op=file
==============================================================================
--- packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/Makefile.PL Tue Jul 17 18:59:07 2007
@@ -1,0 +1,7 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Set::NestedGroups',
+ 'VERSION_FROM' => 'NestedGroups.pm', # finds $VERSION
+);
Added: packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups.pm?rev=5845&op=file
==============================================================================
--- packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups.pm (added)
+++ packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups.pm Tue Jul 17 18:59:07 2007
@@ -1,0 +1,391 @@
+package Set::NestedGroups;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Set::NestedGroups::Member;
+use Carp;
+
+ at ISA = qw();
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+ at EXPORT = qw(
+
+);
+$VERSION = '0.01';
+
+# Constructor
+sub new {
+ my $proto=shift;
+ my $fh=shift;
+ my $class=ref($proto) || $proto;
+ my $self = {};
+ bless($self,$class);
+
+ if(defined $fh){
+ if(ref($fh) eq "DBI::st"){
+ $fh->execute();
+ for(my $i=0;$i<$fh->rows();$i++){
+ my ($member,$group)=$fh->fetchrow();
+ $self->add($member,$group);
+ }
+ } else {
+ no strict "refs"; # Can't use strict here,
+ # incase called with (DATA) instead
+ # of \*DATA
+ $fh=to_filehandle($fh);
+ while(<$fh>){
+ chomp;
+ last if(/^=$/);
+ my ($member,$group)=split(/=/,$_,2);
+ $self->add(unescape($member),unescape($group));
+ }
+ }
+ }
+ return $self;
+}
+
+# Add a member to a group
+sub add {
+ my $self=shift;
+ my ($member,$group)=@_;
+ my $was= $self->{'MEMBERS'}{$member}{$group};
+ $self->{'MEMBERS'}{$member}{$group}=1;
+ return $was;
+}
+
+# And remove a member from a group
+sub remove {
+ my $self=shift;
+ my ($member,$group)=@_;
+ my $was=$self->{'MEMBERS'}{$member}{$group};
+ delete $self->{'MEMBERS'}{$member}{$group};
+ $self->{'GROUPS'}{$group}--;
+ if($self->{'GROUPS'}{$group} == 0){
+ delete $self->{'GROUPS'}{$group};
+ }
+ return $was;
+}
+
+# Create some sort of list object
+sub list {
+ my $self=shift;
+ my %options=@_;
+ my $member_list=new Set::NestedGroups::MemberList;
+ my $nogroups = $options{'-nogroups'} || 0;
+
+ foreach my $user (keys %{$self->{'MEMBERS'}}){
+ next if($nogroups && $self->group($user));
+ foreach my $group ($self->groups($user,%options)){
+ $member_list->add($user,$group);
+ }
+ }
+ return $member_list;
+}
+
+sub to_filehandle {
+ no strict "refs"; # Can't use strict here,
+ # incase called with (DATA) instead
+ # of \*DATA
+ my $string = shift;
+ if ($string && !ref($string)) {
+ my($package) = caller(1);
+ my($tmp) = $string=~/[':]/ ? $string : "$package\:\:$string";
+ return $tmp if defined(fileno($tmp));
+ }
+ return $string;
+}
+
+# unescape URL-encoded data
+sub unescape {
+ my($todecode) = @_;
+ $todecode =~ tr/+/ /; # pluses become spaces
+ $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
+ return $todecode;
+}
+
+# URL-encode data
+sub escape {
+ my($toencode) = @_;
+ $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
+ return $toencode;
+}
+
+# Save the current object
+sub save {
+ my $self=shift;
+ my $fh=shift;
+
+ if(ref($fh) eq "DBI::st"){
+ my $members=$self->list('-norecurse'=>1,-nomiddles=>0);
+ for(my $i=0;$i<$members->rows();$i++){
+ $fh->execute($members->next()) or return;
+ }
+ return 1;
+ } else {
+ no strict "refs"; # Can't use strict here,
+ # incase called with (DATA) instead
+ # of \*DATA
+ $fh=to_filehandle($fh);
+
+ my $members=$self->list('-norecurse'=>1,-nomiddles=>0);
+ for(my $i=0;$i<$members->rows();$i++){
+ my ($member,$group)=$members->next();
+ print $fh escape($member),'=',escape($group),"\n" or return;
+ }
+ print $fh "=\n" or return;
+ }
+}
+
+# Check a member
+sub member {
+ my $self=shift;
+ my $member=shift;
+ if(@_){
+ my $want_group=shift;
+ foreach my $got_group ($self->groups($member,-norecurse=>0,-nomiddles=>0)){
+ return 1 if($got_group eq $want_group);
+ }
+ return undef;
+ }
+
+ return (keys %{$self->{'MEMBERS'}{$member}})
+}
+
+# Check a group
+sub group {
+ my $self=shift;
+ my $group=shift;
+
+ return
+ grep {$_ eq $group} $self->allgroups();
+}
+
+# Return all the members
+sub allmembers {
+ my $self=shift;
+ return (keys %{$self->{'MEMBERS'}});
+}
+
+# Return all the groups
+sub allgroups {
+ my $self=shift;
+ my $group=shift;
+ my %seen;
+
+ return
+ grep { !$seen{$_}++ }
+ map { keys %{$self->{'MEMBERS'}{$_}} }
+ $self->allmembers()
+};
+
+
+# Returns the groups a member belongs to
+sub groups {
+ my $self=shift;
+ my $member=shift;
+ my %options=@_;
+ my $norecurse = $options{'-norecurse'} || 0;
+ my $nomiddles= $options{'-nomiddles'} || 0;
+
+ my %group=%{$self->{'MEMBERS'}{$member}};
+
+ if(!$norecurse){
+ my $again = 1;
+ while($again){
+ $again=0;
+ foreach my $group (keys %group){
+ foreach my $newgroup ( keys %{$self->{'MEMBERS'}{$group}}){
+ if(!$group{$newgroup}){
+ $again=$group{$newgroup}=1;
+ }
+ }
+ }
+ }
+ }
+ return grep { !$nomiddles || !$self->member($_) }keys %group;
+}
+
+# Returns the members in a group
+sub members {
+ my $self=shift;
+ my $group=shift;
+ my %options=@_;
+ my $nomiddles= $options{'-nomiddles'} || 0;
+ my %members;
+
+ foreach my $member ($self -> allmembers()){
+ $members{$member}++ if(grep {$_ eq $group} $self->groups($member,%options));
+ }
+
+ return grep { !$nomiddles || !$self->group($_) }keys %members;
+}
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+__END__
+# Below is the stub of documentation for your module. You better edit it!
+
+=head1 NAME
+
+Set::NestedGroups - grouped data eg ACL's, city/state/country etc
+
+=head1 SYNOPSIS
+
+ use Set::NestedGroups;
+ $nested = new Set::NestedGroups;
+ $nested->add('user','group');
+ $nested->add('group','parentgroup');
+ do_something() if($nested->member('user','parentgroup'));
+
+=head1 DESCRIPTION
+
+Set::NestedGroups gives an implementation of nested groups,
+access control lists (ACLs) would be one example of
+nested groups.
+
+For example, if Joe is a Manager, and Managers have access to payroll,
+you can create an ACL which implements these rules, then ask the ACL
+if Joe has access to payroll.
+
+Another example, you may wish to track which city, state and country
+people are in, by adding people to cities, cities to states, and states
+to countries.
+
+=head1 CONSTRUTORS
+
+=over 4
+
+=item new()
+
+creates a new Set::NestedGroups object.
+
+=item new( fh )
+
+creates a new Set::NestedGroups object,
+the object will be initialized using data read from this handle. For
+details on the format, see the save() method
+
+=item new( $sth )
+
+creates a new Set::NestedGroups object, the object will be initialized
+using data read using this this DBI statement handle. For details on
+the format, see the save() method
+
+=head1 METHODS
+
+=item add ( $member, $group)
+
+adds a member to a group. The group will be created if it doesn't
+already exist.
+
+=item remove ( $member, $group )
+
+removes a member from a group. If this was the last member in this group,
+then the group will be deleted. If the member was only in this group,
+then the member will be deleted.
+
+=item save(FILEHANDLE)
+
+Outputs the object to the given filehandle, which must be already open
+in write mode.
+
+The format is compatable with the format used by CGI, and can be
+used with new to initialize a new object;
+
+Returns true if successfully wrote the data, or false if something
+went wrong (usually that meant that the handle wasn't already open in
+write mode).
+
+=item save($sth)
+
+Saves the object to a DBI database. This can be used with new to initialize
+a new object. The $sth should be expecting 2 values, in this fashion:
+
+ $sth = $dbh->prepare('insert into acl values (?,?)')
+ $acl->save($dbh);
+ $sth->finish();
+
+ $sth = $dbh->prepare('select * from acl');
+ $newacl=new ACL($sth);
+
+Returns true if successfully wrote the data, or false if something
+went wrong.
+
+=item member ( $member, $group )
+
+Returns true if $member is a member of $group.
+
+=item member ( $member )
+
+returns true if $member exists in any group.
+
+=item group ( $group )
+
+returns true if $group exists
+
+=item groups ( $member, %options )
+
+Returns the groups that $member belongs to. Options are explained below.
+
+=item members ( $group , %options )
+
+Returns the members of $group. Keep on reading for the options
+
+=item list(%options)
+
+Returns a Set::NestedGroups::Member object that will output an list
+of the members & groups. This could be considered a calling of groups()
+on each member, except this is more efficent.
+
+The object can be used as follows.
+
+ $list=$nested->list();
+ for(my $i=0;$i<$list->rows();$i++){
+ my ($member,$group)=$list->next();
+ print "$member=$group\n";
+ }
+
+=head2 options
+
+By default, the above methods give every valid combination. However
+you might not always want that. Therefore there are options which
+can prevent return of certain values.
+
+All of these examples presume that 'joe' is a member of 'managers',
+and 'managers' is a member of payroll, and that you are using only
+one of these options. You can use all 3, but that gets complicated
+to explain.
+
+-norecurse=>1
+
+No Recursion is performed, method would ignore
+payroll, and return only managers.
+
+-nomiddles=>1
+
+Doesn't returns groups 'in the middle', method would
+ignore mangers, and return only payroll.
+
+-nogroups=>1
+
+Doesn't return members that are groups. This only applies
+to the list() method, in which case it acts like nomiddles, except on
+the member instead of the group. list would ignore managers and
+return joe => managers , joe => payroll.
+
+=back 2
+
+This sounds a lot more confusing than it actually is, once you try it
+once or twice you'll get the idea.
+
+=head1 AUTHOR
+
+Alan R. Barclay, gorilla at elaine.drink.com
+
+=head1 SEE ALSO
+
+perl(1), CGI, DBI.
+
+=cut
Added: packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups/Member.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups/Member.pm?rev=5845&op=file
==============================================================================
--- packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups/Member.pm (added)
+++ packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/NestedGroups/Member.pm Tue Jul 17 18:59:07 2007
@@ -1,0 +1,91 @@
+package Set::NestedGroups::MemberList;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+ at ISA = qw();
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+ at EXPORT = qw(
+
+);
+$VERSION = '0.01';
+
+# Preloaded methods go here.
+
+sub new {
+ my $proto=shift;
+ my $class=ref($proto) || $proto;
+ my $self ={};
+ $self->{'COUNT'}= 0;
+ bless($self,$class);
+ return $self;
+}
+
+sub add {
+ my $self=shift;
+ my ($member,$group)=@_;
+ push(@{$self->{'LIST'}},$member);
+ push(@{$self->{'LIST'}},$group);
+ $self->{'COUNT'}++;
+}
+
+sub next {
+ my $self=shift;
+
+ my $member=shift(@{$self->{'LIST'}});
+ my $group=shift(@{$self->{'LIST'}});
+
+ return ($member,$group);
+}
+
+sub rows {
+ my $self=shift;
+
+ return $self->{'COUNT'};
+}
+
+
+=head1 NAME
+
+Set::NestedGroup::Member - Set of nested groups
+
+=head1 SYNOPSIS
+
+ use Set::NestedGroup;
+ $acl = new Set::NestedGroup;
+ $acl->add('user','group');
+ $acl->add('group','parentgroup');
+ $list=$acl->list();
+ for(my $i=0;$i<$list->rows();$i++){
+ my ($member,$group)=$list->next();
+ print "$member=$group\n";
+ }
+
+=head1 DESCRIPTION
+
+Set::NestedGroup::Member objects are returns from a Set::NestedGroup
+object's list() method.
+
+=head1 METHODS
+
+=item rows ()
+
+Returns the number of rows this has. May be used to construct a loop
+to extract all the data.
+
+=item next ()
+
+Returns a list comprising of the next member & group. Returns undef
+when the list is exhausted.
+
+=head1 AUTHOR
+
+Alan R. Barclay, gorilla at elaine.drink.com
+
+=head1 SEE ALSO
+
+perl(1), Set::NestedGroup
+
+=cut
Added: packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/README?rev=5845&op=file
==============================================================================
--- packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/README (added)
+++ packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/README Tue Jul 17 18:59:07 2007
@@ -1,0 +1,161 @@
+Copyright (c) 1998 Alan Barclay. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+Please send questions or bug reports to me rather than posting them to
+a newsgroup since I may miss them there.
+
+INSTALLATION
+
+To install, just type
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+TESTS
+
+By default, the dbi tests are not performed. You need to edit the
+t/dbi.t file and set up the correct database & driver.
+
+
+Here is the documentation for the module, directly from the pod
+
+NAME
+ Set::NestedGroups - grouped data eg ACL's, city/state/country etc
+
+SYNOPSIS
+ use Set::NestedGroups;
+ $nested = new Set::NestedGroups;
+ $nested->add('user','group');
+ $nested->add('group','parentgroup');
+ do_something() if($nested->member('user','parentgroup'));
+
+DESCRIPTION
+ Set::NestedGroups gives an implementation of nested groups, access
+ control lists (ACLs) would be one example of nested groups.
+
+ For example, if Joe is a Manager, and Managers have access to payroll,
+ you can create an ACL which implements these rules, then ask the ACL if
+ Joe has access to payroll.
+
+ Another example, you may wish to track which city, state and country
+ people are in, by adding people to cities, cities to states, and states
+ to countries.
+
+CONSTRUTORS
+ new()
+ creates a new Set::NestedGroups object.
+
+ new( fh )
+ creates a new Set::NestedGroups object, the object will be
+ initialized using data read from this handle. For details on the
+ format, see the save() method
+
+ new( $sth )
+ creates a new Set::NestedGroups object, the object will be
+ initialized using data read using this this DBI statement handle.
+ For details on the format, see the save() method
+
+METHODS
+ add ( $member, $group)
+ adds a member to a group. The group will be created if it doesn't
+ already exist.
+
+ remove ( $member, $group )
+ removes a member from a group. If this was the last member in this
+ group, then the group will be deleted. If the member was only in
+ this group, then they will be deleted.
+
+ save(FILEHANDLE)
+ Outputs the object to the given filehandle, which must be already
+ open in write mode.
+
+ The format is compatable with the format used by CGI, and can be
+ used with new to initialize a new object;
+
+ Returns true if successfully wrote the data, or false if something
+ went wrong (usually that meant that the handle wasn't already open
+ in write mode).
+
+ save($sth)
+ Saves the object to a DBI database. This can be used with new to
+ initialize a new object. The $sth should be expecting 2 values, in
+ this fashion:
+
+ $sth = $dbh->prepare('insert into acl values (?,?)')
+ $acl->save($dbh);
+ $sth->finish();
+
+ $sth = $dbh->prepare('select * from acl');
+ $newacl=new ACL($sth);
+
+ Returns true if successfully wrote the data, or false if something
+ went wrong.
+
+ member ( $member, $group )
+ Returns true if $member is a member of $group.
+
+ member ( $member )
+ returns true if $member exists in any group.
+
+ group ( $group )
+ returns true if $group exists
+
+ groups ( $member, %options )
+ Returns the groups that $member belongs to. Options are explained
+ below.
+
+ members ( $group , %options )
+ Returns the members of $group. Keep on reading for the options
+
+ list(%options)
+ Returns a Set::NestedGroups::Member object that will output an list
+ of the members & groups. This could be considered a calling of
+ groups() on each member, except this is more efficent.
+
+ The object can be used as follows.
+
+ $list=$nested->list();
+ for(my $i=0;$i<$list->rows();$i++){
+ my ($member,$group)=$list->next();
+ print "$member=$group\n";
+ }
+
+ options
+
+ By default, the above methods give every valid combination. However
+ you might not always want that. Therefore there are options which
+ can prevent return of certain values.
+
+ All of these examples presume that 'joe' is a member of 'managers',
+ and 'managers' is a member of payroll, and that you are using only
+ one of these options. You can use all 3, but that gets complicated
+ to explain.
+
+ -norecurse=>1
+
+ No Recursion is performed, method would ignore payroll, and return
+ only managers.
+
+ -nomiddles=>1
+
+ Doesn't returns groups 'in the middle', method would ignore mangers,
+ and return only payroll.
+
+ -nogroups=>1
+
+ Doesn't return members that are groups. This only applies to the
+ list() method, in which case it acts like nomiddles, except on the
+ member instead of the group. list would ignore managers and return
+ joe => managers , joe => payroll.
+
+ This sounds a lot more confusing than it actually is, once you try it
+ once or twice you'll get the idea.
+
+AUTHOR
+ Alan R. Barclay, gorilla at elaine.drink.com
+
+SEE ALSO
+ perl(1), CGI, DBI.
+
Added: packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/t/basic.t?rev=5845&op=file
==============================================================================
--- packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/t/basic.t (added)
+++ packages/libset-nestedgroups-perl/libset-nestedgroups-perl/branches/upstream/current/t/basic.t Tue Jul 17 18:59:07 2007
@@ -1,0 +1,73 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..9\n"; }
+END {print "not ok $loaded\n" unless $loaded;}
+use Set::NestedGroups;
+$loaded = 1;
+print "ok 1\n";
+#
+# New
+$acl=new Set::NestedGroups;
+print "ok 2\n";
+
+# Add some data
+$acl->add('joe','manager');
+$acl->add('manager','hr');
+
+# Some basic sanity checks
+if($acl->member('joe')){
+ print "ok 3\n";
+} else {
+ print "not ok 3\n";
+}
+
+unless($acl->member('jim')){
+ print "ok 4\n";
+} else {
+ print "not ok 4\n";
+}
+
+if($acl->group('hr')){
+ print "ok 5\n";
+} else {
+ print "not ok 5\n";
+}
+
+unless($acl->group('payroll')){
+ print "ok 6\n";
+} else {
+ print "not ok 6\n";
+}
+
+# Check the recusion & stuff (I often seem to get this wrong when programming,
+# so it's well worth testing)
+
+# Directly belong to
+ at groups=$acl->groups('joe',-norecurse=>1);
+if(@groups == 1 && $groups[0] eq "manager"){
+ print "ok 7\n";
+} else {
+ print "not ok 7\n";
+}
+
+# Final groups only
+ at groups=$acl->groups('joe',-nomiddles=>1);
+if(@groups == 1 && $groups[0] eq "hr"){
+ print "ok 8\n";
+} else {
+ print "not ok 8\n";
+}
+
+# Both !
+ at groups=$acl->groups('joe');
+if(@groups == 2 && join("",sort @groups) eq "hrmanager"){
+ print "ok 9\n";
+} else {
+ print "not ok 9\n";
+}
More information about the Pkg-perl-cvs-commits
mailing list