FS/FS/access_user.pm

   1 package FS::access_user;
   2
   3 use strict;
   4 use base qw( FS::m2m_Common FS::option_Common );
   5 use vars qw( $DEBUG $me $conf );
   6 use FS::UID;
   7 use FS::Auth;
   8 use FS::Conf;
   9 use FS::Record qw( qsearch qsearchs dbh );
  10 use FS::access_user_pref;
  11 use FS::access_usergroup;
  12 use FS::agent;
  13 use FS::cust_main;
  14
  15 $DEBUG = 0;
  16 $me = '[FS::access_user]';
  17
  18 =head1 NAME
  19
  20 FS::access_user - Object methods for access_user records
  21
  22 =head1 SYNOPSIS
  23
  24   use FS::access_user;
  25
  26   $record = new FS::access_user \%hash;
  27   $record = new FS::access_user { 'column' => 'value' };
  28
  29   $error = $record->insert;
  30
  31   $error = $new_record->replace($old_record);
  32
  33   $error = $record->delete;
  34
  35   $error = $record->check;
  36
  37 =head1 DESCRIPTION
  38
  39 An FS::access_user object represents an internal access user.  FS::access_user
  40 inherits from FS::Record.  The following fields are currently supported:
  41
  42 =over 4
  43
  44 =item usernum - primary key
  45
  46 =item username -
  47
  48 =item _password -
  49
  50 =item last -
  51
  52 =item first -
  53
  54 =item disabled - empty or 'Y'
  55
  56 =back
  57
  58 =head1 METHODS
  59
  60 =over 4
  61
  62 =item new HASHREF
  63
  64 Creates a new internal access user.  To add the user to the database, see L<"insert">.
  65
  66 Note that this stores the hash reference, not a distinct copy of the hash it
  67 points to.  You can ask the object for a copy with the I<hash> method.
  68
  69 =cut
  70
  71 # the new method can be inherited from FS::Record, if a table method is defined
  72
  73 sub table { 'access_user'; }
  74
  75 sub _option_table    { 'access_user_pref'; }
  76 sub _option_namecol  { 'prefname'; }
  77 sub _option_valuecol { 'prefvalue'; }
  78
  79 =item insert
  80
  81 Adds this record to the database.  If there is an error, returns the error,
  82 otherwise returns false.
  83
  84 =cut
  85
  86 sub insert {
  87   my $self = shift;
  88
  89   my $error = $self->check;
  90   return $error if $error;
  91
  92   local $SIG{HUP} = 'IGNORE';
  93   local $SIG{INT} = 'IGNORE';
  94   local $SIG{QUIT} = 'IGNORE';
  95   local $SIG{TERM} = 'IGNORE';
  96   local $SIG{TSTP} = 'IGNORE';
  97   local $SIG{PIPE} = 'IGNORE';
  98
  99   my $oldAutoCommit = $FS::UID::AutoCommit;
 100   local $FS::UID::AutoCommit = 0;
 101   my $dbh = dbh;
 102
 103   if ( $error ) {
 104     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 105     return $error;
 106   }
 107
 108   $error = $self->SUPER::insert(@_);
 109
 110   if ( $error ) {
 111     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 112     return $error;
 113   } else {
 114     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 115     '';
 116   }
 117
 118 }
 119
 120 =item delete
 121
 122 Delete this record from the database.
 123
 124 =cut
 125
 126 sub delete {
 127   my $self = shift;
 128
 129   local $SIG{HUP} = 'IGNORE';
 130   local $SIG{INT} = 'IGNORE';
 131   local $SIG{QUIT} = 'IGNORE';
 132   local $SIG{TERM} = 'IGNORE';
 133   local $SIG{TSTP} = 'IGNORE';
 134   local $SIG{PIPE} = 'IGNORE';
 135
 136   my $oldAutoCommit = $FS::UID::AutoCommit;
 137   local $FS::UID::AutoCommit = 0;
 138   my $dbh = dbh;
 139
 140   my $error = $self->SUPER::delete(@_);
 141
 142   if ( $error ) {
 143     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 144     return $error;
 145   } else {
 146     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 147     '';
 148   }
 149
 150 }
 151
 152 =item replace OLD_RECORD
 153
 154 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 155 returns the error, otherwise returns false.
 156
 157 =cut
 158
 159 sub replace {
 160   my $new = shift;
 161
 162   my $old = ( ref($_[0]) eq ref($new) )
 163               ? shift
 164               : $new->replace_old;
 165
 166   local $SIG{HUP} = 'IGNORE';
 167   local $SIG{INT} = 'IGNORE';
 168   local $SIG{QUIT} = 'IGNORE';
 169   local $SIG{TERM} = 'IGNORE';
 170   local $SIG{TSTP} = 'IGNORE';
 171   local $SIG{PIPE} = 'IGNORE';
 172
 173   my $oldAutoCommit = $FS::UID::AutoCommit;
 174   local $FS::UID::AutoCommit = 0;
 175   my $dbh = dbh;
 176
 177   return "Must change password when enabling this account"
 178     if $old->disabled && !$new->disabled
 179     && (      $new->_password =~ /changeme/i
 180            || $new->_password eq 'notyet'
 181        );
 182
 183   my $error = $new->SUPER::replace($old, @_);
 184
 185   if ( $error ) {
 186     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 187     return $error;
 188   } else {
 189     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 190     '';
 191   }
 192
 193 }
 194
 195 =item check
 196
 197 Checks all fields to make sure this is a valid internal access user.  If there is
 198 an error, returns the error, otherwise returns false.  Called by the insert
 199 and replace methods.
 200
 201 =cut
 202
 203 # the check method should currently be supplied - FS::Record contains some
 204 # data checking routines
 205
 206 sub check {
 207   my $self = shift;
 208
 209   my $error =
 210     $self->ut_numbern('usernum')
 211     || $self->ut_alpha_lower('username')
 212     || $self->ut_text('_password')
 213     || $self->ut_text('last')
 214     || $self->ut_text('first')
 215     || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
 216     || $self->ut_enum('disabled', [ '', 'Y' ] )
 217   ;
 218   return $error if $error;
 219
 220   $self->SUPER::check;
 221 }
 222
 223 =item name
 224
 225 Returns a name string for this user: "Last, First".
 226
 227 =cut
 228
 229 sub name {
 230   my $self = shift;
 231   return $self->username
 232     if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
 233   return $self->get('last'). ', '. $self->first;
 234 }
 235
 236 =item user_cust_main
 237
 238 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
 239 user.
 240
 241 =cut
 242
 243 sub user_cust_main {
 244   my $self = shift;
 245   qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
 246 }
 247
 248 =item access_usergroup
 249
 250 Returns links to the the groups this user is a part of, as FS::access_usergroup
 251 objects (see L<FS::access_usergroup>).
 252
 253 =cut
 254
 255 sub access_usergroup {
 256   my $self = shift;
 257   qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
 258 }
 259
 260 #=item access_groups
 261 #
 262 #=cut
 263 #
 264 #sub access_groups {
 265 #
 266 #}
 267 #
 268 #=item access_groupnames
 269 #
 270 #=cut
 271 #
 272 #sub access_groupnames {
 273 #
 274 #}
 275
 276 =item agentnums
 277
 278 Returns a list of agentnums this user can view (via group membership).
 279
 280 =cut
 281
 282 sub agentnums {
 283   my $self = shift;
 284   my $sth = dbh->prepare(
 285     "SELECT DISTINCT agentnum FROM access_usergroup
 286                               JOIN access_groupagent USING ( groupnum )
 287        WHERE usernum = ?"
 288   ) or die dbh->errstr;
 289   $sth->execute($self->usernum) or die $sth->errstr;
 290   map { $_->[0] } @{ $sth->fetchall_arrayref };
 291 }
 292
 293 =item agentnums_href
 294
 295 Returns a hashref of agentnums this user can view.
 296
 297 =cut
 298
 299 sub agentnums_href {
 300   my $self = shift;
 301   scalar( { map { $_ => 1 } $self->agentnums } );
 302 }
 303
 304 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
 305
 306 Returns an sql fragement to select only agentnums this user can view.
 307
 308 Options are passed as a hashref or a list.  Available options are:
 309
 310 =over 4
 311
 312 =item null
 313
 314 The frament will also allow the selection of null agentnums.
 315
 316 =item null_right
 317
 318 The fragment will also allow the selection of null agentnums if the current
 319 user has the provided access right
 320
 321 =item table
 322
 323 Optional table name in which agentnum is being checked.  Sometimes required to
 324 resolve 'column reference "agentnum" is ambiguous' errors.
 325
 326 =item viewall_right
 327
 328 All agents will be viewable if the current user has the provided access right.
 329 Defaults to 'View customers of all agents'.
 330
 331 =back
 332
 333 =cut
 334
 335 sub agentnums_sql {
 336   my( $self ) = shift;
 337   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 338
 339   my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
 340
 341   my @or = ();
 342
 343   my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
 344   if ( $self->access_right($viewall_right) ) {
 345     push @or, "$agentnum IS NOT NULL";
 346   } else {
 347     push @or, "$agentnum IN (". join(',', $self->agentnums). ')';
 348   }
 349
 350   push @or, "$agentnum IS NULL"
 351     if $opt{'null'}
 352     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 353
 354   return ' 1 = 0 ' unless scalar(@or);
 355   '( '. join( ' OR ', @or ). ' )';
 356
 357 }
 358
 359 =item agentnum
 360
 361 Returns true if the user can view the specified agent.
 362
 363 =cut
 364
 365 sub agentnum {
 366   my( $self, $agentnum ) = @_;
 367   my $sth = dbh->prepare(
 368     "SELECT COUNT(*) FROM access_usergroup
 369                      JOIN access_groupagent USING ( groupnum )
 370        WHERE usernum = ? AND agentnum = ?"
 371   ) or die dbh->errstr;
 372   $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
 373   $sth->fetchrow_arrayref->[0];
 374 }
 375
 376 =item agents [ HASHREF | OPTION => VALUE ... ]
 377
 378 Returns the list of agents this user can view (via group membership), as
 379 FS::agent objects.  Accepts the same options as the agentnums_sql method.
 380
 381 =cut
 382
 383 sub agents {
 384   my $self = shift;
 385   qsearch({
 386     'table'     => 'agent',
 387     'hashref'   => { disabled=>'' },
 388     'extra_sql' => ' AND '. $self->agentnums_sql(@_),
 389   });
 390 }
 391
 392 =item access_right RIGHTNAME | LISTREF
 393
 394 Given a right name or a list reference of right names, returns true if this
 395 user has this right, or, for a list, one of the rights (currently via group
 396 membership, eventually also via user overrides).
 397
 398 =cut
 399
 400 sub access_right {
 401   my( $self, $rightname ) = @_;
 402
 403   $rightname = [ $rightname ] unless ref($rightname);
 404
 405   warn "$me access_right called on ". join(', ', @$rightname). "\n"
 406     if $DEBUG;
 407
 408   #some caching of ACL requests for low-hanging fruit perf improvement
 409   #since we get a new $CurrentUser object each page view there shouldn't be any
 410   #issues with stickiness
 411   if ( $self->{_ACLcache} ) {
 412
 413     unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
 414       warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
 415         if $DEBUG;
 416       return grep $self->{_ACLcache}{$_}, @$rightname
 417     }
 418
 419     warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
 420       if $DEBUG;
 421
 422   } else {
 423
 424     warn "initializing ACL cache\n"
 425       if $DEBUG;
 426     $self->{_ACLcache} = {};
 427
 428   }
 429
 430   my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
 431
 432   my $sth = dbh->prepare("
 433     SELECT groupnum FROM access_usergroup
 434                     LEFT JOIN access_group USING ( groupnum )
 435                     LEFT JOIN access_right
 436                          ON ( access_group.groupnum = access_right.rightobjnum )
 437       WHERE usernum = ?
 438         AND righttype = 'FS::access_group'
 439         AND $has_right
 440       LIMIT 1
 441   ") or die dbh->errstr;
 442   $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
 443   my $row = $sth->fetchrow_arrayref;
 444
 445   my $return = $row ? $row->[0] : '';
 446
 447   #just caching the single-rightname hits should be enough of a win for now
 448   if ( scalar(@$rightname) == 1 ) {
 449     $self->{_ACLcache}{${$rightname}[0]} = $return;
 450   }
 451
 452   $return;
 453
 454 }
 455
 456 =item default_customer_view
 457
 458 Returns the default customer view for this user, from the
 459 "default_customer_view" user preference, the "cust_main-default_view" config,
 460 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
 461
 462 =cut
 463
 464 sub default_customer_view {
 465   my $self = shift;
 466
 467   $self->option('default_customer_view')
 468     || $conf->config('cust_main-default_view')
 469     || 'basics'; #s/jumbo/basics/ starting with 3.0
 470
 471 }
 472
 473 =item spreadsheet_format [ OVERRIDE ]
 474
 475 Returns a hashref of this user's Excel spreadsheet download settings:
 476 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
 477 Excel::Writer::XLSX), and 'mime_type'.  If OVERRIDE is 'XLS' or 'XLSX',
 478 use that instead of the user's setting.
 479
 480 =cut
 481
 482 # is there a better place to put this?
 483 my %formats = (
 484   XLS => {
 485     extension => '.xls',
 486     class => 'Spreadsheet::WriteExcel',
 487     mime_type => 'application/vnd.ms-excel',
 488   },
 489   XLSX => {
 490     extension => '.xlsx',
 491     class => 'Excel::Writer::XLSX',
 492     mime_type => # it's on wikipedia, it must be true
 493       'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
 494   }
 495 );
 496
 497 sub spreadsheet_format {
 498   my $self = shift;
 499   my $override = shift;
 500
 501   my $f =  $override
 502         || $self->option('spreadsheet_format')
 503         || $conf->config('spreadsheet_format')
 504         || 'XLS';
 505
 506   $formats{$f};
 507 }
 508
 509 =item is_system_user
 510
 511 Returns true if this user has the name of a known system account.  These
 512 users cannot log into the web interface and can't have passwords set.
 513
 514 =cut
 515
 516 sub is_system_user {
 517   my $self = shift;
 518   return grep { $_ eq $self->username } ( qw(
 519     fs_queue
 520     fs_daily
 521     fs_selfservice
 522     fs_signup
 523     fs_bootstrap
 524     fs_selfserv
 525   ) );
 526 }
 527
 528 =item change_password NEW_PASSWORD
 529
 530 =cut
 531
 532 sub change_password {
 533   #my( $self, $password ) = @_;
 534   #FS::Auth->auth_class->change_password( $self, $password );
 535   FS::Auth->auth_class->change_password( @_ );
 536 }
 537
 538 =item change_password_fields NEW_PASSWORD
 539
 540 =cut
 541
 542 sub change_password_fields {
 543   #my( $self, $password ) = @_;
 544   #FS::Auth->auth_class->change_password_fields( $self, $password );
 545   FS::Auth->auth_class->change_password_fields( @_ );
 546 }
 547
 548 =back
 549
 550 =head1 BUGS
 551
 552 =head1 SEE ALSO
 553
 554 L<FS::Record>, schema.html from the base documentation.
 555
 556 =cut
 557
 558 1;
 559