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