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     push @or, "$agentnum IN (". join(',', $self->agentnums). ')';
 358   }
 359
 360   push @or, "$agentnum IS NULL"
 361     if $opt{'null'}
 362     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 363
 364   return ' 1 = 0 ' unless scalar(@or);
 365   '( '. join( ' OR ', @or ). ' )';
 366
 367 }
 368
 369 =item agentnum
 370
 371 Returns true if the user can view the specified agent.
 372
 373 =cut
 374
 375 sub agentnum {
 376   my( $self, $agentnum ) = @_;
 377   my $sth = dbh->prepare(
 378     "SELECT COUNT(*) FROM access_usergroup
 379                      JOIN access_groupagent USING ( groupnum )
 380        WHERE usernum = ? AND agentnum = ?"
 381   ) or die dbh->errstr;
 382   $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
 383   $sth->fetchrow_arrayref->[0];
 384 }
 385
 386 =item agents [ HASHREF | OPTION => VALUE ... ]
 387
 388 Returns the list of agents this user can view (via group membership), as
 389 FS::agent objects.  Accepts the same options as the agentnums_sql method.
 390
 391 =cut
 392
 393 sub agents {
 394   my $self = shift;
 395   qsearch({
 396     'table'     => 'agent',
 397     'hashref'   => { disabled=>'' },
 398     'extra_sql' => ' AND '. $self->agentnums_sql(@_),
 399     'order_by'  => 'ORDER BY agent',
 400   });
 401 }
 402
 403 =item access_right RIGHTNAME | LISTREF
 404
 405 Given a right name or a list reference of right names, returns true if this
 406 user has this right, or, for a list, one of the rights (currently via group
 407 membership, eventually also via user overrides).
 408
 409 =cut
 410
 411 sub access_right {
 412   my( $self, $rightname ) = @_;
 413
 414   $rightname = [ $rightname ] unless ref($rightname);
 415
 416   warn "$me access_right called on ". join(', ', @$rightname). "\n"
 417     if $DEBUG;
 418
 419   #some caching of ACL requests for low-hanging fruit perf improvement
 420   #since we get a new $CurrentUser object each page view there shouldn't be any
 421   #issues with stickiness
 422   if ( $self->{_ACLcache} ) {
 423
 424     unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
 425       warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
 426         if $DEBUG;
 427       return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
 428     }
 429
 430     warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
 431       if $DEBUG;
 432
 433   } else {
 434
 435     warn "initializing ACL cache\n"
 436       if $DEBUG;
 437     $self->{_ACLcache} = {};
 438
 439   }
 440
 441   my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
 442
 443   my $sth = dbh->prepare("
 444     SELECT groupnum FROM access_usergroup
 445                     LEFT JOIN access_group USING ( groupnum )
 446                     LEFT JOIN access_right
 447                          ON ( access_group.groupnum = access_right.rightobjnum )
 448       WHERE usernum = ?
 449         AND righttype = 'FS::access_group'
 450         AND $has_right
 451       LIMIT 1
 452   ") or die dbh->errstr;
 453   $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
 454   my $row = $sth->fetchrow_arrayref;
 455
 456   my $return = $row ? $row->[0] : '';
 457
 458   #just caching the single-rightname hits should be enough of a win for now
 459   if ( scalar(@$rightname) == 1 ) {
 460     $self->{_ACLcache}{${$rightname}[0]} = $return;
 461   }
 462
 463   $return;
 464
 465 }
 466
 467 =item default_customer_view
 468
 469 Returns the default customer view for this user, from the
 470 "default_customer_view" user preference, the "cust_main-default_view" config,
 471 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
 472
 473 =cut
 474
 475 sub default_customer_view {
 476   my $self = shift;
 477
 478   $self->option('default_customer_view')
 479     || FS::Conf->new->config('cust_main-default_view')
 480     || 'basics'; #s/jumbo/basics/ starting with 3.0
 481
 482 }
 483
 484 =item spreadsheet_format [ OVERRIDE ]
 485
 486 Returns a hashref of this user's Excel spreadsheet download settings:
 487 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
 488 Excel::Writer::XLSX), and 'mime_type'.  If OVERRIDE is 'XLS' or 'XLSX',
 489 use that instead of the user's setting.
 490
 491 =cut
 492
 493 # is there a better place to put this?
 494 my %formats = (
 495   XLS => {
 496     extension => '.xls',
 497     class => 'Spreadsheet::WriteExcel',
 498     mime_type => 'application/vnd.ms-excel',
 499   },
 500   XLSX => {
 501     extension => '.xlsx',
 502     class => 'Excel::Writer::XLSX',
 503     mime_type => # it's on wikipedia, it must be true
 504       'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
 505   }
 506 );
 507
 508 sub spreadsheet_format {
 509   my $self = shift;
 510   my $override = shift;
 511
 512   my $f =  $override
 513         || $self->option('spreadsheet_format')
 514         || FS::Conf->new->config('spreadsheet_format')
 515         || 'XLS';
 516
 517   $formats{$f};
 518 }
 519
 520 =item is_system_user
 521
 522 Returns true if this user has the name of a known system account.  These
 523 users cannot log into the web interface and can't have passwords set.
 524
 525 =cut
 526
 527 sub is_system_user {
 528   my $self = shift;
 529   return grep { $_ eq $self->username } ( qw(
 530     fs_queue
 531     fs_daily
 532     fs_selfservice
 533     fs_signup
 534     fs_bootstrap
 535     fs_selfserv
 536     fs_api
 537   ) );
 538 }
 539
 540 =item change_password NEW_PASSWORD
 541
 542 =cut
 543
 544 sub change_password {
 545   #my( $self, $password ) = @_;
 546   #FS::Auth->auth_class->change_password( $self, $password );
 547   FS::Auth->auth_class->change_password( @_ );
 548 }
 549
 550 =item change_password_fields NEW_PASSWORD
 551
 552 =cut
 553
 554 sub change_password_fields {
 555   #my( $self, $password ) = @_;
 556   #FS::Auth->auth_class->change_password_fields( $self, $password );
 557   FS::Auth->auth_class->change_password_fields( @_ );
 558 }
 559
 560 =back
 561
 562 =head1 BUGS
 563
 564 =head1 SEE ALSO
 565
 566 L<FS::Record>, schema.html from the base documentation.
 567
 568 =cut
 569
 570 1;
 571