| [vhffs-dev] [2000] reworked Vhffs::Object, Vhffs::User, Vhffs::Group |
[ Thread Index |
Date Index
| More vhffs.org/vhffs-dev Archives
]
Revision: 2000
Author: gradator
Date: 2012-02-10 00:23:00 +0100 (Fri, 10 Feb 2012)
Log Message:
-----------
reworked Vhffs::Object, Vhffs::User, Vhffs::Group
Modified Paths:
--------------
trunk/vhffs-api/src/Vhffs/Acl.pm
trunk/vhffs-api/src/Vhffs/Group.pm
trunk/vhffs-api/src/Vhffs/Object.pm
trunk/vhffs-api/src/Vhffs/User.pm
trunk/vhffs-api/src/examples/create_user.pl
Modified: trunk/vhffs-api/src/Vhffs/Acl.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Acl.pm 2012-02-08 22:07:20 UTC (rev 1999)
+++ trunk/vhffs-api/src/Vhffs/Acl.pm 2012-02-09 23:23:00 UTC (rev 2000)
@@ -83,6 +83,8 @@
Should be modified soon to use OIDs instead of heavy objects.
+An ACL where granted_oid is a group object is the default access for users of the group.
+
=cut
sub add_acl
Modified: trunk/vhffs-api/src/Vhffs/Group.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Group.pm 2012-02-08 22:07:20 UTC (rev 1999)
+++ trunk/vhffs-api/src/Vhffs/Group.pm 2012-02-09 23:23:00 UTC (rev 2000)
@@ -37,379 +37,586 @@
use DBI;
use Vhffs::Constants;
+=pod
=head1 NAME
-Vhffs::Object - Handle a group in VHFFS
+Vhffs::Group - Vhffs Interface to handle *NIX groups
=head1 SYNOPSIS
-TODO
+ use Vhffs::Main;
+ my $vhffs = init Vhffs::Main or die();
+ my $group = Vhffs::Group::get_by_groupname( $vhffs , 'mygroup' );
+ defined $group ? print "Group exists\n" : print "Group does not exist\n";
+ ...
+ my $group = Vhffs::Group::create( $vhffs, 'mygroup', 'Group Human Name', $uid, $gid, $description );
+ defined $group ? print "Group created" : print "Group error\n";
+ ...
+ print "Groupname: $group->get_groupname";
+ ...
+ print "Successfully updated group preferences\n" if $group->commit > 0;
+=cut
-=head1 DESCRIPTION
+=pod
+=head1 CLASS METHODS
+=cut
-TODO
+=pod
-=head1 METHODS
+=head2 check_groupname
+ print 'Groupname valid' if Vhffs::Group::check_groupname($groupname));
+
+returns false if groupname is not valid (length not between 3 and 12, name not
+composed of alphanumeric chars)
+
=cut
-
sub check_groupname($) {
- my $groupname = shift;
- return ( defined $groupname && $groupname =~ /^[a-z0-9]{3,12}$/ );
+ my $groupname = shift;
+ return defined $groupname and $groupname =~ /^[a-z0-9]{3,12}$/;
}
-
=pod
+=head2 _new
+
+ Self constructor, almost private, please use get_by_* methods instead.
+
+=cut
+sub _new {
+ no strict 'refs';
+ my ($class, $main, $gid, $oid, $owner_uid, $groupname, $realname, $passwd, $quota, $quota_used, $date_creation, $description, $state) = @_;
+ my $self = $class->SUPER::_new($main, $oid, $owner_uid, $gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_GROUP);
+ return undef unless defined $self;
+
+ $self->{gid} = $gid;
+ $self->{groupname} = $groupname;
+ $self->{realname} = $realname;
+ $self->{passwd} = $passwd;
+ $self->{quota} = $quota;
+ $self->{quota_used} = $quota_used;
+
+ return $self;
+}
+
+=pod
+
=head2 create
- my $group = Vhffs::Group::create($main, $groupname, $realname, $owner_uid, $gid, $description)
+ my $group = Vhffs::Group::create($main, $groupname, $realname, $owner_uid, $gid, $description)
Create in DB and return a fully functional group.
=cut
-
sub create {
- my ($main, $groupname, $realname, $owner_uid, $gid, $description) = @_;
- return undef unless check_groupname($groupname);
- return undef unless defined($owner_uid);
+ my ($main, $groupname, $realname, $owner_uid, $gid, $description) = @_;
+ return undef unless check_groupname($groupname);
+ return undef unless defined($owner_uid);
- my $groupconf = $main->get_config->get_groups;
- my $group;
+ my $groupconf = $main->get_config->get_groups;
+ my $group;
- open(my $badgroups, '<', $groupconf->{'bad_groupname_file'} );
- if( defined $badgroups ) {
- while( <$badgroups> ) {
- chomp;
- if ( $_ eq $groupname ) {
- close $badgroups;
- return undef;
- }
- }
- close $badgroups;
- }
+ open(my $badgroups, '<', $groupconf->{'bad_groupname_file'} );
+ if( defined $badgroups ) {
+ while( <$badgroups> ) {
+ chomp;
+ if ( $_ eq $groupname ) {
+ close $badgroups;
+ return undef;
+ }
+ }
+ close $badgroups;
+ }
- $realname = $groupname unless defined $realname;
+ $realname = $groupname unless defined $realname;
- my $dbh = $main->get_db_object;
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
+ my $dbh = $main->get_db_object;
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
- # Avoid an error if we're already in a transaction
- # (eg. when creating user).
- my $transaction_started;
- if($dbh->{AutoCommit}) {
- # AutoCommit is on => we're not yet in a
- # transaction, let's start one
- $dbh->begin_work;
- $transaction_started = 1;
- } else {
- # We're already in a transaction, ensure that
- # we don't corrupt it.
- $transaction_started = 0;
- }
+ # Avoid an error if we're already in a transaction
+ # (eg. when creating user).
+ my $transaction_started;
+ if($dbh->{AutoCommit}) {
+ # AutoCommit is on => we're not yet in a
+ # transaction, let's start one
+ $dbh->begin_work;
+ $transaction_started = 1;
+ } else {
+ # We're already in a transaction, ensure that
+ # we don't corrupt it.
+ $transaction_started = 0;
+ }
- eval {
- # Special case : sometimes, gid can't be passed to create
- # to avoid updates (cf Vhffs::User::create)
- ($gid) = $dbh->selectrow_array('SELECT nextval(\'vhffs_groups_gid_seq\')') unless defined $gid;
+ eval {
+ # Special case : sometimes, gid can't be passed to create
+ # to avoid updates (cf Vhffs::User::create)
+ ($gid) = $dbh->selectrow_array('SELECT nextval(\'vhffs_groups_gid_seq\')') unless defined $gid;
- my $parent = Vhffs::Object::create($main, $owner_uid, $gid, $description, undef, Vhffs::Constants::TYPE_GROUP);
- die('Unable to create parent object') unless(defined $parent);
-
- my $quota = $groupconf->{default_quota} || 10;
-
- my $query = 'INSERT INTO vhffs_groups(gid, groupname, realname, passwd, quota, quota_used, object_id) VALUES(?, ?, ?, NULL, ?, 0, ?)';
- my $sth = $dbh->prepare( $query );
- $sth->execute($gid, $groupname, $realname, $quota, $parent->get_oid);
+ my $parent = Vhffs::Object::create($main, $owner_uid, $gid, $description, undef, Vhffs::Constants::TYPE_GROUP);
+ die('Unable to create parent object') unless(defined $parent);
+
+ my $quota = $groupconf->{default_quota} || 10;
+
+ my $query = 'INSERT INTO vhffs_groups(gid, groupname, realname, passwd, quota, quota_used, object_id) VALUES(?, ?, ?, NULL, ?, 0, ?)';
+ my $sth = $dbh->prepare( $query );
+ $sth->execute($gid, $groupname, $realname, $quota, $parent->get_oid);
- $dbh->commit if($transaction_started);
- $group = get_by_gid($main, $gid);
- };
+ $dbh->commit if($transaction_started);
+ $group = get_by_gid($main, $gid);
+ };
- if($transaction_started && $@) {
- warn "Unable to create group $groupname: $@\n";
- $dbh->rollback;
- }
+ if($transaction_started && $@) {
+ warn "Unable to create group $groupname: $@\n";
+ $dbh->rollback;
+ }
- return $group;
+ return $group;
}
-=head2 remove_user
+=pod
- $group->remove_user( $uid );
+=head2 fill_object
-Remove an user from a given group.
-Return false if an error occurs or if the
-user wasn't in the group.
+See C<Vhffs::Object::fill_object>.
=cut
+sub fill_object {
+ my ($class, $obj) = @_;
+ my $sql = q{SELECT gid, groupname, realname, passwd, quota, quota_used FROM
+ vhffs_groups WHERE object_id = ?};
+ return $class->SUPER::_fill_object($obj, $sql);
+}
-sub remove_user
-{
- my $self = shift;
- my $uid = shift;
+=pod
- my $sql = 'UPDATE vhffs_user_group SET state=? WHERE gid=? AND uid=?';
- return $self->{db}->do( $sql, {}, Vhffs::Constants::TO_DELETE, $self->{gid}, $uid ) > 0;
+=head2 getall
+
+ my @groups = Vhffs::User::getall( $main, $state, $name );
+
+Returns an array of groups which matched $state and $name.
+
+=cut
+sub getall {
+ my $vhffs = shift;
+ my $state = shift;
+ my $name = shift;
+
+ my $db = $vhffs->get_db_object;
+ my @result;
+ my $query = 'SELECT groupname FROM vhffs_groups g INNER JOIN vhffs_object o ON g.object_id=o.object_id LEFT OUTER JOIN vhffs_users u ON u.username = g.groupname WHERE u.username IS NULL ';
+
+ $query .= " AND o.state=$state " if( defined $state );
+ $query .= " AND g.groupname LIKE '%".$name."%' " if( defined $name );
+
+ $query .= " ORDER BY g.groupname";
+
+ my $request = $db->prepare( $query );
+ my $rows = $request->execute;
+
+ return undef if( $rows <= 0 );
+
+ my $names = $request->fetchall_arrayref;
+
+ my $group;
+ foreach $name ( @{$names} ) {
+ $group = Vhffs::Group::get_by_groupname( $vhffs , $name->[0] );
+ push( @result , $group) if( defined $group );
+ }
+ return \@result;
}
+=pod
+=head2 getall_by_letter
-sub commit
-{
- my $self = shift;
+ my @groups = Vhffs::User::getall_by_letter( $main, $letter, $state );
- my $sql = 'UPDATE vhffs_groups SET realname = ?, quota = ?, quota_used = ? WHERE gid = ?';
- my $sth = $self->{db}->prepare($sql);
- $sth->execute( $self->{'realname'}, $self->{'quota'}, $self->{'quota_used'}, $self->{'gid'}) or return -1;
+Returns an array of all groups which starts by letter $letter and are having state $state.
- #Exec the super method !
- return -2 if( $self->SUPER::commit < 0 );
+=cut
+sub getall_by_letter {
+ my $vhffs = shift;
+ my $letter = shift;
+ my $state = shift;
+ return getall($vhffs, $state) if(! defined $letter );
+ $letter .= '%';
+
+ my $db = $vhffs->get_db_object;
+ my @result;
+ my $query = 'SELECT groupname FROM vhffs_groups g INNER JOIN vhffs_object o ON g.object_id=o.object_id LEFT OUTER JOIN vhffs_users u ON u.username = g.groupname WHERE u.username IS NULL AND g.groupname LIKE ?';
+ $query .= "AND o.state=$state " if( defined $state );
+
+ my $request = $db->prepare( $query );
+ return undef if( ! $request->execute( $letter ) );
+
+ my $names = $request->fetchall_arrayref;
+
+ my $group;
+ foreach my $name ( @{$names} ) {
+
+ $group = Vhffs::Group::get_by_groupname( $vhffs , $name->[0] );
+ push( @result , $group) if( defined $group );
+ }
+ return \@result;
+}
+
+=pod
+
+=head2 getall_quotalimit
+
+ my @groups = Vhffs::User::getall_quotalimit( $main, $limit );
+
+Returns an array of groups which are using more than 90% of the disk quota applied
+
+Maximum number of returned group is set by $limit, default value is 10.
+
+=cut
+sub getall_quotalimit {
+ my ($vhffs, $limit) = @_;
+ $limit = 10 unless(defined $limit);
+ my $sql = q{SELECT g.gid, o.object_id, o.owner_uid, g.groupname, g.realname, g.passwd, g.quota,
+ g.quota_used, o.date_creation, o.description, o.state
+ FROM vhffs_groups g INNER JOIN vhffs_object o ON o.object_id = g.object_id
+ WHERE (g.quota_used / g.quota) >= 0.9 ORDER BY g.quota_used DESC LIMIT ?};
+
+ my $dbh = $vhffs->get_db_object;
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($limit) or return undef;
+ my $groups = [];
+ while(my @r = $sth->fetchrow_array) {
+ push @{$groups}, _new Vhffs::Group($vhffs, @r);
+ }
+ return $groups;
+}
+
+=pod
+
+=head2 get_by_gid
+
+ my $group = Vhffs::Group::get_by_gid($main, $gid);
+ die('Group not found') unless(defined $group);
+
+Fetches the group whose gid is $gid.
+
+=cut
+sub get_by_gid {
+ my ($vhffs, $gid) = @_;
+ my $query = 'SELECT g.gid, o.object_id, o.owner_uid, g.groupname, g.realname, g.passwd, g.quota, g.quota_used, o.date_creation, o.description, o.state FROM vhffs_groups g INNER JOIN vhffs_object o ON o.object_id = g.object_id WHERE g.gid = ?';
+
+ my $dbh = $vhffs->get_db_object;
+ my @params = $dbh->selectrow_array($query, undef, $gid);
+ return undef unless(@params);
+ my $group = _new Vhffs::Group($vhffs, @params);
+ return $group;
+}
+
+=pod
+
+=head2 get_by_groupname
+
+ my $group = Vhffs::Group::get_by_groupname($main, $groupname);
+ die('Group not found') unless(defined $group);
+
+Fetches the group whose name is $groupname.
+
+=cut
+sub get_by_groupname {
+ my ($vhffs, $groupname) = @_;
+ my $query = 'SELECT g.gid, o.object_id, o.owner_uid, g.groupname, g.realname, g.passwd, g.quota, g.quota_used, o.date_creation, o.description, o.state FROM vhffs_groups g INNER JOIN vhffs_object o ON o.object_id = g.object_id WHERE g.groupname = ?';
+
+ my $dbh = $vhffs->get_db_object;
+ my @params = $dbh->selectrow_array($query, undef, $groupname);
+ return undef unless(@params);
+ my $group = _new Vhffs::Group($vhffs, @params);
+ return $group;
+}
+
+=pod
+=head1 INSTANCE METHODS
+=cut
+
+=pod
+
+=head2 commit
+
+ my $ret = $group->commit;
+
+Commit all changes to the database, returns 1 if success, otherwise returns a negative value.
+
+=cut
+sub commit {
+ my $self = shift;
+
+ return -1 if $self->SUPER::commit < 0;
+
+ my $sql = 'UPDATE vhffs_groups SET realname = ?, quota = ?, quota_used = ? WHERE gid = ?';
+ my $sth = $self->{db}->prepare($sql);
+ $sth->execute( $self->{'realname'}, $self->{'quota'}, $self->{'quota_used'}, $self->{'gid'}) or return -1;
+
return 1;
}
+=head2 add_user
+ $group->add_user($uid);
-sub is_empty
-{
+Adds an user to a group. Returns false if user doesn't exists or if there was an error.
+
+=cut
+sub add_user {
+ my( $self , $uid ) = @_;
+
+ my $sql = 'INSERT INTO vhffs_user_group(uid, gid, state) VALUES(?, ?, ?)';
+ my $res = $self->{db}->do( $sql, {}, $uid, $self->{gid}, Vhffs::Constants::WAITING_FOR_CREATION );
+ return $res and $res > 0;
+}
+
+=pod
+
+=head2 remove_user
+
+ $group->remove_user( $uid );
+
+Remove an user from a given group.
+Return false if an error occurs or if the user wasn't in the group.
+
+=cut
+sub remove_user {
my $self = shift;
- return -1 unless defined $self;
+ my $uid = shift;
+ my $sql = 'UPDATE vhffs_user_group SET state=? WHERE gid=? AND uid=?';
+ return $self->{db}->do( $sql, {}, Vhffs::Constants::TO_DELETE, $self->{gid}, $uid ) > 0;
+}
+
+=pod
+
+=head2 is_empty
+
+ print "Group is empty !\n" if $group->is_empty;
+
+Return true if the group is empty, otherwise retourn false.
+
+=cut
+sub is_empty {
+ my $self = shift;
+ return 0 unless defined $self;
+
my $query = 'SELECT COUNT(*) FROM vhffs_object WHERE owner_gid=? AND object_id!=?';
my $request = $self->{'db'}->prepare( $query );
$request->execute( $self->get_gid, $self->get_oid );
my ( $rows ) = $request->fetchrow();
- return 1 if( $rows == 0 );
- return 0;
+ return $rows ? 0 : 1;
}
+=pod
-#Delete a group in the database
-sub delete
-{
- my $self;
- my $request;
- my $request2;
- my $request3;
+=head2 delete
- $self = shift;
+ my $ret = $group->delete;
+Delete a group from the database. Should be called after group have been cleaned up from the filesystem.
+
+=cut
+sub delete {
+ my $self;
+ my $request;
+ my $request2;
+ my $request3;
+
+ $self = shift;
+
use Vhffs::Services::MailGroup;
my $mg = init Vhffs::Services::MailGroup( $self->{'main'} , $self );
- if( defined $mg )
- {
+ if( defined $mg ) {
$mg->delbox;
$mg->delforward;
}
- $request = $self->{'db'}->prepare('DELETE FROM vhffs_groups WHERE gid=?');
- $request->execute($self->{'gid'}) or return -1;
-
- $self->SUPER::delete;
+ $request = $self->{'db'}->prepare('DELETE FROM vhffs_groups WHERE gid=?');
+ $request->execute($self->{'gid'}) or return -1;
+
+ $self->SUPER::delete;
- return 1;
+ return 1;
}
+=pod
-=head2 add_user
+=head2 set_quota
- $group->add_user($uid);
+Set the group disk quota.
-Adds an user to a group. Returns false if user
-doesn't exists or if there was an error.
-
=cut
-
-sub add_user
-{
- my( $self , $uid ) = @_;
-
- my $sql = 'INSERT INTO vhffs_user_group(uid, gid, state) VALUES(?, ?, ?)';
- my $res = $self->{db}->do( $sql, {}, $uid, $self->{gid}, Vhffs::Constants::WAITING_FOR_CREATION );
- return $res && $res > 0;
-}
-
-sub set_quota
-{
+sub set_quota {
my $self = shift;
my $value = shift;
$self->{'quota'} = $value;
}
+=pod
-sub set_realname
-{
+=head2 set_realname
+
+Set the group realname.
+
+=cut
+sub set_realname {
my $self = shift;
my $value = shift;
$self->{'realname'} = $value;
}
+=pod
-sub set_quota_used
-{
+=head2 set_quota_used
+
+Set the disk space used by this group.
+
+=cut
+sub set_quota_used {
my $self = shift;
my $value = shift;
$self->{'quota_used'} = $value;
}
+=pod
+=head2 get_quota_used
-sub get_quota_used
-{
+Returns the disk space used by this group.
+
+=cut
+sub get_quota_used {
my $self = shift;
return $self->{'quota_used'};
}
+=pod
-sub get_realname
-{
+=head2 get_realname
+
+Returns the group realname (human name).
+
+=cut
+sub get_realname {
my $self = shift;
return $self->{'realname'};
}
-
=head2 get_label
See C<Vhffs::Object::get_label>.
=cut
-
sub get_label {
my $self = shift;
return $self->{groupname};
}
-sub get_quota
-{
+=pod
+
+=head2 get_quota
+
+Returns the disk quota set for this group.
+
+=cut
+sub get_quota {
my $self = shift;
return $self->{'quota'};
}
-sub get_groupname
-{
+=pod
+
+=head2 get_groupname
+
+Returns the name of this group.
+
+=cut
+sub get_groupname {
my $self = shift;
return $self->{'groupname'};
}
-sub get_gid
-{
+=pod
+
+=head2 get_gid
+
+Returns group GID.
+
+=cut
+sub get_gid {
my $self = shift;
return $self->{'gid'};
}
+=pod
+
+=head2 get_dir
+
+Returns group directory. Such as /data/groups/v/h/vhffs4/.
+
+=cut
sub get_dir {
my $self = shift;
- return $self->{'main'}->get_config->get_datadir.'/groups/'.substr($self->get_groupname, 0, 1).'/'.substr($self->get_groupname, 1, 1).'/'.$self->get_groupname;
+ return $self->{'main'}->get_config->get_datadir.'/groups/'.substr($self->get_groupname, 0, 1).'/'.substr($self->get_groupname, 1, 1).'/'.$self->get_groupname;
}
-sub get_users
-{
- use Vhffs::User;
- my $self = shift;
+=pod
- my @users;
- my $gid = $self->get_gid;
- my $query = 'SELECT ug.uid FROM vhffs_user_group ug WHERE ug.gid = ?';
- my $request = $self->{'db'}->prepare( $query );
- $request->execute($gid);
- while( my ($uid) = $request->fetchrow_array )
- {
- my $user = Vhffs::User::get_by_uid( $self->{'main'} , $uid );
- push( @users , $user ) if( defined $user );
- }
- return \@users;
-}
+=head2 get_users
-sub getall
-{
- my $vhffs = shift;
- my $state = shift;
- my $name = shift;
+Returns an array of all users C<Vhffs::Users> of this group.
- my $db = $vhffs->get_db_object;
- my @result;
- my $query = 'SELECT groupname FROM vhffs_groups g INNER JOIN vhffs_object o ON g.object_id=o.object_id LEFT OUTER JOIN vhffs_users u ON u.username = g.groupname WHERE u.username IS NULL ';
-
- $query .= " AND o.state=$state " if( defined $state );
- $query .= " AND g.groupname LIKE '%".$name."%' " if( defined $name );
+=cut
+sub get_users {
+ use Vhffs::User;
+ my $self = shift;
- $query .= " ORDER BY g.groupname";
-
- my $request = $db->prepare( $query );
- my $rows = $request->execute;
-
- return undef if( $rows <= 0 );
-
- my $names = $request->fetchall_arrayref;
-
- my $group;
- foreach $name ( @{$names} )
- {
- $group = Vhffs::Group::get_by_groupname( $vhffs , $name->[0] );
- push( @result , $group) if( defined $group );
- }
- return \@result;
+ my @users;
+ my $gid = $self->get_gid;
+ my $query = 'SELECT ug.uid FROM vhffs_user_group ug WHERE ug.gid = ?';
+ my $request = $self->{'db'}->prepare( $query );
+ $request->execute($gid);
+ while( my ($uid) = $request->fetchrow_array ) {
+ my $user = Vhffs::User::get_by_uid( $self->{'main'} , $uid );
+ push( @users , $user ) if( defined $user );
+ }
+ return \@users;
}
-sub getall_by_letter
-{
- my $vhffs = shift;
- my $letter = shift;
- my $state = shift;
+=pod
- return getall($vhffs, $state) if(! defined $letter );
- $letter .= '%';
+=head2 get_full_history
- my $db = $vhffs->get_db_object;
- my @result;
- my $query = 'SELECT groupname FROM vhffs_groups g INNER JOIN vhffs_object o ON g.object_id=o.object_id LEFT OUTER JOIN vhffs_users u ON u.username = g.groupname WHERE u.username IS NULL AND g.groupname LIKE ?';
- $query .= "AND o.state=$state " if( defined $state );
-
- my $request = $db->prepare( $query );
- return undef if( ! $request->execute( $letter ) );
+Returns an array containing all history entries for this group and its objects,
+descending ordered by date.
- my $names = $request->fetchall_arrayref;
+=cut
+sub get_full_history {
+ my $self = shift;
- my $group;
- foreach my $name ( @{$names} )
- {
+ my $sql = 'SELECT o.object_id,o.type,h.history_id,h.date,h.message,source.username as source FROM vhffs_history h INNER JOIN vhffs_object o ON o.object_id=h.object_id LEFT JOIN vhffs_users source ON source.uid = h.source_uid WHERE o.owner_gid=? ORDER BY date DESC';
+ my $dbh = $self->get_db_object;
+ return $dbh->selectall_arrayref($sql, {Slice => {}}, $self->{gid});
+}
- $group = Vhffs::Group::get_by_groupname( $vhffs , $name->[0] );
- push( @result , $group) if( defined $group );
- }
- return \@result;
+=pod
-}
+=head2 getall_objects
-sub getall_quotalimit {
- my ($vhffs, $limit) = @_;
- $limit = 10 unless(defined $limit);
- my $sql = q{SELECT g.gid, o.object_id, o.owner_uid, g.groupname, g.realname, g.passwd, g.quota,
- g.quota_used, o.date_creation, o.description, o.state
- FROM vhffs_groups g INNER JOIN vhffs_object o ON o.object_id = g.object_id
- WHERE (g.quota_used / g.quota) >= 0.9 ORDER BY g.quota_used DESC LIMIT ?};
-
- my $dbh = $vhffs->get_db_object;
- my $sth = $dbh->prepare($sql);
- $sth->execute($limit) or return undef;
- my $groups = [];
- while(my @r = $sth->fetchrow_array) {
- push @{$groups}, _new Vhffs::Group($vhffs, @r);
- }
- return $groups;
-}
+Returns an array of all objects C<Vhffs::Object> owned by this group.
-# Get all objects of the group
-# TODO should be in Vhffs::Object or should at least returns Vhffs:Object object...
-sub getall_objects
-{
+=cut
+sub getall_objects {
my $self = shift;
+ # TODO should be in Vhffs::Object
my $query = 'SELECT object_id FROM vhffs_object WHERE owner_gid=?';
my $request = $self->get_main->get_db_object->prepare( $query ) or return -1;
return undef unless $request->execute( $self->get_gid );
@@ -423,92 +630,6 @@
return \@objects;
}
-
-=pod
-
-=head2 get_by_gid
-
- my $group = Vhffs::Group::get_by_gid($main, $gid);
- die('Group not found') unless(defined $group);
-
-Fetches the group whose gid is $gid.
-
-=cut
-
-sub get_by_gid {
- my ($vhffs, $gid) = @_;
- my $query = 'SELECT g.gid, o.object_id, o.owner_uid, g.groupname, g.realname, g.passwd, g.quota, g.quota_used, o.date_creation, o.description, o.state FROM vhffs_groups g INNER JOIN vhffs_object o ON o.object_id = g.object_id WHERE g.gid = ?';
-
- my $dbh = $vhffs->get_db_object;
- my @params = $dbh->selectrow_array($query, undef, $gid);
- return undef unless(@params);
- my $group = _new Vhffs::Group($vhffs, @params);
- return $group;
-}
-
-=pod
-
-=head2 get_by_groupname
-
- my $group = Vhffs::Group::get_by_groupname($main, $groupname);
- die('Group not found') unless(defined $group);
-
-Fetches the group whose name is $groupname.
-
-=cut
-
-sub get_by_groupname {
- my ($vhffs, $groupname) = @_;
- my $query = 'SELECT g.gid, o.object_id, o.owner_uid, g.groupname, g.realname, g.passwd, g.quota, g.quota_used, o.date_creation, o.description, o.state FROM vhffs_groups g INNER JOIN vhffs_object o ON o.object_id = g.object_id WHERE g.groupname = ?';
-
- my $dbh = $vhffs->get_db_object;
- my @params = $dbh->selectrow_array($query, undef, $groupname);
- return undef unless(@params);
- my $group = _new Vhffs::Group($vhffs, @params);
- return $group;
-}
-
-
-sub _new {
- no strict 'refs';
- my ($class, $main, $gid, $oid, $owner_uid, $groupname, $realname, $passwd, $quota, $quota_used, $date_creation, $description, $state) = @_;
- my $self = $class->SUPER::_new($main, $oid, $owner_uid, $gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_GROUP);
- return undef unless defined $self;
-
- $self->{gid} = $gid;
- $self->{groupname} = $groupname;
- $self->{realname} = $realname;
- $self->{passwd} = $passwd;
- $self->{quota} = $quota;
- $self->{quota_used} = $quota_used;
-
- return $self;
-}
-
-sub fill_object {
- my ($class, $obj) = @_;
- my $sql = q{SELECT gid, groupname, realname, passwd, quota, quota_used FROM
- vhffs_groups WHERE object_id = ?};
- return $class->SUPER::_fill_object($obj, $sql);
-}
-
-=head2 get_full_history
-
-Returns an array containing all history entries for this group and its objects,
-descending ordered by date.
-
-=cut
-
-sub get_full_history
-{
- my $self = shift;
-
- my $sql = 'SELECT o.object_id,o.type,h.history_id,h.date,h.message,source.username as source FROM vhffs_history h INNER JOIN vhffs_object o ON o.object_id=h.object_id LEFT JOIN vhffs_users source ON source.uid = h.source_uid WHERE o.owner_gid=? ORDER BY date DESC';
- my $dbh = $self->get_db_object;
- return $dbh->selectall_arrayref($sql, {Slice => {}}, $self->{gid});
-}
-
-
1;
__END__
Modified: trunk/vhffs-api/src/Vhffs/Object.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Object.pm 2012-02-08 22:07:20 UTC (rev 1999)
+++ trunk/vhffs-api/src/Vhffs/Object.pm 2012-02-09 23:23:00 UTC (rev 2000)
@@ -28,6 +28,17 @@
# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
+use strict;
+use utf8;
+
+package Vhffs::Object;
+
+use Vhffs::Constants;
+use POSIX qw(locale_h);
+use locale;
+use Locale::gettext;
+use Encode;
+
=head1 SYNOPSIS
Vhffs::Object - The generic object type in VHFFS
@@ -44,21 +55,19 @@
This type store information about state, history, owner group/user.
-=head1 METHODS
+=cut
+=pod
+=head1 CLASS METHODS
=cut
-use strict;
-use utf8;
+=pod
-package Vhffs::Object;
+=head2 _new
-use Vhffs::Constants;
-use POSIX qw(locale_h);
-use locale;
-use Locale::gettext;
-use Encode;
+ Self constructor, almost private, please use get_by_* methods instead.
+=cut
sub _new {
my ($class, $main, $oid, $owner_uid, $owner_gid, $date_creation, $description, $refuse_reason, $state, $type) = @_;
@@ -149,6 +158,131 @@
=pod
+=head2 getall( Vhffs::Main , $name )
+
+The getall is very important and defined in every service. In Vhffs::Object,
+it returns all object if $name is not defined (undef). Return all objects that matches with $name if $name is defined.
+
+If $name is undefined, the functions returns ALL objects.
+
+=cut
+sub getall {
+ my $vhffs = shift;
+ my $name = shift;
+ my $state = shift;
+ my $age = shift; #seconds late
+
+ my $query = 'SELECT o.object_id, o.owner_uid, o.owner_gid, o.date_creation , o.description, o.refuse_reason, o.state, o.type FROM vhffs_object o';
+ my @params;
+
+ if( defined $name ) {
+ $query .= ' INNER JOIN vhffs_users u ON o.owner_uid = u.uid INNER JOIN vhffs_groups g ON o.owner_gid = g.gid WHERE ( o.description LIKE ? ) OR ( o.object_id LIKE ? ) OR ( o.owner_uid LIKE ? ) OR ( state LIKE ? ) OR ( u.username LIKE ? ) OR ( g.groupname LIKE ? )';
+ push(@params, '%'.$name.'%');
+ push(@params, '%'.$name.'%');
+ push(@params, '%'.$name.'%');
+ push(@params, '%'.$name.'%');
+ push(@params, '%'.$name.'%');
+ push(@params, '%'.$name.'%');
+ }
+ if( defined $state ) {
+ if( $query =~ /WHERE/ ) {
+ $query .= ' AND o.state = ?';
+ }
+ else {
+ $query .= ' WHERE o.state = ?';
+ }
+ push(@params, $state);
+ }
+ if( defined $age ) {
+ my $ts = time() - $age;
+
+ if( $query =~ /WHERE/ ) {
+ $query .= ' AND date_creation < ? ';
+ }
+ else {
+ $query .= ' WHERE date_creation < ? ';
+ }
+ push(@params, $ts);
+ }
+
+ $query .= ' ORDER BY object_id';
+
+ my $request = $vhffs->get_db_object->prepare( $query ) or return -1;
+ return undef unless $request->execute(@params);
+
+ my $result;
+ my $rows = $request->fetchall_arrayref();
+ foreach(@$rows) {
+ push(@$result, _new Vhffs::Object($vhffs, @$_));
+ }
+ return $result;
+}
+
+=pod
+
+=head2 fill_object
+
+my $svc = Vhffs::Service::XXX::fill_object($obj);
+
+This method should be overloaded in every subclasses.
+Its goal is to transform a given object into a more
+specialized subclass.
+
+=cut
+sub fill_object {
+ my ($class, $obj) = @_;
+ warn 'Unimplemented fill_object method'."\n";
+ return $obj;
+}
+
+=pod
+
+=head2 _fill_object
+
+my $svc = $class->SUPER::_fill_object($obj, $sql);
+
+Convenience method to implement fill_object in subclasses.
+
+Adds fields returned by C<$sql> query to object $obj and, if the query succeed,
+bless the object with C<$class>.
+
+C<$sql> must contain a placeholder (?) which will be filled with the object
+OID. See subclasses implementation of C<fill_object> for more details.
+
+=cut
+sub _fill_object {
+ my ($class, $obj, $sql) = @_;
+ my $dbh = $obj->get_db_object();
+ my $res = $dbh->selectrow_hashref($sql, undef, $obj->get_oid);
+ return $obj unless(defined $res);
+ foreach(keys %$res) {
+ $obj->{$_} = $res->{$_};
+ }
+ return bless($obj, $class);
+}
+
+=pod
+=head1 INSTANCE METHODS
+=cut
+
+=pod
+
+=head2 commit
+
+Apply all changes that were made on this object. Returns negative value if failed, positive if success.
+
+=cut
+sub commit {
+ my $self = shift;
+ my $request;
+
+ $request = 'UPDATE vhffs_object SET state=?, description=?, refuse_reason=?, owner_uid=?, owner_gid=? WHERE object_id=?';
+ my $result = $self->{'db'}->prepare($request);
+ $result->execute( $self->{'state'} , $self->{'description'} , $self->{'refuse_reason'}, $self->{'owner_uid'} , $self->{'owner_gid'} , $self->{'object_id'} );
+}
+
+=pod
+
=head2 get_main
This method returns the Vhffs::Main object contained in this object.
@@ -160,6 +294,15 @@
return $self->{'main'};
}
+=pod
+
+=head2 delete
+
+Delete the object. This method is called from inherited class.
+Note that it destroy the object-part (history, ...), but not the inherited class.
+Returns negative value if fails, positive if success.
+
+=cut
sub get_db_object {
my $self = shift;
return $self->{main}->get_db_object;
@@ -237,25 +380,17 @@
return $self->{'owner_gid'};
}
-sub get_type {
- my $self = shift;
- return $self->{type};
-}
=pod
-=head2 commit
+=head2 get_type
-Apply all changes that were made on this object. Returns negative value if failed, positive if success.
+Returns the object type. See C<Vhffs::Constants>
=cut
-sub commit {
+sub get_type {
my $self = shift;
- my $request;
-
- $request = 'UPDATE vhffs_object SET state=?, description=?, refuse_reason=?, owner_uid=?, owner_gid=? WHERE object_id=?';
- my $result = $self->{'db'}->prepare($request);
- $result->execute( $self->{'state'} , $self->{'description'} , $self->{'refuse_reason'}, $self->{'owner_uid'} , $self->{'owner_gid'} , $self->{'object_id'} );
+ return $self->{type};
}
=pod
@@ -313,7 +448,6 @@
servername).
=cut
-
sub get_label {
return '????';
}
@@ -331,32 +465,25 @@
$value = shift;
$self->{'state'} = $value;
- if( $value == Vhffs::Constants::TO_DELETE )
- {
+ if( $value == Vhffs::Constants::TO_DELETE ) {
$self->add_history( "Will be deleted" );
}
- elsif( $value == Vhffs::Constants::WAITING_FOR_CREATION )
- {
+ elsif( $value == Vhffs::Constants::WAITING_FOR_CREATION ) {
$self->add_history( "Moderated. Will be created" );
}
- elsif( $value == Vhffs::Constants::CREATING_ERROR )
- {
+ elsif( $value == Vhffs::Constants::CREATING_ERROR ) {
$self->add_history( "Creating error ! Robots can't create it" );
}
- elsif( $value == Vhffs::Constants::CREATED )
- {
+ elsif( $value == Vhffs::Constants::CREATED ) {
$self->add_history( "Object is created" );
}
- elsif( $value == Vhffs::Constants::WAITING_FOR_VALIDATION )
- {
+ elsif( $value == Vhffs::Constants::WAITING_FOR_VALIDATION ) {
$self->add_history( "Object is under moderation");
}
- elsif( $value == Vhffs::Constants::VALIDATION_REFUSED )
- {
+ elsif( $value == Vhffs::Constants::VALIDATION_REFUSED ) {
$self->add_history( "Validation refused");
}
- elsif( $value == Vhffs::Constants::ACTIVATED )
- {
+ elsif( $value == Vhffs::Constants::ACTIVATED ) {
$self->add_history( "Is now active for production");
}
@@ -384,7 +511,6 @@
=cut
sub add_history {
- use Vhffs::Main;
my $self = shift;
my $message = shift;
my $user = $self->{main}->get_current_user->get_uid if defined $self->{main}->get_current_user;
@@ -404,23 +530,15 @@
$history = $object->get_history();
-if( defined $history )
+if( defined $history )
+ foreach $key ( keys %{$history} ) {
-{
-
- foreach $key ( keys %{$history} )
-
- {
-
print "At date " . $key . " message: " . $history->{$key}{'message'};
-
}
-
}
=cut
sub get_history {
- use Vhffs::Functions;
my $self = shift;
my $dbh = $self->get_db_object;
@@ -428,20 +546,38 @@
return $dbh->selectall_arrayref($sql, {Slice => {}}, $self->{object_id});
}
+=pod
+=head2 set_refuse_reason( $reason )
+
+Set refuse reason for this object, with reason $reason.
+
+=cut
sub set_refuse_reason {
my ($self , $value) = @_;
$self->{'refuse_reason'} = $value;
}
+=pod
+
+=head2 get_refuse_reason()
+
+Get refusal reason of this object.
+
+=cut
sub get_refuse_reason {
my $self = shift;
- return gettext('no reason given') if( !defined $self->{'refuse_reason'} || length $self->{'refuse_reason'} <= 0 );
+ return gettext('no reason given') unless defined $self->{'refuse_reason'} and length $self->{'refuse_reason'} > 0;
return $self->{'refuse_reason'};
}
+=pod
-# Accept this object
+=head2 moderate_accept( $comment )
+
+Accept this object, with optional comment $comment.
+
+=cut
sub moderate_accept {
my $self = shift;
my $comments = shift;
@@ -502,8 +638,13 @@
return $self->commit;
}
+=pod
-# Refuse this object
+=head2 moderate_refuse( $reason )
+
+Refuse this object, with reason $reason.
+
+=cut
sub moderate_refuse {
my $self = shift;
my $reason = shift;
@@ -551,8 +692,13 @@
return $self->commit;
}
+=pod
-# Delete this object with a notice mail
+=head2 delete_withmail()
+
+Delete this object, sending a nice mail to the owner.
+
+=cut
sub delete_withmail {
my $self = shift;
@@ -593,7 +739,13 @@
$self->delete;
}
+=pod
+=head2 resubmit_for_moderation( $description )
+
+Put an object back in waiting for moderation state, using the new $description description.
+
+=cut
sub resubmit_for_moderation {
my $self = shift;
my $description = shift;
@@ -608,71 +760,6 @@
=pod
-=head2 getall( Vhffs::Main , $name )
-
-The getall is very important and defined in every service. In Vhffs::Object,
-it returns all object if $name is not defined (undef). Return all objects that matches with $name if $name is defined.
-
-If $name is undefined, the functions returns ALL objects.
-
-=cut
-sub getall {
- my $vhffs = shift;
- my $name = shift;
- my $state = shift;
- my $age = shift; #seconds late
-
- my $query = 'SELECT o.object_id, o.owner_uid, o.owner_gid, o.date_creation , o.description, o.refuse_reason, o.state, o.type FROM vhffs_object o';
- my @params;
-
- if( defined $name )
- {
- $query .= ' INNER JOIN vhffs_users u ON o.owner_uid = u.uid INNER JOIN vhffs_groups g ON o.owner_gid = g.gid WHERE ( o.description LIKE ? ) OR ( o.object_id LIKE ? ) OR ( o.owner_uid LIKE ? ) OR ( state LIKE ? ) OR ( u.username LIKE ? ) OR ( g.groupname LIKE ? )';
- push(@params, '%'.$name.'%');
- push(@params, '%'.$name.'%');
- push(@params, '%'.$name.'%');
- push(@params, '%'.$name.'%');
- push(@params, '%'.$name.'%');
- push(@params, '%'.$name.'%');
- }
- if( defined $state )
- {
- if( $query =~ /WHERE/ ) {
- $query .= ' AND o.state = ?';
- }
- else {
- $query .= ' WHERE o.state = ?';
- }
- push(@params, $state);
- }
- if( defined $age )
- {
- my $ts = time() - $age;
-
- if( $query =~ /WHERE/ ) {
- $query .= ' AND date_creation < ? ';
- }
- else {
- $query .= ' WHERE date_creation < ? ';
- }
- push(@params, $ts);
- }
-
- $query .= ' ORDER BY object_id';
-
- my $request = $vhffs->get_db_object->prepare( $query ) or return -1;
- return undef unless $request->execute(@params);
-
- my $result;
- my $rows = $request->fetchall_arrayref();
- foreach(@$rows) {
- push(@$result, _new Vhffs::Object($vhffs, @$_));
- }
- return $result;
-}
-
-=pod
-
=head2 get_group
my $group = $object->get_group;
@@ -705,45 +792,6 @@
return $self->{'user'};
}
-=head2 fill_object
-
-my $svc = Vhffs::Service::XXX::fill_object($obj);
-
-This method should be overloaded in every subclasses.
-Its goal is to transform a given object into a more
-specialized subclass.
-=cut
-sub fill_object {
- my ($class, $obj) = @_;
- warn 'Unimplemented fill_object method'."\n";
- return $obj;
-}
-
-=head2 _fill_object
-
-my $svc = $class->SUPER::_fill_object($obj, $sql);
-
-Convenience method to implement fill_object in subclasses.
-
-Adds fields returned by C<$sql> query to object $obj and, if the query succeed,
-bless the object whith C<$class>.
-
-C<$sql> must contain a placeholder (?) which will be filled with the object
-OID. See subclasses implementation of C<fill_object> for more details.
-
-=cut
-
-sub _fill_object {
- my ($class, $obj, $sql) = @_;
- my $dbh = $obj->get_db_object();
- my $res = $dbh->selectrow_hashref($sql, undef, $obj->get_oid);
- return $obj unless(defined $res);
- foreach(keys %$res) {
- $obj->{$_} = $res->{$_};
- }
- return bless($obj, $class);
-}
-
1;
__END__
Modified: trunk/vhffs-api/src/Vhffs/User.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/User.pm 2012-02-08 22:07:20 UTC (rev 1999)
+++ trunk/vhffs-api/src/Vhffs/User.pm 2012-02-09 23:23:00 UTC (rev 2000)
@@ -30,11 +30,6 @@
package Vhffs::User;
-#Vhffs::User written by sod` <dieu AT gunnm DOT org>
-#Vhffs::User implements Unix authentification as an module of Vhffs.
-#You can manage user with Unix.
-#libnss-postgresql must be used with it to have an account on a machine with the database
-
use base qw(Vhffs::Object);
use strict;
use utf8;
@@ -55,168 +50,138 @@
=head1 SYNOPSIS
use Vhffs::Main;
- $vhffs = init Vhffs::Main;
- $user = Vhffs::User::get_by_username( $vhffs , "myuser" );
- if( defined $user )
- {
- print "User exists\n";
- }
- else
- {
- print "User does not exist\n";
- }
+ my $vhffs = init Vhffs::Main or die();
+ my $user = Vhffs::User::get_by_username( $vhffs , 'myuser' );
+ defined $user ? print "User exists\n" : print "User does not exist\n";
...
- $user = Vhffs::User::create( $vhffs, 'myuser', 'apassword', 0, 'myuser@xxxxxxxxx');
- if( defined $user )
- {
- print "User created";
- }
- else
- {
- print "User error\n";
- }
+ my $user = Vhffs::User::create( $vhffs, 'myuser', 'apassword', 0, 'myuser@xxxxxxxxx');
+ defined $user ? print "User created" : print "User error\n";
...
print "Username: $user->get_username";
...
- if( $user->commit > 0 )
- {
- print "Update user status : succesfull\n";
- }
+ print "Successfully updated user preferences\n" if $user->commit > 0;
+=cut
-=head1 METHODS
-
+=pod
+=head1 CLASS METHODS
=cut
-
-sub _new {
- my ($class, $main, $uid, $gid, $oid, $username, $passwd, $homedir, $shell, $admin, $firstname, $lastname, $address, $zipcode, $city, $country, $mail, $gpg_key, $note, $language, $theme, $lastloginpanel, $ircnick, $date_creation, $description, $state) = @_;
- my $self = $class->SUPER::_new($main, $oid, $uid, $gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_USER);
- return undef unless(defined $self);
- $self->{uid} = $uid;
- $self->{gid} = $gid;
- $self->{username} = $username;
- $self->{passwd} = $passwd;
- $self->{homedir} = $homedir;
- $self->{shell} = $shell;
- $self->{admin} = $admin;
- $self->{firstname} = $firstname;
- $self->{lastname} = $lastname;
- $self->{address} = $address;
- $self->{zipcode} = $zipcode;
- $self->{city} = $city;
- $self->{country} = $country;
- $self->{mail} = $mail;
- $self->{gpg_key} = $gpg_key;
- $self->{note} = $note;
- $self->{language} = $language;
- $self->{theme} = $theme;
- $self->{lastloginpanel} = $lastloginpanel;
- $self->{ircnick} = $ircnick;
- return $self;
-}
-
=pod
-=head2 exists
+=head2 check_username
- print "User $username already exists\n" if(Vhffs::User::exists($username));
+ print 'Username valid' if Vhffs::User::check_username($username);
-Indicates wether an username is already taken.
+returns false if username is not valid (length not between 3 and 12, name not
+composed of alphanumeric chars)
=cut
-
-sub exists
-{
- my ($main, $username) = @_;
-
- return ($main->get_db_object()->do('SELECT uid FROM vhffs_users WHERE username = ?', undef, $username) > 0);
+sub check_username($) {
+ my $username = shift;
+ return defined $username and $username =~ /^[a-z0-9]{3,12}$/;
}
=pod
-=head2 check_username
+=head2 _new
- print 'Username valid' if(Vhffs::User::check_username($username));
+ Self constructor, almost private, please use get_by_* methods instead.
-returns false if username is not valid (length not between 3 and 12, name not
-composed of alphanumeric chars)
-
=cut
-
-sub check_username($) {
- my $username = shift;
- return ( defined($username) && ($username =~ /^[a-z0-9]{3,12}$/) );
+sub _new {
+ my ($class, $main, $uid, $gid, $oid, $username, $passwd, $homedir, $shell, $admin, $firstname, $lastname, $address, $zipcode, $city, $country, $mail, $gpg_key, $note, $language, $theme, $lastloginpanel, $ircnick, $date_creation, $description, $state) = @_;
+ my $self = $class->SUPER::_new($main, $oid, $uid, $gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_USER);
+ return undef unless(defined $self);
+ $self->{uid} = $uid;
+ $self->{gid} = $gid;
+ $self->{username} = $username;
+ $self->{passwd} = $passwd;
+ $self->{homedir} = $homedir;
+ $self->{shell} = $shell;
+ $self->{admin} = $admin;
+ $self->{firstname} = $firstname;
+ $self->{lastname} = $lastname;
+ $self->{address} = $address;
+ $self->{zipcode} = $zipcode;
+ $self->{city} = $city;
+ $self->{country} = $country;
+ $self->{mail} = $mail;
+ $self->{gpg_key} = $gpg_key;
+ $self->{note} = $note;
+ $self->{language} = $language;
+ $self->{theme} = $theme;
+ $self->{lastloginpanel} = $lastloginpanel;
+ $self->{ircnick} = $ircnick;
+ return $self;
}
=pod
=head2 create
- my $u = Vhffs::User::create($main, $username, $password, $admin,
- $mail, $firstname, $lastname, $city, $zipcode,
- $country, $address, $gpg_key);
+ my $user = Vhffs::User::create($main, $username, $password, $admin,
+ $mail, $firstname, $lastname, $city, $zipcode,
+ $country, $address, $gpg_key);
Create in DB and return a fully functional user.
=cut
-
sub create {
- my ( $main, $username, $password, $admin, $mail, $firstname, $lastname, $city, $zipcode, $country, $address, $gpg_key ) = @_;
- return undef unless check_username($username);
- use Vhffs::Functions;
+ my ( $main, $username, $password, $admin, $mail, $firstname, $lastname, $city, $zipcode, $country, $address, $gpg_key ) = @_;
+ return undef unless check_username($username);
- my $userconf = $main->get_config->get_users;
- my $user;
+ my $userconf = $main->get_config->get_users;
+ my $user;
- open(my $badusers, '<', $userconf->{'bad_username_file'} );
- if(defined $badusers) {
- while( <$badusers> ) {
- chomp;
- if ( $_ eq $username ) {
- close $badusers;
- return undef;
- }
- }
- close $badusers;
- }
+ open(my $badusers, '<', $userconf->{'bad_username_file'} );
+ if(defined $badusers) {
+ while( <$badusers> ) {
+ chomp;
+ if ( $_ eq $username ) {
+ close $badusers;
+ return undef;
+ }
+ }
+ close $badusers;
+ }
- my $dbh = $main->get_db_object;
- # Localize RaiseError so it get restored after we finish
- # With this enabled, DBI automagically call die if a
- # query goes wrong.
- local $dbh->{RaiseError} = 1;
- $dbh->begin_work;
- eval {
- # object(owner_uid) references user(uid) and user(object_id) object(object_id)
- # so we have to tell pg that constraints shouldn't be checked before the end
- # of transaction
- $dbh->do('SET CONSTRAINTS ALL DEFERRED');
-
- my ($uid) = $dbh->selectrow_array('SELECT nextval(\'vhffs_users_uid_seq\')');
- my ($gid) = $dbh->selectrow_array('SELECT nextval(\'vhffs_groups_gid_seq\')');
-
- # Create corresponding object
- # -- TODO, user moderation (easy to do now)
- my $parent = Vhffs::Object::create($main, $uid, $gid, '', Vhffs::Constants::WAITING_FOR_CREATION, Vhffs::Constants::TYPE_USER);
- die('Error creating parent') unless (defined $parent);
+ my $dbh = $main->get_db_object;
+ # Localize RaiseError so it get restored after we finish
+ # With this enabled, DBI automagically call die if a
+ # query goes wrong.
+ local $dbh->{RaiseError} = 1;
+ $dbh->begin_work;
+ eval {
+ # object(owner_uid) references user(uid) and user(object_id) object(object_id)
+ # so we have to tell pg that constraints shouldn't be checked before the end
+ # of transaction
+ $dbh->do('SET CONSTRAINTS ALL DEFERRED');
+
+ my ($uid) = $dbh->selectrow_array('SELECT nextval(\'vhffs_users_uid_seq\')');
+ my ($gid) = $dbh->selectrow_array('SELECT nextval(\'vhffs_groups_gid_seq\')');
+
+ # Create corresponding object
+ # -- TODO, user moderation (easy to do now)
+ my $parent = Vhffs::Object::create($main, $uid, $gid, '', Vhffs::Constants::WAITING_FOR_CREATION, Vhffs::Constants::TYPE_USER);
+ die('Error creating parent') unless (defined $parent);
- # Insert base information
- $admin = 0 unless (defined $admin);
- $password = Vhffs::Functions::generate_random_password if( not defined $password or $password eq '' );
- my $homedir = $main->get_config->get_datadir.'/home/'.substr( $username, 0, 1 ).'/'.substr( $username, 1, 1 ).'/'.$username;
+ # Insert base information
+ $admin = 0 unless (defined $admin);
+ $password = Vhffs::Functions::generate_random_password if( not defined $password or $password eq '' );
+ my $homedir = $main->get_config->get_datadir.'/home/'.substr( $username, 0, 1 ).'/'.substr( $username, 1, 1 ).'/'.$username;
- my $sth = $dbh->prepare('INSERT INTO vhffs_users (uid, gid, username, shell, passwd, homedir, admin, firstname, lastname, address, zipcode, city, country, mail, gpg_key, note, language, theme, lastloginpanel, object_id) VALUES(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, 0, ?, NULL, NULL, ?)');
- $sth->execute($uid, $gid, $username, $userconf->{'default_shell'}, Vhffs::Functions::password_encrypt($password), $homedir, $admin, $firstname, $lastname, $address, $zipcode, $city, $country, $mail, $gpg_key, Vhffs::Constants::DEFAULT_LANG, $parent->get_oid);
-
- my $group = Vhffs::Group::create($main, $username, undef, $uid, $gid);
- die('Error creating group') unless (defined $group);
- $group->set_status(Vhffs::Constants::ACTIVATED);
- $group->set_quota( $userconf->{'default_quota'} || 1 );
- $group->commit;
+ my $sth = $dbh->prepare('INSERT INTO vhffs_users (uid, gid, username, shell, passwd, homedir, admin, firstname, lastname, address, zipcode, city, country, mail, gpg_key, note, language, theme, lastloginpanel, object_id) VALUES(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, 0, ?, NULL, NULL, ?)');
+ $sth->execute($uid, $gid, $username, $userconf->{'default_shell'}, Vhffs::Functions::password_encrypt($password), $homedir, $admin, $firstname, $lastname, $address, $zipcode, $city, $country, $mail, $gpg_key, Vhffs::Constants::DEFAULT_LANG, $parent->get_oid);
+
+ my $group = Vhffs::Group::create($main, $username, undef, $uid, $gid);
+ die('Error creating group') unless (defined $group);
+ $group->set_status(Vhffs::Constants::ACTIVATED);
+ $group->set_quota( $userconf->{'default_quota'} || 1 );
+ $group->commit;
- $dbh->commit;
- $user = get_by_uid($main, $uid);
- };
+ $dbh->commit;
+ $user = get_by_uid($main, $uid);
+ };
if($@) {
warn "Error creating user : $@\n";
@@ -232,82 +197,202 @@
return $user;
}
-#modify a user
-#use as this : modify_user($db , username , field , value);
-#Example : modify_user($db , "soda" , "shell" , "/bin/bash");
-#
-# DEPRECATED WILL BE REMOVED use set_xxx instead
-#
-#
-sub modify
-{
- my $field;
- my $value;
- my $self;
- my $request;
+=pod
- ( $self , $field , $value ) = @_;
-
- return -1 if( $field eq "uid" );
- return -2 if( $field eq "username" );
+=head2 fill_object
+See C<Vhffs::Object::fill_object>.
- if ( $field eq "passwd" )
- {
- $request = $self->{'db'}->prepare("UPDATE vhffs_users SET passwd='" + Vhffs::Main::password_encrypt $value + "' WHERE uid='$self->{'uid'}'") or return -3;
+=cut
+sub fill_object {
+# We just add some specific fields
+ my ($class, $obj) = @_;
+ my $sql = q{SELECT uid, gid, username, shell, passwd, homedir, admin,
+ firstname, lastname, address, zipcode, city, country, mail, gpg_key,
+ note, language, theme FROM vhffs_users WHERE object_id = ?};
+ return $class->SUPER::_fill_object($obj, $sql);
+}
+
+=pod
+
+=head2 getall
+
+ my @users = Vhffs::User::getall( $main, $state, $name );
+
+Returns an array of users who matched $state and $name.
+
+=cut
+sub getall {
+ my $vhffs = shift;
+ my $state = shift;
+ my $name = shift;
+ my @users;
+ my @params;
+ return unless defined $vhffs;
+
+ my $query = 'SELECT username FROM vhffs_users vu INNER JOIN vhffs_object o ON o.object_id=vu.object_id WHERE o.object_id=vu.object_id ';
+
+ if(defined $name) {
+ $name = '%'.$name.'%';
+ $query .= ' AND ( vu.username LIKE ? OR vu.firstname LIKE ? OR vu.lastname LIKE ? )';
+ push @params, $name, $name, $name;
+ }
+ (push(@params, $state), $query.= ' AND o.state=?') if( defined $state );
- }
- else
- {
- $request = $self->{'db'}->prepare("UPDATE vhffs_users SET $field='$value' WHERE uid='$self->{'uid'}'") or return -3;
- }
-
- $request->execute() or return -4;
+ $query .= 'ORDER BY username';
+
+ my $request = $vhffs->{'db'}->prepare( $query );
+ $request->execute(@params);
+ while( my ($name) = $request->fetchrow_array ) {
+ my $user = Vhffs::User::get_by_username( $vhffs , $name );
+ push( @users , $user ) if( defined $user );
+ }
+
+ return \@users;
}
-sub commit
-{
- my $self = shift;
+=pod
- #Exec the super method !
+=head2 get_unused_accounts
- $self->{'shell'} = $self->{'main'}->get_config->get_users->{'default_shell'} if (! defined $self->{'shell'} );
- $self->{'status'} = 'I' if ( ! defined $self->{'status'} );
- $self->{'admin'} = 0 if ( ! defined $self->{'admin'} );
- return -1 if ( ( ! defined $self->{'passwd'} ) || ( $self->{'passwd'} eq "" ) );
-
- return -1 if( $self->SUPER::commit < 0 );
-
- my $sql = 'UPDATE vhffs_users SET shell = ?, passwd = ?, admin = ?, firstname = ?, lastname = ?, address = ?, zipcode = ?, country = ?, mail = ?, city = ?, gpg_key = ? , note = ? , lastloginpanel = ? , ircnick = ? WHERE uid = ?';
- my $sth = $self->{db}->prepare($sql) or return -1;
- $sth->execute($self->{'shell'}, $self->{'passwd'}, $self->{'admin'},
- $self->{'firstname'}, $self->{'lastname'}, $self->{'address'}, $self->{'zipcode'},
- $self->{'country'}, $self->{'mail'}, $self->{'city'}, $self->{'gpg_key'}, $self->{'note'}, $self->{'lastloginpanel'},
- $self->{'ircnick'}, $self->{'uid'}) or return -3;
+ my @users = Vhffs::User::get_unused_accounts( $main, $age );
- return 1;
+Returns an array of users who seem to be left unused for at least $age seconds long.
+
+Unused = no active group and last login panel over $age seconds long.
+
+=cut
+sub get_unused_accounts {
+ my $vhffs = shift;
+ my $age = shift;
+ my @users;
+ return unless defined $vhffs;
+
+ my $ts = time() - $age;
+
+ my $query = 'SELECT u.uid FROM vhffs_users u INNER JOIN vhffs_object o ON o.object_id=u.object_id WHERE u.admin=? AND o.state=? AND o.date_creation<? AND ( u.lastloginpanel IS NULL OR u.lastloginpanel<? ) AND u.uid NOT IN (SELECT u.uid FROM vhffs_users u INNER JOIN vhffs_user_group ug ON u.uid=ug.uid)';
+
+ my $request = $vhffs->{'db'}->prepare( $query );
+ $request->execute( Vhffs::Constants::USER_NORMAL , Vhffs::Constants::ACTIVATED , $ts , $ts );
+ while( my $uid = $request->fetchrow_array ) {
+ my $user = Vhffs::User::get_by_uid( $vhffs , $uid );
+ push( @users , $user ) if( defined $user );
+ }
+
+ return \@users;
}
+=pod
+=head2 get_by_uid
+ my $user = Vhffs::User::get_by_uid($main, $uid);
+ die('User not found') unless defined($user);
-#Delete a user in the database
-sub delete
-{
- my $request;
- my $self;
+Fetches an user using its UID. Returned user is fully functional.
- $self = shift;
+=cut
+sub get_by_uid {
+ my ($main, $uid) = @_;
+ my $query = 'SELECT u.uid, u.gid, u.object_id, u.username, u.passwd, u.homedir, u.shell, u.admin, u.firstname, u.lastname, u.address, u.zipcode, u.city, u.country, u.mail, u.gpg_key, u.note, u.language, u.theme, u.lastloginpanel, u.ircnick, o.date_creation, o.description, o.state FROM vhffs_users u INNER JOIN vhffs_object o ON o.object_id = u.object_id WHERE u.uid = ?';
+ my $dbh = $main->get_db_object;
+ my @params = $dbh->selectrow_array($query, undef, $uid);
+ return undef unless(@params);
+ return _new Vhffs::User($main, @params);
+}
- return -1 if ( ! defined $self->{'username'} );
- return -1 if ( ! defined $self->{'uid'} );
- return -2 if ( $self->{'group'}->delete < 0 );
+=pod
+=head2 get_by_username
+
+ my $user = Vhffs::User::get_by_username($main, $username);
+ die('User not found') unless defined($user);
+
+Fetches an user using its username. Returned user is fully functional.
+
+=cut
+sub get_by_username {
+ my ($main, $username) = @_;
+ my $query = 'SELECT u.uid, u.gid, u.object_id, u.username, u.passwd, u.homedir, u.shell, u.admin, u.firstname, u.lastname, u.address, u.zipcode, u.city, u.country, u.mail, u.gpg_key, u.note, u.language, u.theme, u.lastloginpanel, u.ircnick, o.date_creation, o.description, o.state FROM vhffs_users u INNER JOIN vhffs_object o ON o.object_id = u.object_id WHERE u.username = ?';
+ my $dbh = $main->get_db_object;
+ my @params = $dbh->selectrow_array($query, undef, $username);
+ return undef unless(@params);
+ return _new Vhffs::User($main, @params);
+}
+
+=head2 get_by_ircnick
+
+ my $user = Vhffs::User::get_by_ircnick($main, $ircnick);
+ die('User not found') unless defined($user);
+
+Fetches an user using its IRC nick. Returned user is fully functional.
+
+=cut
+sub get_by_ircnick {
+ my ($main, $ircnick) = @_;
+ my $query = 'SELECT u.uid, u.gid, u.object_id, u.username, u.passwd, u.homedir, u.shell, u.admin, u.firstname, u.lastname, u.address, u.zipcode, u.city, u.country, u.mail, u.gpg_key, u.note, u.language, u.theme, u.lastloginpanel, u.ircnick, o.date_creation, o.description, o.state FROM vhffs_users u INNER JOIN vhffs_object o ON o.object_id = u.object_id WHERE u.ircnick = ?';
+ my $dbh = $main->get_db_object;
+ my @params = $dbh->selectrow_array($query, undef, $ircnick);
+ return undef unless(@params);
+ return _new Vhffs::User($main, @params);
+}
+
+=pod
+=head1 INSTANCE METHODS
+=cut
+
+=pod
+
+=head2 commit
+
+ my $ret = $user->commit;
+
+Commit all changes to the database, returns 1 if success, otherwise returns a negative value.
+
+=cut
+sub commit {
+ my $self = shift;
+
+ $self->{'shell'} = $self->{'main'}->get_config->get_users->{'default_shell'} unless defined $self->{'shell'};
+ $self->{'admin'} = 0 unless defined $self->{'admin'};
+
+ return -1 unless defined $self->{'passwd'} and $self->{'passwd'} ne '';
+ return -2 if $self->SUPER::commit < 0;
+
+ my $sql = 'UPDATE vhffs_users SET shell = ?, passwd = ?, admin = ?, firstname = ?, lastname = ?, address = ?, zipcode = ?, country = ?, mail = ?, city = ?, gpg_key = ? , note = ? , lastloginpanel = ? , ircnick = ? WHERE uid = ?';
+ my $sth = $self->{db}->prepare($sql) or return -1;
+ $sth->execute($self->{'shell'}, $self->{'passwd'}, $self->{'admin'},
+ $self->{'firstname'}, $self->{'lastname'}, $self->{'address'}, $self->{'zipcode'},
+ $self->{'country'}, $self->{'mail'}, $self->{'city'}, $self->{'gpg_key'}, $self->{'note'}, $self->{'lastloginpanel'},
+ $self->{'ircnick'}, $self->{'uid'}) or return -3;
+
+ return 1;
+}
+
+=pod
+
+=head2 delete
+
+ my $ret = $user->delete;
+
+Delete a user from the database. Should be called after user have been cleaned up from the filesystem.
+
+=cut
+sub delete {
+ my $request;
+ my $self;
+
+ $self = shift;
+
+ if( $self->{'group'}->delete < 0 ) {
+ # TODO: set Vhffs::Constants::DELETE_ERROR or something
+ return -2;
+ }
+
# delete mail user if mail_user is enabled
use Vhffs::Services::MailUser;
my $mu = init Vhffs::Services::MailUser( $self->{'main'} , $self );
- if( defined $mu )
- {
+ if( defined $mu ) {
$mu->delbox;
$mu->delforward;
}
@@ -317,16 +402,22 @@
my $newsletter = init Vhffs::Services::Newsletter( $self->{'main'} , $self );
$newsletter->del if defined $newsletter;
- # User references corresponding object with an ON DELETE cascade foreign key
- # so we don't even need to delete user
- # rows that reference this user will be deleted by foreign keys constraints
+ # User references corresponding object with an ON DELETE cascade foreign key
+ # so we don't even need to delete user
+ # rows that reference this user will be deleted by foreign keys constraints
return $self->SUPER::delete;
}
+=pod
-# Delete this user with a notice mail
-sub pendingdeletion_withmail
-{
+=head2 delete
+
+ my $ret = $user->pendingdeletion_withmail;
+
+Delete a user with a notice mail.
+
+=cut
+sub pendingdeletion_withmail {
my $self = shift;
my $vhffs = $self->{main};
@@ -355,7 +446,7 @@
$vhffs->get_config->get_host_name
);
- Vhffs::Functions::send_mail( $vhffs , $vhffs->get_config->get_moderator_mail , $self->get_mail , $vhffs->get_config->get_mailtag , $subject , $mail );
+ Vhffs::Functions::send_mail( $vhffs, $vhffs->get_config->get_moderator_mail, $self->get_mail, $vhffs->get_config->get_mailtag, $subject, $mail );
setlocale( LC_ALL , $prevlocale );
@@ -363,24 +454,16 @@
$self->commit;
}
+=pod
-sub uid_exists
-{
- my ( $dbh , $uid ) = @_;
- my $request;
+=head2 check_password
- return -1 if ( !defined $uid);
+ my $ret = $user->check_password( $plaintext_password );
- $request = $dbh->prepare('SELECT COUNT(*) FROM vhffs_users WHERE uid=?');
- $request->execute($uid);
-
- my ($result) = $request->fetchrow_array();
- return $result;
-}
+Check user password against crypt md5 password stored in the database.
-
-sub check_password
-{
+=cut
+sub check_password {
use Crypt::PasswdMD5;
my $self = shift;
@@ -391,569 +474,676 @@
return 0;
}
+=pod
-sub send_mail_user
-{
+=head2 send_mail_user
+
+ $user->send_mail_user( $subject, $content );
+
+Send a mail to the user, this is only a helper for Vhffs::Functions::send_mail() which sets all arguments excepted subject and content.
+
+=cut
+sub send_mail_user {
use Vhffs::Functions;
my ( $user, $subject, $content ) = @_;
my $vhffs = $user->{'main'};
- my $from;
- $from = $vhffs->get_config->get_master_mail;
- $from = "vhffs\@nosrc.com" if( ! defined $from );
+ my $from = $vhffs->get_config->get_master_mail;
+ return undef unless defined $from;
- Vhffs::Functions::send_mail( $vhffs , $from , $user->get_mail , $vhffs->get_config->get_mailtag , $subject , $content );
+ return Vhffs::Functions::send_mail( $vhffs, $from, $user->get_mail, $vhffs->get_config->get_mailtag, $subject, $content );
}
+=pod
-#
-# Some accessors
-################
+=head2 get_username
-sub get_username
-{
- my $self = shift;
- return $self->{'username'};
-}
+ $user->get_username;
-sub get_firstname
-{
- my $self = shift;
- return $self->{'firstname'};
-}
+Returns user username.
-sub get_lastname
-{
- my $self = shift;
- return $self->{'lastname'};
+=cut
+sub get_username {
+ my $self = shift;
+ return $self->{'username'};
}
-sub get_city
-{
- my $self = shift;
- return $self->{'city'};
+=pod
+
+=head2 get_firstname
+
+ $user->get_firstname;
+
+Returns user firstname.
+
+=cut
+sub get_firstname {
+ my $self = shift;
+ return $self->{'firstname'};
}
-sub get_country
-{
- my $self = shift;
- return $self->{'country'};
+=pod
+
+=head2 get_lastname
+
+ $user->get_lastname;
+
+Returns user lastname.
+
+=cut
+sub get_lastname {
+ my $self = shift;
+ return $self->{'lastname'};
}
-sub get_gpg
-{
- my $self = shift;
- return $self->{'gpg_key'};
+=pod
+
+=head2 get_city
+
+ $user->get_city;
+
+Returns user city.
+
+=cut
+sub get_city {
+ my $self = shift;
+ return $self->{'city'};
}
-sub get_zipcode
-{
- my $self = shift;
- return $self->{'zipcode'};
+=pod
+
+=head2 get_country
+
+ $user->get_country;
+
+Returns user country.
+
+=cut
+sub get_country {
+ my $self = shift;
+ return $self->{'country'};
}
-sub get_home
-{
- my $self = shift;
- return $self->{'homedir'}
+=pod
+
+=head2 get_zipcode
+
+ $user->get_zipcode;
+
+Returns user zipcode.
+
+=cut
+sub get_zipcode {
+ my $self = shift;
+ return $self->{'zipcode'};
}
-sub get_password
-{
- my $self = shift;
- return $self->{'passwd'}
+=pod
+
+=head2 get_home
+
+ $user->get_home;
+
+Returns user home directory.
+
+=cut
+sub get_home {
+ my $self = shift;
+ return $self->{'homedir'}
}
-sub get_uid
-{
- my $self = shift;
- return $self->{'uid'} if( defined $self->{'uid'} );
- return -1;
+=pod
+
+=head2 get_password
+
+ $user->get_password;
+
+Returns user hashed password (using crypt-md5).
+
+=cut
+sub get_password {
+ my $self = shift;
+ return $self->{'passwd'}
}
-sub get_gid
-{
- my $self = shift;
- return $self->{'gid'} if( defined $self->{'gid'} );
- return -1;
+=pod
+
+=head2 get_uid
+
+ $user->get_uid;
+
+Returns user UID.
+
+=cut
+sub get_uid {
+ my $self = shift;
+ return $self->{'uid'};
}
-sub get_lang
-{
- my $self = shift;
- return $self->{language};
+=pod
+
+=head2 get_gid
+
+ $user->get_gid;
+
+Returns user GID.
+
+=cut
+sub get_gid {
+ my $self = shift;
+ return $self->{'gid'};
}
-sub get_mail
-{
- my $self = shift;
- return $self->{'mail'};
+=pod
+
+=head2 get_lang
+
+ $user->get_lang;
+
+Returns user lang (in the locale xx_XX pattern).
+
+=cut
+sub get_lang {
+ my $self = shift;
+ return $self->{language};
}
-sub get_theme
-{
- my $self = shift;
- return $self->{theme};
+=pod
+
+=head2 get_mail
+
+ $user->get_mail;
+
+Returns user mail.
+
+=cut
+sub get_mail {
+ my $self = shift;
+ return $self->{'mail'};
}
-sub get_address
-{
- my $self = shift;
- return $self->{'address'};
+=pod
+
+=head2 get_theme
+
+ $user->get_theme;
+
+Returns user theme (used in Panel).
+
+=cut
+sub get_theme {
+ my $self = shift;
+ return $self->{theme};
}
-sub get_group
-{
- my $self = shift;
- return $self->{'group'};
+=pod
+
+=head2 get_address
+
+ $user->get_address;
+
+Returns user address.
+
+=cut
+sub get_address {
+ my $self = shift;
+ return $self->{'address'};
}
-sub get_shell
-{
- my $self = shift;
- return $self->{'shell'};
+=pod
+
+=head2 get_shell
+
+ $user->get_shell;
+
+Returns user shell.
+
+=cut
+sub get_shell {
+ my $self = shift;
+ return $self->{'shell'};
}
-sub get_gpgkey
-{
- my $self = shift;
- return( $self->{'gpg_key'} );
+=pod
+
+=head2 get_gpgkey
+
+ $user->get_gpgkey;
+
+Returns user GPG key.
+
+=cut
+sub get_gpgkey {
+ my $self = shift;
+ return( $self->{'gpg_key'} );
}
-sub get_note
-{
- my $self = shift;
- return( $self->{'note'} );
+=pod
+
+=head2 get_note
+
+ $user->get_note;
+
+Returns user note.
+
+=cut
+sub get_note {
+ my $self = shift;
+ return( $self->{'note'} );
}
-sub get_lastloginpanel
-{
- my $self = shift;
- return( $self->{'lastloginpanel'} );
+=pod
+
+=head2 get_lastloginpanel
+
+ $user->get_lastloginpanel;
+
+Returns last time user logged in to the panel.
+
+=cut
+sub get_lastloginpanel {
+ my $self = shift;
+ return( $self->{'lastloginpanel'} );
}
-sub get_ircnick
-{
- my $self = shift;
- return( $self->{'ircnick'} );
+=pod
+
+=head2 get_ircnick
+
+ $user->get_ircnick;
+
+Returns user IRC nick.
+
+=cut
+sub get_ircnick {
+ my $self = shift;
+ return( $self->{'ircnick'} );
}
-sub set_shell
-{
- my $self = shift;
- my $value = shift;
- $self->{'shell'} = $value;
+=pod
+
+=head2 set_shell
+
+ $user->set_shell( $shell );
+
+Set user shell.
+
+=cut
+sub set_shell {
+ my $self = shift;
+ my $value = shift;
+ $self->{'shell'} = $value;
}
-sub set_firstname
-{
- my $self = shift;
- my $value = shift;
- $self->{'firstname'} = $value;
+=pod
+
+=head2 set_firstname
+
+ $user->set_firstname( $firstname );
+
+Set user firstname.
+
+=cut
+sub set_firstname {
+ my $self = shift;
+ my $value = shift;
+ $self->{'firstname'} = $value;
}
-sub set_lastname
-{
- my $self = shift;
- my $value = shift;
- $self->{'lastname'} = $value;
+=pod
+
+=head2 set_lastname
+
+ $user->set_lastname( $lastname );
+
+Set user lastname.
+
+=cut
+sub set_lastname {
+ my $self = shift;
+ my $value = shift;
+ $self->{'lastname'} = $value;
}
-sub set_city
-{
- my $self = shift;
- my $value = shift;
- $self->{'city'} = $value;
+=pod
+
+=head2 set_city
+
+ $user->set_city( $city );
+
+Set user city.
+
+=cut
+sub set_city {
+ my $self = shift;
+ my $value = shift;
+ $self->{'city'} = $value;
}
-sub set_zipcode
-{
- my $self = shift;
- my $value = shift;
- $self->{'zipcode'} = $value;
+=pod
+
+=head2 set_zipcode
+
+ $user->set_zipcode( $zipcode );
+
+Set user zipcode.
+
+=cut
+sub set_zipcode {
+ my $self = shift;
+ my $value = shift;
+ $self->{'zipcode'} = $value;
}
-sub set_country
-{
- my $self = shift;
- my $value = shift;
- $self->{'country'} = $value;
+=pod
+
+=head2 set_country
+
+ $user->set_country( $country );
+
+Set user country.
+
+=cut
+sub set_country {
+ my $self = shift;
+ my $value = shift;
+ $self->{'country'} = $value;
}
-sub set_address
-{
- my $self = shift;
- my $value = shift;
- $self->{'address'} = $value;
+=pod
+
+=head2 set_address
+
+ $user->set_address( $address );
+
+Set user address.
+
+=cut
+sub set_address {
+ my $self = shift;
+ my $value = shift;
+ $self->{'address'} = $value;
}
-sub set_mail
-{
+=pod
+
+=head2 set_mail
+
+ $user->set_mail( $mail );
+
+Set user mail.
+
+=cut
+sub set_mail {
use Vhffs::Functions;
- my $self = shift;
+ my $self = shift;
my $value = shift;
-
- if( Vhffs::Functions::valid_mail( $value ) )
- {
- $self->{'mail'} = $value;
- return 0;
- }
- else
- {
- return -1;
- }
-}
-sub set_gpgkey
-{
- my $self = shift;
- my $value = shift;
- $self->{'gpg_key'} = $value;
+ return -1 unless Vhffs::Functions::valid_mail( $value );
+ $self->{'mail'} = $value;
+ return 0;
}
-sub set_note
-{
- my $self = shift;
- my $value = shift;
- $self->{'note'} = $value;
-}
+=pod
-sub set_password
-{
- use Vhffs::Functions;
-
- my $self = shift;
- my $value = shift;
- $self->{'passwd'} = Vhffs::Functions::password_encrypt( $value );
-}
+=head2 set_gpgkey
-sub update_lastloginpanel
-{
+ $user->set_gpgkey( $gpgkey );
+
+Set user GPG key.
+
+=cut
+sub set_gpgkey {
my $self = shift;
- $self->{'lastloginpanel'} = time();
+ my $value = shift;
+ $self->{'gpg_key'} = $value;
}
-sub set_ircnick
-{
- my $self = shift;
- my $value = shift;
- $self->{'ircnick'} = $value;
-}
+=pod
-sub set_admin
-{
- my ( $self , $value ) = @_;
- $self->{'admin'} = $value;
+=head2 set_note
+
+ $user->set_note( $note );
+
+Set user note.
+
+=cut
+sub set_note {
+ my $self = shift;
+ my $value = shift;
+ $self->{'note'} = $value;
}
=pod
-See C<Vhffs::Object::get_label>.
+=head2 set_password
+ $user->set_password( $plaintext_password );
+
+Set user password.
+
=cut
-
-sub get_label
-{
- my $self = shift;
- return $self->{username};
+sub set_password {
+ use Vhffs::Functions;
+
+ my $self = shift;
+ my $value = shift;
+ $self->{'passwd'} = Vhffs::Functions::password_encrypt( $value );
}
-sub is_admin
-{
+=pod
+
+=head2 update_lastloginpanel
+
+ $user->update_lastloginpanel;
+
+Set user last time login to panel.
+
+=cut
+sub update_lastloginpanel {
my $self = shift;
- if( ( defined $self->{'admin'} ) && ( $self->{'admin'} == Vhffs::Constants::USER_ADMIN ) )
- {
- return 1;
- }
- else
- {
- return 0;
- }
+ $self->{'lastloginpanel'} = time();
}
+=pod
-sub is_moderator
-{
+=head2 set_ircnick
+
+ $user->set_ircnick( $nick );
+
+Set user IRC nick (used by IRC bot to join IRC users to VHFFS users).
+
+=cut
+sub set_ircnick {
my $self = shift;
- if( ( defined $self->{'admin'} ) && ( $self->{'admin'} == Vhffs::Constants::USER_MODERATOR ) )
- {
- return 1;
- }
- else
- {
- return 0;
- }
+ my $value = shift;
+ $self->{'ircnick'} = $value;
}
-sub get_permissions {
- my $self = shift;
- return $self->{admin};
+=pod
+
+=head2 set_admin
+
+ $user->set_admin( $level );
+
+Set user access level.
+
+=cut
+sub set_admin {
+ my ( $self , $value ) = @_;
+ $self->{'admin'} = $value;
}
-sub get_name_by_uid
-{
- my $main = shift;
- my $uid = shift;
- my $request = $main->{'db'}->prepare('SELECT username FROM vhffs_users where uid=?') or return -2;
- my $rows = $request->execute($uid);
-
- if( $rows == 0 )
- {
- return( "nobody" );
- }
- else
- {
- my ($result) = $request->fetchrow_array();
- return $result;
- }
+=pod
+See C<Vhffs::Object::get_label>.
+
+=cut
+sub get_label {
+ my $self = shift;
+ return $self->{username};
}
+=pod
-sub getall
-{
- my $vhffs = shift;
- my $state = shift;
- my $name = shift;
- my @users;
- my @params;
- return unless defined $vhffs;
+=head2 is_admin
- my $query = 'SELECT username FROM vhffs_users vu INNER JOIN vhffs_object o ON o.object_id=vu.object_id WHERE o.object_id=vu.object_id ';
+ my $isadmin = $user->is_admin;
- if(defined $name) {
- $name = '%'.$name.'%';
- $query .= ' AND ( vu.username LIKE ? OR vu.firstname LIKE ? OR vu.lastname LIKE ? )';
- push @params, $name, $name, $name;
- }
- (push(@params, $state), $query.= ' AND o.state=?') if( defined $state );
-
- $query .= 'ORDER BY username';
-
- my $request = $vhffs->{'db'}->prepare( $query );
- $request->execute(@params);
- while( my ($name) = $request->fetchrow_array )
- {
- my $user = Vhffs::User::get_by_username( $vhffs , $name );
- push( @users , $user ) if( defined $user );
- }
+Returns 1 if user is an administrator, otherwise returns 0.
- return \@users;
+=cut
+sub is_admin {
+ my $self = shift;
+ return 1 if defined $self->{'admin'} and $self->{'admin'} == Vhffs::Constants::USER_ADMIN;
+ return 0;
}
+=pod
-sub get_unused_accounts
-{
- my $vhffs = shift;
- my $age = shift;
- my @users;
- return unless defined $vhffs;
+=head2 is_moderator
- my $ts = time() - $age;
+ my $ismodo = $user->is_moderator;
- my $query = 'SELECT u.uid FROM vhffs_users u INNER JOIN vhffs_object o ON o.object_id=u.object_id WHERE u.admin=? AND o.state=? AND o.date_creation<? AND ( u.lastloginpanel IS NULL OR u.lastloginpanel<? ) AND u.uid NOT IN (SELECT u.uid FROM vhffs_users u INNER JOIN vhffs_user_group ug ON u.uid=ug.uid)';
+Returns 1 if user is a moderator, otherwise returns 0.
+Caution, it does not return 1 if user is an administrator.
- my $request = $vhffs->{'db'}->prepare( $query );
- $request->execute( Vhffs::Constants::USER_NORMAL , Vhffs::Constants::ACTIVATED , $ts , $ts );
- while( my $uid = $request->fetchrow_array )
- {
- my $user = Vhffs::User::get_by_uid( $vhffs , $uid );
- push( @users , $user ) if( defined $user );
- }
-
- return \@users;
+=cut
+sub is_moderator {
+ my $self = shift;
+ return 1 if defined $self->{'admin'} and $self->{'admin'} == Vhffs::Constants::USER_MODERATOR;
+ return 0;
}
+=pod
-sub get_groups
-{
+=head2 get_permissions
+
+ my $perm = $user->get_permissions;
+
+Returns user access level.
+
+=cut
+sub get_permissions {
my $self = shift;
-
- my @groups;
- my $uid = $self->get_uid;
- my $query = 'SELECT g.groupname FROM vhffs_groups g INNER JOIN vhffs_user_group ug ON g.gid=ug.gid WHERE ug.uid=? ORDER BY g.groupname';
- my $request = $self->{'db'}->prepare( $query );
- return undef if( ! $request->execute($uid) );
- while( my ($groupname) = $request->fetchrow_array )
- {
- my $group = Vhffs::Group::get_by_groupname( $self->{'main'} , $groupname );
- push( @groups , $group ) if( defined($group) );
- }
- return \@groups;
+ return $self->{admin};
}
=head2 can_view
- die("You are not allowed to view this object\n")
- unless($user->can_view($object));
+ die("You are not allowed to view this object\n")
+ unless($user->can_view($object));
Returns true if the user on which the method is called can view the given
object.
=cut
-
-sub can_view
-{
+sub can_view {
my ($self, $o) = @_;
return 0 unless( $o->get_status == Vhffs::Constants::ACTIVATED || $self->is_admin || $self->is_moderator );
return ( Vhffs::Acl::get_perm( $self->get_main, $o, $self ) >= Vhffs::Constants::ACL_VIEW );
}
-
=head2 can_modify
- die("You are not allowed to modify this object\n")
- unless($user->can_modify($object));
+ die("You are not allowed to modify this object\n")
+ unless($user->can_modify($object));
Returns true if the user on which the method is called can modify the given
object.
=cut
-
-sub can_modify
-{
+sub can_modify {
my ($self, $o) = @_;
return 0 unless( $o->get_status == Vhffs::Constants::ACTIVATED || $self->is_admin || $self->is_moderator );
return ( Vhffs::Acl::get_perm( $self->get_main, $o, $self ) >= Vhffs::Constants::ACL_MODIFY );
}
-
=head2 can_manageacl
- die("You are not allowed to manage acl on this object\n")
- unless($user->can_manageacl($object));
+ die("You are not allowed to manage acl on this object\n")
+ unless($user->can_manageacl($object));
Returns true if the user on which the method is called can modify ACLs on the given object.
=cut
-
-sub can_manageacl
-{
+sub can_manageacl {
my ($self, $o) = @_;
return ( Vhffs::Acl::get_perm( $self->get_main, $o, $self ) >= Vhffs::Constants::ACL_MANAGEACL );
}
-
=head2 can_delete
- die("You are not allowed to delete this object\n")
- unless($user->can_delete($object));
+ die("You are not allowed to delete this object\n")
+ unless($user->can_delete($object));
Returns true if the user on which the method is called can delete the given
object.
=cut
-
-sub can_delete
-{
+sub can_delete {
my ($self, $o) = @_;
return 0 unless( $o->get_status == Vhffs::Constants::ACTIVATED || $self->is_admin || $self->is_moderator );
return ( Vhffs::Acl::get_perm( $self->get_main, $o, $self ) >= Vhffs::Constants::ACL_DELETE );
}
-
=head2 get_perm
- $perm = $user->get_perm($object);
+ my $perm = $user->get_perm( $object );
Returns the permission level of the user on the given object.
=cut
-
-sub get_perm
-{
+sub get_perm {
my ($self, $o) = @_;
return Vhffs::Acl::get_perm( $self->get_main, $o, $self );
}
+=head2 have_activegroups
+ my $havegroups = $user->have_activegroups;
-sub have_activegroups
-{
+Returns the number of groups of which the user is contributing. Returns -1 in case of failure.
+
+=cut
+sub have_activegroups {
my $self = shift;
my $uid = $self->get_uid;
my $query = 'SELECT COUNT(g.groupname) FROM vhffs_groups g, vhffs_user_group ug, vhffs_object o WHERE ug.uid=? AND g.gid=ug.gid AND o.object_id=g.object_id AND o.state='.Vhffs::Constants::ACTIVATED;
my $request = $self->{'db'}->prepare( $query );
- return -1 if( !$request->execute($uid) );
+ return -1 unless $request->execute($uid);
my $row = $request->fetchrow_arrayref;
- return -1 if ( ! defined $row );
+ return -1 unless defined $row;
return $row->[0];
}
-sub get_by_uid {
- my ($main, $uid) = @_;
- my $query = 'SELECT u.uid, u.gid, u.object_id, u.username, u.passwd, u.homedir, u.shell, u.admin, u.firstname, u.lastname, u.address, u.zipcode, u.city, u.country, u.mail, u.gpg_key, u.note, u.language, u.theme, u.lastloginpanel, u.ircnick, o.date_creation, o.description, o.state FROM vhffs_users u INNER JOIN vhffs_object o ON o.object_id = u.object_id WHERE u.uid = ?';
- my $dbh = $main->get_db_object;
- my @params = $dbh->selectrow_array($query, undef, $uid);
- return undef unless(@params);
- my $user = _new Vhffs::User($main, @params);
- $user->{group} = Vhffs::Group::get_by_gid($main, $user->get_gid);
- return $user;
-}
+=head2 get_groups
-=pod
+ my @groups = $user->get_groups;
-=head2 get_by_username
+Returns an array of all of the user groups.
- my $user = Vhffs::User::get_by_username($main, $username);
- die('User not found') unless defined($user);
-
-Fetches an user using its username. Returned user is fully functional.
-
=cut
+sub get_groups {
+ my $self = shift;
-sub get_by_username {
- my ($main, $username) = @_;
- my $query = 'SELECT u.uid, u.gid, u.object_id, u.username, u.passwd, u.homedir, u.shell, u.admin, u.firstname, u.lastname, u.address, u.zipcode, u.city, u.country, u.mail, u.gpg_key, u.note, u.language, u.theme, u.lastloginpanel, u.ircnick, o.date_creation, o.description, o.state FROM vhffs_users u INNER JOIN vhffs_object o ON o.object_id = u.object_id WHERE u.username = ?';
- my $dbh = $main->get_db_object;
- my @params = $dbh->selectrow_array($query, undef, $username);
- return undef unless(@params);
- my $user = _new Vhffs::User($main, @params);
- $user->{group} = Vhffs::Group::get_by_gid($main, $user->get_gid);
- return $user;
-
+ my @groups;
+ my $uid = $self->get_uid;
+ my $query = 'SELECT g.groupname FROM vhffs_groups g INNER JOIN vhffs_user_group ug ON g.gid=ug.gid WHERE ug.uid=? ORDER BY g.groupname';
+ my $request = $self->{'db'}->prepare( $query );
+ return undef if( ! $request->execute($uid) );
+ while( my ($groupname) = $request->fetchrow_array )
+ {
+ my $group = Vhffs::Group::get_by_groupname( $self->{'main'} , $groupname );
+ push( @groups , $group ) if( defined($group) );
+ }
+ return \@groups;
}
-=head2 get_by_ircnick
-
- my $user = Vhffs::User::get_by_ircnick($main, $ircnick);
- die('User not found') unless defined($user);
-
-Fetches an user using its IRC nick. Returned user is fully functional.
-
-=cut
-
-sub get_by_ircnick {
- my ($main, $ircnick) = @_;
- my $query = 'SELECT u.uid, u.gid, u.object_id, u.username, u.passwd, u.homedir, u.shell, u.admin, u.firstname, u.lastname, u.address, u.zipcode, u.city, u.country, u.mail, u.gpg_key, u.note, u.language, u.theme, u.lastloginpanel, u.ircnick, o.date_creation, o.description, o.state FROM vhffs_users u INNER JOIN vhffs_object o ON o.object_id = u.object_id WHERE u.ircnick = ?';
- my $dbh = $main->get_db_object;
- my @params = $dbh->selectrow_array($query, undef, $ircnick);
- return undef unless(@params);
- my $user = _new Vhffs::User($main, @params);
- $user->{group} = Vhffs::Group::get_by_gid($main, $user->get_gid);
- return $user;
-
-}
-
-=head2 fill_object
-
-See C<Vhffs::Object::fill_object>.
-
-=cut
-
-sub fill_object {
-# We just add some specific fields
- my ($class, $obj) = @_;
- my $sql = q{SELECT uid, gid, username, shell, passwd, homedir, admin,
- firstname, lastname, address, zipcode, city, country, mail, gpg_key,
- note, language, theme FROM vhffs_users WHERE object_id = ?};
- return $class->SUPER::_fill_object($obj, $sql);
-}
-
1;
__END__
@@ -967,3 +1157,5 @@
Julien Delange <julien at tuxfamily dot org>
Sebastien Le Ray <beuss at tuxfamily dot org>
+
+Sylvain Rochet <gradator at tuxfamily dot org>
Modified: trunk/vhffs-api/src/examples/create_user.pl
===================================================================
--- trunk/vhffs-api/src/examples/create_user.pl 2012-02-08 22:07:20 UTC (rev 1999)
+++ trunk/vhffs-api/src/examples/create_user.pl 2012-02-09 23:23:00 UTC (rev 2000)
@@ -16,8 +16,6 @@
my ($username, $password) = @ARGV;
-die("User $username already exists\n") if(Vhffs::User::exists($princ, $username));
-
my $user = Vhffs::User::create($princ, $username, $password);
if( !defined $user )