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 viewall_right
 401
 402 All agents will be viewable if the current user has the provided access right.
 403 Defaults to 'View customers of all agents'.
 404
 405 =back
 406
 407 =cut
 408
 409 sub agentnums_sql {
 410   my( $self ) = shift;
 411   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 412
 413   my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
 414
 415   my @or = ();
 416
 417   my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
 418   if ( $self->access_right($viewall_right) ) {
 419     push @or, "$agentnum IS NOT NULL";
 420   } else {
 421     my @agentnums = $self->agentnums;
 422     push @or, "$agentnum IN (". join(',', @agentnums). ')'
 423       if @agentnums;
 424   }
 425
 426   push @or, "$agentnum IS NULL"
 427     if $opt{'null'}
 428     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 429
 430   return ' 1 = 0 ' unless scalar(@or);
 431   '( '. join( ' OR ', @or ). ' )';
 432
 433 }
 434
 435 =item agentnum
 436
 437 Returns true if the user can view the specified agent.
 438
 439 Also accepts optional hashref cache, to avoid redundant database calls.
 440
 441 =cut
 442
 443 sub agentnum {
 444   my( $self, $agentnum, $cache ) = @_;
 445   $cache ||= {};
 446   return $cache->{$self->usernum}->{$agentnum}
 447     if $cache->{$self->usernum}->{$agentnum};
 448   my $sth = dbh->prepare(
 449     "SELECT COUNT(*) FROM access_usergroup
 450                      JOIN access_groupagent USING ( groupnum )
 451        WHERE usernum = ? AND agentnum = ?"
 452   ) or die dbh->errstr;
 453   $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
 454   $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
 455   $sth->finish;
 456   return $cache->{$self->usernum}->{$agentnum};
 457 }
 458
 459 =item agents [ HASHREF | OPTION => VALUE ... ]
 460
 461 Returns the list of agents this user can view (via group membership), as
 462 FS::agent objects.  Accepts the same options as the agentnums_sql method.
 463
 464 =cut
 465
 466 sub agents {
 467   my $self = shift;
 468   qsearch({
 469     'table'     => 'agent',
 470     'hashref'   => { disabled=>'' },
 471     'extra_sql' => ' AND '. $self->agentnums_sql(@_),
 472     'order_by'  => 'ORDER BY agent',
 473   });
 474 }
 475
 476 =item access_users [ HASHREF | OPTION => VALUE ... ]
 477
 478 Returns an array of FS::access_user objects, one for each non-disabled
 479 access_user in the system that shares an agent (via group membership) with
 480 the invoking object.  Regardless of options and agents, will always at
 481 least return the invoking user and any users who have viewall_right.
 482
 483 Accepts the following options:
 484
 485 =over 4
 486
 487 =item table
 488
 489 Only return users who appear in the usernum field of this table
 490
 491 =item disabled
 492
 493 Include disabled users if true (defaults to false)
 494
 495 =item viewall_right
 496
 497 All users will be returned if the current user has the provided
 498 access right, regardless of agents (other filters still apply.)
 499 Defaults to 'View customers of all agents'
 500
 501 =cut
 502
 503 #Leaving undocumented until such time as this functionality is actually used
 504 #
 505 #=item null
 506 #
 507 #Users with no agents will be returned.
 508 #
 509 #=item null_right
 510 #
 511 #Users with no agents will be returned if the current user has the provided
 512 #access right.
 513
 514 sub access_users {
 515   my $self = shift;
 516   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 517   my $table = $opt{'table'};
 518   my $search = { 'table' => 'access_user' };
 519   $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
 520   $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
 521     if $table;
 522   my @access_users = qsearch($search);
 523   my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
 524   return @access_users if $self->access_right($viewall_right);
 525   #filter for users with agents $self can view
 526   my @out;
 527   my $agentnum_cache = {};
 528 ACCESS_USER:
 529   foreach my $access_user (@access_users) {
 530     # you can always view yourself, regardless of agents,
 531     # and you can always view someone who can view you,
 532     # since they might have affected your customers
 533     if ( ($self->usernum eq $access_user->usernum)
 534          || $access_user->access_right($viewall_right)
 535     ) {
 536       push(@out,$access_user);
 537       next;
 538     }
 539     # if user has no agents, you need null or null_right to view
 540     my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
 541     if (!@agents) {
 542       if ( $opt{'null'} ||
 543            ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
 544       ) {
 545         push(@out,$access_user);
 546       }
 547       next;
 548     }
 549     # otherwise, you need an agent in common
 550     foreach my $agent (@agents) {
 551       if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
 552         push(@out,$access_user);
 553         next ACCESS_USER;
 554       }
 555     }
 556   }
 557   return @out;
 558 }
 559
 560 =item access_users_hashref  [ HASHREF | OPTION => VALUE ... ]
 561
 562 Accepts same options as L</access_users>.  Returns a hashref of
 563 users, with keys of usernum and values of username.
 564
 565 =cut
 566
 567 sub access_users_hashref {
 568   my $self = shift;
 569   my %access_users = map { $_->usernum => $_->username }
 570                        $self->access_users(@_);
 571   return \%access_users;
 572 }
 573
 574 =item access_right RIGHTNAME | LISTREF
 575
 576 Given a right name or a list reference of right names, returns true if this
 577 user has this right, or, for a list, one of the rights (currently via group
 578 membership, eventually also via user overrides).
 579
 580 =cut
 581
 582 sub access_right {
 583   my( $self, $rightname ) = @_;
 584
 585   $rightname = [ $rightname ] unless ref($rightname);
 586
 587   warn "$me access_right called on ". join(', ', @$rightname). "\n"
 588     if $DEBUG;
 589
 590   #some caching of ACL requests for low-hanging fruit perf improvement
 591   #since we get a new $CurrentUser object each page view there shouldn't be any
 592   #issues with stickiness
 593   if ( $self->{_ACLcache} ) {
 594
 595     unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
 596       warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
 597         if $DEBUG;
 598       return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
 599     }
 600
 601     warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
 602       if $DEBUG;
 603
 604   } else {
 605
 606     warn "initializing ACL cache\n"
 607       if $DEBUG;
 608     $self->{_ACLcache} = {};
 609
 610   }
 611
 612   my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
 613
 614   my $sth = dbh->prepare("
 615     SELECT groupnum FROM access_usergroup
 616                     LEFT JOIN access_group USING ( groupnum )
 617                     LEFT JOIN access_right
 618                          ON ( access_group.groupnum = access_right.rightobjnum )
 619       WHERE usernum = ?
 620         AND righttype = 'FS::access_group'
 621         AND $has_right
 622       LIMIT 1
 623   ") or die dbh->errstr;
 624   $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
 625   my $row = $sth->fetchrow_arrayref;
 626
 627   my $return = $row ? $row->[0] : '';
 628
 629   #just caching the single-rightname hits should be enough of a win for now
 630   if ( scalar(@$rightname) == 1 ) {
 631     $self->{_ACLcache}{${$rightname}[0]} = $return;
 632   }
 633
 634   $return;
 635
 636 }
 637
 638 =item refund_rights PAYBY
 639
 640 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
 641 list of the refund rights associated with that $payby.
 642
 643 Returns empty list if $payby wasn't recognized.
 644
 645 =cut
 646
 647 sub refund_rights {
 648   my $self = shift;
 649   my $payby = shift;
 650   my @rights = ();
 651   push @rights, 'Post refund'                if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
 652   push @rights, 'Post check refund'          if $payby eq 'BILL';
 653   push @rights, 'Post cash refund '          if $payby eq 'CASH';
 654   push @rights, 'Refund payment'             if $payby =~ /^(CARD|CHEK)$/;
 655   push @rights, 'Refund credit card payment' if $payby eq 'CARD';
 656   push @rights, 'Refund Echeck payment'      if $payby eq 'CHEK';
 657   return @rights;
 658 }
 659
 660 =item refund_access_right PAYBY
 661
 662 Returns true if user has L</access_right> for any L</refund_rights>
 663 for the specified payby.
 664
 665 =cut
 666
 667 sub refund_access_right {
 668   my $self = shift;
 669   my $payby = shift;
 670   my @rights = $self->refund_rights($payby);
 671   return '' unless @rights;
 672   return $self->access_right(\@rights);
 673 }
 674
 675 =item default_customer_view
 676
 677 Returns the default customer view for this user, from the
 678 "default_customer_view" user preference, the "cust_main-default_view" config,
 679 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
 680
 681 =cut
 682
 683 sub default_customer_view {
 684   my $self = shift;
 685
 686   $self->option('default_customer_view')
 687     || $conf->config('cust_main-default_view')
 688     || 'basics'; #s/jumbo/basics/ starting with 3.0
 689
 690 }
 691
 692 =item spreadsheet_format [ OVERRIDE ]
 693
 694 Returns a hashref of this user's Excel spreadsheet download settings:
 695 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
 696 Excel::Writer::XLSX), and 'mime_type'.  If OVERRIDE is 'XLS' or 'XLSX',
 697 use that instead of the user's setting.
 698
 699 =cut
 700
 701 # is there a better place to put this?
 702 my %formats = (
 703   XLS => {
 704     extension => '.xls',
 705     class => 'Spreadsheet::WriteExcel',
 706     mime_type => 'application/vnd.ms-excel',
 707   },
 708   XLSX => {
 709     extension => '.xlsx',
 710     class => 'Excel::Writer::XLSX',
 711     mime_type => # it's on wikipedia, it must be true
 712       'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
 713   }
 714 );
 715
 716 sub spreadsheet_format {
 717   my $self = shift;
 718   my $override = shift;
 719
 720   my $f =  $override
 721         || $self->option('spreadsheet_format')
 722         || $conf->config('spreadsheet_format')
 723         || 'XLS';
 724
 725   $formats{$f};
 726 }
 727
 728 =item is_system_user
 729
 730 Returns true if this user has the name of a known system account.  These
 731 users will not appear in the htpasswd file and can't have passwords set.
 732
 733 =cut
 734
 735 sub is_system_user {
 736   my $self = shift;
 737   return grep { $_ eq $self->username } ( qw(
 738     fs_queue
 739     fs_daily
 740     fs_selfservice
 741     fs_signup
 742     fs_bootstrap
 743     fs_selfserv
 744     fs_api
 745 ) );
 746 }
 747
 748 sub sched_item {
 749   my $self = shift;
 750   qsearch( 'sched_item', { 'usernum' => $self->usernum } );
 751 }
 752
 753 =item locale
 754
 755 =cut
 756
 757 sub locale {
 758   my $self = shift;
 759   return $self->{_locale} if exists($self->{_locale});
 760   $self->{_locale} = $self->option('locale');
 761 }
 762
 763 =item get_page_pref PATH, NAME, TABLENUM
 764
 765 Returns the user's page preference named NAME for the page at PATH. If the
 766 page is a view or edit page or otherwise shows a single record at a time,
 767 it should use TABLENUM to tell which record the preference is for.
 768
 769 =cut
 770
 771 sub get_page_pref {
 772   my $self = shift;
 773   my ($path, $prefname, $tablenum) = @_;
 774   $tablenum ||= '';
 775
 776   my $access_user_page_pref = qsearchs('access_user_page_pref', {
 777       path      => $path,
 778       usernum   => $self->usernum,
 779       tablenum  => $tablenum,
 780       prefname  => $prefname,
 781   });
 782   $access_user_page_pref ? $access_user_page_pref->prefvalue : '';
 783 }
 784
 785 =item set_page_pref PATH, NAME, TABLENUM, VALUE
 786
 787 Sets the user's page preference named NAME for the page at PATH. Use TABLENUM
 788 as for get_page_pref.
 789
 790 =cut
 791
 792 sub set_page_pref {
 793   my $self = shift;
 794   my ($path, $prefname, $tablenum, $prefvalue) = @_;
 795   $tablenum ||= '';
 796
 797   my $error;
 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   if ( $access_user_page_pref ) {
 805     if ( $prefvalue eq $access_user_page_pref->get('prefvalue') ) {
 806       return '';
 807     }
 808     if ( length($prefvalue) > 0 ) {
 809       $access_user_page_pref->set('prefvalue', $prefvalue);
 810       $error = $access_user_page_pref->replace;
 811       $error .= " (updating $prefname)" if $error;
 812     } else {
 813       $error = $access_user_page_pref->delete;
 814       $error .= " (removing $prefname)" if $error;
 815     }
 816   } else {
 817     if ( length($prefvalue) > 0 ) {
 818       $access_user_page_pref = FS::access_user_page_pref->new({
 819           path      => $path,
 820           usernum   => $self->usernum,
 821           tablenum  => $tablenum,
 822           prefname  => $prefname,
 823           prefvalue => $prefvalue,
 824       });
 825       $error = $access_user_page_pref->insert;
 826       $error .= " (creating $prefname)" if $error;
 827     } else {
 828       return '';
 829     }
 830   }
 831
 832   return $error;
 833 }
 834
 835 #3.x
 836
 837 sub saved_search {
 838   my $self = shift;
 839   qsearch('saved_search', { 'usernum' => $self->usernum });
 840 }
 841
 842 =item get_pref NAME
 843
 844 Fetch the prefvalue column from L<FS::access_user_pref> for prefname NAME
 845
 846 Returns undef when no value has been saved, or when record has expired
 847
 848 =cut
 849
 850 sub get_pref {
 851   my ( $self, $prefname ) = @_;
 852   croak 'prefname parameter requrired' unless $prefname;
 853
 854   my $pref_row = $self->get_pref_row( $prefname )
 855     or return undef;
 856
 857   return undef
 858     if $pref_row->expiration
 859     && $pref_row->expiration < time();
 860
 861   $pref_row->prefvalue;
 862 }
 863
 864 =item get_pref_row NAME
 865
 866 Fetch the row object from L<FS::access_user_pref> for prefname NAME
 867
 868 returns undef when no row has been created
 869
 870 =cut
 871
 872 sub get_pref_row {
 873   my ( $self, $prefname ) = @_;
 874   croak 'prefname parameter required' unless $prefname;
 875
 876   qsearchs(
 877     access_user_pref => {
 878       usernum    => $self->usernum,
 879       prefname   => $prefname,
 880     }
 881   );
 882 }
 883
 884 =item set_pref NAME, VALUE, [EXPIRATION_EPOCH]
 885
 886 Add or update user preference in L<FS::access_user_pref> table
 887
 888 Passing an undefined VALUE will delete the user preference
 889
 890 Returns VALUE
 891
 892 =cut
 893
 894 sub set_pref {
 895   my $self = shift;
 896   my ( $prefname, $prefvalue, $expiration ) = @_;
 897
 898   return $self->delete_pref( $prefname )
 899     unless defined $prefvalue;
 900
 901   if ( my $pref_row = $self->get_pref_row( $prefname )) {
 902     return $prefvalue
 903       if $pref_row->prefvalue eq $prefvalue;
 904
 905     $pref_row->prefvalue( $prefvalue );
 906     $pref_row->expiration( $expiration || '');
 907
 908     if ( my $error = $pref_row->replace ) { croak $error }
 909
 910     return $prefvalue;
 911   }
 912
 913   my $pref_row = FS::access_user_pref->new({
 914     usernum    => $self->usernum,
 915     prefname   => $prefname,
 916     prefvalue  => $prefvalue,
 917     expiration => $expiration,
 918   });
 919   if ( my $error = $pref_row->insert ) { croak $error }
 920
 921   $prefvalue;
 922 }
 923
 924 =item delete_pref NAME
 925
 926 Delete user preference from L<FS::access_user_pref> table
 927
 928 =cut
 929
 930 sub delete_pref {
 931   my ( $self, $prefname ) = @_;
 932
 933   my $pref_row = $self->get_pref_row( $prefname )
 934     or return;
 935
 936   if ( my $error = $pref_row->delete ) { croak $error }
 937 }
 938
 939 =back
 940
 941 =head1 BUGS
 942
 943 =head1 SEE ALSO
 944
 945 L<FS::Record>, schema.html from the base documentation.
 946
 947 =cut
 948
 949 1;
 950