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