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 num_agents
 287
 288 Returns the number of agents this user can view (via group membership).
 289
 290 =cut
 291
 292 sub num_agents {
 293   my $self = shift;
 294   $self->scalar_sql(
 295     'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
 296                                      JOIN access_groupagent USING ( groupnum )
 297        WHERE usernum = ?',
 298     $self->usernum,
 299   );
 300 }
 301
 302 =item agentnums
 303
 304 Returns a list of agentnums this user can view (via group membership).
 305
 306 =cut
 307
 308 sub agentnums {
 309   my $self = shift;
 310   my $sth = dbh->prepare(
 311     "SELECT DISTINCT agentnum FROM access_usergroup
 312                               JOIN access_groupagent USING ( groupnum )
 313        WHERE usernum = ?"
 314   ) or die dbh->errstr;
 315   $sth->execute($self->usernum) or die $sth->errstr;
 316   map { $_->[0] } @{ $sth->fetchall_arrayref };
 317 }
 318
 319 =item agentnums_href
 320
 321 Returns a hashref of agentnums this user can view.
 322
 323 =cut
 324
 325 sub agentnums_href {
 326   my $self = shift;
 327   scalar( { map { $_ => 1 } $self->agentnums } );
 328 }
 329
 330 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
 331
 332 Returns an sql fragement to select only agentnums this user can view.
 333
 334 Options are passed as a hashref or a list.  Available options are:
 335
 336 =over 4
 337
 338 =item null
 339
 340 The frament will also allow the selection of null agentnums.
 341
 342 =item null_right
 343
 344 The fragment will also allow the selection of null agentnums if the current
 345 user has the provided access right
 346
 347 =item table
 348
 349 Optional table name in which agentnum is being checked.  Sometimes required to
 350 resolve 'column reference "agentnum" is ambiguous' errors.
 351
 352 =item viewall_right
 353
 354 All agents will be viewable if the current user has the provided access right.
 355 Defaults to 'View customers of all agents'.
 356
 357 =back
 358
 359 =cut
 360
 361 sub agentnums_sql {
 362   my( $self ) = shift;
 363   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 364
 365   my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
 366
 367   my @or = ();
 368
 369   my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
 370   if ( $self->access_right($viewall_right) ) {
 371     push @or, "$agentnum IS NOT NULL";
 372   } else {
 373     my @agentnums = $self->agentnums;
 374     push @or, "$agentnum IN (". join(',', @agentnums). ')'
 375       if @agentnums;
 376   }
 377
 378   push @or, "$agentnum IS NULL"
 379     if $opt{'null'}
 380     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 381
 382   return ' 1 = 0 ' unless scalar(@or);
 383   '( '. join( ' OR ', @or ). ' )';
 384
 385 }
 386
 387 =item agentnum
 388
 389 Returns true if the user can view the specified agent.
 390
 391 Also accepts optional hashref cache, to avoid redundant database calls.
 392
 393 =cut
 394
 395 sub agentnum {
 396   my( $self, $agentnum, $cache ) = @_;
 397   $cache ||= {};
 398   return $cache->{$self->usernum}->{$agentnum}
 399     if $cache->{$self->usernum}->{$agentnum};
 400   my $sth = dbh->prepare(
 401     "SELECT COUNT(*) FROM access_usergroup
 402                      JOIN access_groupagent USING ( groupnum )
 403        WHERE usernum = ? AND agentnum = ?"
 404   ) or die dbh->errstr;
 405   $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
 406   $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
 407   $sth->finish;
 408   return $cache->{$self->usernum}->{$agentnum};
 409 }
 410
 411 =item agents [ HASHREF | OPTION => VALUE ... ]
 412
 413 Returns the list of agents this user can view (via group membership), as
 414 FS::agent objects.  Accepts the same options as the agentnums_sql method.
 415
 416 =cut
 417
 418 sub agents {
 419   my $self = shift;
 420   qsearch({
 421     'table'     => 'agent',
 422     'hashref'   => { disabled=>'' },
 423     'extra_sql' => ' AND '. $self->agentnums_sql(@_),
 424     'order_by'  => 'ORDER BY agent',
 425   });
 426 }
 427
 428 =item access_users [ HASHREF | OPTION => VALUE ... ]
 429
 430 Returns an array of FS::access_user objects, one for each non-disabled
 431 access_user in the system that shares an agent (via group membership) with
 432 the invoking object.  Regardless of options and agents, will always at
 433 least return the invoking user and any users who have viewall_right.
 434
 435 Accepts the following options:
 436
 437 =over 4
 438
 439 =item table
 440
 441 Only return users who appear in the usernum field of this table
 442
 443 =item disabled
 444
 445 Include disabled users if true (defaults to false)
 446
 447 =item viewall_right
 448
 449 All users will be returned if the current user has the provided
 450 access right, regardless of agents (other filters still apply.)
 451 Defaults to 'View customers of all agents'
 452
 453 =cut
 454
 455 #Leaving undocumented until such time as this functionality is actually used
 456 #
 457 #=item null
 458 #
 459 #Users with no agents will be returned.
 460 #
 461 #=item null_right
 462 #
 463 #Users with no agents will be returned if the current user has the provided
 464 #access right.
 465
 466 sub access_users {
 467   my $self = shift;
 468   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 469   my $table = $opt{'table'};
 470   my $search = { 'table' => 'access_user' };
 471   $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
 472   $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
 473     if $table;
 474   my @access_users = qsearch($search);
 475   my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
 476   return @access_users if $self->access_right($viewall_right);
 477   #filter for users with agents $self can view
 478   my @out;
 479   my $agentnum_cache = {};
 480 ACCESS_USER:
 481   foreach my $access_user (@access_users) {
 482     # you can always view yourself, regardless of agents,
 483     # and you can always view someone who can view you,
 484     # since they might have affected your customers
 485     if ( ($self->usernum eq $access_user->usernum)
 486          || $access_user->access_right($viewall_right)
 487     ) {
 488       push(@out,$access_user);
 489       next;
 490     }
 491     # if user has no agents, you need null or null_right to view
 492     my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
 493     if (!@agents) {
 494       if ( $opt{'null'} ||
 495            ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
 496       ) {
 497         push(@out,$access_user);
 498       }
 499       next;
 500     }
 501     # otherwise, you need an agent in common
 502     foreach my $agent (@agents) {
 503       if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
 504         push(@out,$access_user);
 505         next ACCESS_USER;
 506       }
 507     }
 508   }
 509   return @out;
 510 }
 511
 512 =item access_users_hashref  [ HASHREF | OPTION => VALUE ... ]
 513
 514 Accepts same options as L</access_users>.  Returns a hashref of
 515 users, with keys of usernum and values of username.
 516
 517 =cut
 518
 519 sub access_users_hashref {
 520   my $self = shift;
 521   my %access_users = map { $_->usernum => $_->username }
 522                        $self->access_users(@_);
 523   return \%access_users;
 524 }
 525
 526 =item access_right RIGHTNAME | LISTREF
 527
 528 Given a right name or a list reference of right names, returns true if this
 529 user has this right, or, for a list, one of the rights (currently via group
 530 membership, eventually also via user overrides).
 531
 532 =cut
 533
 534 sub access_right {
 535   my( $self, $rightname ) = @_;
 536
 537   $rightname = [ $rightname ] unless ref($rightname);
 538
 539   warn "$me access_right called on ". join(', ', @$rightname). "\n"
 540     if $DEBUG;
 541
 542   #some caching of ACL requests for low-hanging fruit perf improvement
 543   #since we get a new $CurrentUser object each page view there shouldn't be any
 544   #issues with stickiness
 545   if ( $self->{_ACLcache} ) {
 546
 547     unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
 548       warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
 549         if $DEBUG;
 550       return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
 551     }
 552
 553     warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
 554       if $DEBUG;
 555
 556   } else {
 557
 558     warn "initializing ACL cache\n"
 559       if $DEBUG;
 560     $self->{_ACLcache} = {};
 561
 562   }
 563
 564   my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
 565
 566   my $sth = dbh->prepare("
 567     SELECT groupnum FROM access_usergroup
 568                     LEFT JOIN access_group USING ( groupnum )
 569                     LEFT JOIN access_right
 570                          ON ( access_group.groupnum = access_right.rightobjnum )
 571       WHERE usernum = ?
 572         AND righttype = 'FS::access_group'
 573         AND $has_right
 574       LIMIT 1
 575   ") or die dbh->errstr;
 576   $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
 577   my $row = $sth->fetchrow_arrayref;
 578
 579   my $return = $row ? $row->[0] : '';
 580
 581   #just caching the single-rightname hits should be enough of a win for now
 582   if ( scalar(@$rightname) == 1 ) {
 583     $self->{_ACLcache}{${$rightname}[0]} = $return;
 584   }
 585
 586   $return;
 587
 588 }
 589
 590 =item default_customer_view
 591
 592 Returns the default customer view for this user, from the
 593 "default_customer_view" user preference, the "cust_main-default_view" config,
 594 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
 595
 596 =cut
 597
 598 sub default_customer_view {
 599   my $self = shift;
 600
 601   $self->option('default_customer_view')
 602     || FS::Conf->new->config('cust_main-default_view')
 603     || 'basics'; #s/jumbo/basics/ starting with 3.0
 604
 605 }
 606
 607 =item spreadsheet_format [ OVERRIDE ]
 608
 609 Returns a hashref of this user's Excel spreadsheet download settings:
 610 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
 611 Excel::Writer::XLSX), and 'mime_type'.  If OVERRIDE is 'XLS' or 'XLSX',
 612 use that instead of the user's setting.
 613
 614 =cut
 615
 616 # is there a better place to put this?
 617 my %formats = (
 618   XLS => {
 619     extension => '.xls',
 620     class => 'Spreadsheet::WriteExcel',
 621     mime_type => 'application/vnd.ms-excel',
 622   },
 623   XLSX => {
 624     extension => '.xlsx',
 625     class => 'Excel::Writer::XLSX',
 626     mime_type => # it's on wikipedia, it must be true
 627       'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
 628   }
 629 );
 630
 631 sub spreadsheet_format {
 632   my $self = shift;
 633   my $override = shift;
 634
 635   my $f =  $override
 636         || $self->option('spreadsheet_format')
 637         || FS::Conf->new->config('spreadsheet_format')
 638         || 'XLS';
 639
 640   $formats{$f};
 641 }
 642
 643 =item is_system_user
 644
 645 Returns true if this user has the name of a known system account.  These
 646 users cannot log into the web interface and can't have passwords set.
 647
 648 =cut
 649
 650 sub is_system_user {
 651   my $self = shift;
 652   return grep { $_ eq $self->username } ( qw(
 653     fs_queue
 654     fs_daily
 655     fs_selfservice
 656     fs_signup
 657     fs_bootstrap
 658     fs_selfserv
 659     fs_api
 660   ) );
 661 }
 662
 663 =item change_password NEW_PASSWORD
 664
 665 =cut
 666
 667 sub change_password {
 668   #my( $self, $password ) = @_;
 669   #FS::Auth->auth_class->change_password( $self, $password );
 670   FS::Auth->auth_class->change_password( @_ );
 671 }
 672
 673 =item change_password_fields NEW_PASSWORD
 674
 675 =cut
 676
 677 sub change_password_fields {
 678   #my( $self, $password ) = @_;
 679   #FS::Auth->auth_class->change_password_fields( $self, $password );
 680   FS::Auth->auth_class->change_password_fields( @_ );
 681 }
 682
 683 =back
 684
 685 =head1 BUGS
 686
 687 =head1 SEE ALSO
 688
 689 L<FS::Record>, schema.html from the base documentation.
 690
 691 =cut
 692
 693 1;
 694