FS/FS/access_user.pm

   1 package FS::access_user;
   2
   3 use strict;
   4 use vars qw( @ISA $htpasswd_file );
   5 use FS::Record qw( qsearch qsearchs dbh );
   6 use FS::m2m_Common;
   7 use FS::access_usergroup;
   8
   9 @ISA = qw( FS::m2m_Common FS::Record );
  10
  11 #kludge htpasswd for now
  12 $htpasswd_file = '/usr/local/etc/freeside/htpasswd';
  13
  14 =head1 NAME
  15
  16 FS::access_user - Object methods for access_user records
  17
  18 =head1 SYNOPSIS
  19
  20   use FS::access_user;
  21
  22   $record = new FS::access_user \%hash;
  23   $record = new FS::access_user { 'column' => 'value' };
  24
  25   $error = $record->insert;
  26
  27   $error = $new_record->replace($old_record);
  28
  29   $error = $record->delete;
  30
  31   $error = $record->check;
  32
  33 =head1 DESCRIPTION
  34
  35 An FS::access_user object represents an internal access user.  FS::access_user inherits from
  36 FS::Record.  The following fields are currently supported:
  37
  38 =over 4
  39
  40 =item usernum - primary key
  41
  42 =item username -
  43
  44 =item _password -
  45
  46 =item last -
  47
  48 =item first -
  49
  50 =back
  51
  52 =head1 METHODS
  53
  54 =over 4
  55
  56 =item new HASHREF
  57
  58 Creates a new internal access user.  To add the user to the database, see L<"insert">.
  59
  60 Note that this stores the hash reference, not a distinct copy of the hash it
  61 points to.  You can ask the object for a copy with the I<hash> method.
  62
  63 =cut
  64
  65 # the new method can be inherited from FS::Record, if a table method is defined
  66
  67 sub table { 'access_user'; }
  68
  69 =item insert
  70
  71 Adds this record to the database.  If there is an error, returns the error,
  72 otherwise returns false.
  73
  74 =cut
  75
  76 sub insert {
  77   my $self = shift;
  78
  79   local $SIG{HUP} = 'IGNORE';
  80   local $SIG{INT} = 'IGNORE';
  81   local $SIG{QUIT} = 'IGNORE';
  82   local $SIG{TERM} = 'IGNORE';
  83   local $SIG{TSTP} = 'IGNORE';
  84   local $SIG{PIPE} = 'IGNORE';
  85
  86   my $oldAutoCommit = $FS::UID::AutoCommit;
  87   local $FS::UID::AutoCommit = 0;
  88   my $dbh = dbh;
  89
  90   my $error =
  91        $self->SUPER::insert(@_)
  92     || $self->htpasswd_kludge()
  93   ;
  94
  95   if ( $error ) {
  96     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
  97     return $error;
  98   } else {
  99     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 100     '';
 101   }
 102
 103 }
 104
 105 sub htpasswd_kludge {
 106   my $self = shift;
 107   if (
 108        system('htpasswd', '-b', @_,
 109                           $htpasswd_file,
 110                           $self->username,
 111                           $self->_password,
 112              ) == 0
 113      )
 114   {
 115     return '';
 116   } else {
 117     return 'htpasswd exited unsucessfully';
 118   }
 119 }
 120
 121
 122 =item delete
 123
 124 Delete this record from the database.
 125
 126 =cut
 127
 128 sub delete {
 129   my $self = shift;
 130
 131   local $SIG{HUP} = 'IGNORE';
 132   local $SIG{INT} = 'IGNORE';
 133   local $SIG{QUIT} = 'IGNORE';
 134   local $SIG{TERM} = 'IGNORE';
 135   local $SIG{TSTP} = 'IGNORE';
 136   local $SIG{PIPE} = 'IGNORE';
 137
 138   my $oldAutoCommit = $FS::UID::AutoCommit;
 139   local $FS::UID::AutoCommit = 0;
 140   my $dbh = dbh;
 141
 142   my $error =
 143        $self->SUPER::delete(@_)
 144     || $self->htpasswd_kludge('-D')
 145   ;
 146
 147   if ( $error ) {
 148     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 149     return $error;
 150   } else {
 151     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 152     '';
 153   }
 154
 155 }
 156
 157 =item replace OLD_RECORD
 158
 159 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 160 returns the error, otherwise returns false.
 161
 162 =cut
 163
 164 sub replace {
 165   my($new, $old) = ( shift, shift );
 166
 167   local $SIG{HUP} = 'IGNORE';
 168   local $SIG{INT} = 'IGNORE';
 169   local $SIG{QUIT} = 'IGNORE';
 170   local $SIG{TERM} = 'IGNORE';
 171   local $SIG{TSTP} = 'IGNORE';
 172   local $SIG{PIPE} = 'IGNORE';
 173
 174   my $oldAutoCommit = $FS::UID::AutoCommit;
 175   local $FS::UID::AutoCommit = 0;
 176   my $dbh = dbh;
 177
 178   my $error =
 179        $new->SUPER::replace($old, @_)
 180     || $new->htpasswd_kludge()
 181   ;
 182
 183   if ( $error ) {
 184     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 185     return $error;
 186   } else {
 187     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 188     '';
 189   }
 190
 191 }
 192
 193 =item check
 194
 195 Checks all fields to make sure this is a valid internal access user.  If there is
 196 an error, returns the error, otherwise returns false.  Called by the insert
 197 and replace methods.
 198
 199 =cut
 200
 201 # the check method should currently be supplied - FS::Record contains some
 202 # data checking routines
 203
 204 sub check {
 205   my $self = shift;
 206
 207   my $error =
 208     $self->ut_numbern('usernum')
 209     || $self->ut_text('username')
 210     || $self->ut_text('_password')
 211     || $self->ut_text('last')
 212     || $self->ut_text('first')
 213   ;
 214   return $error if $error;
 215
 216   $self->SUPER::check;
 217 }
 218
 219 =item name
 220
 221 Returns a name string for this user: "Last, First".
 222
 223 =cut
 224
 225 sub name {
 226   my $self = shift;
 227   $self->get('last'). ', '. $self->first;
 228 }
 229
 230 =item access_usergroup
 231
 232 =cut
 233
 234 sub access_usergroup {
 235   my $self = shift;
 236   qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
 237 }
 238
 239 #=item access_groups
 240 #
 241 #=cut
 242 #
 243 #sub access_groups {
 244 #
 245 #}
 246 #
 247 #=item access_groupnames
 248 #
 249 #=cut
 250 #
 251 #sub access_groupnames {
 252 #
 253 #}
 254
 255 =item agentnums
 256
 257 Returns a list of agentnums this user can view (via group membership).
 258
 259 =cut
 260
 261 sub agentnums {
 262   my $self = shift;
 263   my $sth = dbh->prepare(
 264     "SELECT DISTINCT agentnum FROM access_usergroup
 265                               JOIN access_groupagent USING ( groupnum )
 266        WHERE usernum = ?"
 267   ) or die dbh->errstr;
 268   $sth->execute($self->usernum) or die $sth->errstr;
 269   map { $_->[0] } @{ $sth->fetchall_arrayref };
 270 }
 271
 272 =item agentnums_href
 273
 274 Returns a hashref of agentnums this user can view.
 275
 276 =cut
 277
 278 sub agentnums_href {
 279   my $self = shift;
 280   { map { $_ => 1 } $self->agentnums };
 281 }
 282
 283 =item agentnums_sql
 284
 285 Returns an sql fragement to select only agentnums this user can view.
 286
 287 =cut
 288
 289 sub agentnums_sql {
 290   my $self = shift;
 291   '( '.
 292     join( ' OR ', map "agentnum = $_", $self->agentnums ).
 293   ' )';
 294 }
 295
 296 =item access_right
 297
 298 Given a right name, returns true if this user has this right (currently via
 299 group membership, eventually also via user overrides).
 300
 301 =cut
 302
 303 sub access_right {
 304   my( $self, $rightname ) = @_;
 305   my $sth = dbh->prepare("
 306     SELECT groupnum FROM access_usergroup
 307                     LEFT JOIN access_group USING ( groupnum )
 308                     LEFT JOIN access_right
 309                          ON ( access_group.groupnum = access_right.rightobjnum )
 310       WHERE usernum = ?
 311         AND righttype = 'FS::access_group'
 312         AND rightname = ?
 313   ") or die dbh->errstr;
 314   $sth->execute($self->usernum, $rightname) or die $sth->errstr;
 315   my $row = $sth->fetchrow_arrayref;
 316   $row ? $row->[0] : '';
 317 }
 318
 319 =back
 320
 321 =head1 BUGS
 322
 323 =head1 SEE ALSO
 324
 325 L<FS::Record>, schema.html from the base documentation.
 326
 327 =cut
 328
 329 1;
 330