This file is indexed.

/usr/share/perl5/User/Identity/Collection.pm is in libuser-identity-perl 0.96-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
# Copyrights 2003-2016 by [Mark Overmeer <perl@overmeer.net>].
#  For other contributors see Changes.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
package User::Identity::Collection;
use vars '$VERSION';
$VERSION = '0.96';

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;