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