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_textn('_password')
 213     || $self->ut_textn('last')
 214     || $self->ut_textn('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     or $self->get('last') eq ''         && $self->first eq '';
 234   return $self->get('last'). ', '. $self->first;
 235 }
 236
 237 =item user_cust_main
 238
 239 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
 240 user.
 241
 242 =cut
 243
 244 sub user_cust_main {
 245   my $self = shift;
 246   qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
 247 }
 248
 249 =item access_usergroup
 250
 251 Returns links to the the groups this user is a part of, as FS::access_usergroup
 252 objects (see L<FS::access_usergroup>).
 253
 254 =cut
 255
 256 sub access_usergroup {
 257   my $self = shift;
 258   qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
 259 }
 260
 261 #=item access_groups
 262 #
 263 #=cut
 264 #
 265 #sub access_groups {
 266 #
 267 #}
 268 #
 269 #=item access_groupnames
 270 #
 271 #=cut
 272 #
 273 #sub access_groupnames {
 274 #
 275 #}
 276
 277 =item agentnums
 278
 279 Returns a list of agentnums this user can view (via group membership).
 280
 281 =cut
 282
 283 sub agentnums {
 284   my $self = shift;
 285   my $sth = dbh->prepare(
 286     "SELECT DISTINCT agentnum FROM access_usergroup
 287                               JOIN access_groupagent USING ( groupnum )
 288        WHERE usernum = ?"
 289   ) or die dbh->errstr;
 290   $sth->execute($self->usernum) or die $sth->errstr;
 291   map { $_->[0] } @{ $sth->fetchall_arrayref };
 292 }
 293
 294 =item agentnums_href
 295
 296 Returns a hashref of agentnums this user can view.
 297
 298 =cut
 299
 300 sub agentnums_href {
 301   my $self = shift;
 302   scalar( { map { $_ => 1 } $self->agentnums } );
 303 }
 304
 305 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
 306
 307 Returns an sql fragement to select only agentnums this user can view.
 308
 309 Options are passed as a hashref or a list.  Available options are:
 310
 311 =over 4
 312
 313 =item null
 314
 315 The frament will also allow the selection of null agentnums.
 316
 317 =item null_right
 318
 319 The fragment will also allow the selection of null agentnums if the current
 320 user has the provided access right
 321
 322 =item table
 323
 324 Optional table name in which agentnum is being checked.  Sometimes required to
 325 resolve 'column reference "agentnum" is ambiguous' errors.
 326
 327 =item viewall_right
 328
 329 All agents will be viewable if the current user has the provided access right.
 330 Defaults to 'View customers of all agents'.
 331
 332 =back
 333
 334 =cut
 335
 336 sub agentnums_sql {
 337   my( $self ) = shift;
 338   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 339
 340   my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
 341
 342   my @or = ();
 343
 344   my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
 345   if ( $self->access_right($viewall_right) ) {
 346     push @or, "$agentnum IS NOT NULL";
 347   } else {
 348     push @or, "$agentnum IN (". join(',', $self->agentnums). ')';
 349   }
 350
 351   push @or, "$agentnum IS NULL"
 352     if $opt{'null'}
 353     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 354
 355   return ' 1 = 0 ' unless scalar(@or);
 356   '( '. join( ' OR ', @or ). ' )';
 357
 358 }
 359
 360 =item agentnum
 361
 362 Returns true if the user can view the specified agent.
 363
 364 =cut
 365
 366 sub agentnum {
 367   my( $self, $agentnum ) = @_;
 368   my $sth = dbh->prepare(
 369     "SELECT COUNT(*) FROM access_usergroup
 370                      JOIN access_groupagent USING ( groupnum )
 371        WHERE usernum = ? AND agentnum = ?"
 372   ) or die dbh->errstr;
 373   $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
 374   $sth->fetchrow_arrayref->[0];
 375 }
 376
 377 =item agents [ HASHREF | OPTION => VALUE ... ]
 378
 379 Returns the list of agents this user can view (via group membership), as
 380 FS::agent objects.  Accepts the same options as the agentnums_sql method.
 381
 382 =cut
 383
 384 sub agents {
 385   my $self = shift;
 386   qsearch({
 387     'table'     => 'agent',
 388     'hashref'   => { disabled=>'' },
 389     'extra_sql' => ' AND '. $self->agentnums_sql(@_),
 390   });
 391 }
 392
 393 =item access_right RIGHTNAME | LISTREF
 394
 395 Given a right name or a list reference of right names, returns true if this
 396 user has this right, or, for a list, one of the rights (currently via group
 397 membership, eventually also via user overrides).
 398
 399 =cut
 400
 401 sub access_right {
 402   my( $self, $rightname ) = @_;
 403
 404   $rightname = [ $rightname ] unless ref($rightname);
 405
 406   warn "$me access_right called on ". join(', ', @$rightname). "\n"
 407     if $DEBUG;
 408
 409   #some caching of ACL requests for low-hanging fruit perf improvement
 410   #since we get a new $CurrentUser object each page view there shouldn't be any
 411   #issues with stickiness
 412   if ( $self->{_ACLcache} ) {
 413
 414     unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
 415       warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
 416         if $DEBUG;
 417       return grep $self->{_ACLcache}{$_}, @$rightname
 418     }
 419
 420     warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
 421       if $DEBUG;
 422
 423   } else {
 424
 425     warn "initializing ACL cache\n"
 426       if $DEBUG;
 427     $self->{_ACLcache} = {};
 428
 429   }
 430
 431   my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
 432
 433   my $sth = dbh->prepare("
 434     SELECT groupnum FROM access_usergroup
 435                     LEFT JOIN access_group USING ( groupnum )
 436                     LEFT JOIN access_right
 437                          ON ( access_group.groupnum = access_right.rightobjnum )
 438       WHERE usernum = ?
 439         AND righttype = 'FS::access_group'
 440         AND $has_right
 441       LIMIT 1
 442   ") or die dbh->errstr;
 443   $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
 444   my $row = $sth->fetchrow_arrayref;
 445
 446   my $return = $row ? $row->[0] : '';
 447
 448   #just caching the single-rightname hits should be enough of a win for now
 449   if ( scalar(@$rightname) == 1 ) {
 450     $self->{_ACLcache}{${$rightname}[0]} = $return;
 451   }
 452
 453   $return;
 454
 455 }
 456
 457 =item default_customer_view
 458
 459 Returns the default customer view for this user, from the
 460 "default_customer_view" user preference, the "cust_main-default_view" config,
 461 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
 462
 463 =cut
 464
 465 sub default_customer_view {
 466   my $self = shift;
 467
 468   $self->option('default_customer_view')
 469     || $conf->config('cust_main-default_view')
 470     || 'basics'; #s/jumbo/basics/ starting with 3.0
 471
 472 }
 473
 474 =item spreadsheet_format [ OVERRIDE ]
 475
 476 Returns a hashref of this user's Excel spreadsheet download settings:
 477 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
 478 Excel::Writer::XLSX), and 'mime_type'.  If OVERRIDE is 'XLS' or 'XLSX',
 479 use that instead of the user's setting.
 480
 481 =cut
 482
 483 # is there a better place to put this?
 484 my %formats = (
 485   XLS => {
 486     extension => '.xls',
 487     class => 'Spreadsheet::WriteExcel',
 488     mime_type => 'application/vnd.ms-excel',
 489   },
 490   XLSX => {
 491     extension => '.xlsx',
 492     class => 'Excel::Writer::XLSX',
 493     mime_type => # it's on wikipedia, it must be true
 494       'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
 495   }
 496 );
 497
 498 sub spreadsheet_format {
 499   my $self = shift;
 500   my $override = shift;
 501
 502   my $f =  $override
 503         || $self->option('spreadsheet_format')
 504         || $conf->config('spreadsheet_format')
 505         || 'XLS';
 506
 507   $formats{$f};
 508 }
 509
 510 =item is_system_user
 511
 512 Returns true if this user has the name of a known system account.  These
 513 users cannot log into the web interface and can't have passwords set.
 514
 515 =cut
 516
 517 sub is_system_user {
 518   my $self = shift;
 519   return grep { $_ eq $self->username } ( qw(
 520     fs_queue
 521     fs_daily
 522     fs_selfservice
 523     fs_signup
 524     fs_bootstrap
 525     fs_selfserv
 526   ) );
 527 }
 528
 529 =item change_password NEW_PASSWORD
 530
 531 =cut
 532
 533 sub change_password {
 534   #my( $self, $password ) = @_;
 535   #FS::Auth->auth_class->change_password( $self, $password );
 536   FS::Auth->auth_class->change_password( @_ );
 537 }
 538
 539 =item change_password_fields NEW_PASSWORD
 540
 541 =cut
 542
 543 sub change_password_fields {
 544   #my( $self, $password ) = @_;
 545   #FS::Auth->auth_class->change_password_fields( $self, $password );
 546   FS::Auth->auth_class->change_password_fields( @_ );
 547 }
 548
 549 =back
 550
 551 =head1 BUGS
 552
 553 =head1 SEE ALSO
 554
 555 L<FS::Record>, schema.html from the base documentation.
 556
 557 =cut
 558
 559 1;
 560