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