FS/FS/access_user.pm

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