FS/FS/access_user.pm

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