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