diff options
Diffstat (limited to 'libpiny/lib/Piny/User.pm')
| -rw-r--r-- | libpiny/lib/Piny/User.pm | 216 |
1 files changed, 216 insertions, 0 deletions
diff --git a/libpiny/lib/Piny/User.pm b/libpiny/lib/Piny/User.pm new file mode 100644 index 0000000..20ef4f1 --- /dev/null +++ b/libpiny/lib/Piny/User.pm @@ -0,0 +1,216 @@ +# Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org> +# Licensed under the BSD 3-clause license. + +use strict; +use warnings; + +package Piny::User; + +use Moose; +use Moose::Util::TypeConstraints; +use MooseX::StrictConstructor; + +use Piny::Email; +use Piny::Group; + +# Types + +subtype 'Username' + => as 'Str' + => where { $_ =~ /^(?!(git|ikiwiki)-)[a-zA-Z][a-zA-Z0-9_.-]*$/ } + => message { 'That username is not in the correct format for a piny user.' } + ; + +# Attributes + +has 'uid' => + ( is => 'ro' + , isa => 'Int' + , lazy_build => 1 + ); + +has 'name' => + ( is => 'ro' + , isa => 'Username' + , lazy_build => 1 + ); + +has 'pwent' => + ( is => 'ro' + , isa => 'ArrayRef' + , lazy_build => 1 + , init_arg => undef + ); + +has 'password_hash' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'email' => + ( is => 'ro' + , isa => 'Piny::Email' + , lazy_build => 1 + , init_arg => undef + ); + +has 'groups' => + ( is => 'ro' + , isa => 'ArrayRef[Piny::Group]' + , lazy_build => 1 + , init_arg => undef + ); + +# Public methods + +sub add_group { + my ( $s, @groups ) = @_; + + foreach my $group ( @groups ) { + $group->add_member( $s ); + }; +}; + +sub remove_group { + my ( $s, @groups ) = @_; + + foreach my $group ( @groups ) { + $group->remove_member( $s ); + }; +}; + +sub has_group { + my ( $s, $group ) = @_; + + foreach my $owngroup ( @{$s->groups( )} ) { + return 1 if $owngroup->gid( ) == $group->gid( ); + }; + + return; +}; + +# Class methods + +sub all_users { + my ( $class ) = @_; + + my @ret; + + endpwent( ); + + while ( my @info = getpwent( ) ) { + eval { + my $user = $class->new( uid => $info[2] ); + # Some forced early evaluation, so error checking happens now. + $user->name( ); + $user->email( ); + push( @ret, $user ); + }; + }; + + endpwent( ); + + return @ret; +}; + +# Builder methods + +# If constructed with just one argument, then +# * If that argument is numeric, treat it as a UID. +# * Otherwise, treat it as a username. +around BUILDARGS => sub { + my ( $orig, $class ) = ( shift, shift ); + + if ( @_ == 1 && ! ref $_[0] ) { + if ( $_[0] =~ m/^\d+$/ ) { + return $class->$orig( uid => $_[0] ); + } else { + return $class->$orig( name => $_[0] ); + }; + } else { + return $class->$orig( @_ ); + }; +}; + +sub BUILD { + my ( $s ) = @_; + + if ( not ( $s->has_uid( ) or $s->has_name( ) ) ) { + die "You must provide either UID or name!"; + }; + + if ( $s->has_uid( ) and $s->has_name( ) ) { + die "You must not provide both UID and name!"; + }; +}; + +sub _build_uid { + my ( $s ) = @_; + + return $s->pwent( )->[2]; +}; + +sub _build_name { + my ( $s ) = @_; + + return $s->pwent( )->[0]; +}; + +sub _build_pwent { + my ( $s ) = @_; + + if ( $s->has_uid( ) ) { + my @res = getpwuid( $s->uid( ) ); + die "getpwuid( " . $s->uid( ) . " ) failed: $!" unless @res; + return \@res; + } elsif ( $s->has_name( ) ) { + my @res = getpwnam( $s->name( ) ); + die "getpwnam( " . $s->name( ) . " ) failed: $!" unless @res; + return \@res; + } else { + die "Not enough information provided to lookup user!"; + }; +}; + +sub _build_password_hash { + my ( $s ) = @_; + + return $s->pwent( )->[1]; +}; + +sub _build_email { + my ( $s ) = @_; + + return Piny::Email->new( address => $s->pwent( )->[6] ); +}; + +sub _build_groups { + my ( $s ) = @_; + + my @res; + my @ent; + + endgrent( ); + + while ( @ent = getgrent( ) ) { + next if ( $ent[3] eq "" ); + foreach my $member ( split( / /, $ent[3] ) ) { + if ( $member eq $s->name( ) ) { + push @res, Piny::Group->new( gid => $ent[2] ); + last; + }; + }; + }; + + endgrent( ); + + return \@res; +}; + +# Moose boilerplate + +__PACKAGE__->meta->make_immutable; + +1; |