cgi-bin/LJ/User.pm

   1 package LJ::User;
   2 use strict;
   3 no warnings 'uninitialized';
   4
   5 use lib "$ENV{LJHOME}/cgi-bin";
   6
   7 use base qw/
   8     LJ::User::Relations::Friends
   9     LJ::User::Relations::Subscribers
  10 /;
  11
  12 use Carp;
  13 use HTTP::Date qw( str2time );
  14 use List::Util qw();
  15 use URI        qw();
  16
  17 use LJ::Constants;
  18 use LJ::JSON;
  19 use LJ::FileStore;
  20 use LJ::MemCache;
  21 use LJ::MemCacheProxy;
  22 use LJ::RateLimit           qw();
  23 use LJ::RelationService;
  24 use LJ::Request;
  25 use LJ::Session;
  26 use LJ::TimeUtil;
  27 use LJ::User::InfoHistory;
  28 use LJ::User::PropStorage;
  29 use LJ::User::Userlog;
  30 use LJ::Response::CachedTemplate;
  31 use LJ::PersonalStats::DB;
  32 use LJ::Redis;
  33
  34 # TODO: get rid of Class::Autouse, maybe? it's pretty useless
  35 # in web context and leads to some nasty bugs otherwise, so probably
  36 # the benefit is not worth it
  37 use Class::Autouse qw(
  38     IO::Socket::INET
  39     Time::Local
  40
  41     LJ::Auth
  42     LJ::BetaFeatures
  43     LJ::Identity
  44     LJ::Jabber::Presence
  45     LJ::M::FriendsOf
  46     LJ::Subscription
  47     LJ::S2
  48     LJ::S2Theme
  49     LJ::SMS
  50     LJ::SMS::Message
  51     LJ::Subscription
  52     LJ::Subscription::GroupSet
  53 );
  54
  55 # class method to create a new account.
  56 sub create {
  57     my ($class, %opts) = @_;
  58
  59     my $username = LJ::canonical_username($opts{user}) or return;
  60
  61     my $cluster     = $opts{cluster} || LJ::new_account_cluster();
  62     my $caps        = $opts{caps} || $LJ::NEWUSER_CAPS;
  63     my $journaltype = $opts{journaltype} || "P";
  64
  65     # non-clustered accounts aren't supported anymore
  66     return unless $cluster;
  67
  68     my $dbh = LJ::get_db_writer();
  69
  70     $dbh->do("INSERT INTO user (user, clusterid, dversion, caps, journaltype) " .
  71              "VALUES (?, ?, ?, ?, ?)", undef,
  72              $username, $cluster, $LJ::MAX_DVERSION, $caps, $journaltype);
  73     return if $dbh->err;
  74
  75     my $userid = $dbh->{'mysql_insertid'};
  76     return unless $userid;
  77
  78     $dbh->do("INSERT INTO useridmap (userid, user) VALUES (?, ?)",
  79              undef, $userid, $username);
  80     $dbh->do("INSERT INTO userusage (userid, timecreate) VALUES (?, NOW())",
  81              undef, $userid);
  82
  83     my $u = LJ::load_userid($userid, "force");
  84
  85     my $status   = $opts{status}   || ($LJ::EVERYONE_VALID ? 'A' : 'N');
  86     my $name     = $opts{name}     || $username;
  87     my $bdate    = $opts{bdate}    || "0000-00-00";
  88     my $email    = $opts{email}    || "";
  89     my $password = $opts{password} || "";
  90
  91     LJ::update_user($u, { 'status' => $status, 'name' => $name, 'bdate' => $bdate,
  92                           'email' => $email, 'password' => $password, %LJ::USER_INIT });
  93
  94     my $remote = LJ::get_remote();
  95     LJ::User::UserlogRecord::AccountCreate->create( $u, 'remote' => $remote );
  96
  97     while (my ($name, $val) = each %LJ::USERPROP_INIT) {
  98         $u->set_prop($name, $val);
  99     }
 100
 101     if ($opts{extra_props}) {
 102         while (my ($key, $value) = each( %{$opts{extra_props}} )) {
 103             $u->set_prop( $key => $value );
 104         }
 105     }
 106
 107     if ($opts{status_history}) {
 108         my $system = LJ::load_user("system");
 109         if ($system) {
 110             while (my ($key, $value) = each( %{$opts{status_history}} )) {
 111                 LJ::statushistory_add($u, $system, $key, $value);
 112             }
 113         }
 114     }
 115
 116     LJ::run_hooks("post_create", {
 117         'userid' => $userid,
 118         'user'   => $username,
 119         'code'   => undef,
 120         'news'   => $opts{'get_ljnews'},
 121         'email'  => $opts{'email'},
 122     });
 123
 124     return $u;
 125 }
 126
 127 sub create_personal {
 128     my ($class, %opts) = @_;
 129
 130     my $u = LJ::User->create(%opts) or return;
 131
 132     $u->set_prop("init_bdate", $opts{bdate});
 133     while (my ($name, $val) = each %LJ::USERPROP_INIT_PERSONAL) {
 134         $u->set_prop($name, $val);
 135     }
 136
 137     # so birthday notifications get sent
 138     $u->set_next_birthday;
 139
 140     # Set the default style
 141     LJ::run_hook('set_default_style', $u);
 142
 143     if (length $opts{inviter}) {
 144         if ($opts{inviter} =~ /^partner:/) {
 145             LJ::run_hook('partners_registration_done', $u, $opts{inviter});
 146         } else {
 147             # store inviter, if there was one
 148             my $inviter = LJ::load_user($opts{inviter});
 149             if ($inviter) {
 150                 LJ::set_rel($u, $inviter, "I");
 151                 LJ::statushistory_add($u, $inviter, 'create_from_invite', "Created new account.");
 152
 153
 154                 $u->add_friend($inviter);
 155                 LJ::Event::InvitedFriendJoins->new($inviter, $u)->fire;
 156             }
 157         }
 158     }
 159     # if we have initial friends for new accounts, add them.
 160     my @initial_friends = LJ::SUP->is_sup_enabled($u)
 161             ? (LJ::GeoLocation->ip_country eq 'UA' ? @LJ::UA_INITIAL_FRIENDS : @LJ::SUP_INITIAL_FRIENDS)
 162             : @LJ::INITIAL_FRIENDS;
 163     foreach my $friend (@initial_friends) {
 164         my $friendid = LJ::get_userid($friend);
 165         LJ::add_friend($u->id, $friendid) if $friendid;
 166     }
 167
 168     # populate some default friends groups
 169     my %res;
 170     LJ::do_request(
 171                    {
 172                        'mode'           => 'editfriendgroups',
 173                        'user'           => $u->user,
 174                        'ver'            => $LJ::PROTOCOL_VER,
 175                        'efg_set_1_name' => 'Family',
 176                        'efg_set_2_name' => 'Local Friends',
 177                        'efg_set_3_name' => 'Online Friends',
 178                        'efg_set_4_name' => 'School',
 179                        'efg_set_5_name' => 'Work',
 180                        'efg_set_6_name' => 'Mobile View',
 181                    }, \%res, { 'u' => $u, 'noauth' => 1, }
 182                    );
 183
 184     $u->set_prop("newpost_minsecurity", "friends") if $u->is_child;
 185
 186     # now flag as underage (and set O to mean was old or Y to mean was young)
 187     $u->underage(1, $opts{ofage} ? 'O' : 'Y', 'account creation') if $opts{underage};
 188
 189     # For settings that are to be set explicitly
 190     # on create, with more private settings for non-adults
 191     if ($u->underage || $u->is_child) {
 192         $u->set_prop("opt_findbyemail", 'N');
 193     } else {
 194         $u->set_prop("opt_findbyemail", 'H');
 195     }
 196
 197     return $u;
 198 }
 199
 200 sub create_community {
 201     my ($class, %opts) = @_;
 202
 203     $opts{journaltype} = "C";
 204     my $u = LJ::User->create(%opts) or return;
 205
 206     $u->set_prop("spamprotection" => 'Y');
 207     $u->set_prop("nonmember_posting", $opts{nonmember_posting}+0);
 208     $u->set_prop("moderated", $opts{moderated});
 209     $u->set_prop("adult_content", $opts{journal_adult_settings}) if LJ::is_enabled("content_flag");
 210
 211     my $remote = $opts{'owner'} || LJ::get_remote();
 212
 213         die "No remote user!\n" unless $remote;
 214
 215     LJ::set_rel($u, $remote, "A");  # maintainer
 216
 217     LJ::set_rel($u, $remote, "S");  # supermaintainer
 218
 219     LJ::User::UserlogRecord::SetOwner->create( $u,
 220         'ownerid' => $remote->userid, 'remote' => $remote );
 221
 222     LJ::statushistory_add($u, $remote, 'set_owner', "Set supermaintainer on created time as " . $remote->{user});
 223
 224     LJ::set_rel($u, $remote, "M") if $opts{moderated} =~ /^[AF]$/; # moderator if moderated
 225     LJ::join_community($remote, $u, 1, 1); # member
 226
 227     LJ::set_comm_settings($u, $remote, { membership => $opts{membership},
 228                                          postlevel => $opts{postlevel} });
 229
 230     my $theme = LJ::S2Theme->load_by_uniq($LJ::DEFAULT_THEME_COMMUNITY);
 231     LJ::Customize->apply_theme($u, $theme) if $theme;
 232
 233     $remote->clear_cache_friends($u);
 234
 235     return $u;
 236 }
 237
 238 sub create_syndicated {
 239     my ($class, %opts) = @_;
 240
 241     return unless $opts{feedurl};
 242
 243     $opts{caps}        = $LJ::SYND_CAPS;
 244     $opts{cluster}     = $LJ::SYND_CLUSTER;
 245     $opts{journaltype} = "Y";
 246
 247     my $u = LJ::User->create(%opts) or return;
 248
 249     my $dbh = LJ::get_db_writer();
 250     $dbh->do("INSERT INTO syndicated (userid, synurl, checknext) VALUES (?, ?, NOW())",
 251              undef, $u->id, $opts{feedurl});
 252     die $dbh->errstr if $dbh->err;
 253
 254     my $remote = $opts{'creator'} || LJ::get_remote();
 255     LJ::statushistory_add($remote, $u, "synd_create", "acct: " . $u->user);
 256
 257     return $u;
 258 }
 259
 260 # retrieve hash of basic syndicated info
 261 sub get_syndicated {
 262     my $u = shift;
 263
 264     return unless $u->is_syndicated;
 265     my $memkey = [$u->{'userid'}, "synd:$u->{'userid'}"];
 266
 267     my $synd = {};
 268     $synd = LJ::MemCache::get($memkey);
 269     unless ($synd) {
 270         my $dbr = LJ::get_db_reader();
 271         return unless $dbr;
 272         $synd = $dbr->selectrow_hashref("SELECT * FROM syndicated WHERE userid=$u->{'userid'}");
 273         LJ::MemCache::set($memkey, $synd, 60 * 120) if $synd;
 274     }
 275
 276     return $synd;
 277 }
 278
 279 sub is_protected_username {
 280     my ($class, $username) = @_;
 281     foreach my $re (@LJ::PROTECTED_USERNAMES) {
 282         return 1 if $username =~ /$re/;
 283     }
 284     return 0;
 285 }
 286
 287 sub new_from_row {
 288     my ($class, $row) = @_;
 289     my $u = bless $row, $class;
 290
 291     return $u;
 292 }
 293
 294 sub new_from_url {
 295     my ($class, $url) = @_;
 296
 297     my $username = $class->username_from_url($url);
 298     if ($username){
 299         return LJ::load_user($username);
 300     }
 301
 302     # domains like 'http://news.independent.livejournal.com' or 'http://some.site.domain.com'
 303     if ($url =~ m!^http://([\w.-]+)/?$!) {
 304         return $class->new_from_external_domain($1);
 305     }
 306
 307     return undef;
 308 }
 309
 310 ## Input: domain (e.g. 'news.independent.livejournal.com' or 'some.site.domain.com')
 311 ## Output: LJ::User object or undef
 312 sub new_from_external_domain {
 313     my( $class, $host ) = @_;
 314
 315     $host = lc($host);
 316     $host =~ s/^www\.//;
 317     $host =~ s/_/-/g if ($host =~ /(.*?)\.?(?:xn--80adlbbiisqhy9a|xn--f1aa)\.xn--p1ai/);
 318
 319     if (my $user = $LJ::DOMAIN_JOURNALS_REVERSE{$host}) {
 320         return LJ::load_user($user);
 321     }
 322
 323     my $key = "domain:$host";
 324     my $userid = LJ::MemCache::get($key);
 325
 326     unless (defined $userid) {
 327         my $db = LJ::get_db_reader();
 328         ($userid) = $db->selectrow_array(qq{SELECT userid FROM domains WHERE domain=?}, undef, $host);
 329         $userid ||= 0; ## we do cache negative results - if no user for such domain, set userid=0
 330         my $expire = time() + 1800;
 331         LJ::MemCache::set($key, $userid, $expire);
 332     }
 333
 334     my $u = LJ::load_userid($userid);
 335     return $u if $u;
 336     return undef;
 337 }
 338
 339 sub username_from_url {
 340     my ($class, $url) = @_;
 341
 342     # /users, /community, or /~
 343     if ($url =~ m!^\Q$LJ::SITEROOT\E/(?:users/|community/|~)([\w-]+)/?!) {
 344         return $1;
 345     }
 346
 347     # subdomains that hold a bunch of users (eg, users.siteroot.com/username/)
 348     if ($url =~ m!^http://(\w+)\.\Q$LJ::USER_DOMAIN\E/([\w_-]+)/?!) {
 349         if ( $LJ::IS_USER_DOMAIN->{$1} ) {
 350             return $2;
 351         }
 352     }
 353
 354     # user subdomains
 355     my $user_uri_regex = qr{
 356         # it all starts with a protocol:
 357         ^http://
 358
 359         # username:
 360         ([\w-]+)
 361
 362         # literal dot separating it from our domain space:
 363         [.]
 364
 365         # our domain space:
 366         \Q$LJ::USER_DOMAIN\E
 367
 368         # either it ends right there, or there is a forward slash character
 369         # followed by something (we don't care what):
 370         (?:$|/)
 371
 372     }xo; # $LJ::USER_DOMAIN is basically a constant, let Perl know that
 373
 374     if ( $LJ::USER_DOMAIN && $url =~ $user_uri_regex ) {
 375         return $1;
 376     }
 377
 378 }
 379
 380 # returns LJ::User class of a random user, undef if we couldn't get one
 381 #   my $random_u = LJ::User->load_random_user();
 382 sub load_random_user {
 383     my $class = shift;
 384
 385     # get a random database, but make sure to try them all if one is down or not
 386     # responding or similar
 387     my $dbcr;
 388     foreach (List::Util::shuffle(@LJ::CLUSTERS)) {
 389         $dbcr = LJ::get_cluster_reader($_);
 390         last if $dbcr;
 391     }
 392     die "Unable to get database cluster reader handle\n" unless $dbcr;
 393
 394     # get a selection of users around a random time
 395     my $when = time() - int(rand($LJ::RANDOM_USER_PERIOD * 24 * 60 * 60)); # days -> seconds
 396     my $uids = $dbcr->selectcol_arrayref(qq{
 397             SELECT userid FROM random_user_set
 398             WHERE posttime > $when
 399             ORDER BY posttime
 400             LIMIT 10
 401         });
 402     die "Failed to execute query: " . $dbcr->errstr . "\n" if $dbcr->err;
 403     return undef unless $uids && @$uids;
 404
 405     # try the users we got
 406     foreach my $uid (@$uids) {
 407         my $u = LJ::load_userid($uid)
 408             or next;
 409
 410         # situational checks to ensure this user is a good one to show
 411         next unless $u->is_person;         # people accounts only
 412         next unless $u->is_visible;        # no suspended/deleted/etc users
 413         next if $u->prop('latest_optout'); # they have chosen to be excluded
 414
 415         # they've passed the checks, return this user
 416         return $u;
 417     }
 418
 419     # must have failed
 420     return undef;
 421 }
 422
 423 # class method.  returns remote (logged in) user object.  or undef if
 424 # no session is active.
 425 sub remote {
 426     my ($class, $opts) = @_;
 427     return LJ::get_remote($opts);
 428 }
 429
 430 # class method.  set the remote user ($u or undef) for the duration of this request.
 431 # once set, it'll never be reloaded, unless "unset_remote" is called to forget it.
 432 sub set_remote
 433 {
 434     my ($class, $remote) = @_;
 435     $LJ::CACHED_REMOTE = 1;
 436     $LJ::CACHE_REMOTE = $remote;
 437     1;
 438 }
 439
 440 # class method.  forgets the cached remote user.
 441 sub unset_remote
 442 {
 443     my $class = shift;
 444     $LJ::CACHED_REMOTE = 0;
 445     $LJ::CACHE_REMOTE = undef;
 446     1;
 447 }
 448
 449 sub preload_props {
 450     my $u = shift;
 451     LJ::load_user_props($u, @_);
 452 }
 453
 454 sub prefetch_subscriptions {
 455     my $u = shift;
 456     my @subs = LJ::Subscription->find($u, prefetch => 1);
 457     $u->{__subscriptions} = \@subs;
 458 }
 459
 460 sub readonly {
 461     my $u = shift;
 462     return LJ::get_cap($u, "readonly");
 463 }
 464
 465 # returns self (the $u object which can be used for $u->do) if
 466 # user is writable, else 0
 467 sub writer {
 468     my $u = shift;
 469     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u);
 470     return $dbcm || 0;
 471 }
 472
 473 sub database_cluster_up {
 474     my ($u) = @_;
 475
 476     my $master = eval { LJ::get_cluster_master($u) };
 477
 478     if ($@) {
 479         my $username = $u->username;
 480         warn "error getting a cluster handle for $username: $@";
 481     }
 482
 483     return $master ? 1 : 0;
 484 }
 485
 486 sub userpic {
 487     my $u = shift;
 488     return undef unless $u->{defaultpicid};
 489     return LJ::Userpic->new($u, $u->{defaultpicid});
 490 }
 491
 492 # returns a true value if the user is underage; or if you give it an argument,
 493 # will turn on/off that user's underage status.  can also take a second argument
 494 # when you're setting the flag to also update the underage_status userprop
 495 # which is used to record if a user was ever marked as underage.
 496 sub underage {
 497     # has no bearing if this isn't on
 498     return undef unless LJ::class_bit("underage");
 499
 500     my @args = @_;
 501     my $ret_zero = 0; # no need to return zero
 502
 503     # now get the args and continue
 504     my $u = shift(@args);
 505     unless (@args) { # we are getter
 506         my $young = LJ::get_cap($u, 'underage');
 507         return unless $young; # cap is clear -> return false
 508
 509         # here cap is set -> may be we will return it, may be we will update
 510         return 1 unless $u->underage_status eq 'Y'; # only "provided birthdate" may be updated, "manual" and "cookie" must be preserved
 511         return 1 if $u->init_age < 14; # yes, user is young -> return true
 512
 513         # here cap is set and user is not young now -> will update
 514         @args = (0, undef, 'auto clear based on init_age()');
 515         # fall to setter code
 516         $ret_zero = 1;
 517     }
 518
 519     # now set it on or off
 520     my $on = shift(@args) ? 1 : 0;
 521     if ($on) {
 522         $u->add_to_class("underage");
 523     } else {
 524         $u->remove_from_class("underage");
 525     }
 526
 527     # now set their status flag if one was sent
 528     my $status = shift(@args);
 529     if ($status || $on) {
 530         # by default, just records if user was ever underage ("Y")
 531         $u->underage_status($status || 'Y');
 532     }
 533
 534     # add to statushistory
 535     if (my $shwhen = shift(@args)) {
 536         my $text = $on ? "marked" : "unmarked";
 537         my $status = $u->underage_status;
 538         LJ::statushistory_add($u, undef, "coppa", "$text; status=$status; when=$shwhen");
 539     }
 540
 541     # now fire off any hooks that are available
 542     LJ::run_hooks('set_underage', {
 543         u => $u,
 544         on => $on,
 545         status => $u->underage_status,
 546     });
 547
 548     # return true if no failures
 549     return $ret_zero ? 0 : 1;
 550 }
 551 *is_underage = \&underage;
 552
 553 # return true if we know user is a minor (< 18)
 554 sub is_minor {
 555     my $self = shift;
 556     my $age = $self->best_guess_age;
 557     return 0 unless $age;
 558     return 1 if ($age < 18);
 559     return 0;
 560 }
 561
 562 # return true if we know user is a child (< 14)
 563 sub is_child {
 564     my $self = shift;
 565     my $age = $self->best_guess_age;
 566
 567     return 0 unless $age;
 568     return 1 if ($age < 14);
 569     return 0;
 570 }
 571
 572 # get/set the gizmo account of a user
 573 sub gizmo_account {
 574     my $u = shift;
 575
 576     # parse out their account information
 577     my $acct = $u->prop( 'gizmo' );
 578     my ($validated, $gizmo);
 579     if ($acct && $acct =~ /^([01]);(.+)$/) {
 580         ($validated, $gizmo) = ($1, $2);
 581     }
 582
 583     # setting the account
 584     # all account sets are initially unvalidated
 585     if (@_) {
 586         my $newgizmo = shift;
 587         $u->set_prop( 'gizmo' => "0;$newgizmo" );
 588
 589         # purge old memcache keys
 590         LJ::MemCache::delete( "gizmo-ljmap:$gizmo" );
 591     }
 592
 593     # return the information (either account + validation or just account)
 594     return wantarray ? ($gizmo, $validated) : $gizmo unless @_;
 595 }
 596
 597 # get/set the validated status of a user's gizmo account
 598 sub gizmo_account_validated {
 599     my $u = shift;
 600
 601     my ($gizmo, $validated) = $u->gizmo_account;
 602
 603     if ( defined $_[0] && $_[0] =~ /[01]/) {
 604         $u->set_prop( 'gizmo' => "$_[0];$gizmo" );
 605         return $_[0];
 606     }
 607
 608     return $validated;
 609 }
 610
 611 # return or set the underage status userprop
 612 sub underage_status {
 613     return undef unless LJ::class_bit("underage");
 614
 615     my $u = shift;
 616
 617     # return if they aren't setting it
 618     unless (@_) {
 619         return $u->prop("underage_status");
 620     }
 621
 622     # set and return what it got set to
 623     $u->set_prop('underage_status', shift());
 624     return $u->{underage_status};
 625 }
 626
 627 # returns a true value if user has a reserved 'ext' name.
 628 sub external {
 629     my $u = shift;
 630     return $u->{user} =~ /^ext_/;
 631 }
 632
 633 # this is for debugging/special uses where you need to instruct
 634 # a user object on what database handle to use.  returns the
 635 # handle that you gave it.
 636 sub set_dbcm {
 637     my $u = shift;
 638     return $u->{'_dbcm'} = shift;
 639 }
 640
 641 sub nodb_err {
 642     my $u = shift;
 643     return "Database handle unavailable [user: " . $u->user . "; cluster: " . $u->clusterid . ", errstr: $DBI::errstr]";
 644 }
 645
 646 sub is_innodb {
 647     my $u = shift;
 648     return $LJ::CACHE_CLUSTER_IS_INNO{$u->{clusterid}}
 649     if defined $LJ::CACHE_CLUSTER_IS_INNO{$u->{clusterid}};
 650
 651     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 652         or croak $u->nodb_err;
 653     my (undef, $ctable) = $dbcm->selectrow_array("SHOW CREATE TABLE log2");
 654     die "Failed to auto-discover database type for cluster \#$u->{clusterid}: [$ctable]"
 655         unless $ctable =~ /^CREATE TABLE/;
 656
 657     my $is_inno = ($ctable =~ /=InnoDB/i ? 1 : 0);
 658     return $LJ::CACHE_CLUSTER_IS_INNO{$u->{clusterid}} = $is_inno;
 659 }
 660
 661 sub begin_work {
 662     my $u = shift;
 663     return 1 unless $u->is_innodb;
 664
 665     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 666         or croak $u->nodb_err;
 667
 668     my $rv = $dbcm->begin_work;
 669     if ($u->{_dberr} = $dbcm->err) {
 670         $u->{_dberrstr} = $dbcm->errstr;
 671     }
 672     return $rv;
 673 }
 674
 675 sub commit {
 676     my $u = shift;
 677     return 1 unless $u->is_innodb;
 678
 679     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 680         or croak $u->nodb_err;
 681
 682     my $rv = $dbcm->commit;
 683     if ($u->{_dberr} = $dbcm->err) {
 684         $u->{_dberrstr} = $dbcm->errstr;
 685     }
 686     return $rv;
 687 }
 688
 689 sub rollback {
 690     my $u = shift;
 691     return 1 unless $u->is_innodb;
 692
 693     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 694         or croak $u->nodb_err;
 695
 696     my $rv = $dbcm->rollback;
 697     if ($u->{_dberr} = $dbcm->err) {
 698         $u->{_dberrstr} = $dbcm->errstr;
 699     }
 700     return $rv;
 701 }
 702
 703 # get an $sth from the writer
 704 sub prepare {
 705     my $u = shift;
 706
 707     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 708         or croak $u->nodb_err;
 709
 710     my $rv = $dbcm->prepare(@_);
 711     if ($u->{_dberr} = $dbcm->err) {
 712         $u->{_dberrstr} = $dbcm->errstr;
 713     }
 714     return $rv;
 715 }
 716
 717 # $u->do("UPDATE foo SET key=?", undef, $val);
 718 sub do {
 719     my $u = shift;
 720     my $query = shift;
 721
 722     my $uid = $u->{userid}+0
 723         or croak "Database update called on null user object";
 724
 725     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 726         or croak $u->nodb_err;
 727
 728     $query =~ s!^(\s*\w+\s+)!$1/* uid=$uid */ !;
 729
 730     my $rv = $dbcm->do($query, @_);
 731     if ($u->{_dberr} = $dbcm->err) {
 732         $u->{_dberrstr} = $dbcm->errstr;
 733     }
 734
 735     $u->{_mysql_insertid} = $dbcm->{'mysql_insertid'} if $dbcm->{'mysql_insertid'};
 736
 737     return $rv;
 738 }
 739
 740 sub selectrow_array {
 741     my $u = shift;
 742     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 743         or croak $u->nodb_err;
 744
 745     my $set_err = sub {
 746         if ($u->{_dberr} = $dbcm->err) {
 747             $u->{_dberrstr} = $dbcm->errstr;
 748         }
 749     };
 750
 751     if (wantarray()) {
 752         my @rv = $dbcm->selectrow_array(@_);
 753         $set_err->();
 754         return @rv;
 755     }
 756
 757     my $rv = $dbcm->selectrow_array(@_);
 758     $set_err->();
 759     return $rv;
 760 }
 761
 762 sub selectcol_arrayref {
 763     my $u = shift;
 764     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 765         or croak $u->nodb_err;
 766
 767     my $rv = $dbcm->selectcol_arrayref(@_);
 768
 769     if ($u->{_dberr} = $dbcm->err) {
 770         $u->{_dberrstr} = $dbcm->errstr;
 771     }
 772
 773     return $rv;
 774 }
 775
 776
 777 sub selectall_hashref {
 778     my $u = shift;
 779     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 780         or croak $u->nodb_err;
 781
 782     my $rv = $dbcm->selectall_hashref(@_);
 783
 784     if ($u->{_dberr} = $dbcm->err) {
 785         $u->{_dberrstr} = $dbcm->errstr;
 786     }
 787
 788     return $rv;
 789 }
 790
 791 sub selectall_arrayref {
 792     my $u = shift;
 793     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 794         or croak $u->nodb_err;
 795
 796     my $rv = $dbcm->selectall_arrayref(@_);
 797
 798     if ($u->{_dberr} = $dbcm->err) {
 799         $u->{_dberrstr} = $dbcm->errstr;
 800     }
 801
 802     return $rv;
 803 }
 804
 805 sub selectrow_hashref {
 806     my $u = shift;
 807     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 808         or croak $u->nodb_err;
 809
 810     my $rv = $dbcm->selectrow_hashref(@_);
 811
 812     if ($u->{_dberr} = $dbcm->err) {
 813         $u->{_dberrstr} = $dbcm->errstr;
 814     }
 815
 816     return $rv;
 817 }
 818
 819 sub err {
 820     my $u = shift;
 821     return $u->{_dberr};
 822 }
 823
 824 sub errstr {
 825     my $u = shift;
 826     return $u->{_dberrstr};
 827 }
 828
 829 sub quote {
 830     my $u = shift;
 831     my $text = shift;
 832
 833     my $dbcm = $u->{'_dbcm'} || LJ::get_cluster_master($u)
 834         or croak $u->nodb_err;
 835
 836     return $dbcm->quote($text);
 837 }
 838
 839 sub mysql_insertid {
 840     my $u = shift;
 841     if ($u->isa("LJ::User")) {
 842         return $u->{_mysql_insertid};
 843     } elsif (LJ::isdb($u)) {
 844         my $db = $u;
 845         return $db->{'mysql_insertid'};
 846     } else {
 847         die "Unknown object '$u' being passed to LJ::User::mysql_insertid.";
 848     }
 849 }
 850
 851 # <LJFUNC>
 852 # name: LJ::User::dudata_set
 853 # class: logging
 854 # des: Record or delete disk usage data for a journal.
 855 # args: u, area, areaid, bytes
 856 # des-area: One character: "L" for log, "T" for talk, "B" for bio, "P" for pic.
 857 # des-areaid: Unique ID within $area, or '0' if area has no ids (like bio)
 858 # des-bytes: Number of bytes item takes up.  Or 0 to delete record.
 859 # returns: 1.
 860 # </LJFUNC>
 861 sub dudata_set {
 862     my ($u, $area, $areaid, $bytes) = @_;
 863     $bytes += 0; $areaid += 0;
 864     if ($bytes) {
 865         $u->do("REPLACE INTO dudata (userid, area, areaid, bytes) ".
 866                "VALUES (?, ?, $areaid, $bytes)", undef,
 867                $u->{userid}, $area);
 868     } else {
 869         $u->do("DELETE FROM dudata WHERE userid=? AND ".
 870                "area=? AND areaid=$areaid", undef,
 871                $u->{userid}, $area);
 872     }
 873     return 1;
 874 }
 875
 876 sub make_login_session {
 877     my ($u, $exptype, $ipfixed) = @_;
 878     $exptype ||= 'short';
 879     return 0 unless $u;
 880
 881     eval { LJ::Request->notes('ljuser' => $u->{'user'}); };
 882
 883     # create session and log user in
 884     my $sess_opts = {
 885         'exptype' => $exptype,
 886         'ipfixed' => $ipfixed,
 887     };
 888
 889     my $sess = LJ::Session->create($u, %$sess_opts);
 890     $sess->update_master_cookie;
 891
 892     LJ::User->set_remote($u);
 893
 894     # add a uniqmap row if we don't have one already
 895     my $uniq = LJ::UniqCookie->current_uniq;
 896     LJ::UniqCookie->save_mapping($uniq => $u);
 897
 898     # restore scheme and language
 899     my $bl = LJ::Lang::get_lang($u->prop('browselang'));
 900     BML::set_language($bl->{'lncode'}) if $bl;
 901
 902     # don't set/force the scheme for this page if we're on SSL.
 903     # we'll pick it up from cookies on subsequent pageloads
 904     # but if their scheme doesn't have an SSL equivalent,
 905     # then the post-login page throws security errors
 906     BML::set_scheme($u->prop('schemepref'))
 907         unless $LJ::IS_SSL;
 908
 909     # run some hooks
 910     my @sopts;
 911     LJ::run_hooks("login_add_opts", {
 912         "u" => $u,
 913         "form" => {},
 914         "opts" => \@sopts
 915     });
 916     my $sopts = @sopts ? ":" . join('', map { ".$_" } @sopts) : "";
 917     $sess->flags($sopts);
 918
 919     my $etime = $sess->expiration_time;
 920     LJ::run_hooks("post_login", {
 921         "u" => $u,
 922         "form" => {},
 923         "expiretime" => $etime,
 924     });
 925
 926     # activity for cluster usage tracking
 927     LJ::mark_user_active($u, 'login');
 928
 929     # activity for global account number tracking
 930     $u->note_activity('A');
 931
 932     return 1;
 933 }
 934
 935 # We have about 10 million different forms of activity tracking.
 936 # This one is for tracking types of user activity on a per-hour basis
 937 #
 938 #    Example: $u had login activity during this out
 939 #
 940 sub note_activity {
 941     my ($u, $atype) = @_;
 942     croak ("invalid user") unless ref $u;
 943     croak ("invalid activity type") unless $atype;
 944
 945     # If we have no memcache servers, this function would trigger
 946     # an insert for every logged-in pageview.  Probably not a problem
 947     # load-wise if the site isn't using memcache anyway, but if the
 948     # site is that small active user tracking probably doesn't matter
 949     # much either.  :/
 950     return undef unless @LJ::MEMCACHE_SERVERS;
 951
 952     # Also disable via config flag
 953     return undef if $LJ::DISABLED{active_user_tracking};
 954
 955     my $now    = time();
 956     my $uid    = $u->{userid}; # yep, lazy typist w/ rsi
 957     my $explen = 1800;         # 30 min, same for all types now
 958
 959     my $memkey = [ $uid, "uactive:$atype:$uid" ];
 960
 961     # get activity key from memcache
 962     my $atime = LJ::MemCacheProxy::get($memkey);
 963
 964     # nothing to do if we got an $atime within the last hour
 965     return 1 if $atime && $atime > $now - $explen;
 966
 967     # key didn't exist due to expiration, or was too old,
 968     # means we need to make an activity entry for the user
 969     my ($hr, $dy, $mo, $yr) = (gmtime($now))[2..5];
 970     $yr += 1900; # offset from 1900
 971     $mo += 1;    # 0-based
 972
 973     # delayed insert in case the table is currently locked due to an analysis
 974     # running.  this way the apache won't be tied up waiting
 975     $u->do("INSERT IGNORE INTO active_user " .
 976            "SET year=?, month=?, day=?, hour=?, userid=?, type=?",
 977            undef, $yr, $mo, $dy, $hr, $uid, $atype);
 978
 979     # set a new memcache key good for $explen
 980     LJ::MemCacheProxy::set($memkey, $now, $explen);
 981
 982     return 1;
 983 }
 984
 985 sub note_transition {
 986     my ($u, $what, $from, $to) = @_;
 987     croak "invalid user object" unless LJ::isu($u);
 988
 989     return 1 if $LJ::DISABLED{user_transitions};
 990
 991     # we don't want to insert if the requested transition is already
 992     # the last noted one for this user... in that case there has been
 993     # no transition at all
 994     my $last = $u->last_transition($what);
 995     return 1 if
 996         $last->{before} eq $from &&
 997         $last->{after}  eq $to;
 998
 999     my $dbh = LJ::get_db_writer()
1000         or die "unable to contact global db master";
1001
1002     # bleh, need backticks on the 'before' and 'after' columns since those
1003     # are MySQL reserved words
1004     $dbh->do("INSERT INTO usertrans " .
1005              "SET userid=?, time=UNIX_TIMESTAMP(), what=?, " .
1006              "`before`=?, `after`=?",
1007              undef, $u->{userid}, $what, $from, $to);
1008     die $dbh->errstr if $dbh->err;
1009
1010     # also log account changes to statushistory
1011     my $remote = LJ::get_remote();
1012     LJ::statushistory_add($u, $remote, "account_level_change", "$from -> $to")
1013         if $what eq "account";
1014
1015     return 1;
1016 }
1017
1018 sub transition_list {
1019     my ($u, $what) = @_;
1020     croak "invalid user object" unless LJ::isu($u);
1021
1022     my $dbh = LJ::get_db_writer()
1023         or die "unable to contact global db master";
1024
1025     # FIXME: return list of transition object singleton instances?
1026     my @list = ();
1027     my $sth = $dbh->prepare("SELECT time, `before`, `after` " .
1028                             "FROM usertrans WHERE userid=? AND what=?");
1029     $sth->execute($u->{userid}, $what);
1030     die $dbh->errstr if $dbh->err;
1031
1032     while (my $trans = $sth->fetchrow_hashref) {
1033
1034         # fill in a couple of properties here rather than
1035         # sending over the network from db
1036         $trans->{userid} = $u->{userid};
1037         $trans->{what}   = $what;
1038
1039         push @list, $trans;
1040     }
1041
1042     return wantarray() ? @list : \@list;
1043 }
1044
1045 sub last_transition {
1046     my ($u, $what) = @_;
1047     croak "invalid user object" unless LJ::isu($u);
1048
1049     $u->transition_list($what)->[-1];
1050 }
1051
1052 sub tosagree_set
1053 {
1054     my ($u, $err) = @_;
1055     return undef unless $u;
1056
1057     unless (-f "$LJ::HOME/htdocs/inc/legal-tos") {
1058         $$err = "TOS include file could not be found";
1059         return undef;
1060     }
1061
1062     my $rev;
1063     open (TOS, "$LJ::HOME/htdocs/inc/legal-tos");
1064     while ((!$rev) && (my $line = <TOS>)) {
1065         my $rcstag = "Revision";
1066         if ($line =~ /\$$rcstag:\s*(\S+)\s*\$/) {
1067             $rev = $1;
1068         }
1069     }
1070     close TOS;
1071
1072     # if the required version of the tos is not available, error!
1073     my $rev_req = $LJ::REQUIRED_TOS{rev};
1074     if ($rev_req > 0 && $rev ne $rev_req) {
1075         $$err = "Required Terms of Service revision is $rev_req, but system version is $rev.";
1076         return undef;
1077     }
1078
1079     my $newval = join(', ', time(), $rev);
1080     my $rv = $u->set_prop("legal_tosagree", $newval);
1081     if ($rv) {
1082         # set in $u object for callers later
1083         ## hm, doesn't "set_prop" do it?
1084         $u->{legal_tosagree} = $newval;
1085         return $rv;
1086     } else {
1087         $$err = "Internal error: can't set prop legal_tosagree";
1088         return;
1089     }
1090 }
1091
1092 sub tosagree_verify {
1093     my $u = shift;
1094     return 1 unless $LJ::TOS_CHECK;
1095
1096     my $rev_req = $LJ::REQUIRED_TOS{rev};
1097     return 1 unless $rev_req > 0;
1098
1099     my $rev_cur = (split(/\s*,\s*/, $u->prop("legal_tosagree")))[1];
1100     return $rev_cur eq $rev_req;
1101 }
1102
1103 # my $sess = $u->session           (returns current session)
1104 # my $sess = $u->session($sessid)  (returns given session id for user)
1105
1106 sub session {
1107     my ($u, $sessid) = @_;
1108     $sessid = $sessid + 0;
1109     return $u->{_session} unless $sessid;  # should be undef, or LJ::Session hashref
1110     return LJ::Session->instance($u, $sessid);
1111 }
1112
1113 # in list context, returns an array of LJ::Session objects which are active.
1114 # in scalar context, returns hashref of sessid -> LJ::Session, which are active
1115 sub sessions {
1116     my $u = shift;
1117     my @sessions = LJ::Session->active_sessions($u);
1118     return @sessions if wantarray;
1119     my $ret = {};
1120     foreach my $s (@sessions) {
1121         $ret->{$s->id} = $s;
1122     }
1123     return $ret;
1124 }
1125
1126 sub logout {
1127     my $u = shift;
1128     if (my $sess = $u->session) {
1129         $sess->destroy;
1130     }
1131     $u->_logout_common;
1132 }
1133
1134 sub logout_all {
1135     my $u = shift;
1136     LJ::Session->destroy_all_sessions($u)
1137         or die "Failed to logout all";
1138     $u->_logout_common;
1139 }
1140
1141 sub _logout_common {
1142     my $u = shift;
1143     LJ::Session->clear_master_cookie;
1144     LJ::User->set_remote(undef);
1145     delete $BML::COOKIE{'BMLschemepref'};
1146     delete $BML::COOKIE{'cart'};
1147     eval { BML::set_scheme(undef); };
1148     LJ::run_hooks("user_logout");
1149 }
1150
1151 # returns a new LJ::Session object, or undef on failure
1152 sub create_session
1153 {
1154     my ($u, %opts) = @_;
1155     return LJ::Session->create($u, %opts);
1156 }
1157
1158 # $u->kill_session(@sessids)
1159 sub kill_sessions {
1160     my $u = shift;
1161     return LJ::Session->destroy_sessions($u, @_);
1162 }
1163
1164 sub kill_all_sessions {
1165     my $u = shift
1166         or return 0;
1167
1168     LJ::Session->destroy_all_sessions($u)
1169         or return 0;
1170
1171     # forget this user, if we knew they were logged in
1172     if ($LJ::CACHE_REMOTE && $LJ::CACHE_REMOTE->{userid} == $u->{userid}) {
1173         LJ::Session->clear_master_cookie;
1174         LJ::User->set_remote(undef);
1175     }
1176
1177     return 1;
1178 }
1179
1180 sub kill_session {
1181     my $u = shift
1182         or return 0;
1183     my $sess = $u->session
1184         or return 0;
1185
1186     $sess->destroy;
1187
1188     if ($LJ::CACHE_REMOTE && $LJ::CACHE_REMOTE->{userid} == $u->{userid}) {
1189         LJ::Session->clear_master_cookie;
1190         LJ::User->set_remote(undef);
1191     }
1192
1193     return 1;
1194 }
1195
1196 # <LJFUNC>
1197 # name: LJ::User::mogfs_userpic_key
1198 # class: mogilefs
1199 # des: Make a mogilefs key for the given pic for the user.
1200 # args: pic
1201 # des-pic: Either the userpic hash or the picid of the userpic.
1202 # returns: 1.
1203 # </LJFUNC>
1204 sub mogfs_userpic_key {
1205     my $self = shift or return undef;
1206     my $pic = shift or croak "missing required arg: userpic";
1207
1208     my $picid = ref $pic ? $pic->{picid} : $pic+0;
1209     return "up:$self->{userid}:$picid";
1210 }
1211
1212 # all reads/writes to talk2 must be done inside a lock, so there's
1213 # no race conditions between reading from db and putting in memcache.
1214 # can't do a db write in between those 2 steps.  the talk2 -> memcache
1215 # is elsewhere (talklib.pl), but this $dbh->do wrapper is provided
1216 # here because non-talklib things modify the talk2 table, and it's
1217 # nice to centralize the locking rules.
1218 #
1219 # return value is return of $dbh->do.  $errref scalar ref is optional, and
1220 # if set, gets value of $dbh->errstr
1221 #
1222 # write:  (LJ::talk2_do)
1223 #   GET_LOCK
1224 #    update/insert into talk2
1225 #   RELEASE_LOCK
1226 #    delete memcache
1227 #
1228 # read:   (LJ::Talk::get_talk_data)
1229 #   try memcache
1230 #   GET_LOCk
1231 #     read db
1232 #     update memcache
1233 #   RELEASE_LOCK
1234
1235 sub talk2_do {
1236     #my ($u, $nodetype, $nodeid, $errref, $sql, @args) = @_;
1237     my $u = shift;
1238     my %args = @_;
1239     my $nodetype = $args{nodetype};
1240     my $nodeid   = $args{nodeid};
1241     my $errref   = $args{errref};
1242     my $sql      = $args{sql};
1243     my @bindings = ref $args{bindings} eq 'ARRAY' ? @{$args{bindings}} : ();
1244     my $flush_cache = exists $args{flush_cache} ? $args{flush_cache} : 1;
1245
1246     # some checks
1247     return undef unless $nodetype =~ /^\w$/;
1248     return undef unless $nodeid =~ /^\d+$/;
1249     return undef unless $u->writer;
1250
1251     my $dbcm = $u->writer;
1252
1253     my $memkey = [$u->{'userid'}, "talk2:$u->{'userid'}:$nodetype:$nodeid"];
1254     my $lockkey = $memkey->[1];
1255
1256     $dbcm->selectrow_array("SELECT GET_LOCK(?,10)", undef, $lockkey);
1257     my $ret = $u->do($sql, undef, @bindings);
1258     $$errref = $u->errstr if ref $errref && $u->err;
1259     $dbcm->selectrow_array("SELECT RELEASE_LOCK(?)", undef, $lockkey);
1260
1261     # flush talks tree.
1262     LJ::MemCache::delete($memkey, 0) if int($ret) and $flush_cache;
1263
1264     return $ret;
1265 }
1266
1267
1268
1269
1270 # log2_do
1271 # see comments for talk2_do
1272
1273 sub log2_do {
1274     my ($u, $errref, $sql, @args) = @_;
1275     return undef unless $u->writer;
1276
1277     my $dbcm = $u->writer;
1278
1279     my $memkey = [$u->{'userid'}, "log2lt:$u->{'userid'}"];
1280     my $lockkey = $memkey->[1];
1281
1282     $dbcm->selectrow_array("SELECT GET_LOCK(?,10)", undef, $lockkey);
1283     my $ret = $u->do($sql, undef, @args);
1284     $$errref = $u->errstr if ref $errref && $u->err;
1285     $dbcm->selectrow_array("SELECT RELEASE_LOCK(?)", undef, $lockkey);
1286
1287     LJ::MemCache::delete($memkey, 0) if int($ret);
1288     return $ret;
1289 }
1290
1291 sub url {
1292     my $u = shift;
1293
1294     my $url;
1295
1296     if ($u->is_identity && !$u->prop('url')) {
1297         $u->set_prop( 'url' => $u->identity->url($u) );
1298     }
1299
1300     $url ||= $u->prop('url');
1301     return unless $url;
1302
1303     $url = "http://$url" unless $url =~ m!^https?://!;
1304
1305     return $url;
1306 }
1307
1308 # there are two procedures for finding an LJ::Identity object for the given
1309 # user, the difference being that identity() checks for journaltype eq 'I'
1310 # while find_identity() does not. this is done this way for backwards
1311 # compatibility: some parts of LJ code use identity() to check what
1312 # is_identity() checks (suboptimal, yes, but it works that way)
1313
1314 sub find_identity {
1315     my ($u) = @_;
1316
1317     return $u->{'_identity'} if $u->{'_identity'};
1318
1319     my $memkey = [$u->{userid}, "ident:$u->{userid}"];
1320     my $ident = LJ::MemCache::get($memkey);
1321     if ($ident) {
1322         my $i = LJ::Identity->new(
1323                                   typeid => $ident->[0],
1324                                   value  => $ident->[1],
1325                                   );
1326
1327         return $u->{_identity} = $i;
1328     }
1329
1330     my $dbh = LJ::get_db_writer();
1331     $ident = $dbh->selectrow_arrayref("SELECT idtype, identity FROM identitymap ".
1332                                       "WHERE userid=? LIMIT 1", undef, $u->{userid});
1333     if ($ident) {
1334         LJ::MemCache::set($memkey, $ident);
1335         my $i = LJ::Identity->new(
1336                                   typeid => $ident->[0],
1337                                   value  => $ident->[1],
1338                                   );
1339         return $i;
1340     }
1341
1342     return;
1343 }
1344
1345 sub identity {
1346     my ($u) = @_;
1347
1348     return unless $u->is_identity;
1349     return $u->find_identity;
1350 }
1351
1352 # returns a URL if account is an OpenID identity.  undef otherwise.
1353 sub openid_identity {
1354     my $u = shift;
1355     my $ident = $u->identity;
1356     return undef unless $ident && $ident->typeid == 0;
1357     return $ident->value;
1358 }
1359
1360 # returns username or identity display name
1361 sub display_name {
1362     my $u = shift;
1363
1364     my $display_name_override;
1365     LJ::run_hooks( 'override_display_name', $u, \$display_name_override );
1366     return $display_name_override if $display_name_override;
1367
1368     return $u->username unless $u->is_identity;
1369
1370     my $id = $u->identity;
1371     return "[ERR:unknown_identity]" unless $id;
1372     return LJ::ehtml( $id->display_name($u) );
1373 }
1374
1375 sub ljuser_display {
1376     my ($u, $opts) = @_;
1377     return LJ::ljuser($u, $opts);
1378 }
1379
1380 # class function - load an identity user, but only if they're already known to us
1381 sub load_existing_identity_user {
1382     my ($type, $ident) = @_;
1383
1384     my $dbh = LJ::get_db_reader();
1385     my $uid = $dbh->selectrow_array("SELECT userid FROM identitymap WHERE idtype=? AND identity=?",
1386                                     undef, $type, $ident);
1387     return $uid ? LJ::load_userid($uid) : undef;
1388 }
1389
1390 # class function - load an identity user, and if we've never seen them before create a user account for them
1391 sub load_identity_user {
1392     my ($type, $ident, $extra, $created_ref) = @_;
1393
1394     my $u = load_existing_identity_user($type, $ident);
1395
1396     # If the user is marked as expunged, move identity mapping aside
1397     # and continue to create new account.
1398     # Otherwise return user if it exists.
1399     if ($u) {
1400         if ($u->is_expunged) {
1401             return undef unless ($u->rename_identity);
1402         } else {
1403             return $u;
1404         }
1405     }
1406
1407     # increment ext_ counter until we successfully create an LJ
1408     # account.  hard cap it at 10 tries. (arbitrary, but we really
1409     # shouldn't have *any* failures here, let alone 10 in a row)
1410     my $dbh = LJ::get_db_writer();
1411     my $uid;
1412
1413     for (1..10) {
1414         my $extuser = 'ext_' . LJ::alloc_global_counter('E');
1415
1416         $uid = LJ::create_account({
1417             caps => undef,
1418             user => $extuser,
1419             name => $extuser,
1420             journaltype => 'I',
1421         });
1422
1423         last if $uid;
1424         select undef, undef, undef, .10;  # lets not thrash over this
1425     }
1426     return undef unless $uid &&
1427         $dbh->do("INSERT INTO identitymap (idtype, identity, userid) VALUES (?,?,?)",
1428                  undef, $type, $ident, $uid);
1429
1430     $u = LJ::load_userid($uid);
1431
1432     $u->identity->initialize_user($u, $extra);
1433     $$created_ref = 1 if $created_ref;
1434
1435     # record create information
1436     my $remote = LJ::get_remote();
1437     LJ::User::UserlogRecord::AccountCreate->create( $u, 'remote' => $remote );
1438
1439     return $u;
1440 }
1441
1442 sub remove_identity {
1443     my ($u) = @_;
1444
1445     my $dbh = LJ::get_db_writer();
1446     $dbh->do( 'DELETE FROM identitymap WHERE userid=?', undef, $u->id );
1447
1448     delete $u->{'_identity'};
1449
1450      my $memkey = [$u->{userid}, "ident:$u->{userid}"];
1451      LJ::MemCache::delete($memkey);
1452 }
1453
1454 # instance method:  returns userprop for a user.  currently from cache with no
1455 # way yet to force master.
1456 sub prop {
1457     my ($u, $prop) = @_;
1458
1459     # some props have accessors which do crazy things, if so they need
1460     # to be redirected from this method, which only loads raw values
1461     if ({ map { $_ => 1 }
1462           qw(opt_sharebday opt_showbday opt_showlocation opt_showmutualfriends
1463              view_control_strip show_control_strip opt_ctxpopup opt_embedplaceholders
1464              esn_inbox_default_expand opt_getting_started)
1465         }->{$prop})
1466     {
1467         return $u->$prop;
1468     }
1469
1470     return $u->raw_prop($prop);
1471 }
1472
1473 sub raw_prop {
1474     my ($u, $prop) = @_;
1475     $u->preload_props($prop) unless exists $u->{$prop};
1476     return $u->{$prop};
1477 }
1478
1479 sub _lazy_migrate_infoshow {
1480     my ($u) = @_;
1481     return 1 if $LJ::DISABLED{infoshow_migrate};
1482
1483     # 1) column exists, but value is migrated
1484     # 2) column has died from 'user')
1485     if ($u->{allow_infoshow} eq ' ' || ! $u->{allow_infoshow}) {
1486         return 1; # nothing to do
1487     }
1488
1489     my $infoval = $u->{allow_infoshow} eq 'Y' ? undef : 'N';
1490
1491     # need to migrate allow_infoshow => opt_showbday
1492     if ($infoval) {
1493         foreach my $prop (qw(opt_showbday opt_showlocation)) {
1494             $u->set_prop($prop => $infoval);
1495         }
1496     }
1497
1498     # setting allow_infoshow to ' ' means we've migrated it
1499     LJ::update_user($u, { allow_infoshow => ' ' })
1500         or die "unable to update user after infoshow migration";
1501     $u->{allow_infoshow} = ' ';
1502
1503     return 1;
1504 }
1505
1506 # opt_showbday options
1507 # F - Full Display of Birthday
1508 # D - Only Show Month/Day
1509 # Y - Only Show Year
1510 # N - Do not display
1511 sub opt_showbday {
1512     my $u = shift;
1513     # option not set = "yes", set to N = "no"
1514     $u->_lazy_migrate_infoshow;
1515
1516     # migrate above did nothing
1517     # -- if user was already migrated in the past, we'll
1518     #    fall through and show their prop value
1519     # -- if user not migrated yet, we'll synthesize a prop
1520     #    value from infoshow without writing it
1521     if ($LJ::DISABLED{infoshow_migrate} && $u->{allow_infoshow} ne ' ') {
1522         return $u->{allow_infoshow} eq 'Y' ? undef : 'N';
1523     }
1524     if ($u->raw_prop('opt_showbday') =~ /^(D|F|N|Y)$/) {
1525         return $u->raw_prop('opt_showbday');
1526     } else {
1527         return 'D';
1528     }
1529 }
1530
1531 # opt_sharebday options
1532 # A - All people
1533 # R - Registered Users
1534 # F - Friends Only
1535 # N - Nobody
1536 sub opt_sharebday {
1537     my $u = shift;
1538
1539     if ($u->raw_prop('opt_sharebday') =~ /^(A|F|N|R)$/) {
1540         return $u->raw_prop('opt_sharebday');
1541     } else {
1542         return 'N' if ($u->underage || $u->is_child);
1543         return 'F' if ($u->is_minor);
1544         return 'A';
1545     }
1546 }
1547
1548 # opt_showljtalk options based on user setting
1549 # Y = Show the LJ Talk field on profile (default)
1550 # N = Don't show the LJ Talk field on profile
1551 sub opt_showljtalk {
1552     my $u = shift;
1553
1554     # Check for valid value, or just return default of 'Y'.
1555     if ($u->raw_prop('opt_showljtalk') =~ /^(Y|N)$/) {
1556         return $u->raw_prop('opt_showljtalk');
1557     } else {
1558         return 'Y';
1559     }
1560 }
1561
1562 # Show LJ Talk field on profile?  opt_showljtalk needs a value of 'Y'.
1563 sub show_ljtalk {
1564     my $u = shift;
1565     croak "Invalid user object passed" unless LJ::isu($u);
1566
1567     # Fail if the user wants to hide the LJ Talk field on their profile,
1568     # or doesn't even have the ability to show it.
1569     return 0 if $u->opt_showljtalk eq 'N' || $LJ::DISABLED{'ljtalk'} || !$u->is_person;
1570
1571     # User either decided to show LJ Talk field or has left it at the default.
1572     return 1 if $u->opt_showljtalk eq 'Y';
1573 }
1574
1575 # Hide the LJ Talk field on profile?  opt_showljtalk needs a value of 'N'.
1576 sub hide_ljtalk {
1577     my $u = shift;
1578     croak "Invalid user object passed" unless LJ::isu($u);
1579
1580     # ... The opposite of showing the field. :)
1581     return $u->show_ljtalk ? 0 : 1;
1582 }
1583
1584 sub ljtalk_id {
1585     my $u = shift;
1586     croak "Invalid user object passed" unless LJ::isu($u);
1587
1588     return $u->{'user'}.'@'.$LJ::USER_DOMAIN;
1589 }
1590
1591 sub opt_showlocation {
1592     my $u = shift;
1593     # option not set = "yes", set to N = "no"
1594     $u->_lazy_migrate_infoshow;
1595
1596     # see comments for opt_showbday
1597     if ($LJ::DISABLED{infoshow_migrate} && $u->{allow_infoshow} ne ' ') {
1598         return $u->{allow_infoshow} eq 'Y' ? undef : 'N';
1599     }
1600     if ($u->raw_prop('opt_showlocation') =~ /^(N|Y|R|F)$/) {
1601         return $u->raw_prop('opt_showlocation');
1602     } else {
1603         return 'N' if ($u->underage || $u->is_child);
1604         return 'F' if ($u->is_minor);
1605         return 'Y';
1606     }
1607 }
1608
1609 sub opt_showcontact {
1610     my $u = shift;
1611
1612     if ($u->{'allow_contactshow'} =~ /^(N|Y|R|F)$/) {
1613         return $u->{'allow_contactshow'};
1614     } else {
1615         return 'N' if ($u->underage || $u->is_child);
1616         return 'F' if ($u->is_minor);
1617         return 'Y';
1618     }
1619 }
1620
1621 # opt_showonlinestatus options
1622 # F = Mutual Friends
1623 # Y = Everybody
1624 # N = Nobody
1625 sub opt_showonlinestatus {
1626     my $u = shift;
1627
1628     if ($u->raw_prop('opt_showonlinestatus') =~ /^(F|N|Y)$/) {
1629         return $u->raw_prop('opt_showonlinestatus');
1630     } else {
1631         return 'F';
1632     }
1633 }
1634
1635 sub can_show_location {
1636     my $u = shift;
1637     croak "invalid user object passed" unless LJ::isu($u);
1638
1639     my %opts = @_;
1640     my $remote = $opts{remote} || LJ::get_remote();
1641
1642     return 0 if $u->underage;
1643     return 0 if ($u->opt_showlocation eq 'N');
1644     return 0 if ($u->opt_showlocation eq 'R' && !$remote);
1645     return 0 if ($u->opt_showlocation eq 'F' && !$u->is_friend($remote));
1646     return 1;
1647 }
1648
1649 sub can_show_onlinestatus {
1650     my $u = shift;
1651     my $remote = shift;
1652     croak "invalid user object passed"
1653         unless LJ::isu($u);
1654
1655     # Nobody can see online status of u
1656     return 0 if $u->opt_showonlinestatus eq 'N';
1657     # Everybody can see online status of u
1658     return 1 if $u->opt_showonlinestatus eq 'Y';
1659     # Only mutual friends of u can see online status
1660     if ($u->opt_showonlinestatus eq 'F') {
1661         return 0 unless $remote;
1662         return 1 if $u->is_mutual_friend($remote);
1663         return 0;
1664     }
1665     return 0;
1666 }
1667
1668 # return the setting indicating how a user can be found by their email address
1669 # Y - Findable, N - Not findable, H - Findable but identity hidden
1670 sub opt_findbyemail {
1671     my $u = shift;
1672
1673     if ($u->raw_prop('opt_findbyemail') =~ /^(N|Y|H)$/) {
1674         return $u->raw_prop('opt_findbyemail');
1675     } else {
1676         return undef;
1677     }
1678 }
1679
1680 # return user selected mail encoding or undef
1681 sub mailencoding {
1682     my $u = shift;
1683     my $enc = $u->prop('mailencoding');
1684
1685     return undef unless $enc;
1686
1687     LJ::load_codes({ "encoding" => \%LJ::CACHE_ENCODINGS } )
1688         unless %LJ::CACHE_ENCODINGS;
1689     return $LJ::CACHE_ENCODINGS{$enc}
1690 }
1691
1692 # Birthday logic -- show appropriate string based on opt_showbday
1693 # This will return true if the actual birthday can be shown
1694 sub can_show_bday {
1695     my ($u, %opts) = @_;
1696     croak "invalid user object passed" unless LJ::isu($u);
1697
1698     my $to_u = $opts{to} || LJ::get_remote();
1699
1700     return 0 unless $u->can_share_bday( with => $to_u );
1701     return 0 unless $u->opt_showbday eq 'D' || $u->opt_showbday eq 'F';
1702     return 1;
1703 }
1704
1705 # Birthday logic -- can any of the birthday info be shown
1706 # This will return true if any birthday info can be shown
1707 sub can_share_bday {
1708     my $u = shift;
1709     croak "invalid user object passed" unless LJ::isu($u);
1710
1711     my %opts = @_;
1712     my $with_u = $opts{with} || LJ::get_remote();
1713
1714     return 0 if ($u->opt_sharebday eq 'N');
1715     return 0 if ($u->opt_sharebday eq 'R' && !$with_u);
1716     return 0 if ($u->opt_sharebday eq 'F' && !$u->is_friend($with_u));
1717     return 1;
1718 }
1719
1720
1721 # This will return true if the actual birth year can be shown
1722 sub can_show_bday_year {
1723     my $u = shift;
1724     croak "invalid user object passed" unless LJ::isu($u);
1725
1726     my %opts = @_;
1727     my $to_u = $opts{to} || LJ::get_remote();
1728
1729     return 0 unless $u->can_share_bday( with => $to_u );
1730     return 0 unless $u->opt_showbday eq 'Y' || $u->opt_showbday eq 'F';
1731     return 1;
1732 }
1733
1734 # This will return true if month, day, and year can be shown
1735 sub can_show_full_bday {
1736     my $u = shift;
1737     croak "invalid user object passed" unless LJ::isu($u);
1738
1739     my %opts = @_;
1740     my $to_u = $opts{to} || LJ::get_remote();
1741
1742     return 0 unless $u->can_share_bday( with => $to_u );
1743     return 0 unless $u->opt_showbday eq 'F';
1744     return 1;
1745 }
1746
1747 # This will format the birthdate based on the user prop
1748 sub bday_string {
1749     my ($u, %opts) = @_;
1750     croak "invalid user object passed" unless LJ::isu($u);
1751     return 0 if $u->underage;
1752
1753     my $bdate = $u->{'bdate'};
1754     my ($year,$mon,$day) = split(/-/, $bdate);
1755     my $bday_string = '';
1756
1757     if ($opts{'format'}) {
1758         if ($u->can_show_full_bday && $day > 0 && $mon > 0 && $year > 0) {
1759             $mon = LJ::Lang::ml(LJ::Lang::month_long_genitive_langcode($mon));
1760             $bday_string = sprintf("%2d %s %04d", $day, $mon, $year);
1761         } elsif ($u->can_show_bday && $day > 0 && $mon > 0) {
1762             $mon = LJ::Lang::ml(LJ::Lang::month_long_genitive_langcode($mon));
1763             $bday_string = sprintf("%2d %s", $day, $mon);
1764         } elsif ($u->can_show_bday_year && $year > 0) {
1765             $bday_string = $year;
1766         }
1767     } else {
1768         if ($u->can_show_full_bday && $day > 0 && $mon > 0 && $year > 0) {
1769             $bday_string = $bdate; #sprintf("%02d %s %04d", $day, $mon, $year);
1770         } elsif ($u->can_show_bday && $day > 0 && $mon > 0) {
1771             $bday_string = "$mon-$day"; #sprintf("%02d %s, $day, $mon");
1772         } elsif ($u->can_show_bday_year && $year > 0) {
1773             $bday_string = $year;
1774         }
1775     }
1776     $bday_string =~ s/^0000-//;
1777     return $bday_string;
1778 }
1779
1780 # Users age based off their profile birthdate
1781 sub age {
1782     my $u = shift;
1783     croak "Invalid user object" unless LJ::isu($u);
1784     my $age = $u->{__age} || 0;
1785     return $age if $age;
1786
1787     my $bdate = $u->{bdate};
1788     return unless length $bdate;
1789
1790     my ($year, $mon, $day) = $bdate =~ m/^(\d\d\d\d)-(\d\d)-(\d\d)/;
1791     $age = LJ::TimeUtil->calc_age($year, $mon, $day);
1792     if ($age > 0) {
1793         $u->{__age} = $age;
1794         return $age;
1795     }
1796     return;
1797 }
1798
1799 sub age_for_adcall {
1800     my $u = shift;
1801     croak "Invalid user object" unless LJ::isu($u);
1802
1803     return undef if $u->underage;
1804     return eval {$u->age || $u->init_age};
1805 }
1806
1807 # This returns the users age based on the init_bdate (users coppa validation birthdate)
1808 sub init_age {
1809     my $u = shift;
1810     croak "Invalid user object" unless LJ::isu($u);
1811
1812     my $init_bdate = $u->prop('init_bdate');
1813     return unless $init_bdate;
1814
1815     my ($year, $mon, $day) = $init_bdate =~ m/^(\d\d\d\d)-(\d\d)-(\d\d)/;
1816     my $age = LJ::TimeUtil->calc_age($year, $mon, $day);
1817     return $age if $age > 0;
1818     return;
1819 }
1820
1821 # Returns the best guess age of the user, which is init_age if it exists, otherwise age
1822 sub best_guess_age {
1823     my $u = shift;
1824     return 0 unless $u->is_person || $u->is_identity;
1825     return $u->init_age || $u->age;
1826 }
1827
1828 sub gender {
1829     my $u = shift;
1830     return $u->{gender} if exists $u->{gender};
1831     return $u->prop('gender');
1832 }
1833
1834 sub gender_for_adcall {
1835     my $u = shift;
1836     my $format = shift || '6a';
1837     croak "Invalid user object" unless LJ::isu($u);
1838
1839     my $gender = $u->prop('gender') || '';
1840     $gender = uc(substr($gender, 0, 1));
1841     if ($format eq '6a') {
1842         if ($gender && $gender !~ /^U/i) {
1843             return $gender; # M|F
1844         } else {
1845             return "unspecified";
1846         }
1847     } elsif ($format eq 'dc') {
1848         return  ($gender eq 'M') ? 1 :
1849                 ($gender eq 'F') ? 2 : 0;
1850     } elsif ($format eq 'ga') {
1851         return  ($gender eq 'M') ? 'male' :
1852                 ($gender eq 'F') ? 'female' : 'all';
1853     } else {
1854         return;
1855     }
1856 }
1857
1858 sub should_fire_birthday_notif {
1859     my $u = shift;
1860
1861     return 0 unless $u->is_person;
1862     return 0 unless $u->is_visible;
1863
1864     # if the month/day can't be shown
1865     return 0 if $u->opt_showbday =~ /^[YN]$/;
1866
1867     # if the birthday isn't shown to anyone
1868     return 0 if $u->opt_sharebday eq "N";
1869
1870     # note: this isn't intended to capture all cases where birthday
1871     # info is restricted. we want to pare out as much as possible;
1872     # individual "can user X see this birthday" is handled in
1873     # LJ::Event::Birthday->matches_filter
1874
1875     return 1;
1876 }
1877
1878 sub next_birthday {
1879     my $u = shift;
1880     return if $u->is_expunged;
1881
1882     return $u->selectrow_array("SELECT nextbirthday FROM birthdays " .
1883                                "WHERE userid = ?", undef, $u->id)+0;
1884 }
1885
1886 # class method, loads next birthdays for a bunch of users
1887 sub next_birthdays {
1888     my $class = shift;
1889
1890     # load the users we need, so we can get their clusters
1891     my $clusters = LJ::User->split_by_cluster(@_);
1892
1893     my %bdays = ();
1894     foreach my $cid (keys %$clusters) {
1895         next unless $cid;
1896
1897         my @users = @{$clusters->{$cid} || []};
1898         my $dbcr = LJ::get_cluster_def_reader($cid)
1899             or die "Unable to load reader for cluster: $cid";
1900
1901         my $bind = join(",", map { "?" } @users);
1902         my $sth = $dbcr->prepare("SELECT * FROM birthdays WHERE userid IN ($bind)");
1903         $sth->execute(@users);
1904         while (my $row = $sth->fetchrow_hashref) {
1905             $bdays{$row->{userid}} = $row->{nextbirthday};
1906         }
1907     }
1908
1909     return \%bdays;
1910 }
1911
1912
1913 # this sets the unix time of their next birthday for notifications
1914 sub set_next_birthday {
1915     my $u = shift;
1916     return if $u->is_expunged;
1917
1918     my ($year, $mon, $day) = split(/-/, $u->{bdate});
1919     unless ($mon > 0 && $day > 0) {
1920         $u->do("DELETE FROM birthdays WHERE userid = ?", undef, $u->id);
1921         return;
1922     }
1923
1924     my $as_unix = sub {
1925         return LJ::TimeUtil->mysqldate_to_time(sprintf("%04d-%02d-%02d", @_));
1926     };
1927
1928     my $curyear = (gmtime(time))[5]+1900;
1929
1930     # Calculate the time of their next birthday.
1931
1932     # Assumption is that birthday-notify jobs won't be backed up.
1933     # therefore, if a user's birthday is 1 day from now, but
1934     # we process notifications for 2 days in advance, their next
1935     # birthday is really a year from tomorrow.
1936
1937     # We need to do calculate three possible "next birthdays":
1938     # Current Year + 0: For the case where we it for the first
1939     #   time, which could happen later this year.
1940     # Current Year + 1: For the case where we're setting their next
1941     #   birthday on (approximately) their birthday. Gotta set it for
1942     #   next year. This works in all cases but...
1943     # Current Year + 2: For the case where we're processing notifs
1944     #   for next year already (eg, 2 days in advance, and we do
1945     #   1/1 birthdays on 12/30). Year + 1 gives us the date two days
1946     #   from now! So, add another year on top of that.
1947
1948     # We take whichever one is earliest, yet still later than the
1949     # window of dates where we're processing notifications.
1950
1951     my $bday;
1952     for my $inc (0..2) {
1953         $bday = $as_unix->($curyear + $inc, $mon, $day);
1954         last if $bday > time() + $LJ::BIRTHDAY_NOTIFS_ADVANCE;
1955     }
1956
1957     # up to twelve hours drift so we don't get waves
1958     $bday += int(rand(12*3600));
1959
1960     $u->do("REPLACE INTO birthdays VALUES (?, ?)", undef, $u->id, $bday);
1961     die $u->errstr if $u->err;
1962
1963     return $bday;
1964 }
1965
1966
1967 sub include_in_age_search {
1968     my $u = shift;
1969
1970     # if they don't display the year
1971     return 0 if $u->opt_showbday =~ /^[DN]$/;
1972
1973     # if it's not visible to registered users
1974     return 0 if $u->opt_sharebday =~ /^[NF]$/;
1975
1976     return 1;
1977 }
1978
1979
1980 # data for generating packed directory records
1981 sub usersearch_age_with_expire {
1982     my $u = shift;
1983     croak "Invalid user object" unless LJ::isu($u);
1984
1985     # don't include their age in directory searches
1986     # if it's not publicly visible in their profile
1987     my $age = $u->include_in_age_search ? $u->age : 0;
1988     $age += 0;
1989
1990     # no need to expire due to age if we don't have a birthday
1991     my $expire = $u->next_birthday || undef;
1992
1993     return ($age, $expire);
1994 }
1995
1996 # returns the country specified by the user
1997 sub country {
1998     my $u = shift;
1999     return $u->prop('country');
2000 }
2001
2002 # sets prop, and also updates $u's cached version
2003 sub set_prop {
2004     my ($u, $prop, $value) = @_;
2005
2006     my $propmap = ref $prop ? $prop : { $prop => $value };
2007
2008     # filter out props that do not change
2009     foreach my $propname (keys %$propmap) {
2010         # it's not loaded, so let's not check it
2011         next unless exists $u->{$propname};
2012
2013         if ( (!$propmap->{$propname} && !$u->{$propname})
2014           || $propmap->{$propname} eq $u->{$propname} )
2015         {
2016             delete $propmap->{$propname};
2017         }
2018     }
2019
2020     my @props_affected = keys %$propmap;
2021     my $groups = LJ::User::PropStorage->get_handler_multi(\@props_affected);
2022     my $memcache_available = @LJ::MEMCACHE_SERVERS;
2023
2024     my $memc_expire = time + 3600 * 24;
2025
2026     foreach my $handler (keys %$groups) {
2027         my $propnames_handled = $groups->{$handler};
2028         my %propmap_handled   = map { $_ => $propmap->{$_} }
2029                                 @$propnames_handled;
2030
2031         # first, actually save stuff to the database;
2032         # then, delete it from memcache, depending on the memcache
2033         # policy of the handler
2034         $handler->set_props( $u, \%propmap_handled );
2035
2036         # if there is no memcache, or if the handler doesn't wish to use
2037         # memcache, we don't need to deal with it, yay
2038         if ( !$memcache_available || !defined $handler->use_memcache )
2039         {
2040             next;
2041         }
2042
2043         # now let's find out what we're going to do with memcache
2044         my $memcache_policy = $handler->use_memcache;
2045
2046         if ( $memcache_policy eq 'lite' ) {
2047             # the handler loads everything from the corresponding
2048             # table and uses only one memcache key to cache that
2049
2050             my $memkey = $handler->memcache_key($u);
2051             LJ::MemCacheProxy::delete([ $u->userid, $memkey ]);
2052         } elsif ( $memcache_policy eq 'blob' ) {
2053             # the handler uses one memcache key for each prop,
2054             # so let's delete them all
2055
2056             foreach my $propname (@$propnames_handled) {
2057                 my $memkey = $handler->memcache_key( $u, $propname );
2058                 LJ::MemCacheProxy::delete([ $u->userid, $memkey ]);
2059             }
2060         }
2061     }
2062
2063     # now, actually reflect that we've changed the props in the
2064     # user object
2065     foreach my $propname (keys %$propmap) {
2066         $u->{$propname} = $propmap->{$propname};
2067     }
2068
2069     # and run the hooks, too
2070     LJ::run_hooks( 'props_changed', $u, $propmap );
2071
2072     return $value;
2073 }
2074
2075 sub clear_prop {
2076     my ($u, $prop) = @_;
2077     $u->set_prop($prop, undef);
2078     return 1;
2079 }
2080
2081 sub journal_base {
2082     my $u = shift;
2083     return $u->{'journal_base'} if $u->{'journal_base'};
2084     return LJ::journal_base($u);
2085 }
2086
2087 sub allpics_base {
2088     my $u = shift;
2089     return "$LJ::SITEROOT/allpics.bml?user=" . $u->user;
2090 }
2091
2092 sub get_userpic_count {
2093     my $u = shift or return undef;
2094     my $count = scalar LJ::Userpic->load_user_userpics($u);
2095
2096     return $count;
2097 }
2098
2099 sub userpic_quota {
2100     my $u = shift or return undef;
2101     my $quota = $u->get_cap('userpics');
2102
2103     return $quota;
2104 }
2105
2106 sub wishlist_url {
2107     my $u = shift;
2108     croak "invalid user object passed" unless LJ::isu($u);
2109
2110     return $u->journal_base . "/wishlist";
2111 }
2112
2113 sub profile_url {
2114     my ($u, %opts) = @_;
2115
2116     my $remote = LJ::get_remote();
2117
2118     my $url;
2119     if ($u->{journaltype} eq "I") {
2120         if ($LJ::DISABLED{profile_controller}) {
2121             $url = "$LJ::SITEROOT/userinfo.bml?userid=$u->{'userid'}&t=I";
2122             $url .= "&mode=full" if $opts{full};
2123         } else {
2124             $url = "$LJ::SITEROOT/profile";
2125             $url .= "/".$opts{'friends_page'} if $opts{'friends_page'};
2126             $url .= "?userid=$u->{'userid'}&t=I";
2127             $url .= "&mode=full" if $opts{full};
2128         }
2129     } else {
2130         $url = $u->journal_base . "/profile";
2131         $url .= "/".$opts{'friends_page'} if $opts{'friends_page'};
2132         $url .= "?mode=full" if $opts{full};
2133     }
2134     return $url;
2135 }
2136
2137 # returns the gift shop URL to buy a gift for that user
2138 sub gift_url {
2139     my ($u, $opts) = @_;
2140     croak "invalid user object passed" unless LJ::isu($u);
2141     my $item = $opts->{item} ? delete $opts->{item} : '';
2142
2143     return "$LJ::SITEROOT/shop/vgift.bml?to=$u->{'user'}";
2144 }
2145
2146 # return the URL to the send message page
2147 sub message_url {
2148     my $u = shift;
2149     croak "invalid user object passed" unless LJ::isu($u);
2150
2151     return undef if $LJ::DISABLED{user_messaging};
2152     return "$LJ::SITEROOT/inbox/compose.bml?user=$u->{'user'}";
2153 }
2154
2155 # <LJFUNC>
2156 # name: LJ::User::large_journal_icon
2157 # des: get the large icon by journal type.
2158 # returns: HTML to display large journal icon.
2159 # </LJFUNC>
2160 sub large_journal_icon {
2161     my $u = shift;
2162     croak "invalid user object"
2163         unless LJ::isu($u);
2164
2165     my $wrap_img = sub {
2166         return "<img src='$LJ::IMGPREFIX/$_[0]' border='0' height='24' " .
2167             "width='24' style='padding: 0px 2px 0px 0px' />";
2168     };
2169
2170     # hook will return image to use if it cares about
2171     # the $u it's been passed
2172     my $hook_img = LJ::run_hook("large_journal_icon", $u);
2173     return $wrap_img->($hook_img) if $hook_img;
2174
2175     if ($u->is_comm) {
2176         return $wrap_img->("community24x24.gif?v=6283");
2177     }
2178
2179     if ($u->is_syndicated) {
2180         return $wrap_img->("syndicated24x24.gif?v=6283");
2181     }
2182
2183     if ($u->is_identity) {
2184         return $wrap_img->("openid24x24.gif?v=6034");
2185     }
2186
2187     # personal, news, or unknown fallthrough
2188     return $wrap_img->("userinfo24x24.gif?v=6283");
2189 }
2190
2191 # <LJFUNC>
2192 # name: LJ::User::caps_icon
2193 # des: get the icon for a user's cap.
2194 # returns: HTML with site-specific cap icon.
2195 # </LJFUNC>
2196 sub caps_icon {
2197     my $u = shift;
2198     return LJ::user_caps_icon($u->{caps});
2199 }
2200
2201 # tests to see if a user is in a specific named class. class
2202 # names are site-specific.
2203 sub in_any_class {
2204     my ($u, @classes) = @_;
2205
2206     foreach my $class (@classes) {
2207         return 1 if LJ::caps_in_group($u->{caps}, $class);
2208     }
2209
2210     return 0;
2211 }
2212
2213
2214 # get recent talkitems posted to this user
2215 # args: maximum number of comments to retrieve
2216 # returns: array of hashrefs with jtalkid, nodetype, nodeid, parenttalkid, posterid, state
2217 sub get_recent_talkitems {
2218     my ($u, $maxshow, %opts) = @_;
2219
2220     $maxshow ||= 15;
2221     my $max_fetch = int($LJ::TOOLS_RECENT_COMMENTS_MAX*1.5) || 150;
2222     # We fetch more items because some may be screened
2223     # or from suspended users, and we weed those out later
2224
2225     my $remote   = $opts{remote} || LJ::get_remote();
2226     return undef unless LJ::isu($u);
2227
2228     ## $raw_talkitems - contains DB rows that are not filtered
2229     ## to match remote user's permissions to see
2230     my $raw_talkitems;
2231     my $memkey = [$u->userid, 'rcntalk:' . $u->userid ];
2232     $raw_talkitems = LJ::MemCache::get($memkey);
2233     if (!$raw_talkitems) {
2234         my $sth = $u->prepare(
2235             "SELECT jtalkid, nodetype, nodeid, parenttalkid, ".
2236             "       posterid, UNIX_TIMESTAMP(datepost) as 'datepostunix', state ".
2237             "FROM talk2 ".
2238             "WHERE journalid=? AND (state <> 'D' AND state <> 'B') " .
2239             "ORDER BY jtalkid DESC ".
2240             "LIMIT $max_fetch"
2241         );
2242         $sth->execute($u->{'userid'});
2243         $raw_talkitems = $sth->fetchall_arrayref({});
2244         LJ::MemCache::set($memkey, $raw_talkitems, 60*5);
2245     }
2246
2247     ## Check remote's permission to see the comment, and create singletons
2248     my @recv;
2249     foreach my $r (@$raw_talkitems) {
2250         last if @recv >= $maxshow;
2251
2252         # construct an LJ::Comment singleton
2253         my $comment = LJ::Comment->new($u, jtalkid => $r->{jtalkid});
2254         $comment->absorb_row($r);
2255         next unless $comment->visible_to($remote);
2256         push @recv, $r;
2257     }
2258
2259     # need to put the comments in order, with "oldest first"
2260     # they are fetched from DB in "recent first" order
2261     return reverse @recv;
2262 }
2263
2264 sub last_login_time {
2265     my ($u) = @_;
2266
2267     my $userid = $u->userid;
2268     my $cache  = ( $LJ::REQ_GLOBAL{'user_last_login_time'} ||= {} );
2269
2270     return $cache->{$userid} if exists $cache->{$userid};
2271
2272     my $dbr = LJ::get_cluster_reader($u);
2273     my ($time) = $dbr->selectrow_array(
2274         'SELECT MAX(logintime) FROM loginlog WHERE userid=?',
2275         undef, $userid );
2276
2277     $time ||= 0;
2278
2279     $cache->{$userid} = $time;
2280     return $time;
2281 }
2282
2283 sub last_password_change_time {
2284     my ($u) = @_;
2285
2286     my $userid = $u->userid;
2287     my $cache  = ( $LJ::REQ_GLOBAL{'user_last_password_change_time'} ||= {} );
2288
2289     return $cache->{$userid} if exists $cache->{$userid};
2290
2291     my $infohistory = LJ::User::InfoHistory->get( $u, 'password' );
2292     my @password_change_timestamps = map { $_->timechange_unix } @$infohistory;
2293
2294     my $time;
2295     if (@password_change_timestamps) {
2296         $time = List::Util::max( @password_change_timestamps );
2297     } else {
2298         $time = 0;
2299     }
2300
2301     $cache->{$userid} = $time;
2302     return $time;
2303 }
2304
2305 # THIS IS DEPRECATED DO NOT USE
2306 sub email {
2307     my ($u, $remote) = @_;
2308     return $u->emails_visible($remote);
2309 }
2310
2311 sub email_raw {
2312     my $u = shift;
2313     $u->{_email} ||= LJ::MemCache::get_or_set([$u->{userid}, "email:$u->{userid}"], sub {
2314         my $dbh = LJ::get_db_writer() or die "Couldn't get db master";
2315         return $dbh->selectrow_array("SELECT email FROM email WHERE userid=?",
2316                                      undef, $u->id);
2317     });
2318     return $u->{_email};
2319 }
2320
2321 sub validated_mbox_sha1sum {
2322     my $u = shift;
2323
2324     # must be validated
2325     return undef unless $u->is_validated;
2326
2327     # must have one on file
2328     my $email = $u->email_raw;
2329     return undef unless $email;
2330
2331     # return SHA1, which does not disclose the actual value
2332     return Digest::SHA1::sha1_hex('mailto:' . $email);
2333 }
2334
2335 # in scalar context, returns user's email address.  given a remote user,
2336 # bases decision based on whether $remote user can see it.  in list context,
2337 # returns all emails that can be shown
2338 sub email_visible {
2339     my ($u, $remote) = @_;
2340
2341     return scalar $u->emails_visible($remote);
2342 }
2343
2344 sub emails_visible {
2345     my ($u, $remote) = @_;
2346
2347     return () if $u->{journaltype} =~ /[YI]/;
2348
2349     # security controls
2350     return () unless $u->share_contactinfo($remote);
2351
2352     my $whatemail = $u->prop("opt_whatemailshow");
2353     my $useremail_cap = LJ::get_cap($u, 'useremail');
2354
2355     # some classes of users we want to have their contact info hidden
2356     # after so much time of activity, to prevent people from bugging
2357     # them for their account or trying to brute force it.
2358     my $hide_contactinfo = sub {
2359         my $hide_after = LJ::get_cap($u, "hide_email_after");
2360         return 0 unless $hide_after;
2361         my $memkey = [$u->{userid}, "timeactive:$u->{userid}"];
2362         my $active;
2363         unless (defined($active = LJ::MemCache::get($memkey))) {
2364             my $dbcr = LJ::get_cluster_def_reader($u) or return 0;
2365             $active = $dbcr->selectrow_array("SELECT timeactive FROM clustertrack2 ".
2366                                              "WHERE userid=?", undef, $u->{userid});
2367             LJ::MemCache::set($memkey, $active, 86400);
2368         }
2369         return $active && (time() - $active) > $hide_after * 86400;
2370     };
2371
2372     return () if $u->{'opt_whatemailshow'} eq "N" ||
2373         $u->{'opt_whatemailshow'} eq "L" && ($u->prop("no_mail_alias") || ! $useremail_cap || ! $LJ::USER_EMAIL) ||
2374         $hide_contactinfo->();
2375
2376     my @emails = ($u->email_raw);
2377     if ($u->{'opt_whatemailshow'} eq "L") {
2378         @emails = ();
2379     }
2380     if ($LJ::USER_EMAIL && $useremail_cap) {
2381         unless ($u->{'opt_whatemailshow'} eq "A" || $u->prop('no_mail_alias')) {
2382             push @emails, "$u->{'user'}\@$LJ::USER_DOMAIN";
2383         }
2384     }
2385     return wantarray ? @emails : $emails[0];
2386 }
2387
2388 sub email_for_feeds {
2389     my $u = shift;
2390
2391     # don't display if it's mangled
2392     return if $u->prop("opt_mangleemail") eq "Y";
2393
2394     my $remote = LJ::get_remote();
2395     return $u->email_visible($remote);
2396 }
2397
2398 sub email_status {
2399     my $u = shift;
2400     return $u->{status};
2401 }
2402
2403 sub is_validated {
2404     my $u = shift;
2405     return $u->email_status eq "A";
2406 }
2407
2408 sub receives_html_emails {
2409     my $u = shift;
2410     return $u->{opt_htmlemail} eq 'Y';
2411 }
2412
2413 sub update_email_alias {
2414     my $u = shift;
2415
2416     return unless $u && $u->get_cap("useremail");
2417     return if exists $LJ::FIXED_ALIAS{$u->{'user'}};
2418     return if $u->prop("no_mail_alias");
2419     return unless $u->is_validated;
2420
2421     my $dbh = LJ::get_db_writer();
2422     $dbh->do("REPLACE INTO email_aliases (alias, rcpt) VALUES (?,?)",
2423              undef, "$u->{'user'}\@$LJ::USER_DOMAIN", $u->email_raw);
2424
2425     return 0 if $dbh->err;
2426     return 1;
2427 }
2428
2429 # my $u = LJ::want_user(12);
2430 # my $data = $u->get_email_data('test@test.ru');
2431 # print $data->{'email_state'}; # email status if test@test.ru is the
2432 #                               # current email; "P" otherwise
2433 # print $data->{'time'}; # time when that email was added to the account
2434 sub get_email_data {
2435     my ($u, $addr) = @_;
2436
2437     return undef unless $u && $addr;
2438
2439     my $emails = $u->emails_info;
2440     my $is_current = lc($addr) eq lc($u->email_raw);
2441
2442     foreach my $email (@$emails) {
2443         next unless lc($email->{'email'}) eq lc($addr);
2444         next if $email->{'deleted'};
2445         next unless $email->{'status'} eq 'A';
2446         next if $is_current && !$email->{'current'};
2447
2448         my $ret = {};
2449         $ret->{'email_state'} = $is_current ? $email->{'status'} : 'P';
2450         $ret->{'time'} = $email->{'set'};
2451
2452         return $ret;
2453     }
2454
2455     return undef;
2456 }
2457
2458 # get information about which emails the user has used previously or uses now
2459 # returns:
2460 # [
2461 #     { email => 'test@test.com', current => 1, set => 123142345234, status => 'A' },
2462 #     { email => 'test2@test.com', set => $timestamp, changed => 123142345234, status => 'A' },
2463 #     { email => 'test3@test.com', set => $timestamp2, changed => $timestamp, status => 'T', deleted => $timestamp3 },
2464 # ]
2465 sub emails_info {
2466     my ($u) = @_;
2467
2468     return $u->{'_emails'} if defined $u->{'_emails'};
2469
2470     my @ret;
2471
2472     my $infohistory =
2473         LJ::User::InfoHistory->get( $u, [ 'email', 'emaildeleted' ] );
2474
2475     my $infohistory_records =
2476         [ sort { $a->timechange_unix <=> $b->timechange_unix } @$infohistory ];
2477
2478     # my $dbr = LJ::get_db_reader();
2479     # my $infohistory_rows = $dbr->selectall_arrayref(
2480     #     'SELECT what, UNIX_TIMESTAMP(timechange) AS timechange, '.
2481     #     'oldvalue, other FROM infohistory WHERE userid=? AND '.
2482     #     'what IN ("email", "emaildeleted") ORDER BY timechange',
2483     #     { Slice => {} }, $u->id
2484     # );
2485     # my @infohistory_rows = @$infohistory_rows;
2486
2487     # this actually finds the greatest timechange in rows before $recordnum;
2488     # if it fails to find it, it returns $u->timecreate
2489     my $find_timeset = sub {
2490         my ($recordnum) = @_;
2491
2492         for ( my $recordnum2 = $recordnum - 1;
2493             $recordnum2 >= 0; $recordnum2-- )
2494         {
2495             my $record2 = $infohistory_records->[$recordnum2];
2496             return $record2->timechange_unix if $record2->what eq 'email';
2497         }
2498
2499         # in case we found nothing, the address was set when the account
2500         # was registered
2501         return $u->timecreate;
2502     };
2503
2504     foreach my $recordnum ( 0 .. $#$infohistory_records ) {
2505         my $record = $infohistory_records->[$recordnum];
2506         if ( $record->what eq 'email' ) {
2507             # new email has been added to the list, but now, we're going to
2508             # record the old address
2509             push @ret, {
2510                 'email'   => $record->oldvalue,
2511                 'changed' => $record->timechange_unix,
2512                 'status'  => $record->other,
2513                 'set'     => $find_timeset->($recordnum),
2514             };
2515         } elsif ( $record->what eq 'emaildeleted' ) {
2516             # there may be two cases here: 1) it was something like an admin
2517             # deletion or 2) it was deletion through /tools/emailmanage.bml,
2518             # which previously did 'UPDATE infohistory SET what="emaildelete"'
2519             # (oh weird) and also changed `other` to "A; $timeset".
2520             # /tools/emailmanage.bml has since been changed to record that
2521             # change as a new entry, which returns us to the first case
2522
2523             unless ( $record->other =~ /;/ ) {
2524                 # first case: find all other occurences of that email
2525                 # and mark them with the date of deletion
2526
2527                 foreach my $email (@ret) {
2528                     next unless $email->{'email'} eq $record->oldvalue;
2529                     next unless $email->{'set'} <= $record->timechange_unix;
2530
2531                     $email->{'deleted'} = $record->timechange_unix
2532                         unless $email->{'deleted'};
2533                 }
2534             } else {
2535                 # second case: parse the timestamp, create an email hashref,
2536                 # find the record with the next address to set "set", and
2537                 # finally, mark it as deleted. ugh.
2538
2539                 my ( $status, $time ) = split /;/, $record->other;
2540
2541                 # there is no joke here. in infohistory, time is stored as
2542                 # MySQL DATETIME. emailmanage.bml used to just append it to
2543                 # previous status, so now, we need to parse.
2544                 $time = str2time($time);
2545
2546                 # we need to find the first record which has timestamp
2547                 # greater or equal to $time so that we can call $find_timeset
2548                 my $nextrecord = 0;
2549                 foreach my $recordnum2 ( 0 .. $#$infohistory_records ) {
2550                     my $record2 = $infohistory_records->[$recordnum2];
2551                     next unless $record2->what eq 'email';
2552                     next if $record2->timechange_unix < $time;
2553
2554                     $nextrecord = $recordnum2;
2555                     last;
2556                 }
2557
2558                 push @ret, {
2559                     'email'   => $record->oldvalue,
2560                     'changed' => $time,
2561                     'status'  => $status,
2562                     'deleted' => $record->timechange_unix,
2563                     'set'     => $find_timeset->($nextrecord),
2564                 };
2565             }
2566         }
2567     }
2568
2569     # finally, the current address
2570     push @ret, {
2571         'email'   => $u->email_raw,
2572         'current' => 1,
2573         'status'  => $u->email_status,
2574         'set'     => $find_timeset->( $#$infohistory_records + 1 ),
2575     };
2576
2577     $u->{'_emails'} = \@ret;
2578     return \@ret;
2579 }
2580
2581 # returns array (not arrayref) of emails that the user has ever used, including
2582 # deleted ones
2583 sub emails_unique {
2584     my ($u) = @_;
2585
2586     my $emails = $u->emails_info;
2587     my %ret;
2588
2589     foreach my $email (@$emails) {
2590         $ret{lc($email->{'email'})} = 1;
2591     }
2592
2593     return sort keys %ret;
2594 }
2595
2596 # read emails and calculate primitives:
2597 # date of last leaving
2598 # date of chain start
2599 # returns data of emails_info function with additional keys ('leaving', may be undef, and 'starting')
2600 # skips internal steps of chains
2601 # skips deleted emails
2602 # cleans out all chains, which are unusable for password restoring, i.e. 'leaving' is newer than 6 month old
2603 # must return array for printing on tools/emailmanage.bml
2604 sub emails_chained_info {
2605     my $u = shift;
2606
2607     return $u->{'_emails_chained'} if defined $u->{'_emails_chained'};
2608
2609     my $emails = $u->emails_info;
2610     my @email_addresses = $u->emails_unique;
2611
2612     my @chains;
2613
2614     # process all elements
2615     foreach my $addr (@email_addresses) {
2616         # find all information about this element
2617         my ($starting, $leaving);
2618         my $lc_addr = lc $addr;
2619
2620         my @relevant = grep { lc($_->{email}) eq $lc_addr } @$emails;
2621             # already sorted by MySQL
2622
2623         my $written_addr;
2624         foreach my $step (@relevant) {
2625
2626             $written_addr = $step->{email};
2627
2628             next unless $step->{status} eq 'A'; # restoring can be done only by validated addressed
2629
2630             if ($step->{deleted}) {
2631                 undef $starting;
2632                 undef $leaving;
2633                 next;
2634             }
2635
2636             if (defined $leaving and $step->{set} - $leaving > $LJ::EMAIL_FORGET_AGE) {
2637                 # forget old chain - because it is unusable for password restoring
2638                 undef $starting; # start new chain
2639                 undef $leaving;
2640             }
2641
2642             # most early starting
2643             $starting = $step->{set} unless defined $starting and $starting < $step->{set};
2644
2645             # most late leaving
2646             $leaving = $step->{changed} unless defined $leaving and defined $step->{changed} and $step->{changed} < $leaving;
2647         }
2648
2649         if ($starting and time - $leaving < $LJ::EMAIL_FORGET_AGE or not defined $leaving) {
2650             push @chains, { email => $written_addr, leaving => $leaving, starting => $starting }; # fix this chain
2651                 # we store address with upper case letters possibly,
2652                 # to make it more comfort for user when he/she reads address
2653         }
2654     }
2655
2656     $u->{'_emails_chained'} = \@chains;
2657     return \@chains;
2658 }
2659
2660 # returns time when the user has last stopped using the given email
2661 # (that is, switched their current address to a different one)
2662 # this ASSUMES that the address is not a current one, but that it was
2663 # validated previously.
2664 sub email_lastchange {
2665     my ($u, $addr) = @_;
2666
2667     use Data::Dumper;
2668     my $emails = $u->emails_info;
2669     my $lastchange = 0;
2670     my $found = 0;
2671
2672     foreach my $email (@$emails) {
2673         next unless lc($email->{'email'}) eq lc($addr);
2674         next unless $email->{'status'} eq 'A';
2675         next if $email->{'current'};
2676         next if $email->{'deleted'};
2677
2678         $found = 1;
2679         $lastchange = $email->{'changed'} if $email->{'changed'} > $lastchange;
2680     }
2681
2682     return undef unless $found;
2683     return $lastchange;
2684 }
2685
2686 # checks whether user is allowed to remove the given email from their history
2687 # and this way, disable themselves from sending a password reset to that address
2688 sub can_delete_email {
2689     my ($u, $email) = @_;
2690
2691     my $chains = $u->emails_chained_info;
2692     my $addr = ref $email ? $email->{email} : $email;
2693     $addr = lc $addr;
2694
2695     # reformat as email => parameters hash
2696     my %chains = map { lc($_->{email}) => $_ } @$chains;
2697
2698     my $current = lc $u->email_raw;
2699     my $edge_age = $chains{$current}->{starting};
2700
2701     my $aim_value = $chains{$addr}->{starting};
2702
2703     return 0 unless defined $edge_age and $aim_value;
2704     return $aim_value > $edge_age;
2705 }
2706
2707 # delete the given email from user's history, disabling the user from sending
2708 # a password reset to that address
2709 # this performs the necessary checks by calling can_delete_email() as defined
2710 # above
2711 sub delete_email {
2712     my ($u, $addr) = @_;
2713
2714     return unless $u->can_delete_email($addr);
2715
2716     LJ::User::InfoHistory->add( $u, 'emaildeleted', $addr );
2717
2718     # update cache now
2719     my $emails = $u->emails_info;
2720     foreach my $email (@$emails) {
2721         next if $email->{'deleted'};
2722
2723         next unless lc($email->{'email'}) eq lc($addr);
2724         $email->{'deleted'} = time;
2725     }
2726 }
2727
2728 # checks whether the given email has been validated, regardless of whether it is
2729 # set to current right now. despite the name, it specifically omits deleted
2730 # emails, too.
2731 sub is_email_validated {
2732     my ($u, $addr) = @_;
2733
2734     my $emails = $u->emails_info;
2735     foreach my $email (@$emails) {
2736         next unless lc($email->{'email'}) eq lc($addr);
2737         next if $email->{'deleted'};
2738         next unless $email->{'status'} eq 'A';
2739
2740         return 1;
2741     }
2742
2743     return 0;
2744 }
2745
2746 # checks whether the user can send a password reset to the given email
2747 # the current logic is:
2748 # case 1: NOT $LJ::DISABLED{'limit_password_reset'}
2749 # yes if the email is set to current OR
2750 # (has been previously validated AND has not been deleted after that AND
2751 # the user has stopped using it no more than 6 months ago);
2752 # no otherwise
2753 # case 2: $LJ::DISABLED{'limit_password_reset'}
2754 # yes if and only if the email is set to current
2755 sub can_reset_password_using_email {
2756     my ($u, $addr) = @_;
2757
2758     return 0 unless $LJ::DISABLED{'limit_password_reset'};
2759
2760     my $current = lc $u->email_raw;
2761     return 1 if lc($addr) eq $current;
2762
2763     return 0 unless $u->is_email_validated($addr);
2764
2765     my $chains = $u->emails_chained_info;
2766
2767     # reformat as email => parameters hash
2768     my %chains = map { lc($_->{email}) => $_ } @$chains;
2769
2770     my $aim_value = $chains{lc $addr}->{leaving};
2771
2772     return 0 unless defined $aim_value;
2773     return time - $aim_value < $LJ::EMAIL_FORGET_AGE;
2774 }
2775
2776 # returns date when the user has last changed their email
2777 sub get_current_email_set_date {
2778     my ($u) = @_;
2779
2780     my $emails = $u->emails_info;
2781
2782     foreach my $email (@$emails) {
2783         next unless $email->{'current'};
2784         return $email->{'set'};
2785     }
2786
2787     return undef;
2788 }
2789
2790 sub previous_usernames {
2791     my ($u) = @_;
2792
2793     # the memcache is set to expire automatically on an account rename;
2794     # the value there contains a username, and if that changes, we have
2795     # to recalculate stuff
2796     my $memkey = [ $u->userid, 'previous_usernames:' . $u->userid ];
2797     if ( my $value = LJ::MemCache::get($memkey) ) {
2798         if ( $value->{'current'} eq $u->username ) {
2799             return $value->{'previous'};
2800         }
2801     }
2802
2803     my $infohistory = LJ::User::InfoHistory->get( $u, 'username' );
2804     my @usernames   = map { $_->oldvalue } @$infohistory;
2805
2806     my $value = { 'current' => $u->username, 'previous' => \@usernames };
2807
2808     # the auto-expiration here may fail us in case user is renamed back
2809     # before this function is called with that user in the other username,
2810     # so let's expire it after a day passes to somehow handle that
2811     LJ::MemCache::set( $memkey, $value, 86400 );
2812
2813     return \@usernames;
2814 }
2815
2816 sub share_contactinfo {
2817     my ($u, $remote) = @_;
2818
2819     return 0 if ($u->underage || $u->{journaltype} eq "Y");
2820     return 0 if ($u->opt_showcontact eq 'N');
2821     return 0 if ($u->opt_showcontact eq 'R' && !$remote);
2822     return 0 if ($u->opt_showcontact eq 'F' && !$u->is_friend($remote));
2823     return 1;
2824 }
2825
2826 # return social capital by user
2827 sub get_social_capital {
2828     my ($u) = @_;
2829
2830     if ( $LJ::IS_DEV_SERVER && ( my $getter = $LJ::FAKE_SOCIAL_CAPITAL ) ) {
2831         return $getter->($u);
2832     }
2833
2834     my $key = $u->userid . ":sccap";
2835     my $attr = '_social_capital';
2836
2837     return $u->{$attr} if defined $u->{$attr};
2838
2839     my $soc_capital = LJ::MemCache::get( $key );
2840
2841     unless (defined $soc_capital || $LJ::IS_DEV_SERVER || !LJ::is_enabled('authority_redis_storage')) {
2842         # TODO: Check the date of social capital (if the data is wrong that try to get actual version of social cap from service
2843         my $redis = LJ::Redis->get_connection;
2844         if ($redis) {
2845             my $authority = $redis->get('authority.'.$u->userid) || 0;
2846             $soc_capital = int($authority / 1000);
2847         }
2848     }
2849
2850     unless (defined $soc_capital) {
2851         my $response = LJ::PersonalStats::DB->fetch_raw('ratings', {func => 'get_authority', journal_id => $u->userid});
2852         if ($response) {
2853             $soc_capital = int($response->{result}->{authority}/1000);
2854             LJ::MemCache::set( $key, $soc_capital, 5*60);
2855         }
2856     }
2857
2858     $u->{$attr} = $soc_capital if defined $soc_capital;
2859
2860     return $soc_capital;
2861 }
2862
2863 sub get_authority_multi {
2864     my ($class, $uids) = @_;
2865
2866     return unless $uids && @$uids;
2867
2868     if ( $LJ::IS_DEV_SERVER && ( my $getter = $LJ::FAKE_SOCIAL_CAPITAL ) ) {
2869         my $users = LJ::load_userids(@$uids);
2870         return { map {$_ => ($getter->($users->{$_})*1000)} @$uids };
2871     }
2872
2873     my $redis = LJ::Redis->get_connection || return;
2874
2875     my @keys = map {"authority.$_"} @$uids;
2876
2877     my @res = $redis->mget(@keys);
2878
2879     my $res = { map { $uids->[$_] => ($res[$_]) } (0..$#res) };
2880
2881     return $res;
2882 }
2883
2884 # <LJFUNC>
2885 # name: LJ::display_soccap
2886 # class: text
2887 # des: Encode social capital into nice look text
2888 # args: number
2889 # returns: nice string
2890 # </LJFUNC>
2891 sub display_soccap
2892 {
2893         my $soc_capital = shift;
2894         if ( $soc_capital =~ /^\d+$/ ) {
2895                 $soc_capital = $soc_capital < 10 ? LJ::Lang::ml('/tools/endpoints/ctxpopup.bml.social_capital_less_that') : LJ::commafy($soc_capital);
2896         } else {
2897                 $soc_capital = LJ::Lang::ml('social_capital_undef');
2898         }
2899         return $soc_capital;
2900 }
2901
2902 # <LJFUNC>
2903 # name: LJ::User::get_reader_weight
2904 # des: returns reader_weight of user
2905 # </LJFUNC>
2906
2907 sub get_reader_weight {
2908     my ($u) = @_;
2909
2910     my $memkey = join ':', $u->userid, 'reader_weight';
2911
2912     my $reader_weight = LJ::MemCache::get( $memkey );
2913
2914     return $reader_weight if defined $reader_weight;
2915
2916     my $resp = LJ::PersonalStats::DB->fetch_raw('ratings', {
2917         func => 'get_reader_weight',
2918         journal_id => $u->userid,
2919     });
2920
2921     return undef unless $resp;
2922
2923     $reader_weight = $resp->{reader_weight};
2924
2925     LJ::MemCache::set( $memkey, $reader_weight, 60);
2926
2927     return $reader_weight || -1;
2928 }
2929
2930 # <LJFUNC>
2931 # name: LJ::User::activate_userpics
2932 # des: Sets/unsets userpics as inactive based on account caps.
2933 # returns: nothing
2934 # </LJFUNC>
2935 sub activate_userpics {
2936     my $u = shift;
2937
2938     # this behavior is optional, but enabled by default
2939     return 1 if $LJ::ALLOW_PICS_OVER_QUOTA;
2940
2941     return undef unless LJ::isu($u);
2942
2943     # can't get a cluster read for expunged users since they are clusterid 0,
2944     # so just return 1 to the caller from here and act like everything went fine
2945     return 1 if $u->is_expunged;
2946
2947     my $userid = $u->{'userid'};
2948
2949     # active / inactive lists
2950     my @active = ();
2951     my @inactive = ();
2952     my $allow = LJ::get_cap($u, "userpics");
2953
2954     # get a database handle for reading/writing
2955     my $dbh = LJ::get_db_writer();
2956     my $dbcr = LJ::get_cluster_def_reader($u);
2957
2958     # select all userpics and build active / inactive lists
2959     my $sth;
2960     if ($u->{'dversion'} > 6) {
2961         return undef unless $dbcr;
2962         $sth = $dbcr->prepare("SELECT picid, state FROM userpic2 WHERE userid=?");
2963     } else {
2964         return undef unless $dbh;
2965         $sth = $dbh->prepare("SELECT picid, state FROM userpic WHERE userid=?");
2966     }
2967     $sth->execute($userid);
2968     while (my ($picid, $state) = $sth->fetchrow_array) {
2969         next if $state eq 'X'; # expunged, means userpic has been removed from site by admins
2970         if ($state eq 'I') {
2971             push @inactive, $picid;
2972         } else {
2973             push @active, $picid;
2974         }
2975     }
2976
2977     # inactivate previously activated userpics
2978     if (@active > $allow) {
2979
2980         my @ban = sort { $a <=> $b } @active;
2981         splice(@ban, 0, $allow);
2982
2983         my $ban_in = join(",", map { $dbh->quote($_) } @ban);
2984         if ($u->{'dversion'} > 6) {
2985             $u->do("UPDATE userpic2 SET state='I' WHERE userid=? AND picid IN ($ban_in)",
2986                    undef, $userid) if $ban_in;
2987         } else {
2988             $dbh->do("UPDATE userpic SET state='I' WHERE userid=? AND picid IN ($ban_in)",
2989                      undef, $userid) if $ban_in;
2990         }
2991     }
2992
2993     # activate previously inactivated userpics
2994     if (@inactive && @active < $allow) {
2995         my $to_activate = $allow - @active;
2996         $to_activate = @inactive if $to_activate > @inactive;
2997
2998         # take the $to_activate newest (highest numbered) pictures
2999         # to reactivated
3000         @inactive = sort @inactive;
3001         my @activate_picids = splice(@inactive, -$to_activate);
3002
3003         my $activate_in = join(",", map { $dbh->quote($_) } @activate_picids);
3004         if ($activate_in) {
3005             if ($u->{'dversion'} > 6) {
3006                 $u->do("UPDATE userpic2 SET state='N' WHERE userid=? AND picid IN ($activate_in)",
3007                        undef, $userid);
3008             } else {
3009                 $dbh->do("UPDATE userpic SET state='N' WHERE userid=? AND picid IN ($activate_in)",
3010                          undef, $userid);
3011             }
3012         }
3013     }
3014
3015     # delete userpic info object from memcache
3016     LJ::Userpic->delete_cache($u);
3017
3018     return 1;
3019 }
3020
3021
3022 # revert S2 style to the default if the user is using a layout/theme layer that they don't have permission to use
3023 sub revert_style {
3024     my $u = shift;
3025
3026     # FIXME: this solution sucks
3027     # - ensure that these packages are loaded via Class::Autouse by calling a method on them
3028     LJ::S2->can("dostuff");
3029     LJ::S2Theme->can("dostuff");
3030     LJ::Customize->can("dostuff");
3031
3032     my $current_theme = LJ::Customize->get_current_theme($u);
3033     return unless $current_theme;
3034     my $default_theme_of_current_layout = LJ::S2Theme->load_default_of($current_theme->layoutid, user => $u);
3035     return unless $default_theme_of_current_layout;
3036
3037     my $default_style = LJ::run_hook('get_default_style', $u) || $LJ::DEFAULT_STYLE;
3038     my $default_layout_uniq = exists $default_style->{layout} ? $default_style->{layout} : '';
3039     my $default_theme_uniq = exists $default_style->{theme} ? $default_style->{theme} : '';
3040
3041     my %style = LJ::S2::get_style($u, "verify");
3042     my $public = LJ::S2::get_public_layers();
3043     my $userlay = LJ::S2::get_layers_of_user($u);
3044
3045     # check to see if the user is using a custom layout or theme
3046     # if so, we want to let them keep using it
3047     foreach my $layerid (keys %$userlay) {
3048         return if $current_theme->layoutid == $layerid;
3049         return if $current_theme->themeid == $layerid;
3050     }
3051
3052     # if the user cannot use the layout or the default theme of that layout, switch to the default style (if it's defined)
3053     if (($default_layout_uniq || $default_theme_uniq) && (!LJ::S2::can_use_layer($u, $current_theme->layout_uniq) || !$default_theme_of_current_layout->available_to($u))) {
3054         my $new_theme;
3055         if ($default_theme_uniq) {
3056             $new_theme = LJ::S2Theme->load_by_uniq($default_theme_uniq);
3057         } else {
3058             my $layoutid = '';
3059             $layoutid = $public->{$default_layout_uniq}->{s2lid}
3060                 if $public->{$default_layout_uniq} && $public->{$default_layout_uniq}->{type} eq "layout";
3061             $new_theme = LJ::S2Theme->load_default_of($layoutid, user => $u) if $layoutid;
3062         }
3063
3064         return unless $new_theme;
3065
3066         # look for a style that uses the default layout/theme, and use it if it exists
3067         my $styleid = $new_theme->get_styleid_for_theme($u);
3068         my $style_exists = 0;
3069         if ($styleid) {
3070             $style_exists = 1;
3071             $u->set_prop("s2_style", $styleid);
3072
3073             my $stylelayers = LJ::S2::get_style_layers($u, $u->prop('s2_style'));
3074             foreach my $layer (qw(user i18nc i18n core)) {
3075                 $style{$layer} = exists $stylelayers->{$layer} ? $stylelayers->{$layer} : 0;
3076             }
3077         }
3078
3079         # set the layers that are defined by $default_style
3080         while (my ($layer, $name) = each %$default_style) {
3081             next if $name eq "";
3082             next unless $public->{$name};
3083             my $id = $public->{$name}->{s2lid};
3084             $style{$layer} = $id if $id;
3085         }
3086
3087         # make sure core was set
3088         $style{core} = $new_theme->coreid
3089             if $style{core} == 0;
3090
3091         # make sure the other layers were set
3092         foreach my $layer (qw(user i18nc i18n)) {
3093             $style{$layer} = 0 unless $style{$layer} || $style_exists;
3094         }
3095
3096         # create the style
3097         if ($style_exists) {
3098             LJ::Customize->implicit_style_create($u, %style);
3099         } else {
3100             LJ::Customize->implicit_style_create({ 'force' => 1 }, $u, %style);
3101         }
3102
3103     # if the user can use the layout but not the theme, switch to the default theme of that layout
3104     # we know they can use this theme at this point because if they couldn't, the above block would have caught it
3105     } elsif (LJ::S2::can_use_layer($u, $current_theme->layout_uniq) && !LJ::S2::can_use_layer($u, $current_theme->uniq)) {
3106         $style{theme} = $default_theme_of_current_layout->themeid;
3107         LJ::Customize->implicit_style_create($u, %style);
3108     }
3109
3110     return;
3111 }
3112
3113 sub uncache_prop {
3114     my ($u, $name) = @_;
3115
3116     my $handler = LJ::User::PropStorage->get_handler ($name);
3117     $handler->delete_prop_memcache ($u, $name);
3118     delete $u->{$name};
3119
3120     return 1;
3121 }
3122
3123 sub set_draft_text {
3124     my ($u, $draft, $prop_name) = @_;
3125
3126     $prop_name ||= 'entry_draft';
3127
3128     my $old = $u->draft_text($prop_name);
3129
3130     $LJ::_T_DRAFT_RACE->() if $LJ::_T_DRAFT_RACE;
3131
3132     # try to find a shortcut that makes the SQL shorter
3133     my @methods;  # list of [ $subref, $cost ]
3134
3135     # one method is just setting it all at once.  which incurs about
3136     # 75 bytes of SQL overhead on top of the length of the draft,
3137     # not counting the escaping
3138     push @methods, [ "set", sub { $u->set_prop($prop_name, $draft); 1 },
3139                      75 + length $draft ];
3140
3141     # stupid case, setting the same thing:
3142     push @methods, [ "noop", sub { 1 }, 0 ] if $draft eq $old;
3143
3144     # simple case: appending
3145     if (length $old && $draft =~ /^\Q$old\E(.+)/s) {
3146         my $new = $1;
3147         my $appending = sub {
3148             my $prop = LJ::get_prop("user", $prop_name) or die; # FIXME: use exceptions
3149             my $rv = $u->do("UPDATE userpropblob SET value = CONCAT(value, ?) WHERE userid=? AND upropid=? AND LENGTH(value)=?",
3150                             undef, $new, $u->{userid}, $prop->{id}, length $old);
3151             return 0 unless $rv > 0;
3152             $u->uncache_prop($prop_name);
3153             return 1;
3154         };
3155         push @methods, [ "append", $appending, 40 + length $new ];
3156     }
3157
3158     # TODO: prepending/middle insertion (the former being just the latter), as well
3159     # appending, wihch we could then get rid of
3160
3161     # try the methods in increasing order
3162     foreach my $m (sort { $a->[2] <=> $b->[2] } @methods) {
3163         my $func = $m->[1];
3164         if ($func->()) {
3165             $LJ::_T_METHOD_USED->($m->[0]) if $LJ::_T_METHOD_USED; # for testing
3166             return 1;
3167         }
3168     }
3169     return 0;
3170 }
3171
3172 sub draft_text {
3173     my ($u, $prop_name) = @_;
3174     $prop_name ||= 'entry_draft';
3175     return $u->prop($prop_name);
3176 }
3177
3178 sub notable_interests {
3179     my ($u, $n) = @_;
3180     $n ||= 20;
3181
3182     # arrayref of arrayrefs of format [intid, intname, intcount];
3183     my $ints = LJ::get_interests($u)
3184         or return ();
3185
3186     my @ints = map { $_->[1] } @$ints;
3187
3188     # sorta arrayref inline
3189     LJ::AdTargetedInterests->sort_interests(\@ints);
3190
3191     return @ints[0..$n-1] if @ints > $n;
3192     return @ints;
3193 }
3194
3195 # returns $n number of communities that $u is a member of, sorted by update time (most recent to least recent)
3196 sub notable_communities {
3197     my ($u, $n) = @_;
3198     $n ||= 3;
3199
3200     my $friends = $u->friends;
3201
3202     my $fro_m = LJ::M::FriendsOf->new(
3203         $u,
3204         sloppy => 1, # approximate if no summary info
3205         friends => { map {$_ => 1} keys %$friends },
3206     );
3207
3208     my $update_times = LJ::get_timeupdate_multi( map { $_->id } $fro_m->member_of );
3209
3210     my @ret_commids;
3211     my $count = 1;
3212     foreach my $commid (sort {$update_times->{$b} <=> $update_times->{$a}} keys %$update_times) {
3213         last if $count > $n;
3214         push @ret_commids, $commid;
3215         $count++;
3216     }
3217
3218     my $us = LJ::load_userids(@ret_commids);
3219
3220     return map { $us->{$_} } @ret_commids;
3221 }
3222
3223 # returns the max capability ($cname) for all the classes
3224 # the user is a member of
3225 sub get_cap {
3226     my ($u, $cname) = @_;
3227     return 1 if $LJ::T_HAS_ALL_CAPS;
3228     return LJ::get_cap($u, $cname);
3229 }
3230
3231 # tests to see if a user is in a specific named class. class
3232 # names are site-specific.
3233 sub in_class {
3234     my ($u, $class) = @_;
3235     return LJ::caps_in_group($u->{caps}, $class);
3236 }
3237
3238 sub add_to_class {
3239     my ($u, $class) = @_;
3240     my $bit = LJ::class_bit($class);
3241     die "unknown class '$class'" unless defined $bit;
3242
3243     # call add_to_class hook before we modify the
3244     # current $u, so it can make inferences from the
3245     # old $u caps vs the new we say we'll be adding
3246     if (LJ::are_hooks('add_to_class')) {
3247         LJ::run_hooks('add_to_class', $u, $class);
3248     }
3249
3250     return LJ::modify_caps($u, [$bit], []);
3251 }
3252
3253 sub remove_from_class {
3254     my ($u, $class) = @_;
3255     my $bit = LJ::class_bit($class);
3256     die "unknown class '$class'" unless defined $bit;
3257
3258     # call remove_from_class hook before we modify the
3259     # current $u, so it can make inferences from the
3260     # old $u caps vs what we'll be removing
3261     if (LJ::are_hooks('remove_from_class')) {
3262         LJ::run_hooks('remove_from_class', $u, $class);
3263     }
3264
3265     return LJ::modify_caps($u, [], [$bit]);
3266 }
3267
3268 sub cache {
3269     my ($u, $key) = @_;
3270     my $val = $u->selectrow_array("SELECT value FROM userblobcache WHERE userid=? AND bckey=?",
3271                                   undef, $u->{userid}, $key);
3272     return undef unless defined $val;
3273     if (my $thaw = eval { Storable::thaw($val); }) {
3274         return $thaw;
3275     }
3276     return $val;
3277 }
3278
3279 sub set_cache {
3280     my ($u, $key, $value, $expr) = @_;
3281     my $now = time();
3282     $expr ||= $now + 86400;
3283     $expr += $now if $expr < 315532800;  # relative to absolute time
3284     $value = Storable::nfreeze($value) if ref $value;
3285     $u->do("REPLACE INTO userblobcache (userid, bckey, value, timeexpire) VALUES (?,?,?,?)",
3286            undef, $u->{userid}, $key, $value, $expr);
3287 }
3288
3289 # returns array of LJ::Entry objects, ignoring security
3290 sub recent_entries {
3291     my ($u, %opts) = @_;
3292     my $remote = delete $opts{'filtered_for'} || LJ::get_remote();
3293     my $count  = delete $opts{'count'}        || 50;
3294     my $order  = delete $opts{'order'}        || "";
3295     die "unknown options" if %opts;
3296
3297     my $err;
3298     my @recent = LJ::get_recent_items({
3299         itemshow  => $count,
3300         err       => \$err,
3301         userid    => $u->{userid},
3302         clusterid => $u->{clusterid},
3303         remote    => $remote,
3304         order     => $order,
3305     });
3306     die "Error loading recent items: $err" if $err;
3307
3308     my @objs;
3309     foreach my $ri (@recent) {
3310         my $entry = LJ::Entry->new($u, jitemid => $ri->{itemid});
3311         push @objs, $entry;
3312         # FIXME: populate the $entry with security/posterid/alldatepart/ownerid/rlogtime
3313     }
3314     return @objs;
3315 }
3316
3317 # front-end to recent_entries, which forces the remote user to be
3318 # the owner, so we get everything.
3319 sub all_recent_entries {
3320     my $u = shift;
3321     my %opts = @_;
3322     $opts{filtered_for} = $u;
3323     return $u->recent_entries(%opts);
3324 }
3325
3326 sub sms_active_number {
3327     my $u = shift;
3328     return LJ::SMS->uid_to_num($u, verified_only => 1);
3329 }
3330
3331 sub sms_pending_number {
3332     my $u = shift;
3333     my $num = LJ::SMS->uid_to_num($u, verified_only => 0);
3334     return undef unless $num;
3335     return $num if LJ::SMS->num_is_pending($num);
3336     return undef;
3337 }
3338
3339 # this method returns any mapped number for the user,
3340 # regardless of its verification status
3341 sub sms_mapped_number {
3342     my $u = shift;
3343     return LJ::SMS->uid_to_num($u, verified_only => 0);
3344 }
3345
3346 sub sms_active {
3347     my $u = shift;
3348
3349     # active if the user has a verified sms number
3350     return LJ::SMS->configured_for_user($u);
3351 }
3352
3353 sub sms_pending {
3354     my $u = shift;
3355
3356     # pending if user has an unverified number
3357     return LJ::SMS->pending_for_user($u);
3358 }
3359
3360 sub sms_register_time_remaining {
3361     my $u = shift;
3362
3363     return LJ::SMS->num_register_time_remaining($u);
3364 }
3365
3366 sub sms_num_instime {
3367     my $u = shift;
3368
3369     return LJ::SMS->num_instime($u->sms_mapped_number);
3370 }
3371
3372 sub set_sms_number {
3373     my ($u, $num, %opts) = @_;
3374     my $verified = delete $opts{verified};
3375
3376     # these two are only checked if $num, because it's possible
3377     # to just pass ($u, undef, undef) to delete the mapping
3378     if ($num) {
3379         croak "invalid number" unless $num =~ /^\+\d+$/;
3380         croak "invalid verified flag" unless $verified =~ /^[YN]$/;
3381     }
3382
3383     return LJ::SMS->replace_mapping($u, $num, $verified);
3384 }
3385
3386 sub set_sms_number_verified {
3387     my ($u, $verified) = @_;
3388
3389     return LJ::SMS->set_number_verified($u, $verified);
3390 }
3391
3392 sub sms_message_count {
3393     my $u = shift;
3394     return LJ::SMS->message_count($u, @_);
3395 }
3396
3397 sub sms_sent_message_count {
3398     my $u = shift;
3399     return LJ::SMS->sent_message_count($u, @_);
3400 }
3401
3402 sub delete_sms_number {
3403     my $u = shift;
3404     return LJ::SMS->replace_mapping($u, undef);
3405 }
3406
3407 # opts:
3408 #   no_quota = don't check user quota or deduct from their quota for sending a message
3409 sub send_sms {
3410     my ($u, $msg, %opts) = @_;
3411
3412     return 0 unless $u;
3413
3414     croak "invalid user object for object method"
3415         unless LJ::isu($u);
3416     croak "invalid LJ::SMS::Message object to send"
3417         unless $msg && $msg->isa("LJ::SMS::Message");
3418
3419     my $ret = $msg->send(%opts);
3420
3421     return $ret;
3422 }
3423
3424 sub send_sms_text {
3425     my ($u, $msgtext, %opts) = @_;
3426
3427     my $msg = LJ::SMS::Message->new(
3428                                     owner => $u,
3429                                     to    => $u,
3430                                     type  => 'outgoing',
3431                                     body_text => $msgtext,
3432                                     );
3433
3434     # if user specified a class_key for send, set it on
3435     # the msg object
3436     if ($opts{class_key}) {
3437         $msg->class_key($opts{class_key});
3438     }
3439
3440     $msg->send(%opts);
3441 }
3442
3443 sub sms_quota_remaining {
3444     my ($u, $type) = @_;
3445
3446     return LJ::SMS->sms_quota_remaining($u, $type);
3447 }
3448
3449 sub add_sms_quota {
3450     my ($u, $qty, $type) = @_;
3451
3452     return LJ::SMS->add_sms_quota($u, $qty, $type);
3453 }
3454
3455 sub set_sms_quota {
3456     my ($u, $qty, $type) = @_;
3457
3458     return LJ::SMS->set_sms_quota($u, $qty, $type);
3459 }
3460
3461 sub max_sms_bytes {
3462     my $u = shift;
3463     return LJ::SMS->max_sms_bytes($u);
3464 }
3465
3466 sub max_sms_substr {
3467     my ($u, $text, %opts) = @_;
3468     return LJ::SMS->max_sms_substr($u, $text, %opts);
3469 }
3470
3471 sub subtract_sms_quota {
3472     my ($u, $qty, $type) = @_;
3473
3474     return LJ::SMS->subtract_sms_quota($u, $qty, $type);
3475 }
3476
3477 sub is_syndicated {
3478     my $u = shift;
3479     return $u->{journaltype} eq "Y";
3480 }
3481
3482 sub is_community {
3483     my $u = shift;
3484     return $u->{journaltype} eq "C";
3485 }
3486 *is_comm = \&is_community;
3487
3488 sub is_shared {
3489     my $u = shift;
3490     return $u->{journaltype} eq "S";
3491 }
3492
3493 sub is_news {
3494     my $u = shift;
3495     return $u->{journaltype} eq "N";
3496 }
3497
3498 sub is_person {
3499     my $u = shift;
3500     return $u->{journaltype} eq "P";
3501 }
3502 *is_personal = \&is_person;
3503
3504 sub is_identity {
3505     my $u = shift;
3506     return $u->{journaltype} eq "I";
3507 }
3508
3509 sub is_redirected {
3510     my $u = shift;
3511     return $u->{journaltype} eq "R";
3512 }
3513
3514 ## We trust OpenID users if they are either from trusted OpenID provider or
3515 ## have e-mail validated. During e-mail validation, they answer CAPTCHA test.
3516 ## Trusted OpenID users are like registered user, untrusted are like anonymous
3517 sub is_trusted_identity {
3518     my $u = shift;
3519     return unless $u->is_identity;
3520
3521     return 1 if $u->is_validated;
3522
3523     my $id = $u->identity;
3524
3525     if ($id->short_code eq 'openid') {
3526         ## Check top-to-down domain names in list of trusted providers:
3527         ## asdf.openid.somewhere.com -> openid.somewhere.com -> somewhere.com
3528         my $url = $id->url;
3529         if ($url and my $uri = URI->new($url)) {
3530             return unless $uri->can('host');
3531             my $host = $uri->host;
3532             while ($host =~ /\./) {
3533                 return 1 if $LJ::TRUSTED_OPENID_PROVIDERS{$host};
3534                 # remove first domain name (or whatever) with dot
3535                 $host =~ s/^.*?\.//;
3536             }
3537         }
3538
3539         return;
3540     }
3541
3542     return;
3543 }
3544
3545 # return the journal type as a name
3546 sub journaltype_readable {
3547     my $u = shift;
3548
3549     return {
3550         R => 'redirect',
3551         I => 'identity',
3552         P => 'personal',
3553         S => 'shared',
3554         Y => 'syndicated',
3555         N => 'news',
3556         C => 'community',
3557     }->{$u->{journaltype}};
3558 }
3559
3560 sub who_invited {
3561     my $u = shift;
3562     my $inviterid = LJ::load_rel_user($u, 'I');
3563
3564     return LJ::load_userid($inviterid);
3565 }
3566
3567 sub subscriptions {
3568     my $u = shift;
3569     return LJ::Subscription->subscriptions_of_user($u);
3570 }
3571
3572 sub subscription_count {
3573     my $u = shift;
3574     return scalar LJ::Subscription->subscriptions_of_user($u);
3575 }
3576
3577 # this is the count used to check the maximum subscription count
3578 sub active_inbox_subscription_count {
3579     my $u = shift;
3580     return $u->subscriptions_count;
3581 }
3582
3583 sub max_subscriptions {
3584     my $u = shift;
3585     return $u->get_cap('subscriptions');
3586 }
3587
3588 sub can_add_inbox_subscription {
3589     my $u = shift;
3590     return $u->active_inbox_subscription_count >= $u->max_subscriptions ? 0 : 1;
3591 }
3592
3593 # subscribe to an event
3594 sub subscribe {
3595     my ($u, %opts) = @_;
3596     croak "No subscription options" unless %opts;
3597
3598     return LJ::Subscription->create($u, %opts);
3599 }
3600
3601 # unsubscribe from an event(s)
3602 sub unsubscribe {
3603     my ($u, %opts) = @_;
3604     croak "No subscription options" unless %opts;
3605
3606     # find all matching subscriptions
3607     my @subs = LJ::Subscription->find($u, %opts);
3608
3609     return 0
3610         unless @subs;
3611
3612     foreach (@subs) {
3613         # run delete method on each subscription
3614         $_->delete();
3615     }
3616
3617     return 1;
3618 }
3619
3620
3621
3622 sub subscribe_entry_comments_via_sms {
3623     my ($u, $entry) = @_;
3624     croak "Invalid LJ::Entry passed"
3625         unless $entry && $entry->isa("LJ::Entry");
3626
3627     # don't subscribe if user is over subscription limit
3628     return unless $u->can_add_inbox_subscription;
3629
3630     my %sub_args =
3631         ( event   => "LJ::Event::JournalNewComment",
3632           journal => $u,
3633           arg1    => $entry->ditemid, );
3634
3635     $u->subscribe
3636         ( method  => "LJ::NotificationMethod::SMS",
3637           %sub_args, );
3638
3639     $u->subscribe
3640         ( method  => "LJ::NotificationMethod::Inbox",
3641           %sub_args, );
3642
3643     return 1;
3644 }
3645
3646 # search for a subscription
3647 *find_subscriptions = \&has_subscription;
3648 sub has_subscription {
3649     my ($u, %params) = @_;
3650     croak "No parameters" unless %params;
3651
3652     $params{postprocess} = $u->{__subscriptions}
3653         unless $params{postprocess};
3654
3655     return LJ::Subscription->find($u, %params);
3656 }
3657
3658 # interim solution while legacy/ESN notifications are both happening:
3659 # checks possible subscriptions to see if user will get an ESN notification
3660 # THIS IS TEMPORARY. should only be called by talklib.
3661 # params: journal, arg1 (entry ditemid), arg2 (comment talkid)
3662 sub gets_notified {
3663     my ($u, %params) = @_;
3664
3665     $params{event} = "LJ::Event::JournalNewComment";
3666     $params{method} = "LJ::NotificationMethod::Email";
3667
3668     my $has_sub;
3669
3670     # did they subscribe to the parent comment?
3671     $has_sub = LJ::Subscription->find($u, %params);
3672     return $has_sub if $has_sub;
3673
3674     # remove the comment-specific parameter, then check for an entry subscription
3675     $params{arg2} = 0;
3676     $has_sub = LJ::Subscription->find($u, %params);
3677     return $has_sub if $has_sub;
3678
3679     # remove the entry-specific parameter, then check if they're subscribed to the entire journal
3680     $params{arg1} = 0;
3681     $has_sub = LJ::Subscription->find($u, %params);
3682     return $has_sub;
3683 }
3684
3685 # delete all of a user's subscriptions
3686 sub delete_all_subscriptions {
3687     my $u = shift;
3688
3689     ## Logging for delete all subscriptions
3690     my $remote = LJ::get_remote();
3691     my $admin = $remote || LJ::load_user('system');
3692     my $subs_number = scalar $u->subscriptions;
3693     LJ::statushistory_add ( $u, $admin, 'remove_subs', $subs_number )
3694         if $subs_number;
3695
3696     return LJ::Subscription->delete_all_subs($u);
3697 }
3698
3699 # delete all of a user's subscriptions
3700 sub delete_all_inactive_subscriptions {
3701     my $u = shift;
3702     my $dryrun = shift;
3703
3704     ## Logging for delete all subscriptions
3705     my $remote = LJ::get_remote();
3706     my $admin = $remote || LJ::load_user('system');
3707     my $set = LJ::Subscription::GroupSet->fetch_for_user($u);
3708     my @inactive_groups = grep { !$_->active } $set->groups;
3709     my $subs_number = scalar @inactive_groups;
3710     LJ::statushistory_add ( $u, $admin, 'remove_subs', $subs_number )
3711         if $subs_number;
3712
3713     return LJ::Subscription->delete_all_inactive_subs($u, $dryrun);
3714 }
3715
3716 # What journals can this user post to?
3717 sub posting_access_list {
3718     my $u = shift;
3719
3720     my @res;
3721
3722     my $ids = LJ::load_rel_target($u, 'P');
3723     my $us = LJ::load_userids(@$ids);
3724     foreach my $u ( values %$us ) {
3725         next unless $u && $u->is_visible && $u->database_cluster_up;
3726         push @res, $u;
3727     }
3728
3729     return sort { $a->username cmp $b->username } @res;
3730 }
3731
3732 # can $u post to $targetu?
3733 sub can_post_to {
3734     my ($u, $targetu) = @_;
3735     return unless $u && $targetu;
3736     return LJ::can_use_journal($u->id, $targetu->user);
3737 }
3738
3739 sub delete_and_purge_completely {
3740     my $u = shift;
3741     # TODO: delete from user tables
3742     # TODO: delete from global tables
3743     my $dbh = LJ::get_db_writer();
3744
3745     my @tables = qw(user useridmap priv_map infohistory email password);
3746     foreach my $table (@tables) {
3747         $dbh->do("DELETE FROM $table WHERE userid=?", undef, $u->id);
3748     }
3749
3750     LJ::RelationService->delete_and_purge_completely($u);
3751
3752     $dbh->do("DELETE FROM email_aliases WHERE alias=?", undef, $u->user . "\@$LJ::USER_DOMAIN");
3753
3754     $dbh->do("DELETE FROM community WHERE userid=?", undef, $u->id)
3755         if $u->is_community;
3756     $dbh->do("DELETE FROM syndicated WHERE userid=?", undef, $u->id)
3757         if $u->is_syndicated;
3758     $dbh->do("DELETE FROM content_flag WHERE journalid=? OR reporterid=?", undef, $u->id, $u->id);
3759
3760     return 1;
3761 }
3762
3763 # Returns 'rich' or 'plain' depending on user's
3764 # setting of which editor they would like to use
3765 # and what they last used
3766 sub new_entry_editor {
3767     my $u = shift;
3768
3769     my $editor = $u->prop('entry_editor');
3770     return 'plain' if $editor eq 'always_plain'; # They said they always want plain
3771     return 'rich' if $editor eq 'always_rich'; # They said they always want rich
3772     return $editor if $editor =~ /(rich|plain)/; # What did they last use?
3773     return $LJ::DEFAULT_EDITOR; # Use config default
3774 }
3775
3776 # Returns the NotificationInbox for this user
3777 *inbox = \&notification_inbox;
3778 sub notification_inbox {
3779     my $u = shift;
3780     return LJ::NotificationInbox->new($u);
3781 }
3782
3783 sub new_message_count {
3784     my $u = shift;
3785     my $inbox = $u->notification_inbox;
3786     my $count = $inbox->unread_count;
3787
3788     return $count || 0;
3789 }
3790
3791 sub notification_archive {
3792     my $u = shift;
3793     return LJ::NotificationArchive->new($u);
3794 }
3795
3796 #
3797 sub can_receive_message {
3798     my ($u, $sender) = @_;
3799
3800     my $opt_usermsg = $u->opt_usermsg;
3801     return 0 if ($opt_usermsg eq 'N' || !$sender);
3802     return 0 if ($u->has_banned($sender));
3803     return 0 if ($opt_usermsg eq 'M' && !$u->is_mutual_friend($sender));
3804     return 0 if ($opt_usermsg eq 'F' && !$u->is_friend($sender));
3805
3806     return 1;
3807 }
3808
3809 # opt_usermsg options
3810 # Y - Registered Users
3811 # F - Friends
3812 # M - Mutual Friends
3813 # N - Nobody
3814 sub opt_usermsg {
3815     my $u = shift;
3816
3817     if ($u->raw_prop('opt_usermsg') =~ /^(Y|F|M|N)$/) {
3818         return $u->raw_prop('opt_usermsg');
3819     } else {
3820         return 'N' if ($u->underage || $u->is_child);
3821         return 'M' if ($u->is_minor);
3822         return 'Y';
3823     }
3824 }
3825
3826 sub view_control_strip {
3827     my $u = shift;
3828
3829     LJ::run_hook('control_strip_propcheck', $u, 'view_control_strip') unless $LJ::DISABLED{control_strip_propcheck};
3830
3831     my $prop = $u->raw_prop('view_control_strip');
3832     return 0 if $prop =~ /^off/;
3833
3834     return 'dark' if $prop eq 'forced';
3835
3836     return $prop;
3837 }
3838
3839 sub show_control_strip {
3840     my $u = shift;
3841
3842     LJ::run_hook('control_strip_propcheck', $u, 'show_control_strip') unless $LJ::DISABLED{control_strip_propcheck};
3843
3844     my $prop = $u->raw_prop('show_control_strip');
3845     return 0 if $prop =~ /^off/;
3846
3847     return 'dark' if $prop eq 'forced';
3848
3849     return $prop;
3850 }
3851
3852 # when was this account created?
3853 # returns unixtime
3854 sub timecreate {
3855     my $u = shift;
3856
3857     return $u->{_cache_timecreate} if $u->{_cache_timecreate};
3858
3859     my $memkey = [$u->id, "tc:" . $u->id];
3860     my $timecreate = LJ::MemCache::get($memkey);
3861     if ($timecreate) {
3862         $u->{_cache_timecreate} = $timecreate;
3863         return $timecreate;
3864     }
3865
3866     my $dbr = LJ::get_db_reader() or die "No db";
3867     my $when = $dbr->selectrow_array("SELECT timecreate FROM userusage WHERE userid=?", undef, $u->id);
3868
3869     $timecreate = LJ::TimeUtil->mysqldate_to_time($when);
3870     $u->{_cache_timecreate} = $timecreate;
3871     LJ::MemCache::set($memkey, $timecreate, 60*60*24);
3872
3873     return $timecreate;
3874 }
3875
3876 # when was last time this account updated?
3877 # returns unixtime
3878 sub timeupdate {
3879     my $u = shift;
3880     my $timeupdate = LJ::get_timeupdate_multi($u->id);
3881     return $timeupdate->{$u->id};
3882 }
3883
3884 # when was last time new public entry was created
3885 # (fast reposts are excluded)
3886 sub last_public_entry_time {
3887     my ($u, %opts) = @_;
3888
3889     my $key  = "lpt.".$u->id;
3890     my $attr = '_cache_last_public_time';
3891
3892     return $u->{$attr} if defined $u->{$attr};
3893
3894     my $redis = LJ::Redis->get_connection;
3895
3896     my $lastpublic = $redis && !$opts{nocache} ? $redis->get($key) : undef;
3897
3898     if (defined $lastpublic) {
3899         $u->{$attr} = $lastpublic;
3900         return $lastpublic;
3901     }
3902
3903     my $err;
3904
3905     my $is_person = $u->is_person;
3906
3907     my $req = {
3908         'userid'      => $u->userid,
3909         'clusterid'   => $u->clusterid,
3910         'skip'        => 0,
3911         'itemshow'    => 1,
3912         'friendsview' => 1,
3913         'security'    => "public",
3914         'load_props'  => $is_person ? 1 : 0,
3915         'err'         => \$err,
3916     };
3917
3918     $lastpublic = 0;
3919
3920     my ($skip, $itemshow) = (0, 10);
3921
3922     until ( $lastpublic ) {
3923
3924         my @entries = ();
3925         $req->{'entry_objects'} = \@entries;
3926
3927         $req->{'skip'}     = $skip;
3928         $req->{'itemshow'} = $is_person ? $itemshow : 1;
3929
3930         LJ::get_recent_items($req);
3931
3932         if ($err) {
3933             warn "Error loading recent_entries: $err";
3934             undef $lastpublic;
3935             last;
3936         }
3937
3938         last unless @entries;
3939
3940         foreach my $entry (@entries) {
3941             unless( $is_person && $entry->prop('repost') && $entry->prop('repost') eq 'e' ) {
3942                 $lastpublic = LJ::TimeUtil->mysqldate_to_time($entry->{logtime}, 0);
3943                 last;
3944             }
3945         }
3946
3947         $skip += $itemshow;
3948     }
3949
3950     if (defined $lastpublic) {
3951         $u->{$attr} = $lastpublic;
3952         $redis->set($key, $lastpublic) if $redis;
3953     }
3954
3955     return $lastpublic;
3956 }
3957
3958
3959 sub get_last_public_entry_time_multi {
3960     my ($class, $uids) = @_;
3961
3962     return unless $uids && @$uids;
3963
3964     my $redis = LJ::Redis->get_connection || return;
3965
3966     my @keys = map {"lpt.$_"} @$uids;
3967
3968     my @res = $redis->mget(@keys);
3969
3970     my $res = { map { $uids->[$_] => $res[$_] } (0..$#res) };
3971
3972     return $res;
3973 }
3974
3975 # set the last public entry time
3976 # do it only if key already exists, i.e. if somebody has already request it
3977 sub set_last_public_entry_time {
3978     my ($u, $lastpublic) = @_;
3979
3980     my $key  = "lpt.".$u->id;
3981     my $attr = '_cache_last_public_time';
3982
3983     $u->{$attr} = $lastpublic;
3984
3985     my $redis = LJ::Redis->get_connection || return;
3986
3987     return unless $redis->exists($key);
3988     $redis->set($key, $lastpublic);
3989
3990 }
3991
3992 # delete last public entry time
3993 sub del_last_public_entry_time {
3994     my ($u) = @_;
3995
3996     my $key  = "lpt.".$u->id;
3997     my $attr = '_cache_last_public_time';
3998
3999     delete $u->{$attr};
4000
4001     my $redis = LJ::Redis->get_connection || return;
4002     $redis->del($key);
4003 }
4004
4005 # can this user use ESN?
4006 sub can_use_esn {
4007     my $u = shift;
4008     return 0 if $LJ::DISABLED{esn};
4009     my $disable = $LJ::DISABLED{esn_ui};
4010     return 1 unless $disable;
4011
4012     if (ref $disable eq 'CODE') {
4013         return $disable->($u) ? 0 : 1;
4014     }
4015
4016     return $disable ? 0 : 1;
4017 }
4018
4019 sub can_use_sms {
4020     my $u = shift;
4021     return LJ::SMS->can_use_sms($u);
4022 }
4023
4024 sub can_use_ljphoto {
4025     my $u = shift;
4026
4027     return $u->is_personal ? 1 : 0;
4028 }
4029
4030 sub can_upload_photo {
4031     my $u = shift;
4032
4033     return 0 unless $u->can_use_ljphoto();
4034     return $u->get_cap('disk_quota') ? 1 : 0;
4035 }
4036
4037 sub ajax_auth_token {
4038     my $u = shift;
4039     return LJ::Auth->ajax_auth_token($u, @_);
4040 }
4041
4042 sub check_ajax_auth_token {
4043     my $u = shift;
4044     return LJ::Auth->check_ajax_auth_token($u, @_);
4045 }
4046
4047 # returns username
4048 *username = \&user;
4049 sub user {
4050     my $u = shift;
4051     return $u->{user};
4052 }
4053
4054 sub user_url_arg {
4055     my $u = shift;
4056     return "I,$u->{userid}" if $u->{journaltype} eq "I";
4057     return $u->{user};
4058 }
4059
4060 # returns username for display
4061 sub display_username {
4062     my $u = shift;
4063     my $need_cut = shift || 0;
4064
4065     my $username = $u->{user};
4066     if ($u->is_identity){
4067         $username = $u->display_name;
4068         if ($need_cut){
4069             my $short_name = substr ($username, 0, 16);
4070             if ($username eq $short_name) {
4071                 $username = $short_name;
4072             } else {
4073                 $username = $short_name . "...";
4074             }
4075         }
4076     }
4077
4078     return LJ::ehtml($username);
4079 }
4080
4081 # returns the user-specified name of a journal exactly as entered
4082 sub name_orig {
4083     my $u = shift;
4084     return $u->{name};
4085 }
4086
4087 # returns the user-specified name of a journal in valid UTF-8
4088 sub name_raw {
4089     my $u = shift;
4090     LJ::text_out(\$u->{name});
4091     return $u->{name};
4092 }
4093
4094 # returns the user-specified name of a journal in valid UTF-8
4095 # and with HTML escaped
4096 sub name_html {
4097     my $u = shift;
4098     return LJ::ehtml($u->name_raw);
4099 }
4100
4101 # userid
4102 *userid = \&id;
4103 sub id {
4104     my $u = shift;
4105     return int($u->{userid});
4106 }
4107
4108 sub clusterid {
4109     my $u = shift;
4110     return $u->{clusterid};
4111 }
4112
4113 # class method, returns { clusterid => [ uid, uid ], ... }
4114 sub split_by_cluster {
4115     my $class = shift;
4116
4117     my @uids = @_;
4118     my $us = LJ::load_userids(@uids);
4119
4120     my %clusters;
4121     foreach my $u (values %$us) {
4122         next unless $u;
4123         push @{$clusters{$u->clusterid}}, $u->id;
4124     }
4125
4126     return \%clusters;
4127 }
4128
4129 ## Returns current userhead for user.
4130 sub userhead {
4131     my $u    = shift;
4132     my $opts = +shift || {};
4133
4134     my $userhead_override;
4135     LJ::run_hooks( 'override_userhead', $u, \$userhead_override );
4136     return ( $userhead_override, 16, 16 ) if $userhead_override;
4137
4138     my $head_size = $opts->{head_size};
4139
4140     my $userhead   = 'userinfo.gif?v=17080';
4141     my $userhead_w = 16;
4142     my $userhead_h = undef;
4143
4144     ## special icon?
4145     my ($icon, $size) = LJ::run_hook("head_icon",
4146                                      $u, head_size => $head_size);
4147     if ($icon){
4148         ## yeap.
4149         $userhead = $icon;
4150         $userhead_w = $size || 16;
4151         $userhead_h = $userhead_w;
4152         return $userhead, $userhead_w, $userhead_h;
4153     }
4154
4155     ## default way
4156     if (!$LJ::IS_SSL && ($icon = $u->custom_usericon)) {
4157         $userhead = $icon;
4158         $userhead_w = 16;
4159     } elsif ($u->is_community) {
4160         if ($head_size) {
4161             $userhead = "comm_${head_size}.gif";
4162             $userhead_w = $head_size;
4163         } else {
4164             $userhead = "community.gif?v=556";
4165             $userhead_w = 16;
4166         }
4167     } elsif ($u->is_syndicated) {
4168         if ($head_size) {
4169             $userhead = "syn_${head_size}.gif";
4170             $userhead_w = $head_size;
4171         } else {
4172             $userhead = "syndicated.gif?v=6283";
4173             $userhead_w = 16;
4174         }
4175     } elsif ($u->is_news) {
4176         if ($head_size) {
4177             $userhead = "news_${head_size}.gif";
4178             $userhead_w = $head_size;
4179         } else {
4180             $userhead = "newsinfo.gif?v=2990";
4181             $userhead_w = 16;
4182         }
4183     } elsif ($u->is_identity) {
4184         my $ident  = $u->identity;
4185         my $params = $ident ? $ident->ljuser_display_params($u, $opts) : {};
4186         $userhead     = $params->{'userhead'}     || $userhead;
4187         $userhead_w   = $params->{'userhead_w'}   || $userhead_w;
4188         $userhead_h   = $params->{'userhead_h'}   || $userhead_h;
4189     } else {
4190         if ($head_size) {
4191             $userhead = "user_${head_size}.gif";
4192             $userhead_w = $head_size;
4193         } else {
4194             $userhead = "userinfo.gif?v=17080";
4195             $userhead_w = 16;
4196         }
4197     }
4198     $userhead_h ||= $userhead_w;
4199     return $userhead, $userhead_w, $userhead_h;
4200 }
4201
4202 sub userhead_url {
4203     my $u = shift;
4204     my ($userhead) = $u->userhead;
4205     return undef unless $userhead;
4206     return $userhead if $userhead =~ m|^https?://|;
4207     return join '', $LJ::IMGPREFIX, '/', $userhead, '?v=', $LJ::CURRENT_VERSION;
4208 }
4209
4210 sub bio {
4211     my $u = shift;
4212     return LJ::get_bio($u);
4213 }
4214
4215 # if bio_absent is set to "yes", bio won't be updated
4216 sub set_bio {
4217     my ($u, $text, $bio_absent) = @_;
4218     $bio_absent = "" unless $bio_absent;
4219
4220     my $oldbio = $u->bio;
4221     my $newbio = $bio_absent eq "yes" ? $oldbio : $text;
4222     my $has_bio = ($newbio =~ /\S/) ? "Y" : "N";
4223
4224     my %update = (
4225         'has_bio' => $has_bio,
4226     );
4227     LJ::update_user($u, \%update);
4228
4229     # update their bio text
4230     if (($oldbio ne $text) && $bio_absent ne "yes") {
4231         if ($has_bio eq "N") {
4232             $u->do("DELETE FROM userbio WHERE userid=?", undef, $u->id);
4233             $u->dudata_set('B', 0, 0);
4234         } else {
4235             $u->do("REPLACE INTO userbio (userid, bio) VALUES (?, ?)",
4236                    undef, $u->id, $text);
4237             $u->dudata_set('B', 0, length($text));
4238         }
4239         LJ::MemCache::set([$u->id, "bio:" . $u->id], $text);
4240     }
4241 }
4242
4243 sub opt_ctxpopup {
4244     my $u = shift;
4245
4246     # if unset, default to on
4247     my $prop = $u->raw_prop('opt_ctxpopup') || 'Y';
4248
4249     return $prop eq 'Y';
4250 }
4251
4252 # opt_imagelinks format:
4253 # 0|1 - replace images with placeholders at friends page
4254 # :   - delimiter
4255 # 0|1 - replace images with placeholders in comments at entry page
4256 sub get_opt_imagelinks {
4257     my $u = shift;
4258     my $opt = $u->prop("opt_imagelinks") || "0:0";
4259     $opt = "0:0" unless $opt;
4260     $opt = "1:0" unless $opt =~ /^\d\:\d$/;
4261     return $opt;
4262 }
4263
4264 sub opt_placeholders_comments {
4265     my $u = shift;
4266     my $opt = $u->get_opt_imagelinks;
4267
4268     if ( $opt =~ /^\d\:(\d)$/ ) {
4269         return $1;
4270     }
4271
4272     return 0;
4273 }
4274
4275 sub get_opt_videolinks {
4276     my $u = shift;
4277     my $opt = $u->raw_prop("opt_embedplaceholders") || "0:0";
4278     $opt = "0:0" if ! $opt || $opt eq 'N';
4279     $opt = "1:0" unless $opt =~ /^\d\:\d$/;
4280     return $opt;
4281 }
4282
4283 sub opt_embedplaceholders {
4284     my $u = shift;
4285     my $opt = $u->get_opt_videolinks;
4286
4287     if ( $opt =~ /^(\d)\:\d$/ ) {
4288         return $1;
4289     }
4290
4291     return 0;
4292 }
4293
4294 sub opt_videoplaceholders_comments {
4295     my $u = shift;
4296     my $opt = $u->get_opt_videolinks;
4297
4298     if ( $opt =~ /^\d\:(\d)$/ ) {
4299         return $1;
4300     }
4301
4302     return 0;
4303 }
4304
4305 sub opt_getting_started {
4306     my $u = shift;
4307
4308     # if unset, default to on
4309     my $prop = $u->raw_prop('opt_getting_started') || 'Y';
4310
4311     return $prop;
4312 }
4313
4314 sub opt_stylealwaysmine {
4315     my $u = shift;
4316
4317     return 0 unless $u->can_use_stylealwaysmine;
4318     return $u->raw_prop('opt_stylealwaysmine') eq 'Y' ? 1 : 0;
4319 }
4320
4321 sub can_use_stylealwaysmine {
4322     my $u = shift;
4323     my $ret = 0;
4324
4325     return 0 if $LJ::DISABLED{stylealwaysmine};
4326     $ret = LJ::run_hook("can_use_stylealwaysmine", $u);
4327     return $ret;
4328 }
4329
4330 sub opt_commentsstylemine {
4331     my $u = shift;
4332
4333     return 0 unless $u->can_use_commentsstylemine;
4334
4335     if ( $u->raw_prop('opt_stylemine') ) {
4336         $u->set_prop( opt_stylemine => 0 );
4337         $u->set_prop( opt_commentsstylemine => 'Y' );
4338     }
4339
4340     return $u->raw_prop('opt_commentsstylemine') eq 'Y'? 1 : 0;
4341 }
4342
4343 sub can_use_commentsstylemine {
4344     return 0 unless LJ::is_enabled('comments_style_mine');
4345     return 1;
4346 }
4347
4348 sub has_enabled_getting_started {
4349     my $u = shift;
4350
4351     return $u->opt_getting_started eq 'Y' ? 1 : 0;
4352 }
4353
4354
4355 # ***                                                                      *** #
4356 # ***************************** OBSOLETE ************************************* #
4357 # ***                                                                      *** #
4358 # This method sends messages using djabberd servers
4359 # which have been changed with Ejabberd. So method is obsolete.
4360 # Code to send messages to Ejabberd is in cgi-bin/LJ/NotificationMethod/IM.pm
4361 #
4362 #
4363 # find what servers a user is logged in to, and send them an IM
4364 # returns true if sent, false if failure or user not logged on
4365 # Please do not call from web context
4366 sub send_im {
4367     my ($self, %opts) = @_;
4368
4369     croak "Can't call in web context" if LJ::is_web_context();
4370
4371     my $from = delete $opts{from};
4372     my $msg  = delete $opts{message} or croak "No message specified";
4373
4374     croak "No from or bot jid defined" unless $from || $LJ::JABBER_BOT_JID;
4375
4376     my @resources = keys %{LJ::Jabber::Presence->get_resources($self)} or return 0;
4377
4378     my $res = $resources[0] or return 0; # FIXME: pick correct server based on priority?
4379     my $pres = LJ::Jabber::Presence->new($self, $res) or return 0;
4380     my $ip = $LJ::JABBER_SERVER_IP || '127.0.0.1';
4381
4382     my $sock = IO::Socket::INET->new(PeerAddr => "${ip}:5200")
4383         or return 0;
4384
4385     my $vhost = $LJ::DOMAIN;
4386
4387     my $to_jid   = $self->user   . '@' . $LJ::DOMAIN;
4388     my $from_jid = $from ? $from->user . '@' . $LJ::DOMAIN : $LJ::JABBER_BOT_JID;
4389
4390     my $emsg = LJ::exml($msg);
4391     my $stanza = LJ::eurl(qq{<message to="$to_jid" from="$from_jid"><body>$emsg</body></message>});
4392
4393     print $sock "send_stanza $vhost $to_jid $stanza\n";
4394
4395     my $start_time = time();
4396
4397     while (1) {
4398         my $rin = '';
4399         vec($rin, fileno($sock), 1) = 1;
4400         select(my $rout=$rin, undef, undef, 1);
4401         if (vec($rout, fileno($sock), 1)) {
4402             my $ln = <$sock>;
4403             return 1 if $ln =~ /^OK/;
4404         }
4405
4406         last if time() > $start_time + 5;
4407     }
4408
4409     return 0;
4410 }
4411
4412 # returns whether or not the user is online on jabber
4413 sub jabber_is_online {
4414     my $u = shift;
4415
4416     return keys %{LJ::Jabber::Presence->get_resources($u)} ? 1 : 0;
4417 }
4418
4419 sub esn_inbox_default_expand {
4420     my $u = shift;
4421
4422     my $prop = $u->raw_prop('esn_inbox_default_expand');
4423     return $prop ne 'N';
4424 }
4425
4426 sub rate_log {
4427     my ($u, $ratename, $count, $opts) = @_;
4428     LJ::rate_log($u, $ratename, $count, $opts);
4429 }
4430
4431 sub rate_check {
4432     my ($u, $ratename, $count, $opts) = @_;
4433     LJ::rate_check($u, $ratename, $count, $opts);
4434 }
4435
4436 sub statusvis {
4437     my $u = shift;
4438     return $u->{statusvis};
4439 }
4440
4441 sub statusvisdate {
4442     my $u = shift;
4443     return $u->{statusvisdate};
4444 }
4445
4446 sub statusvisdate_unix {
4447     my $u = shift;
4448     return LJ::TimeUtil->mysqldate_to_time($u->{statusvisdate});
4449 }
4450
4451 # returns list of all previous statuses of the journal
4452 # in order from newest to oldest
4453 sub get_previous_statusvis {
4454     my $u = shift;
4455
4456     my $records = LJ::User::Userlog->get_records( $u,
4457         'action' => 'accountstatus' );
4458
4459     my @statusvis;
4460     foreach my $record (@$records) {
4461         push @statusvis, $record->extra_unpacked->{'old'};
4462     }
4463
4464     return @statusvis;
4465 }
4466
4467 # set_statusvis only change statusvis parameter, all accompanied actions are done in set_* methods
4468 sub set_statusvis {
4469     my ($u, $statusvis) = @_;
4470
4471     LJ::MemCache::delete('u:s:' . $u->userid);
4472
4473     croak "Invalid statusvis: $statusvis"
4474         unless $statusvis =~ /^(?:
4475             V|       # visible
4476             D|       # deleted
4477             X|       # expunged
4478             S|       # suspended
4479             L|       # locked
4480             M|       # memorial
4481             O|       # read-only
4482             R        # renamed
4483                                 )$/x;
4484
4485     # log the change to userlog, but only in case we have a valid clusterid;
4486     # this check addresses the case when an expunged user gets suspended
4487     if ( $u->clusterid ) {
4488         # remote looked up by create()
4489         LJ::User::UserlogRecord::AccountStatus->create( $u,
4490             'old' => $u->statusvis, 'new' => $statusvis );
4491     }
4492
4493     # do update
4494     my $ret = LJ::update_user($u, { statusvis => $statusvis,
4495                                  raw => 'statusvisdate=NOW()' });
4496
4497     LJ::run_hooks("props_changed", $u, {statusvis => $statusvis});
4498
4499     $u->fb_push;
4500
4501     return $ret;
4502 }
4503
4504 sub set_visible {
4505     my $u = shift;
4506
4507     LJ::run_hooks("account_will_be_visible", $u);
4508     return $u->set_statusvis('V');
4509 }
4510
4511 sub set_deleted {
4512     my $u = shift;
4513     my $res = $u->set_statusvis('D');
4514
4515     # run any account cancellation hooks
4516     LJ::run_hooks("account_delete", $u);
4517     return $res;
4518 }
4519
4520 sub set_expunged {
4521     my $u = shift;
4522     return $u->set_statusvis('X');
4523 }
4524
4525 sub set_suspended {
4526     my ($u, $who, $reason, $errref, $public_reason) = @_;
4527     die "Not enough parameters for LJ::User::set_suspended call" unless $who and $reason;
4528
4529     my $res = $u->set_statusvis('S');
4530     unless ($res) {
4531         $$errref = "DB error while setting statusvis to 'S'" if ref $errref;
4532         return $res;
4533     }
4534
4535     LJ::statushistory_add($u, $who, "suspend", $reason);
4536
4537     # close all spamreports on this user
4538     my $dbh = LJ::get_db_writer();
4539     $dbh->do("UPDATE spamreports SET state='closed' WHERE posterid = ? AND state='open'", undef, $u->userid);
4540
4541     # close all botreports on this user
4542     require LJ::BotReport;
4543     LJ::BotReport->close_requests($u->userid);
4544
4545     #
4546     LJ::run_hooks("account_cancel", $u);
4547     LJ::run_hooks("account_suspend", $u);
4548
4549     if ($public_reason) {
4550         LJ::statushistory_add($u, $who, "suspend_reason", $public_reason);
4551         $u->set_prop('suspend_reason' => $public_reason);
4552     }
4553
4554     if (my $err = LJ::run_hook("cdn_purge_userpics", $u)) {
4555         $$errref = $err if ref $errref and $err;
4556         return 0;
4557     }
4558
4559     return $res; # success
4560 }
4561
4562 # sets a user to visible, but also does all of the stuff necessary when a suspended account is unsuspended
4563 # this can only be run on a suspended account
4564 sub set_unsuspended {
4565     my ($u, $who, $reason, $errref) = @_;
4566     die "Not enough parameters for LJ::User::set_unsuspended call" unless $who and $reason;
4567
4568     unless ($u->is_suspended) {
4569         $$errref = "User isn't suspended" if ref $errref;
4570         return 0;
4571     }
4572
4573     my $res = $u->set_statusvis('V');
4574     unless ($res) {
4575         $$errref = "DB error while setting statusvis to 'V'" if ref $errref;
4576         return $res;
4577     }
4578
4579     LJ::statushistory_add($u, $who, "unsuspend", $reason);
4580     LJ::run_hooks("account_unsuspend", $u);
4581
4582     return $res; # success
4583 }
4584
4585 sub set_locked {
4586     my $u = shift;
4587     return $u->set_statusvis('L');
4588 }
4589
4590 sub set_memorial {
4591     my $u = shift;
4592     return $u->set_statusvis('M');
4593 }
4594
4595 sub set_readonly {
4596     my $u = shift;
4597     return $u->set_statusvis('O');
4598 }
4599
4600 sub set_renamed {
4601     my $u = shift;
4602     return $u->set_statusvis('R');
4603 }
4604
4605 # returns if this user is considered visible
4606 sub is_visible {
4607     my $u = shift;
4608     return ($u->statusvis eq 'V' && $u->clusterid != 0);
4609 }
4610
4611 sub is_deleted {
4612     my $u = shift;
4613     return $u->statusvis eq 'D';
4614 }
4615
4616 sub is_expunged {
4617     my $u = shift;
4618     return $u->statusvis eq 'X' || $u->clusterid == 0;
4619 }
4620
4621 sub is_suspended {
4622     my $u = shift;
4623     return $u->statusvis eq 'S';
4624 }
4625
4626 sub is_locked {
4627     my $u = shift;
4628     return $u->statusvis eq 'L';
4629 }
4630
4631 sub is_memorial {
4632     my $u = shift;
4633     return $u->statusvis eq 'M';
4634 }
4635
4636 sub is_readonly {
4637     my $u = shift;
4638     return $u->statusvis eq 'O';
4639 }
4640
4641 sub is_renamed {
4642     my $u = shift;
4643     return $u->statusvis eq 'R';
4644 }
4645
4646 sub caps {
4647     my $u = shift;
4648     return $u->{caps};
4649 }
4650
4651 *get_post_count = \&number_of_posts;
4652 sub number_of_posts {
4653     my ($u, %opts) = @_;
4654
4655     # to count only a subset of all posts
4656     if (%opts) {
4657         $opts{return} = 'count';
4658         return $u->get_post_ids(%opts);
4659     }
4660
4661     my $memkey = [$u->{userid}, "log2ct:$u->{userid}"];
4662     my $expire = time() + 3600*24*2; # 2 days
4663     return LJ::MemCache::get_or_set($memkey, sub {
4664         return $u->selectrow_array("SELECT COUNT(*) FROM log2 WHERE journalid=?",
4665                                    undef, $u->{userid});
4666     }, $expire);
4667 }
4668
4669 # return the number if public posts
4670 sub number_of_public_posts {
4671     my ($u) = @_;
4672     my $memkey = [$u->{userid}, "log2publicct:$u->{userid}"];
4673     my $expire = time() + 300;  # 5 min
4674     return LJ::MemCache::get_or_set($memkey, sub {
4675         return $u->get_post_ids(return => 'count', security => 'public');
4676     }, $expire);
4677 }
4678
4679
4680 # return the number of posts that the user actually posted themselves
4681 sub number_of_posted_posts {
4682     my $u = shift;
4683
4684     my $num = $u->number_of_posts;
4685     $num-- if LJ::run_hook('user_has_auto_post', $u);
4686
4687     return $num;
4688 }
4689
4690 # <LJFUNC>
4691 # name: LJ::get_post_ids
4692 # des: Given a user object and some options, return the number of posts or the
4693 #      posts'' IDs (jitemids) that match.
4694 # returns: number of matching posts, <strong>or</strong> IDs of
4695 #          matching posts (default).
4696 # args: u, opts
4697 # des-opts: 'security' - [public|private|usemask]
4698 #           'allowmask' - integer for friends-only or custom groups
4699 #           'start_date' - UTC date after which to look for match
4700 #           'end_date' - UTC date before which to look for match
4701 #           'return' - if 'count' just return the count
4702 #           TODO: Add caching?
4703 # </LJFUNC>
4704 sub get_post_ids {
4705     my ($u, %opts) = @_;
4706
4707     my $query = 'SELECT';
4708     my @vals; # parameters to query
4709
4710     if ($opts{'start_date'} || $opts{'end_date'}) {
4711         croak "start or end date not defined"
4712             if (!$opts{'start_date'} || !$opts{'end_date'});
4713
4714         if (!($opts{'start_date'} >= 0) || !($opts{'end_date'} >= 0) ||
4715             !($opts{'start_date'} <= $LJ::EndOfTime) ||
4716             !($opts{'end_date'} <= $LJ::EndOfTime) ) {
4717             return undef;
4718         }
4719     }
4720
4721     # return count or jitemids
4722     if ($opts{'return'} eq 'count') {
4723         $query .= " COUNT(*)";
4724     } else {
4725         $query .= " jitemid";
4726     }
4727
4728     # from the journal entries table for this user
4729     $query .= " FROM log2 WHERE journalid=?";
4730     push(@vals, $u->{userid});
4731
4732     # filter by security
4733     if ($opts{'security'}) {
4734         $query .= " AND security=?";
4735         push(@vals, $opts{'security'});
4736         # If friends-only or custom
4737         if ($opts{'security'} eq 'usemask' && $opts{'allowmask'}) {
4738             $query .= " AND allowmask=?";
4739             push(@vals, $opts{'allowmask'});
4740         }
4741     }
4742
4743     if ($opts{posterid}){
4744         $query .= " AND posterid = ? ";
4745         push @vals => $opts{posterid};
4746     }
4747     if ($opts{afterid}){
4748         $query .= " AND jitemid > ? ";
4749         push @vals => $opts{afterid};
4750     }
4751
4752     # filter by date, use revttime as it is indexed
4753     if ($opts{'start_date'} && $opts{'end_date'}) {
4754         # revttime is reverse event time
4755         my $s_date = $LJ::EndOfTime - $opts{'start_date'};
4756         my $e_date = $LJ::EndOfTime - $opts{'end_date'};
4757         $query .= " AND revttime<?";
4758         push(@vals, $s_date);
4759         $query .= " AND revttime>?";
4760         push(@vals, $e_date);
4761     }
4762
4763     # return count or jitemids
4764     if ($opts{'return'} eq 'count') {
4765         return $u->selectrow_array($query, undef, @vals);
4766     } else {
4767         my $jitemids = $u->selectcol_arrayref($query, undef, @vals) || [];
4768         die $u->errstr if $u->err;
4769         return @$jitemids;
4770     }
4771 }
4772
4773 sub password {
4774     my $u = shift;
4775     return unless $u->is_person;
4776     $u->{_password} ||= LJ::MemCache::get_or_set([$u->{userid}, "pw:$u->{userid}"], sub {
4777         my $dbh = LJ::get_db_writer() or die "Couldn't get db master";
4778         return $dbh->selectrow_array("SELECT password FROM password WHERE userid=?",
4779                                      undef, $u->id);
4780     });
4781     return $u->{_password};
4782 }
4783
4784 sub journaltype {
4785     my $u = shift;
4786     return $u->{journaltype};
4787 }
4788
4789 sub set_password {
4790     my ($u, $password) = @_;
4791     return LJ::set_password($u->id, $password);
4792 }
4793
4794 sub set_email {
4795     my ($u, $email) = @_;
4796     return LJ::set_email($u->id, $email);
4797 }
4798
4799 sub fb_push {
4800     my $u = shift;
4801     eval {
4802         if ($u) {
4803             require LJ::FBInterface;
4804             LJ::FBInterface->push_user_info( $u->id );
4805         }
4806     };
4807     warn "Error running fb_push: $@\n" if $@ && $LJ::IS_DEV_SERVER;
4808 }
4809
4810 sub grant_priv {
4811     my ($u, $priv, $arg) = @_;
4812     $arg ||= "";
4813     my $dbh = LJ::get_db_writer();
4814
4815     return 1 if LJ::check_priv($u, $priv, $arg);
4816
4817     my $privid = $dbh->selectrow_array("SELECT prlid FROM priv_list".
4818                                        " WHERE privcode = ?", undef, $priv);
4819     return 0 unless $privid;
4820
4821     $dbh->do("INSERT INTO priv_map (userid, prlid, arg) VALUES (?, ?, ?)",
4822              undef, $u->id, $privid, $arg);
4823     return 0 if $dbh->err;
4824
4825     undef $u->{'_privloaded'}; # to force reloading of privs later
4826     return 1;
4827 }
4828
4829 sub revoke_priv {
4830     my ($u, $priv, $arg) = @_;
4831     $arg ||="";
4832     my $dbh = LJ::get_db_writer();
4833
4834     return 1 unless LJ::check_priv($u, $priv, $arg);
4835
4836     my $privid = $dbh->selectrow_array("SELECT prlid FROM priv_list".
4837                                        " WHERE privcode = ?", undef, $priv);
4838     return 0 unless $privid;
4839
4840     $dbh->do("DELETE FROM priv_map WHERE userid = ? AND prlid = ? AND arg = ?",
4841              undef, $u->id, $privid, $arg);
4842     return 0 if $dbh->err;
4843
4844     undef $u->{'_privloaded'}; # to force reloading of privs later
4845     undef $u->{'_priv'};
4846     return 1;
4847 }
4848
4849 sub revoke_priv_all {
4850     my ($u, $priv) = @_;
4851     my $dbh = LJ::get_db_writer();
4852
4853     my $privid = $dbh->selectrow_array("SELECT prlid FROM priv_list".
4854                                        " WHERE privcode = ?", undef, $priv);
4855     return 0 unless $privid;
4856
4857     $dbh->do("DELETE FROM priv_map WHERE userid = ? AND prlid = ?",
4858              undef, $u->id, $privid);
4859     return 0 if $dbh->err;
4860
4861     undef $u->{'_privloaded'}; # to force reloading of privs later
4862     undef $u->{'_priv'};
4863     return 1;
4864 }
4865
4866 # must be called whenever birthday, location, journal modtime, journaltype, etc.
4867 # changes.  see LJ/Directory/PackedUserRecord.pm
4868 sub invalidate_directory_record {
4869     my $u = shift;
4870
4871     # Future: ?
4872     # LJ::try_our_best_to("invalidate_directory_record", $u->id);
4873     # then elsewhere, map that key to subref.  if primary run fails,
4874     # put in schwartz, then have one worker (misc-deferred) to
4875     # redo...
4876
4877     my $dbs = defined $LJ::USERSEARCH_DB_WRITER ? LJ::get_dbh($LJ::USERSEARCH_DB_WRITER) : LJ::get_db_writer();
4878     $dbs->do("UPDATE usersearch_packdata SET good_until=0 WHERE userid=?",
4879              undef, $u->id);
4880 }
4881
4882 # Used to promote communities in interest search results
4883 sub render_promo_of_community {
4884     my ($comm, $style) = @_;
4885
4886     return undef unless $comm;
4887
4888     $style ||= 'Vertical';
4889
4890     # get the ljuser link
4891     my $commljuser = $comm->ljuser_display;
4892
4893     # link to journal
4894     my $journal_base = $comm->journal_base;
4895
4896     # get default userpic if any
4897     my $userpic = $comm->userpic;
4898     my $userpic_html = '';
4899     if ($userpic) {
4900         my $userpic_url = $userpic->url;
4901         $userpic_html = qq { <a href="$journal_base"><img src="$userpic_url" /></a> };
4902     }
4903
4904     my $blurb = $comm->prop('comm_promo_blurb') || '';
4905
4906     my $join_link = "$LJ::SITEROOT/community/join.bml?comm=$comm->{user}";
4907     my $watch_link = "$LJ::SITEROOT/friends/add.bml?user=$comm->{user}";
4908     my $read_link = $comm->journal_base;
4909
4910     LJ::need_res("stc/lj_base.css");
4911
4912     # if horizontal, userpic needs to come before everything
4913     my $box_class;
4914     my $comm_display;
4915
4916     if (lc $style eq 'horizontal') {
4917         $box_class = 'Horizontal';
4918         $comm_display = qq {
4919             <div class="Userpic">$userpic_html</div>
4920             <div class="Title">Community Promo</div>
4921             <div class="CommLink">$commljuser</div>
4922         };
4923     } else {
4924         $box_class = 'Vertical';
4925         $comm_display = qq {
4926             <div class="Title">Community Promo</div>
4927             <div class="CommLink">$commljuser</div>
4928             <div class="Userpic">$userpic_html</div>
4929         };
4930     }
4931
4932
4933     my $html = qq {
4934         <div class="CommunityPromoBox">
4935             <div class="$box_class">
4936                 $comm_display
4937                 <div class="Blurb">$blurb</div>
4938                 <div class="Links"><a href="$join_link">Join</a> | <a href="$watch_link">Watch</a> |
4939                     <a href="$read_link">Read</a></div>
4940
4941                 <div class='ljclear'>&nbsp;</div>
4942             </div>
4943         </div>
4944     };
4945
4946     return $html;
4947 }
4948
4949 sub can_expunge {
4950     my $u = shift;
4951
4952     my $statusvisdate = $u->statusvisdate_unix;
4953
4954     # check admin flag "this journal must not be expunged for abuse team
4955     # investigation". hack: if flag is on, then set statusvisdate to now,
4956     # so that the next time worker bin/worker/expunge-users won't check
4957     # this user again.
4958     #
4959     # optimization concern: isn't it too much strain checking this prop
4960     # for every user? well, we've got to check this prop for every user
4961     # that seems eligible anyway, and moveucluster isn't supposed to send
4962     # us users who got too recent statusvisdate or something.
4963     if ($u->prop('dont_expunge_journal')) {
4964         LJ::update_user($u, { raw => 'statusvisdate=NOW()' });
4965         return 0;
4966     }
4967
4968     if ($u->is_deleted) {
4969         my $expunge_days =
4970             LJ::conf_test($LJ::DAYS_BEFORE_EXPUNGE) || 30;
4971
4972         return 0 unless $statusvisdate < time() - 86400 * $expunge_days;
4973
4974         return 1;
4975     }
4976
4977     if ($u->is_suspended) {
4978         return 0 if $LJ::DISABLED{'expunge_suspended'};
4979
4980         my $expunge_days =
4981             LJ::conf_test($LJ::DAYS_BEFORE_EXPUNGE_SUSPENDED) || 30;
4982
4983         return 0 unless $statusvisdate < time() - 86400 * $expunge_days;
4984
4985         return 1;
4986     }
4987
4988     return 0;
4989 }
4990
4991 # Check to see if the user can use eboxes at all
4992 sub can_use_ebox {
4993     my $u = shift;
4994
4995     return ref $LJ::DISABLED{ebox} ? !$LJ::DISABLED{ebox}->($u) : !$LJ::DISABLED{ebox};
4996 }
4997
4998 # Allow users to choose eboxes if:
4999 # 1. The entire ebox feature isn't disabled AND
5000 # 2. The option to choose eboxes isn't disabled OR
5001 # 3. The option to choose eboxes is disabled AND
5002 # 4. The user already has eboxes turned on
5003 sub can_use_ebox_ui {
5004     my $u = shift;
5005     my $allow_ebox = 1;
5006
5007     if ($LJ::DISABLED{ebox_option}) {
5008         $allow_ebox = $u->prop('journal_box_entries');
5009     }
5010
5011     return $u->can_use_ebox && $allow_ebox;
5012 }
5013
5014 # return hashref with intname => intid
5015 sub interests {
5016     my $u = shift;
5017     my $uints = LJ::get_interests($u);
5018     my %interests;
5019
5020     foreach my $int (@$uints) {
5021         $interests{$int->[1]} = $int->[0];  # $interests{name} = intid
5022     }
5023
5024     return \%interests;
5025 }
5026
5027 sub interest_list {
5028     my $u = shift;
5029
5030     return map { $_->[1] } @{ LJ::get_interests($u) };
5031 }
5032
5033 sub interest_count {
5034     my $u = shift;
5035
5036     # FIXME: fall back to SELECT COUNT(*) if not cached already?
5037     return scalar @{LJ::get_interests($u, { justids => 1 })};
5038 }
5039
5040 sub set_interests {
5041     my $u = shift;
5042     LJ::set_interests($u, @_);
5043 }
5044
5045 sub lazy_interests_cleanup {
5046     my $u = shift;
5047
5048     my $dbh = LJ::get_db_writer();
5049
5050     if ($u->is_community) {
5051         $dbh->do("INSERT IGNORE INTO comminterests SELECT * FROM userinterests WHERE userid=?", undef, $u->id);
5052         $dbh->do("DELETE FROM userinterests WHERE userid=?", undef, $u->id);
5053     } else {
5054         $dbh->do("INSERT IGNORE INTO userinterests SELECT * FROM comminterests WHERE userid=?", undef, $u->id);
5055         $dbh->do("DELETE FROM comminterests WHERE userid=?", undef, $u->id);
5056     }
5057
5058     LJ::memcache_kill($u, "intids");
5059     return 1;
5060 }
5061
5062 # this will return a hash of information about this user.
5063 # this is useful for JavaScript endpoints which need to dump
5064 # JSON data about users.
5065 sub info_for_js {
5066     my $u = shift;
5067
5068     my %ret = (
5069                username         => $u->user,
5070                display_username => $u->display_username,
5071                display_name     => $u->display_name,
5072                userid           => $u->userid,
5073                url_journal      => $u->journal_base,
5074                url_profile      => $u->profile_url,
5075                url_allpics      => $u->allpics_base,
5076                is_comm          => $u->is_comm,
5077                is_person        => $u->is_person,
5078                is_syndicated    => $u->is_syndicated,
5079                is_identity      => $u->is_identity,
5080                is_shared        => $u->is_shared,
5081                );
5082     # Without url_message "Send Message" link should not display
5083     $ret{url_message} = $u->message_url unless ($u->opt_usermsg eq 'N');
5084
5085     LJ::run_hook("extra_info_for_js", $u, \%ret);
5086
5087     my $up = $u->userpic;
5088
5089     if ($up) {
5090         $ret{url_userpic} = $up->url;
5091         $ret{userpic_w}   = $up->width;
5092         $ret{userpic_h}   = $up->height;
5093     }
5094
5095     return %ret;
5096 }
5097
5098 sub postreg_completed {
5099     my $u = shift;
5100
5101     return 0 unless $u->bio;
5102     return 0 unless $u->interest_count;
5103     return 1;
5104 }
5105
5106 # return if $target is banned from $u's journal
5107 *has_banned = \&is_banned;
5108 sub is_banned {
5109     my ($u, $target) = @_;
5110     return LJ::is_banned($target->userid, $u->userid);
5111 }
5112
5113 sub ban_user {
5114     my ($u, $ban_u) = @_;
5115
5116     my $remote = LJ::get_remote();
5117     LJ::User::UserlogRecord::BanSet->create( $u,
5118         'bannedid' => $ban_u->userid, 'remote' => $remote );
5119
5120     LJ::run_hooks('ban_set', $u, $ban_u);
5121
5122     $ban_u->clear_cache_friends($u);
5123
5124     return LJ::set_rel($u->id, $ban_u->id, 'B');
5125 }
5126
5127 sub ban_user_multi {
5128     my ($u, @banlist) = @_;
5129
5130     my $us = LJ::load_userids(@banlist);
5131     my $remote = LJ::get_remote();
5132
5133     foreach my $banuid (@banlist) {
5134
5135         next unless $us->{$banuid};
5136
5137         LJ::User::UserlogRecord::BanSet->create( $u,
5138             'bannedid' => $banuid, 'remote' => $remote );
5139
5140         LJ::run_hooks('ban_set', $u, $us->{$banuid}) if $us->{$banuid};
5141
5142         $us->{$banuid}->clear_cache_friends($u);
5143     }
5144
5145     LJ::set_rel_multi(map { [$u->id, $_, 'B'] } @banlist);
5146
5147     return 1;
5148 }
5149
5150 sub unban_user_multi {
5151     my ($u, @unbanlist) = @_;
5152
5153     my $us = LJ::load_userids(@unbanlist);
5154     my $remote = LJ::get_remote();
5155
5156     foreach my $banuid (@unbanlist) {
5157
5158         next unless $us->{$banuid};
5159
5160         LJ::User::UserlogRecord::BanUnset->create( $u,
5161             'bannedid' => $banuid, 'remote' => $remote );
5162
5163         LJ::run_hooks('ban_unset', $u, $us->{$banuid}) if $us->{$banuid};
5164
5165         $us->{$banuid}->clear_cache_friends($u);
5166
5167     }
5168
5169     LJ::clear_rel_multi(map { [$u->id, $_, 'B'] } @unbanlist);
5170
5171     return 1;
5172 }
5173
5174 # returns if this user's polls are clustered
5175 sub polls_clustered {
5176     my $u = shift;
5177     return $u->dversion >= 8;
5178 }
5179
5180 sub dversion {
5181     my $u = shift;
5182     return $u->{dversion};
5183 }
5184
5185 # take a user on dversion 7 and upgrade them to dversion 8 (clustered polls)
5186 sub upgrade_to_dversion_8 {
5187     my $u = shift;
5188     my $dbh = shift;
5189     my $dbhslo = shift;
5190     my $dbcm = shift;
5191
5192     # If user has been purged, go ahead and update version
5193     # Otherwise move their polls
5194     my $ok = $u->is_expunged ? 1 : LJ::Poll->make_polls_clustered($u, $dbh, $dbhslo, $dbcm);
5195
5196     LJ::update_user($u, { 'dversion' => 8 }) if $ok;
5197
5198     return $ok;
5199 }
5200
5201 # returns if this user can join an adult community or not
5202 # adultref will hold the value of the community's adult content flag
5203 sub can_join_adult_comm {
5204     my ($u, %opts) = @_;
5205
5206     return 1 unless LJ::is_enabled('content_flag');
5207
5208     my $adultref = $opts{adultref};
5209     my $comm = $opts{comm} or croak "No community passed";
5210
5211     my $adult_content = $comm->adult_content_calculated;
5212     $$adultref = $adult_content;
5213
5214     if ($adult_content eq "concepts" && ($u->is_child || !$u->best_guess_age) && $LJ::DISABLED{'remove_adult_concepts'}) {
5215         return 0;
5216     } elsif ($adult_content eq "explicit" && ($u->is_minor || !$u->best_guess_age)) {
5217         return 0;
5218     }
5219
5220     return 1;
5221 }
5222
5223
5224 sub is_in_beta {
5225     my ($u, $key) = @_;
5226     return LJ::BetaFeatures->user_in_beta( $u => $key );
5227 }
5228
5229 # return the user's timezone based on the prop if it's defined, otherwise best guess
5230 sub timezone {
5231     my $u = shift;
5232
5233     return $u->{'__timezone_offset'}
5234             if exists $u->{'__timezone_offset'};
5235
5236     my $offset = 0;
5237     LJ::get_timezone($u, \$offset);
5238
5239     $u->{'__timezone_offset'} = $offset;
5240     return $offset;
5241 }
5242
5243 # returns a DateTime object corresponding to a user's "now"
5244 sub time_now {
5245     my $u = shift;
5246
5247     my $now = DateTime->now;
5248
5249     # if user has timezone, use it!
5250     my $tz = $u->prop("timezone");
5251     return $now unless $tz;
5252
5253     $now = eval { DateTime->from_epoch(
5254                                        epoch => time(),
5255                                        time_zone => $tz,
5256                                        );
5257               };
5258
5259     return $now;
5260 }
5261
5262 sub can_admin_content_flagging {
5263     my $u = shift;
5264
5265     return 0 unless LJ::is_enabled("content_flag");
5266     return 1 if $LJ::IS_DEV_SERVER;
5267     return LJ::check_priv($u, "siteadmin", "contentflag");
5268 }
5269
5270 sub can_see_content_flag_button {
5271     my $u = shift;
5272     my %opts = @_;
5273
5274     return 0 unless LJ::is_enabled("content_flag");
5275
5276     my $content = $opts{content};
5277
5278     # user can't flag any journal they manage nor any entry they posted
5279     # user also can't flag non-public entries
5280     if (LJ::isu($content)) {
5281         return 0 if $u->can_manage($content);
5282     } elsif ($content->isa("LJ::Entry")) {
5283         return 0 if $u->equals($content->poster);
5284         return 0 unless $content->security eq "public";
5285     }
5286
5287     # user can't flag anything if their account isn't at least one month old
5288     my $one_month = 60*60*24*30;
5289     return 0 unless time() - $u->timecreate >= $one_month;
5290
5291     return 1;
5292 }
5293
5294 sub can_flag_content {
5295     my $u = shift;
5296     my %opts = @_;
5297
5298     return 0 unless $u->can_see_content_flag_button(%opts);
5299     return 0 if LJ::sysban_check("contentflag", $u->user);
5300     return 0 unless $u->rate_check("ctflag", 1);
5301     return 1;
5302 }
5303
5304 # sometimes when the app throws errors, we want to display "nice"
5305 # text to end-users, while allowing admins to view the actual error message
5306 sub show_raw_errors {
5307     my $u = shift;
5308
5309     return 1 if $LJ::IS_DEV_SERVER;
5310
5311     return 1 if LJ::check_priv($u, "supporthelp");
5312     return 1 if LJ::check_priv($u, "supportviewscreened");
5313     return 1 if LJ::check_priv($u, "siteadmin");
5314
5315     return 0;
5316 }
5317
5318 # defined by the user
5319 # returns 'none', 'concepts' or 'explicit'
5320 sub adult_content {
5321     my $u = shift;
5322
5323     my $prop_value = $u->prop('adult_content');
5324
5325     return $prop_value ? $prop_value : "none";
5326 }
5327
5328 # defined by an admin
5329 sub admin_content_flag {
5330     my $u = shift;
5331
5332     return $u->prop('admin_content_flag');
5333 }
5334
5335 # uses both user- and admin-defined props to figure out the adult content level
5336 sub adult_content_calculated {
5337     my $u = shift;
5338
5339     $u->preload_props(qw/admin_content_flag adult_content/);
5340     return "explicit" if $u->admin_content_flag eq "explicit_adult";
5341     return $u->adult_content;
5342 }
5343
5344 sub show_graphic_previews {
5345     my $u = shift;
5346
5347     my $prop_value = $u->prop('show_graphic_previews');
5348
5349     my $hook_rv = LJ::run_hook("override_show_graphic_previews", $u, $prop_value);
5350     return $hook_rv if defined $hook_rv;
5351
5352     if (!$prop_value) {
5353         return "on";
5354     } elsif ($prop_value eq "explicit_on") {
5355         return "on";
5356     } elsif ($prop_value eq "explicit_off") {
5357         return "off";
5358     }
5359
5360     return "off";
5361 }
5362
5363 sub should_show_graphic_previews {
5364     my $u = shift;
5365
5366     return $u->show_graphic_previews eq "on" ? 1 : 0;
5367 }
5368
5369 # name: can_super_manage
5370 # des: Given a target user and determines that the user is an supermaintainer of community
5371 # returns: bool: true if supermaitainer, otherwise fail
5372 # args: u
5373 # des-u: user object or userid of community
5374 sub can_super_manage {
5375     my $remote  = shift;
5376     my $u       = LJ::want_user(shift);
5377
5378     return undef unless $remote && $u;
5379
5380     # is same user?
5381     return 1 if LJ::u_equals($u, $remote);
5382
5383     # do not allow suspended users manage other accounts
5384     return 0 if $remote->is_suspended;
5385
5386     # people/syn/rename accounts can only be managed by the one account
5387     return undef if $u->{journaltype} =~ /^[PYR]$/;
5388
5389     # check for supermaintainer access
5390     return 1 if LJ::RelationService->is_relation_to($u, $remote, 'S');
5391
5392     # not passed checks, return false
5393     return undef;
5394 }
5395
5396 # name: can_moderate
5397 # des: Given a target user and determines that the user is an moderator for the target user
5398 # returns: bool: true if authorized, otherwise fail
5399 # args: u
5400 # des-u: user object or userid of target user
5401 sub can_moderate {
5402     my $remote  = shift;
5403     my $u       = LJ::want_user(shift);
5404
5405     return undef unless $remote && $u;
5406
5407     # can moderate only community
5408     return undef unless $u->is_community;
5409
5410     # do not allow suspended users manage other accounts
5411     return 0 if $remote->is_suspended;
5412
5413     # people/syn/rename accounts can only be managed by the one account
5414     return undef if $u->{journaltype} =~ /^[PYR]$/;
5415
5416     # check for moderate access
5417     return 1 if LJ::RelationService->is_relation_to($u, $remote, 'M');
5418
5419     # passed not checks, return false
5420     return undef;
5421 }
5422
5423 # name: can_manage
5424 # des: Given a target user and determines that the user is an admin for the taget  user
5425 # returns: bool: true if authorized, otherwise fail
5426 # args: u
5427 # des-u: user object or userid of target user
5428 sub can_manage {
5429     my $remote  = shift;
5430     my $u       = LJ::want_user(shift);
5431
5432     return undef unless $remote && $u;
5433
5434     # is same user?
5435     return 1 if LJ::u_equals($u, $remote);
5436
5437     # people/syn/rename accounts can only be managed by the one account
5438     return undef if $u->{journaltype} =~ /^[PYR]$/;
5439
5440     # do not allow suspended users manage other accounts
5441     return 0 if $remote->is_suspended;
5442
5443     # check for supermaintainer
5444     return 1 if $remote->can_super_manage($u);
5445
5446     return 0 unless LJ::RelationService->is_relation_to($u, $remote, 'A');
5447
5448     # passed checks, return true
5449     return 1;
5450 }
5451
5452 sub can_sweep {
5453     my $remote  = shift;
5454     my $u       = LJ::want_user(shift);
5455
5456     return undef unless $remote && $u;
5457
5458     # is same user?
5459     return 1 if LJ::u_equals($u, $remote);
5460
5461     # do not allow suspended users to be watchers of other accounts.
5462     return 0 if $remote->is_suspended;
5463
5464     # only personal journals can have watchers
5465     return undef unless $u->journaltype eq 'P';
5466
5467     # check for admin access
5468     return undef unless LJ::check_rel($u, $remote, 'W');
5469
5470     return 1;
5471 }
5472
5473 sub hide_adult_content {
5474     my $u = shift;
5475
5476     my $prop_value = $u->prop('hide_adult_content');
5477
5478     if (($u->is_child || !$u->best_guess_age) && $LJ::DISABLED{'remove_adult_concepts'}) {
5479         return "concepts";
5480     }
5481
5482     if ($u->is_minor && $prop_value ne "concepts") {
5483         return "explicit";
5484     }
5485
5486     return $prop_value ? $prop_value : "none";
5487 }
5488
5489 # returns a number that represents the user's chosen search filtering level
5490 # 0 = no filtering
5491 # 1-10 = moderate filtering
5492 # >10 = strict filtering
5493 sub safe_search {
5494     my $u = shift;
5495
5496     my $prop_value = $u->prop('safe_search');
5497
5498     # current user 18+ default is 0
5499     # current user <18 default is 10
5500     # new user default (prop value is "nu_default") is 10
5501     return 0 if $prop_value eq "none";
5502     return $prop_value if $prop_value && $prop_value =~ /^\d+$/;
5503     return 0 if $prop_value ne "nu_default" && $u->best_guess_age && !$u->is_minor;
5504     return 10;
5505 }
5506
5507 # determine if the user in "for_u" should see $u in a search result
5508 sub should_show_in_search_results {
5509     my $u = shift;
5510     my %opts = @_;
5511
5512     return 1 unless LJ::is_enabled("content_flag") && LJ::is_enabled("safe_search");
5513
5514     my $adult_content = $u->adult_content_calculated;
5515     my $admin_flag = $u->admin_content_flag;
5516
5517     my $for_u = $opts{for};
5518     unless (LJ::isu($for_u)) {
5519         return $adult_content ne "none" || $admin_flag ? 0 : 1;
5520     }
5521
5522     my $safe_search = $for_u->safe_search;
5523     return 1 if $safe_search == 0;
5524
5525     my $adult_content_flag_level = $LJ::CONTENT_FLAGS{$adult_content} ? $LJ::CONTENT_FLAGS{$adult_content}->{safe_search_level} : 0;
5526     my $admin_flag_level = $LJ::CONTENT_FLAGS{$admin_flag} ? $LJ::CONTENT_FLAGS{$admin_flag}->{safe_search_level} : 0;
5527
5528     return 0 if $adult_content_flag_level && ($safe_search >= $adult_content_flag_level);
5529     return 0 if $admin_flag_level && ($safe_search >= $admin_flag_level);
5530     return 1;
5531 }
5532
5533 sub equals {
5534     my ($u, $target) = @_;
5535
5536     return LJ::u_equals($u, $target);
5537 }
5538
5539 sub tags {
5540     my $u = shift;
5541
5542     return LJ::Tags::get_usertags($u);
5543 }
5544
5545 sub newpost_minsecurity {
5546     my $u = shift;
5547
5548     my $val = $u->raw_prop('newpost_minsecurity') || 'public';
5549
5550     $val = 'friends'
5551         if ($u->journaltype ne 'P' && $val eq 'private');
5552
5553     return $val;
5554 }
5555
5556 sub third_party_notify_list {
5557     my $u = shift;
5558
5559     my $val = $u->prop('third_party_notify_list');
5560     my @services = split(',', $val);
5561
5562     return @services;
5563 }
5564
5565 # Check if the user's notify list contains a particular service
5566 sub third_party_notify_list_contains {
5567     my $u = shift;
5568     my $val = shift;
5569
5570     return 1 if grep { $_ eq $val } $u->third_party_notify_list;
5571
5572     return 0;
5573 }
5574
5575 # Add a service to a user's notify list
5576 sub third_party_notify_list_add {
5577     my $u = shift;
5578     my $svc = shift;
5579     return 0 unless $svc;
5580
5581     # Is it already there?
5582     return 1 if $u->third_party_notify_list_contains($svc);
5583
5584     # Create the new list of services
5585     my @cur_services = $u->third_party_notify_list;
5586     push @cur_services, $svc;
5587     my $svc_list = join(',', @cur_services);
5588
5589     # Trim a service from the list if it is too long
5590     if (length $svc_list > 255) {
5591         shift @cur_services;
5592         $svc_list = join(',', @cur_services)
5593     }
5594
5595     # Set it
5596     $u->set_prop('third_party_notify_list', $svc_list);
5597     return 1;
5598 }
5599
5600 # Remove a service to a user's notify list
5601 sub third_party_notify_list_remove {
5602     my $u = shift;
5603     my $svc = shift;
5604     return 0 unless $svc;
5605
5606     # Is it even there?
5607     return 1 unless $u->third_party_notify_list_contains($svc);
5608
5609     # Remove it!
5610     $u->set_prop('third_party_notify_list',
5611                  join(',',
5612                       grep { $_ ne $svc } $u->third_party_notify_list
5613                       )
5614                  );
5615     return 1;
5616 }
5617
5618 # can $u add existing tags to $targetu's entries?
5619 sub can_add_tags_to {
5620     my ($u, $targetu) = @_;
5621
5622     return LJ::Tags::can_add_tags($targetu, $u);
5623 }
5624
5625 sub qct_value_for_ads {
5626     my $u = shift;
5627
5628     return 0 unless LJ::is_enabled("content_flag");
5629
5630     my $adult_content = $u->adult_content_calculated;
5631     my $admin_flag = $u->admin_content_flag;
5632
5633     if ($LJ::CONTENT_FLAGS{$adult_content} && $LJ::CONTENT_FLAGS{$adult_content}->{qct_value_for_ads}) {
5634         return $LJ::CONTENT_FLAGS{$adult_content}->{qct_value_for_ads};
5635     }
5636     if ($LJ::CONTENT_FLAGS{$admin_flag} && $LJ::CONTENT_FLAGS{$admin_flag}->{qct_value_for_ads}) {
5637         return $LJ::CONTENT_FLAGS{$admin_flag}->{qct_value_for_ads};
5638     }
5639
5640     return 0;
5641 }
5642
5643 sub should_block_robots {
5644     my $u = shift;
5645
5646     return 1 if $u->prop('opt_blockrobots');
5647
5648     return 0 unless LJ::is_enabled("content_flag");
5649
5650     my $adult_content = $u->adult_content_calculated;
5651     my $admin_flag = $u->admin_content_flag;
5652
5653     return 1 if $LJ::CONTENT_FLAGS{$adult_content} && $LJ::CONTENT_FLAGS{$adult_content}->{block_robots};
5654     return 1 if $LJ::CONTENT_FLAGS{$admin_flag} && $LJ::CONTENT_FLAGS{$admin_flag}->{block_robots};
5655     return 0;
5656 }
5657
5658 # memcache key that holds the number of times a user performed one of the rate-limited actions
5659 sub rate_memkey {
5660     my ($u, $rp) = @_;
5661
5662     return [$u->id, "rate:" . $u->id . ":$rp->{id}"];
5663 }
5664
5665 sub opt_exclude_from_verticals {
5666     my $u = shift;
5667
5668     my $prop_val = $u->prop('opt_exclude_from_verticals');
5669
5670     return $prop_val if $prop_val =~ /^(?:entries)$/;
5671     return "none";
5672 }
5673
5674 sub set_opt_exclude_from_verticals {
5675     my $u = shift;
5676     my $val = shift;
5677
5678     # only set the "none" value if the prop is currently set to something (explicit off)
5679     my $prop_val = $val ? "entries" : undef;
5680     $prop_val = "none" if !$val && $u->prop('opt_exclude_from_verticals');
5681
5682     $u->set_prop( opt_exclude_from_verticals => $prop_val );
5683
5684     return;
5685 }
5686
5687 # prepare OpenId part of html-page, if needed
5688 sub openid_tags {
5689     my $u = shift;
5690
5691     my $head = '';
5692
5693     # OpenID Server and Yadis
5694     if (LJ::OpenID->server_enabled and defined $u) {
5695         my $journalbase = $u->journal_base;
5696         $head .= qq{<link rel="openid2.provider" href="$LJ::OPENID_SERVER" />\n};
5697         $head .= qq{<link rel="openid.server" href="$LJ::OPENID_SERVER" />\n};
5698         $head .= qq{<meta http-equiv="X-XRDS-Location" content="$journalbase/data/yadis" />\n};
5699     }
5700
5701     return $head;
5702 }
5703
5704 # return the number of comments a user has posted
5705 sub num_comments_posted {
5706     my $u = shift;
5707
5708     my $ret = $u->prop('talkleftct2');
5709
5710     unless (defined $ret) {
5711         my $dbr = LJ::get_cluster_reader($u);
5712         $ret = $dbr->selectrow_array(qq{
5713             SELECT COUNT(*) FROM talkleft WHERE userid=?
5714         }, undef, $u->id);
5715
5716         $u->set_prop('talkleftct2' => $ret);
5717     }
5718
5719     return $ret;
5720 }
5721
5722 # increase the number of comments a user has posted by 1
5723 sub incr_num_comments_posted {
5724     my $u = shift;
5725
5726     $u->set_prop('talkleftct2' => $u->num_comments_posted + 1);
5727 }
5728
5729 # return the number of comments a user has received
5730 sub num_comments_received {
5731     my $u = shift;
5732     my %opts = @_;
5733
5734     my $userid = $u->id;
5735     my $memkey = [$userid, "talk2ct:$userid"];
5736     my $count = LJ::MemCache::get($memkey);
5737     unless ($count) {
5738         my $dbcr = $opts{dbh} || LJ::get_cluster_reader($u);
5739         my $expire = time() + 3600*24*2; # 2 days;
5740         $count = $dbcr->selectrow_array("SELECT COUNT(*) FROM talk2 ".
5741                                         "WHERE journalid=?", undef, $userid);
5742         LJ::MemCache::set($memkey, $count, $expire) if defined $count;
5743     }
5744
5745     return $count;
5746 }
5747
5748 # returns undef if there shouldn't be an option for this user
5749 # B = show ads [B]oth to logged-out traffic on the user's journal and on the user's app pages
5750 # J = show ads only to logged-out traffic on the user's [J]ournal
5751 # A = show ads only on the user's [A]pp pages
5752 sub ad_visibility {
5753     my $u = shift;
5754
5755     return undef unless LJ::is_enabled("basic_ads") && LJ::run_hook("user_is_basic", $u);
5756     return 'J' unless LJ::is_enabled("basic_ad_options") && $u->is_personal;
5757
5758     my $prop_val = $u->prop("ad_visibility");
5759     return $prop_val =~ /^[BJA]$/ ? $prop_val : 'B';
5760 }
5761
5762 sub wants_ads_on_app {
5763     my $u = shift;
5764
5765     my $ad_visibility = $u->ad_visibility;
5766     return $ad_visibility eq "B" || $ad_visibility eq "A" ? 1 : 0;
5767 }
5768
5769 sub wants_ads_in_journal {
5770     my $u = shift;
5771
5772     my $ad_visibility = $u->ad_visibility;
5773     return $ad_visibility eq "B" || $ad_visibility eq "J" ? 1 : 0;
5774 }
5775
5776 # format unixtimestamp according to the user's timezone setting
5777 sub format_time {
5778     my $u = shift;
5779     my $time = shift;
5780
5781     return undef unless $time;
5782
5783     return eval { DateTime->from_epoch(epoch=>$time, time_zone=>$u->prop("timezone"))->ymd('-') } ||
5784                   DateTime->from_epoch(epoch => $time)->ymd('-');
5785 }
5786
5787 sub support_points_count {
5788     my $u = shift;
5789
5790     my $dbr = LJ::get_db_reader();
5791     my $userid = $u->id;
5792     my $count;
5793
5794     $count = $u->{_supportpointsum};
5795     return $count if defined $count;
5796
5797     my $memkey = [$userid, "supportpointsum:$userid"];
5798     $count = LJ::MemCache::get($memkey);
5799     if (defined $count) {
5800         $u->{_supportpointsum} = $count;
5801         return $count;
5802     }
5803
5804     $count = $dbr->selectrow_array("SELECT totpoints FROM supportpointsum WHERE userid=?", undef, $userid) || 0;
5805     $u->{_supportpointsum} = $count;
5806     LJ::MemCache::set($memkey, $count, 60*5);
5807
5808     return $count;
5809 }
5810
5811 sub can_be_nudged_by {
5812     my ($u, $nudger) = @_;
5813
5814     return 0 unless LJ::is_enabled("nudge");
5815     return 0 if $u->equals($nudger);
5816     return 0 unless $u->is_personal;
5817     return 0 unless $u->is_visible;
5818     return 0 if $u->prop("opt_no_nudge");
5819     return 0 unless $u->is_mutual_friend($nudger);
5820     return 0 unless time() - $u->timeupdate >= 604800; # updated in the past week
5821
5822     return 1;
5823 }
5824
5825 sub should_show_schools_to {
5826     my ($u, $targetu) = @_;
5827
5828     return 0 unless LJ::is_enabled("schools");
5829     return 1 if $u->prop('opt_showschools') eq '' || $u->prop('opt_showschools') eq 'Y';
5830     return 1 if $u->prop('opt_showschools') eq 'F' && $u->has_friend($targetu);
5831
5832     return 0;
5833 }
5834
5835 sub can_be_text_messaged_by {
5836     my ($u, $sender) = @_;
5837
5838     return 0 unless $u->get_cap("textmessaging");
5839
5840     my $tminfo = LJ::TextMessage->tm_info($u);
5841
5842     ## messaging is disabled for some providers
5843     my $provider = $tminfo ? $tminfo->{provider} : '';
5844     return 0 if $provider eq 'beeline';
5845     return 0 if $provider eq 'megafon';
5846
5847     ##
5848     my $security = $tminfo && $tminfo->{security} ? $tminfo->{security} : "none";
5849     return 0 if $security eq "none";
5850     return 1 if $security eq "all";
5851
5852     if ($sender) {
5853         return 1 if $security eq "reg";
5854         return 1 if $security eq "friends" && $u->has_friend($sender);
5855     }
5856
5857     return 0;
5858 }
5859
5860 # <LJFUNC>
5861 # name: LJ::User::rename_identity
5862 # des: Change an identity user's 'identity', update DB,
5863 #      clear memcache and log change.
5864 # args: user
5865 # returns: Success or failure.
5866 # </LJFUNC>
5867 sub rename_identity {
5868     my $u = shift;
5869     return 0 unless ($u && $u->is_identity && $u->is_expunged);
5870
5871     my $id = $u->identity;
5872     return 0 unless $id;
5873
5874     my $dbh = LJ::get_db_writer();
5875
5876     # generate a new identity value that looks like ex_oldidvalue555
5877     my $tempid = sub {
5878         my $ident = shift;
5879         my $idtype = shift;
5880         my $temp = (length($ident) > 249) ? substr($ident, 0, 249) : $ident;
5881         my $exid;
5882
5883         for (1..10) {
5884             $exid = "ex_$temp" . int(rand(999));
5885
5886             # check to see if this identity already exists
5887             unless ($dbh->selectrow_array("SELECT COUNT(*) FROM identitymap WHERE identity=? AND idtype=? LIMIT 1", undef, $exid, $idtype)) {
5888                 # name doesn't already exist, use this one
5889                 last;
5890             }
5891             # name existed, try and get another
5892
5893             if ($_ >= 10) {
5894                 return 0;
5895             }
5896         }
5897         return $exid;
5898     };
5899
5900     my $from = $id->value;
5901     my $to = $tempid->($id->value, $id->typeid);
5902
5903     return 0 unless $to;
5904
5905     $dbh->do("UPDATE identitymap SET identity=? WHERE identity=? AND idtype=?",
5906              undef, $to, $from, $id->typeid);
5907
5908     LJ::memcache_kill($u, "userid");
5909
5910     LJ::User::InfoHistory->add( $u, 'identity', $from );
5911
5912     return 1;
5913 }
5914
5915 #<LJFUNC>
5916 # name: LJ::User::get_renamed_user
5917 # des: Get the actual user of a renamed user
5918 # args: user
5919 # returns: user
5920 # </LJFUNC>
5921 sub get_renamed_user {
5922     my $u = shift;
5923     my %opts = @_;
5924     my $hops = $opts{hops} || 5;
5925
5926     # Traverse the renames to the final journal
5927     if ($u) {
5928         while ($u and $u->journaltype eq 'R' and $hops-- > 0) {
5929             my $rt = $u->prop("renamedto");
5930             last unless length $rt;
5931             if ($rt =~ /^https?:\/\//){
5932                 if ( my $newu = LJ::User->new_from_url($rt) ) {
5933                     $u = $newu;
5934                 } else {
5935                     warn $u->username . " links to non-existent user at $rt";
5936                     return $u;
5937                 }
5938             } else {
5939                 if ( my $newu = LJ::load_user($rt) ) {
5940                     $u = $newu;
5941                 } else {
5942                     warn $u->username . " links to non-existent user at $rt";
5943                     return $u;
5944                 }
5945             }
5946         }
5947     }
5948
5949     return $u;
5950 }
5951
5952 sub dismissed_page_notices {
5953     my $u = shift;
5954
5955     my $val = $u->prop("dismissed_page_notices");
5956     my @notices = split(",", $val);
5957
5958     return @notices;
5959 }
5960
5961 sub has_dismissed_page_notice {
5962     my $u = shift;
5963     my $notice_string = shift;
5964
5965     return 1 if grep { $_ eq $notice_string } $u->dismissed_page_notices;
5966     return 0;
5967 }
5968
5969 # add a page notice to a user's dismissed page notices list
5970 sub dismissed_page_notices_add {
5971     my $u = shift;
5972     my $notice_string = shift;
5973     return 0 unless $notice_string && $LJ::VALID_PAGE_NOTICES{$notice_string};
5974
5975     # is it already there?
5976     return 1 if $u->has_dismissed_page_notice($notice_string);
5977
5978     # create the new list of dismissed page notices
5979     my @cur_notices = $u->dismissed_page_notices;
5980     push @cur_notices, $notice_string;
5981     my $cur_notices_string = join(",", @cur_notices);
5982
5983     # remove the oldest notice if the list is too long
5984     if (length $cur_notices_string > 255) {
5985         shift @cur_notices;
5986         $cur_notices_string = join(",", @cur_notices);
5987     }
5988
5989     # set it
5990     $u->set_prop("dismissed_page_notices", $cur_notices_string);
5991
5992     return 1;
5993 }
5994
5995 # remove a page notice from a user's dismissed page notices list
5996 sub dismissed_page_notices_remove {
5997     my $u = shift;
5998     my $notice_string = shift;
5999     return 0 unless $notice_string && $LJ::VALID_PAGE_NOTICES{$notice_string};
6000
6001     # is it even there?
6002     return 0 unless $u->has_dismissed_page_notice($notice_string);
6003
6004     # remove it
6005     $u->set_prop("dismissed_page_notices", join(",", grep { $_ ne $notice_string } $u->dismissed_page_notices));
6006
6007     return 1;
6008 }
6009
6010 sub custom_usericon {
6011     my ($u) = @_;
6012
6013     ## Get user's selected userhead
6014     my $selected_uh_id = 0;
6015     my $url = $u->prop('custom_usericon') || '';
6016     if (
6017            $url =~ /userhead/
6018         && $url !~ /v=\d+/
6019         && (my ($uh_id) = ($selected_uh_id) = $url =~ m/\/userhead\/(\d+)$/)
6020     ) {
6021         my $uh = LJ::UserHead->get_userhead ($uh_id);
6022         if ($uh) {
6023             my $uh_fs = LJ::FileStore->get_path_info ( path => "/userhead/".$uh->get_uh_id );
6024             $url .= "?v=".$uh_fs->{'change_time'} if $uh_fs->{'change_time'};
6025         }
6026     }
6027
6028     ## Check for individual userhead
6029     my $indiv_uh_id = 0;
6030     my $propval = $u->prop ('custom_usericon_individual');
6031     if ($propval) {
6032         ## If it buyed we need to check exp date
6033         my $individual_uh_info = LJ::JSON->from_json ($propval);
6034         if ($individual_uh_info->{'date_exp'} > time) {
6035             my ($uh_id) = ($indiv_uh_id) = $individual_uh_info->{'uh_id'} =~ m#uh-(\d+)#;
6036             my $uh = LJ::UserHead->get_userhead ($uh_id);
6037             if ($uh && $selected_uh_id == $indiv_uh_id) {
6038                 my $uh_fs = LJ::FileStore->get_path_info ( path => "/userhead/".$uh_id );
6039                 $url = $LJ::FILEPREFIX."/userhead/".$uh_id;
6040                 $url .= "?v=".$uh_fs->{'change_time'} if $uh_fs->{'change_time'};
6041             }
6042         } else {
6043             ## If indiv userhead was selected and date is expired, set userhead to default
6044             if ($selected_uh_id == $indiv_uh_id) {
6045                 $u->set_custom_usericon (undef);
6046             }
6047         }
6048     }
6049
6050     $url =~ s#^http://files\.livejournal\.com#$LJ::FILEPREFIX#;
6051
6052     return $url;
6053 }
6054
6055 sub custom_usericon_appid {
6056     my ($u) = @_;
6057     return $u->prop('custom_usericon_appid') || 0;
6058 }
6059
6060 sub set_custom_usericon {
6061     my ($u, $url, %opts) = @_;
6062
6063     $u->set_prop( 'custom_usericon' => $url );
6064
6065     if ($opts{application_id}) {
6066         $u->set_prop( 'custom_usericon_appid' => $opts{application_id});
6067     } else {
6068         $u->clear_prop( 'custom_usericon_appid' );
6069     }
6070 }
6071
6072 sub _subscriptions_count {
6073     my ($u) = @_;
6074
6075     my $set = LJ::Subscription::GroupSet->fetch_for_user($u, sub { 0 });
6076
6077     return $set->{'active_count'};
6078 }
6079
6080 sub subscriptions_count {
6081     my ($u) = @_;
6082
6083     my $cached = LJ::MemCache::get('subscriptions_count:'.$u->id);
6084     return $cached if defined $cached;
6085
6086     my $count = $u->_subscriptions_count;
6087     LJ::MemCache::set('subscriptions_count:'.$u->id, $count);
6088     return $count;
6089 }
6090
6091 sub packed_props {
6092     my ($u) = @_;
6093     return $u->{'packed_props'};
6094 }
6095
6096 sub set_packed_props {
6097     my ($u, $newprops) = @_;
6098
6099     LJ::update_user($u, { 'packed_props' => $newprops });
6100     $u->{'packed_props'} = 1;
6101 }
6102
6103 sub init_userprop_def {
6104     my ($class) = @_;
6105
6106     # defaults for S1 style IDs in config file are magic: really
6107     # uniq strings representing style IDs, so on first use, we need
6108     # to map them
6109     unless ($LJ::CACHED_S1IDMAP) {
6110         my $pubsty = LJ::S1::get_public_styles();
6111         foreach (values %$pubsty) {
6112             my $k = "s1_$_->{'type'}_style";
6113             my $needval = "$_->{'type'}/$_->{'styledes'}";
6114             next unless $LJ::USERPROP_DEF{$k} eq $needval;
6115
6116             $LJ::USERPROP_DEF{$k} = $_->{'styleid'};
6117         }
6118
6119         $LJ::CACHED_S1IDMAP = 1;
6120     }
6121 }
6122
6123 sub reset_cache {
6124     my $u = shift;
6125
6126     my $dbcm = LJ::get_cluster_master($u);
6127     return 0 unless $dbcm;
6128
6129     my @keys = qw(
6130         bio:*
6131         cctry_uid:*
6132         commsettings:*
6133         dayct:*
6134         fgrp:*
6135         friendofs:*
6136         friendofs2:*
6137         friends:*
6138         friends2:*
6139         ident:*
6140         inbox:newct:*
6141         intids:*
6142         invites:*
6143         jablastseen:*
6144         jabuser:*
6145         kws:*
6146         lastcomm:*
6147         linkobj:*
6148         log2ct:*
6149         log2lt:*
6150         logtag:*
6151         mcrate:*
6152         memct:*
6153         memkwcnt:*
6154         memkwid:*
6155         msn:mutual_friends_wlids:uid=*
6156         prtcfg:*
6157         pw:*
6158         rate:tracked:*
6159         rcntalk:*
6160         s1overr:*
6161         s1uc:*
6162         saui:*
6163         subscriptions_count:*
6164         supportpointsum:*
6165         synd:*
6166         tags2:*
6167         talk2ct:*
6168         talkleftct:*
6169         tc:*
6170         timeactive:*
6171         timezone_guess:*
6172         tu:*
6173         txtmsgsecurity:*
6174         uid2uniqs:*
6175         upiccom:*
6176         upicinf:*
6177         upicquota:*
6178         upicurl:*
6179         userid:*
6180     );
6181
6182     foreach my $key (@keys) {
6183         $key =~ s/\*/$u->{userid}/g;
6184         LJ::MemCacheProxy::delete([ $u->{userid}, $key ]);
6185     }
6186
6187     my $bio = $dbcm->selectrow_array('SELECT bio FROM userbio WHERE userid = ?', undef, $u->{userid});
6188     if ($bio =~ /\S/ && $u->{has_bio} ne 'Y') {
6189         LJ::update_user($u, { has_bio => 'Y' });
6190     }
6191
6192     $u->do("UPDATE s1usercache SET override_stor = NULL WHERE userid = ?", undef, $u->{userid});
6193
6194     my $dbh = LJ::get_db_writer();
6195     my $themeids = $dbh->selectcol_arrayref('SELECT moodthemeid FROM moodthemes WHERE ownerid = ?', undef, $u->{userid});
6196     if ($themeids && @$themeids) {
6197         foreach my $themeid (@$themeids) {
6198             LJ::MemCache::delete([ $themeid, "moodthemedata:$themeid" ]);
6199         }
6200     }
6201
6202     my $picids = $dbcm->selectcol_arrayref('SELECT picid FROM userpic2 WHERE userid = ?', undef, $u->{userid});
6203     if ($picids && @$picids) {
6204         foreach my $picid (@$picids) {
6205             LJ::MemCache::delete([ $picid, "mogp.up.$picid" ]);
6206             LJ::MemCache::delete([ $picid, "mogp.up.$picid.alt" ]); # alt-zone (only zone at this time)
6207         }
6208     }
6209
6210     my $s2ids = $dbh->selectcol_arrayref('SELECT styleid FROM s2styles WHERE userid = ?', undef, $u->{userid});
6211     if ($s2ids && @$s2ids) {
6212         foreach my $s2id (@$s2ids) {
6213             LJ::MemCache::delete([ $s2id, "s2s:$s2id" ]);
6214             LJ::MemCache::delete([ $s2id, "s2sl:$s2id" ]);
6215         }
6216     }
6217
6218     my $s2lids = $dbcm->selectcol_arrayref('SELECT s2lid FROM s2stylelayers2 WHERE userid = ?', undef, $u->{userid});
6219     if ($s2lids) {
6220         # put it in a hash to remove duplicates so we don't purge one layer twice
6221         my %s2lids = ( map { $_ => 1 } grep { $_ } @$s2lids );
6222         if (keys %s2lids) {
6223             foreach my $s2lid (keys %s2lids) {
6224                 LJ::MemCache::delete([ $s2lid, "s2lo:$s2lid" ]);
6225                 LJ::MemCache::delete([ $s2lid, "s2c:$s2lid" ]);
6226             }
6227         }
6228     }
6229
6230     return 1;
6231 }
6232
6233 ## Check for activity user at last N days
6234 ## args: days - how many days to check
6235 ## return:
6236 ##      1 - user logs in the last 'days' days
6237 ##      0 - user NOT logs in the last 'days' days
6238 sub check_activity {
6239     my $u    = shift;
6240     my $days = shift;
6241
6242     return 0 unless $days;
6243
6244     my $sth = $u->prepare ("SELECT logintime FROM loginlog WHERE userid=? ORDER BY logintime DESC");
6245     $sth->execute ($u->userid);
6246
6247     if (my @row = $sth->fetchrow_array) {
6248         my $logintime = $row[0];
6249         return 1 if time - $logintime < $days * 86400;
6250     }
6251
6252     return 0;
6253 }
6254
6255 sub is_in_whitelist_for_spam {
6256     my $u = shift;
6257     return $u->prop('in_whitelist_for_spam');
6258 }
6259
6260 sub is_spamprotection_enabled {
6261     my $u = shift;
6262     return 0 if $LJ::DISABLED{'spam_button'};
6263     my $spamprotection = $u->prop('spamprotection');
6264     return 0 if $spamprotection eq 'N';
6265     return 1;
6266 }
6267
6268 sub check_non_whitelist_enabled {
6269     my $u = shift;
6270     return 0 if $LJ::DISABLED{'spam_button'};
6271     return 0 unless $u->is_community;
6272     return 0 if $u->prop("moderated") eq 'N';
6273     my $check_non_whitelist = $u->prop('check_non_whitelist');
6274     return 1 if defined($check_non_whitelist) && $check_non_whitelist eq 'Y';
6275     return 0;
6276 }
6277
6278 # return sticky entries existing
6279 sub has_sticky_entry {
6280     my ($self) = @_;
6281     my $sticky_id  = $self->prop("sticky_entry_id");
6282     if ($sticky_id) {
6283         return 1;
6284     }
6285     return 0;
6286 }
6287
6288 # returns sticky entry jitemid
6289 sub get_sticky_entry_id {
6290     my ($self) = @_;
6291     return $self->prop("sticky_entry_id") || '';
6292 }
6293
6294 # returns sticky entry jitemid
6295 sub remove_sticky_entry_id {
6296     my ($self) = @_;
6297     my $ownerid = $self->userid;
6298     LJ::MemCache::delete([$ownerid, "log2lt:$ownerid"]);
6299     $self->clear_prop("sticky_entry_id");
6300 }
6301
6302 # set sticky entry?
6303 sub set_sticky_id {
6304     my ($self, $itemid) = @_;
6305     die "itemid is not set" unless ($itemid);
6306
6307     my $ownerid = $self->userid;
6308     LJ::MemCache::delete([$ownerid, "log2lt:$ownerid"]);
6309     $self->set_prop( sticky_entry_id => $itemid );
6310 }
6311
6312 # set socical influence  information
6313 sub set_social_influence {
6314     my ($self, $social_influence_infornation) = @_;
6315
6316     # update user cached 'social_influence_info'
6317     $self->{'__social_influence_info'} = $social_influence_infornation;
6318
6319     my $new_prop_value = LJ::JSON->to_json($social_influence_infornation) ;
6320     $self->set_prop( 'social_influence_info' => $new_prop_value);
6321 }
6322
6323 # get socical influence  information
6324 sub get_social_influence {
6325     my ($self) = @_;
6326
6327     # Does user contains cache?
6328     if ( !$self->{'__social_influence_info'} ) {
6329         my $prop_value = $self->prop("social_influence_info");
6330         if (!$prop_value) {
6331             return {};
6332         }
6333
6334         $self->{'__social_influence_info'} = LJ::JSON->from_json($prop_value);
6335     }
6336     return $self->{'__social_influence_info'};
6337 }
6338
6339 sub push_subscriptions {
6340     my $u    = shift;
6341     my %opts = @_;
6342
6343     $u->{push_subscriptions} = LJ::PushNotification::Storage->get_all($u)
6344         if !$u->{push_subscriptions} || $opts{flush};
6345
6346     return keys %{$u->{push_subscriptions}};
6347 }
6348
6349 sub push_subscription {
6350     my $u = shift;
6351     my $key = shift;
6352     return $u->{push_subscriptions}{$key} || {};
6353 }
6354
6355 sub disable_promo_announce {
6356     my $u = shift;
6357     $u->set_prop('promo_announce_disabled', 1);
6358 }
6359
6360 sub promo_announce_disabled {
6361     my $u = shift;
6362     return $u->prop('promo_announce_disabled') || 0;
6363 }
6364
6365 sub spam_counter {
6366     my $u = shift;
6367     return $u->prop('spam_counter') || 0;
6368 }
6369
6370 sub clear_spam_counter {
6371     my ($u) = @_;
6372     $u->set_prop('spam_counter', 0);
6373 }
6374
6375 # If true, user migrated old friends to friends and subscriptions
6376 sub is_migrated_to_friends_and_subscriptions {
6377     my ($u) = @_;
6378     return $u->prop('migrated_to_friends_and_subscriptions');
6379 }
6380
6381 package LJ;
6382
6383 use Carp;
6384
6385 # <LJFUNC>
6386 # name: LJ::get_authas_list
6387 # des: Get a list of usernames a given user can authenticate as.
6388 # returns: an array of usernames.
6389 # args: u, opts?
6390 # des-opts: Optional hashref.  keys are:
6391 #           - type: 'P' to only return users of journaltype 'P'.
6392 #                   'S' return users of Supermaintainer type instead Maintainer type.
6393 #           - cap:  cap to filter users on.
6394 # </LJFUNC>
6395 sub get_authas_list {
6396     my ($u, $opts) = @_;
6397
6398     return unless $u;
6399
6400     # used to accept a user type, now accept an opts hash
6401     $opts = { 'type' => $opts } unless ref $opts;
6402
6403     # Two valid types, Personal or Community
6404     $opts->{'type'} = undef unless $opts->{'type'} =~ m/^(P|C|S)$/;
6405
6406     my $ids = LJ::load_rel_target($u, 'S') || [];
6407     if ($opts->{'type'} ne 'S') {
6408         my $a_ids = LJ::load_rel_target($u, 'A') || [];
6409         push @$ids, @$a_ids;
6410     }
6411     return $u->{'user'} unless $ids && @$ids;
6412
6413     $opts->{'type'} = '' if $opts->{'type'} eq 'S';
6414
6415     # load_userids_multiple
6416     my %users;
6417     LJ::load_userids_multiple([ map { $_, \$users{$_} } @$ids ], [$u]);
6418
6419     return map { $_->{'user'} }
6420                grep { ! $opts->{'cap'} || LJ::get_cap($_, $opts->{'cap'}) }
6421                grep { ! $opts->{'type'} || $opts->{'type'} eq $_->{'journaltype'} }
6422
6423                # unless overridden, hide non-visible/non-read-only journals. always display the user's acct
6424                grep { $opts->{'showall'} || $_->is_visible || $_->is_readonly || LJ::u_equals($_, $u) }
6425
6426                # can't work as an expunged account
6427                grep { $_ && ref $_ eq 'LJ::User' && %$_ && !$_->is_expunged && $_->{clusterid} > 0 }
6428                $u,  sort { $a->{'user'} cmp $b->{'user'} } values %users;
6429 }
6430
6431 # <LJFUNC>
6432 # name: LJ::get_postto_list
6433 # des: Get the list of usernames a given user can post to.
6434 # returns: an array of usernames
6435 # args: u, opts?
6436 # des-opts: Optional hashref.  keys are:
6437 #           - type: 'P' to only return users of journaltype 'P'.
6438 #           - cap:  cap to filter users on.
6439 # </LJFUNC>
6440 sub get_postto_list {
6441     my ($u, $opts) = @_;
6442
6443     # used to accept a user type, now accept an opts hash
6444     $opts = { 'type' => $opts } unless ref $opts;
6445
6446     # only one valid type right now
6447     $opts->{'type'} = 'P' if $opts->{'type'};
6448
6449     my $ids = LJ::load_rel_target($u, 'P');
6450     return undef unless $ids;
6451
6452     # load_userids_multiple
6453     my %users;
6454     LJ::load_userids_multiple([ map { $_, \$users{$_} } @$ids ], [$u]);
6455
6456     return $u->{'user'}, sort map { $_->{'user'} }
6457                          grep { ! $opts->{'cap'} || LJ::get_cap($_, $opts->{'cap'}) }
6458                          grep { ! $opts->{'type'} || $opts->{'type'} eq $_->{'journaltype'} }
6459                          grep { $_->clusterid > 0 }
6460                          grep { $_->is_visible }
6461                          values %users;
6462 }
6463
6464 # <LJFUNC>
6465 # name: LJ::trusted
6466 # des: Checks to see if the remote user can use javascript in S2 layers.
6467 # returns: boolean; 1 if remote user can use javascript
6468 # args: userid
6469 # des-userid: id of user to check
6470 # </LJFUNC>
6471 sub trusted {
6472     my ($userid) = @_;
6473
6474     my $u = LJ::load_userid($userid);
6475     return 0 unless $u;
6476
6477     return $u->prop('javascript');
6478 }
6479
6480 # <LJFUNC>
6481 # name: LJ::can_view
6482 # des: Checks to see if the remote user can view a given journal entry.
6483 #      <b>Note:</b> This is meant for use on single entries at a time,
6484 #      not for calling many times on every entry in a journal.
6485 # returns: boolean; 1 if remote user can see item
6486 # args: remote, item
6487 # des-item: Hashref from the 'log' table.
6488 # </LJFUNC>
6489 sub can_view {
6490     my $remote = shift;
6491     my $item = shift;
6492
6493     # public is okay
6494     return 1 if $item->{'security'} eq "public";
6495
6496     # must be logged in otherwise
6497     return 0 unless $remote;
6498
6499     my $userid = int($item->{'ownerid'} || $item->{'journalid'});
6500     my $u = LJ::load_userid($userid);
6501     my $journal_name = $u ? $u->user : '';
6502     my $remoteid = int($remote->{'userid'});
6503
6504     # owners can always see their own.
6505     return 1 if $remote->can_manage($userid);
6506
6507     # author in community can always see their post
6508     return 1 if $remoteid == $item->{'posterid'} and not $LJ::JOURNALS_WITH_PROTECTED_CONTENT{ $journal_name };;
6509
6510     # other people can't read private
6511     return 0 if ($item->{'security'} eq "private");
6512
6513     # should be 'usemask' security from here out, otherwise
6514     # assume it's something new and return 0
6515     return 0 unless ($item->{'security'} eq "usemask");
6516
6517     # if it's usemask, we have to refuse non-personal journals,
6518     # so we have to load the user
6519     return 0 unless $remote->{'journaltype'} eq 'P' || $remote->{'journaltype'} eq 'I';
6520
6521     # TAG:FR:ljlib:can_view  (turn off bit 0 for just watching?  hmm.)
6522     my $gmask = LJ::get_groupmask($userid, $remoteid);
6523     my $allowed = (int($gmask) & int($item->{'allowmask'}));
6524     return $allowed ? 1 : 0;  # no need to return matching mask
6525 }
6526
6527 # <LJFUNC>
6528 # name: LJ::wipe_major_memcache
6529 # des: invalidate all major memcache items associated with a given user.
6530 # args: u
6531 # returns: nothing
6532 # </LJFUNC>
6533 sub wipe_major_memcache
6534 {
6535     my $u = shift;
6536     my $userid = LJ::want_userid($u);
6537     foreach my $key ("userid","bio","talk2ct","log2ct",
6538                      "log2lt","memkwid","s1overr","s1uc","fgrp",
6539                      "friends","friendofs","tu","upicinf","upiccom",
6540                      "upicurl", "intids", "memct", "lastcomm")
6541     {
6542         LJ::memcache_kill($userid, $key);
6543     }
6544 }
6545
6546 # <LJFUNC>
6547 # name: LJ::load_user_props
6548 # des: Given a user hashref, loads the values of the given named properties
6549 #      into that user hashref.
6550 # args: u, opts?, propname*
6551 # des-opts: hashref of opts.  set key 'cache' to use memcache.
6552 # des-propname: the name of a property from the [dbtable[userproplist]] table.
6553 # </LJFUNC>
6554 sub load_user_props {
6555     my ($u, @props) = @_;
6556     return unless ref $u;
6557
6558     my $opts = ref $props[0]? shift @props : {};
6559     unless ( delete $opts->{'reload'} ) {
6560         @props = grep { not exists $u->{$_} } @props;
6561     }
6562
6563     LJ::load_user_props_multi([$u], \@props, $opts);
6564 }
6565
6566 sub load_user_props_multi {
6567     my ($users, $props, $opts) = @_;
6568     my $use_master = $opts->{'use_master'};
6569
6570     $props = [grep { defined and not ref } @$props];
6571     return unless @$props;
6572
6573     $users = { map { $_->{'userid'} => $_ } grep { $_->{'statusvis'} ne 'X' and $_->{'clusterid'} } grep { ref } @$users };
6574     return unless %$users;
6575
6576     $LJ::COUNT_LOAD_PROPS_MULTI++;
6577
6578     my $groups = LJ::User::PropStorage->get_handler_multi(\@$props);
6579     my $memcache_available = @LJ::MEMCACHE_SERVERS;
6580     $use_master = $memcache_available || $use_master;
6581     my $memc_expire = time() + 3600 * 24;
6582
6583     LJ::User->init_userprop_def;
6584
6585     foreach my $handler (keys %$groups) {
6586         my %propkeys = map { $_ => $LJ::USERPROP_DEF{$_} || '' } @{ $groups->{$handler} };
6587
6588         # if there is no memcache, or if the handler doesn't wish to use
6589         # memcache, hit the storage directly, update the user object,
6590         # and get straight to the next handler
6591         if ( not $memcache_available or not defined $handler->use_memcache ) {
6592             foreach my $u (values %$users) {
6593                 my $propmap = {
6594                     %propkeys,
6595                     %{  $handler->get_props($u, $groups->{$handler},
6596                             {
6597                                 use_master => $use_master
6598                             }
6599                         ) || {}
6600                     },
6601                 };
6602
6603                 _extend_user_object->($u, $propmap);
6604             }
6605
6606             next;
6607         }
6608
6609         # now let's find out what we're going to do with memcache
6610         my $memcache_policy = $handler->use_memcache;
6611
6612         if ( $memcache_policy eq 'lite' ) {
6613             my %memkeys;
6614             my $propmaps = LJ::MemCacheProxy::get_multi(map {
6615                 [
6616                     ($_ => ($memkeys{$_} = $handler->memcache_key($users->{$_})))
6617                 ]
6618             } keys %$users);
6619
6620             my ($userid, $v);
6621             my $rmemkeys = { map { $memkeys{$_} => $_ } keys %memkeys };
6622
6623             while (($userid, $v) = each %$propmaps) {
6624                 next unless $v;
6625                 $userid = $rmemkeys->{$userid};
6626
6627                 delete $memkeys{$userid}; # Loading is successfull
6628
6629                 # Hack to init keys for empty props
6630                 my $packed = {
6631                     %propkeys,
6632                     %{ LJ::User::PropStorage->unpack_from_memcache($v) },
6633                 };
6634
6635                 _extend_user_object($users->{$userid}, $packed);
6636             }
6637
6638             while (($userid, $v) = each %memkeys) {
6639                 my $propmap = $handler->get_props(
6640                     $users->{$userid}, [],
6641                     { 'use_master' => $use_master }
6642                 );
6643
6644                 _extend_user_object($users->{$userid}, { %propkeys, %$propmap });
6645
6646                 my $packed = LJ::User::PropStorage->pack_for_memcache($propmap);
6647                 LJ::MemCache::set([$userid, $v], $packed, $memc_expire);
6648             }
6649         } elsif ( $memcache_policy eq 'blob' ) {
6650             my $handled_props = $groups->{$handler};
6651
6652             foreach my $u (values %$users) {
6653                 my $propmap_memc = $handler->fetch_props_memcache($u, $handled_props);
6654
6655                 _extend_user_object($u, { %propkeys, %$propmap_memc });
6656
6657                 my @load_from_db = grep { !exists $propmap_memc->{$_} }
6658                                    @$handled_props;
6659
6660                 # if we can avoid hitting the db, avoid it
6661                 next unless @load_from_db;
6662
6663                 my $propmap_db = $handler->get_props(
6664                     $u, \@load_from_db,
6665                     { 'use_master' => $use_master }
6666                 );
6667
6668                 _extend_user_object($u, $propmap_db);
6669
6670                 # now, update memcache
6671                 $handler->store_props_memcache( $u, $propmap_db );
6672             }
6673         }
6674     }
6675 }
6676
6677 sub _extend_user_object {
6678     my ($u, $propmap) = @_;
6679     return unless ref $u;
6680     return unless ref $propmap eq 'HASH';
6681     my ($k, $v);
6682
6683     $u->{$k} = $v while ($k, $v) = each %$propmap;
6684 }
6685
6686
6687 # <LJFUNC>
6688 # name: LJ::load_userids
6689 # des: Simple interface to [func[LJ::load_userids_multiple]].
6690 # args: userids
6691 # returns: hashref with keys ids, values $u refs.
6692 # </LJFUNC>
6693 sub load_userids {
6694     my %u;
6695     LJ::load_userids_multiple([ map { $_ => \$u{$_} } @_ ]);
6696     return \%u;
6697 }
6698
6699 # <LJFUNC>
6700 # name: LJ::load_userids_multiple
6701 # des: Loads a number of users at once, efficiently.
6702 # info: loads a few users at once, their userids given in the keys of $map
6703 #       listref (not hashref: can't have dups).  values of $map listref are
6704 #       scalar refs to put result in.  $have is an optional listref of user
6705 #       object caller already has, but is too lazy to sort by themselves.
6706 #       <strong>Note</strong>: The $have parameter is deprecated,
6707 #       as is $memcache_only; but it is still preserved for now.
6708 #       Really, this whole API (i.e. LJ::load_userids_multiple) is clumsy.
6709 #       Use [func[LJ::load_userids]] instead.
6710 # args: map, have, memcache_only?
6711 # des-map: Arrayref of pairs (userid, destination scalarref).
6712 # des-have: Arrayref of user objects caller already has.
6713 # des-memcache_only: Flag to only retrieve data from memcache.
6714 # returns: Nothing.
6715 # </LJFUNC>
6716 sub load_userids_multiple {
6717     # the $have parameter is deprecated, as is $memcache_only, but it's still preserved for now.
6718     # actually this whole API is crap.  use LJ::load_userids() instead.
6719     my ($map, undef, $memcache_only) = @_;
6720
6721     my $sth;
6722     my @have;
6723     my %need;
6724     while (@$map) {
6725         my $id = shift @$map;
6726         my $ref = shift @$map;
6727         next unless int($id);
6728         push @{$need{$id}}, $ref;
6729
6730         if ($LJ::REQ_CACHE_USER_ID{$id}) {
6731             push @have, $LJ::REQ_CACHE_USER_ID{$id};
6732         }
6733     }
6734
6735     my $satisfy = sub {
6736         my $u = shift;
6737         return unless ref $u eq "LJ::User";
6738
6739         # this could change the $u returned to an
6740         # existing one we already have loaded in memory,
6741         # once it's been upgraded.  then everybody points
6742         # to the same one.
6743         $u = _set_u_req_cache($u);
6744
6745         foreach (@{$need{$u->{'userid'}}}) {
6746             # check if existing target is defined and not what we already have.
6747             if (my $eu = $$_) {
6748                 LJ::assert_is($u->{userid}, $eu->{userid});
6749             }
6750             $$_ = $u;
6751         }
6752
6753         delete $need{$u->{'userid'}};
6754     };
6755
6756     unless ($LJ::_PRAGMA_FORCE_MASTER) {
6757         foreach my $u (@have) {
6758             $satisfy->($u);
6759         }
6760
6761         if (%need) {
6762             foreach (LJ::memcache_get_u(map { [$_,"userid:$_"] } keys %need)) {
6763                 $satisfy->($_);
6764             }
6765         }
6766     }
6767
6768     if (%need && ! $memcache_only) {
6769         my $db = @LJ::MEMCACHE_SERVERS || $LJ::_PRAGMA_FORCE_MASTER ?
6770             LJ::get_db_writer() : LJ::get_db_reader();
6771
6772         _load_user_raw($db, "userid", [ keys %need ], sub {
6773             my $u = shift;
6774             LJ::memcache_set_u($u);
6775             $satisfy->($u);
6776         });
6777     }
6778 }
6779
6780 # des-db:  $dbh/$dbr
6781 # des-key:  either "userid" or "user"  (the WHERE part)
6782 # des-vals: value or arrayref of values for key to match on
6783 # des-hook: optional code ref to run for each $u
6784 # returns: last $u found
6785 sub _load_user_raw
6786 {
6787     my ($db, $key, $vals, $hook) = @_;
6788     $hook ||= sub {};
6789     $vals = [ $vals ] unless ref $vals eq "ARRAY";
6790
6791     my $use_isam;
6792     unless ($LJ::CACHE_NO_ISAM{user} || scalar(@$vals) > 10) {
6793         eval { $db->do("HANDLER user OPEN"); };
6794         if ($@ || $db->err) {
6795             $LJ::CACHE_NO_ISAM{user} = 1;
6796         } else {
6797             $use_isam = 1;
6798         }
6799     }
6800
6801     my $last;
6802
6803     if ($use_isam) {
6804         $key = "PRIMARY" if $key eq "userid";
6805         foreach my $v (@$vals) {
6806             my $sth = $db->prepare("HANDLER user READ `$key` = (?) LIMIT 1");
6807             $sth->execute($v);
6808             my $row = $sth->fetchrow_hashref;
6809             if ($row) {
6810                 my $u = LJ::User->new_from_row($row);
6811                 $hook->($u);
6812                 $last = $u;
6813             }
6814         }
6815         $db->do("HANDLER user close");
6816     } else {
6817         my $in = join(", ", map { $db->quote($_) } @$vals);
6818         my $sth = $db->prepare("SELECT * FROM user WHERE $key IN ($in)");
6819         $sth->execute;
6820         while (my $row = $sth->fetchrow_hashref) {
6821             my $u = LJ::User->new_from_row($row);
6822             $hook->($u);
6823             $last = $u;
6824         }
6825     }
6826
6827     return $last;
6828 }
6829
6830 sub _set_u_req_cache {
6831     my $u = shift or die "no u to set";
6832
6833     # if we have an existing user singleton, upgrade it with
6834     # the latested data, but keep using its address
6835     if (my $eu = $LJ::REQ_CACHE_USER_ID{$u->{'userid'}}) {
6836         LJ::assert_is($eu->{userid}, $u->{userid});
6837
6838         $eu->{$_} = $u->{$_} foreach keys %$u;
6839         $u = $eu;
6840     }
6841     $LJ::REQ_CACHE_USER_NAME{$u->{'user'}} = $u;
6842     $LJ::REQ_CACHE_USER_ID{$u->{'userid'}} = $u;
6843     return $u;
6844 }
6845
6846 sub load_user_or_identity {
6847     my $arg = shift;
6848
6849     my $user = LJ::canonical_username($arg);
6850     return LJ::load_user($user) if $user;
6851
6852     # return undef if not dot in arg (can't be a URL)
6853     return undef unless $arg =~ /\./;
6854
6855     my $dbh = LJ::get_db_writer();
6856     my $url = lc($arg);
6857     $url = "http://$url" unless $url =~ m!^http://!;
6858     $url .= "/" unless $url =~ m!/$!;
6859     my $uid = $dbh->selectrow_array("SELECT userid FROM identitymap WHERE idtype=? AND identity=?",
6860                                     undef, 'O', $url);
6861     return LJ::load_userid($uid) if $uid;
6862     return undef;
6863 }
6864
6865 # load either a username, or a "I,<userid>" parameter.
6866 sub load_user_arg {
6867     my ($arg) = @_;
6868     my $user = LJ::canonical_username($arg);
6869     return LJ::load_user($user) if length $user;
6870     if ($arg =~ /^I,(\d+)$/) {
6871         my $u = LJ::load_userid($1);
6872         return $u if $u->is_identity;
6873     }
6874     return; # undef/()
6875 }
6876
6877 # <LJFUNC>
6878 # name: LJ::load_user
6879 # des: Loads a user record, from the [dbtable[user]] table, given a username.
6880 # args: user, force?
6881 # des-user: Username of user to load.
6882 # des-force: if set to true, won't return cached user object and will
6883 #            query a dbh.
6884 # returns: Hashref, with keys being columns of [dbtable[user]] table.
6885 # </LJFUNC>
6886 sub load_user {
6887     my ($user, $force) = @_;
6888
6889     $user = LJ::canonical_username($user);
6890     return undef unless length $user;
6891
6892     my $get_user = sub {
6893         my $use_dbh = shift;
6894         my $db = $use_dbh ? LJ::get_db_writer() : LJ::get_db_reader();
6895         my $u = _load_user_raw($db, "user", $user)
6896             or return undef;
6897
6898         # set caches since we got a u from the master
6899         LJ::memcache_set_u($u) if $use_dbh;
6900
6901         return _set_u_req_cache($u);
6902     };
6903
6904     # caller is forcing a master, return now
6905     return $get_user->("master") if $force || $LJ::_PRAGMA_FORCE_MASTER;
6906
6907     my $u;
6908
6909     # return process cache if we have one
6910     if ($u = $LJ::REQ_CACHE_USER_NAME{$user}) {
6911         return $u;
6912     }
6913
6914     # check memcache
6915     {
6916         my $uid;
6917         if (exists $LJ::PRELOADED_USER_IDS{$user} && !$LJ::IS_DEV_SERVER) {
6918             $uid = $LJ::PRELOADED_USER_IDS{$user};
6919         } else {
6920             $uid = LJ::MemCacheProxy::get("uidof:$user");
6921         }
6922
6923         $u = LJ::memcache_get_u([$uid, "userid:$uid"]) if $uid;
6924         return _set_u_req_cache($u) if $u;
6925     }
6926
6927     # try to load from master if using memcache, otherwise from slave
6928     $u = $get_user->(scalar @LJ::MEMCACHE_SERVERS);
6929     return $u if $u;
6930
6931     # setup LDAP handler if this is the first time
6932     if ($LJ::LDAP_HOST && ! $LJ::AUTH_EXISTS) {
6933         require LJ::LDAP;
6934         $LJ::AUTH_EXISTS = sub {
6935             my $user = shift;
6936             my $rec = LJ::LDAP::load_ldap_user($user);
6937             return $rec ? $rec : undef;
6938         };
6939     }
6940
6941     # if user doesn't exist in the LJ database, it's possible we're using
6942     # an external authentication source and we should create the account
6943     # implicitly.
6944     my $lu;
6945     if (ref $LJ::AUTH_EXISTS eq "CODE" && ($lu = $LJ::AUTH_EXISTS->($user)))
6946     {
6947         my $name = ref $lu eq "HASH" ? ($lu->{'nick'} || $lu->{name} || $user) : $user;
6948         if (LJ::create_account({
6949             'user' => $user,
6950             'name' => $name,
6951             'email' => ref $lu eq "HASH" ? $lu->email_raw : "",
6952             'password' => "",
6953         }))
6954         {
6955             # this should pull from the master, since it was _just_ created
6956             return $get_user->("master");
6957         }
6958     }
6959
6960     return undef;
6961 }
6962
6963 sub load_users {
6964     my @users = @_;
6965
6966     my %need = map {$_ => 1} @users;
6967
6968     ## skip loaded
6969     my %loaded;
6970
6971     foreach my $user ( @users ) {
6972         if (my $u = $LJ::REQ_CACHE_USER_NAME{$user}) {
6973             $loaded{$u->userid} = $u;
6974             delete $need{$u->userid};
6975         }
6976     }
6977
6978     ## username to userid and load
6979     my $us = LJ::load_userids( LJ::get_userid_multi( [keys %need] ) );
6980
6981     while ( my ($k, $v) = each %loaded ) {
6982         $us->{$k} = $v;
6983     }
6984
6985     return $us;
6986 }
6987
6988 # <LJFUNC>
6989 # name: LJ::u_equals
6990 # des: Compares two user objects to see if they are the same user.
6991 # args: userobj1, userobj2
6992 # des-userobj1: First user to compare.
6993 # des-userobj2: Second user to compare.
6994 # returns: Boolean, true if userobj1 and userobj2 are defined and have equal userids.
6995 # </LJFUNC>
6996 sub u_equals {
6997     my ($u1, $u2) = @_;
6998     return $u1 && $u2 && $u1->{'userid'} == $u2->{'userid'};
6999 }
7000
7001 # <LJFUNC>
7002 # name: LJ::load_userid
7003 # des: Loads a user record, from the [dbtable[user]] table, given a userid.
7004 # args: userid, force?
7005 # des-userid: Userid of user to load.
7006 # des-force: if set to true, won't return cached user object and will
7007 #            query a dbh
7008 # returns: Hashref with keys being columns of [dbtable[user]] table.
7009 # </LJFUNC>
7010 sub load_userid {
7011     my ($userid, $force) = @_;
7012     return undef unless $userid;
7013
7014     my $get_user = sub {
7015         my $use_dbh = shift;
7016         my $db = $use_dbh ? LJ::get_db_writer() : LJ::get_db_reader();
7017         my $u = _load_user_raw($db, "userid", $userid)
7018             or return undef;
7019
7020         LJ::memcache_set_u($u) if $use_dbh;
7021         return _set_u_req_cache($u);
7022     };
7023
7024     # user is forcing master, return now
7025     return $get_user->("master") if $force || $LJ::_PRAGMA_FORCE_MASTER;
7026
7027     my $u;
7028
7029     # check process cache
7030     $u = $LJ::REQ_CACHE_USER_ID{$userid};
7031     if ($u) {
7032         return $u;
7033     }
7034
7035     # check memcache
7036     $u = LJ::memcache_get_u([$userid,"userid:$userid"]);
7037     return _set_u_req_cache($u) if $u;
7038
7039     # get from master if using memcache
7040     return $get_user->("master") if @LJ::MEMCACHE_SERVERS;
7041
7042     # check slave
7043     $u = $get_user->();
7044     return $u if $u;
7045
7046     # if we didn't get a u from the reader, fall back to master
7047     return $get_user->("master");
7048 }
7049
7050 sub memcache_get_u
7051 {
7052     my @keys = @_;
7053     my @ret;
7054     my $users = LJ::MemCacheProxy::get_multi(@keys) || {};
7055     while (my ($key, $ar) = each %$users) {
7056         my $row = LJ::MemCache::array_to_hash("user", $ar, $key)
7057             or next;
7058         my $u = LJ::User->new_from_row($row);
7059         push @ret, $u;
7060     }
7061     return wantarray ? @ret : $ret[0];
7062 }
7063
7064 sub memcache_set_u
7065 {
7066     my $u = shift;
7067     return unless $u;
7068     my $expire = time() + 1800;
7069     my $ar = LJ::MemCache::hash_to_array("user", $u);
7070     return unless $ar;
7071     LJ::MemCacheProxy::set([$u->{'userid'}, "userid:$u->{'userid'}"], $ar, $expire);
7072     LJ::MemCacheProxy::set("uidof:$u->{user}", $u->{userid});
7073 }
7074
7075 # <LJFUNC>
7076 # name: LJ::get_bio
7077 # des: gets a user bio, from DB or memcache.
7078 # args: u, force
7079 # des-force: true to get data from cluster master.
7080 # returns: string
7081 # </LJFUNC>
7082 sub get_bio {
7083     my ($u, $force) = @_;
7084     return unless $u && $u->{'has_bio'} eq "Y";
7085
7086     my $bio;
7087
7088     my $memkey = [$u->{'userid'}, "bio:$u->{'userid'}"];
7089     unless ($force) {
7090         my $bio = LJ::MemCache::get($memkey);
7091         return $bio if defined $bio;
7092     }
7093
7094     # not in memcache, fall back to disk
7095     my $db = @LJ::MEMCACHE_SERVERS || $force ?
7096       LJ::get_cluster_def_reader($u) : LJ::get_cluster_reader($u);
7097     $bio = $db->selectrow_array("SELECT bio FROM userbio WHERE userid=?",
7098                                 undef, $u->{'userid'});
7099
7100     # set in memcache
7101     LJ::MemCache::add($memkey, $bio);
7102
7103     return $bio;
7104 }
7105
7106 # <LJFUNC>
7107 # name: LJ::journal_base
7108 # des: Returns URL of a user's journal.
7109 # info: The tricky thing is that users with underscores in their usernames
7110 #       can't have some_user.example.com as a hostname, so that's changed into
7111 #       some-user.example.com.
7112 # args: uuser, vhost?
7113 # des-uuser: LJ::User object, user hashref or username of user whose URL to make.
7114 # des-vhost: What type of URL.  Acceptable options: "users", to make a
7115 #            http://user.example.com/ URL; "tilde" for http://example.com/~user/;
7116 #            "community" for http://example.com/community/user; or the default
7117 #            will be http://example.com/users/user.  If unspecified and uuser
7118 #            is a user hashref, then the best/preferred vhost will be chosen.
7119 # returns: scalar; a URL.
7120 # </LJFUNC>
7121 sub journal_base
7122 {
7123     my ($user, $vhost) = @_;
7124
7125     return unless $user;
7126
7127     if (LJ::are_hooks("journal_base")) {
7128         ## We must pass a real LJ::User object into hook
7129         if (isu($user)) {
7130             ## $user is either LJ::User object or plain hash with 'userid' field
7131             if (!UNIVERSAL::isa($user, "LJ::User")) {
7132                 $user = LJ::load_userid($user->{userid});
7133             }
7134         } else {
7135             ## $user is plain username
7136             $user = LJ::load_user($user);
7137         }
7138
7139         return $user->{'journal_base'}
7140             if $user->{'journal_base'};
7141         my $hookurl = LJ::run_hook("journal_base", $user, $vhost);
7142         $user->{'journal_base'} = $hookurl if (isu($user) && $hookurl);
7143         return $hookurl if $hookurl;
7144     }
7145
7146     if (isu($user)) {
7147         my $u = $user;
7148         $user = $u->{'user'};
7149         unless (defined $vhost) {
7150             if ($LJ::FRONTPAGE_JOURNAL eq $user) {
7151                 $vhost = "front";
7152             } elsif ($u->{'journaltype'} eq "P") {
7153                 $vhost = "";
7154             }
7155
7156         }
7157     }
7158
7159     if ($vhost eq "users") {
7160         my $he_user = $user;
7161         $he_user =~ s/_/-/g;
7162         return "http://$he_user.$LJ::USER_DOMAIN";
7163     } elsif ($vhost eq "tilde") {
7164         return "$LJ::SITEROOT/~$user";
7165     } elsif ($vhost eq "community") {
7166         return "$LJ::SITEROOT/community/$user";
7167     } elsif ($vhost eq "front") {
7168         return $LJ::SITEROOT;
7169     } elsif ($vhost =~ /^other:(.+)/) {
7170         return "http://$1";
7171     } else {
7172         return "$LJ::SITEROOT/users/$user";
7173     }
7174 }
7175
7176
7177 # <LJFUNC>
7178 # name: LJ::load_user_privs
7179 # class:
7180 # des: loads all of the given privs for a given user into a hashref, inside
7181 #      the user record.  See also [func[LJ::check_priv]].
7182 # args: u, priv, arg?
7183 # des-priv: Priv names to load (see [dbtable[priv_list]]).
7184 # des-arg: Optional argument.  See also [func[LJ::check_priv]].
7185 # returns: boolean
7186 # </LJFUNC>
7187 sub load_user_privs {
7188     my $remote = shift;
7189     my @privs = @_;
7190     return unless $remote and @privs;
7191
7192     # return if we've already loaded these privs for this user.
7193     @privs = grep { ! $remote->{'_privloaded'}->{$_} } @privs;
7194     return unless @privs;
7195
7196     my $dbr = LJ::get_db_reader();
7197     return unless $dbr;
7198     foreach (@privs) { $remote->{'_privloaded'}->{$_}++; }
7199     @privs = map { $dbr->quote($_) } @privs;
7200     my $sth = $dbr->prepare("SELECT pl.privcode, pm.arg ".
7201                             "FROM priv_map pm, priv_list pl ".
7202                             "WHERE pm.prlid=pl.prlid AND ".
7203                             "pl.privcode IN (" . join(',',@privs) . ") ".
7204                             "AND pm.userid=$remote->{'userid'}");
7205     $sth->execute;
7206     while (my ($priv, $arg) = $sth->fetchrow_array) {
7207         unless (defined $arg) { $arg = ""; }  # NULL -> ""
7208         $remote->{'_priv'}->{$priv}->{$arg} = 1;
7209     }
7210 }
7211
7212 # <LJFUNC>
7213 # name: LJ::check_priv
7214 # des: Check to see if a user has a certain privilege.
7215 # info: Usually this is used to check the privs of a $remote user.
7216 #       See [func[LJ::get_remote]].  As such, a $u argument of undef
7217 #       is okay to pass: 0 will be returned, as an unknown user can't
7218 #       have any rights.
7219 # args: u, priv, arg?
7220 # des-priv: Priv name to check for (see [dbtable[priv_list]])
7221 # des-arg: Optional argument.  If defined, function only returns true
7222 #          when $remote has a priv of type $priv also with arg $arg, not
7223 #          just any priv of type $priv, which is the behavior without
7224 #          an $arg. Arg can be "*", for all args.
7225 # returns: boolean; true if user has privilege
7226 # </LJFUNC>
7227 sub check_priv {
7228     my ($u, $priv, $arg) = @_;
7229     return 0 unless $u;
7230
7231     LJ::run_hook ("update_counter", {
7232         counter => "check_priv",
7233     });
7234
7235     LJ::load_user_privs($u, $priv)
7236         unless $u->{'_privloaded'}->{$priv};
7237
7238     # no access if they don't have the priv
7239     return 0 unless defined $u->{'_priv'}->{$priv};
7240
7241     # at this point we know they have the priv
7242     return 1 unless defined $arg;
7243
7244     # check if they have the right arguments
7245     return 1 if defined $u->{'_priv'}->{$priv}->{$arg};
7246     return 1 if defined $u->{'_priv'}->{$priv}->{"*"};
7247
7248     # don't have the right argument
7249     return 0;
7250 }
7251
7252 #
7253 #
7254 # <LJFUNC>
7255 # name: LJ::users_by_priv
7256 # class:
7257 # des: Return users with a certain privilege.
7258 # args: priv, arg?
7259 # des-args: user privilege to searching. arg can be "*" for all args.
7260 # return: Userids or empty list.
7261 # TODO Add store to MemCache
7262 sub users_by_priv {
7263     my ($priv, $arg) = @_;
7264
7265     my $dbr = LJ::get_db_reader();
7266     return unless $dbr;
7267
7268     return unless $priv;
7269     $arg ||= '*';
7270     my $users = $dbr->selectcol_arrayref ("SELECT userid FROM priv_list pl, priv_map pm
7271                                            WHERE pl.prlid = pm.prlid
7272                                                 AND privcode = ?
7273                                                 AND arg = ?
7274                                         ", undef, $priv, $arg);
7275
7276     return unless ref $users eq 'ARRAY';
7277     return $users;
7278 }
7279
7280 #
7281 #
7282 # <LJFUNC>
7283 # name: LJ::remote_has_priv
7284 # des: Check to see if the given remote user has a certain privilege.
7285 # </LJFUNC>
7286 sub remote_has_priv {
7287     my $remote = shift;
7288     my $privcode = shift;     # required.  priv code to check for.
7289     my $ref = shift;  # optional, arrayref or hashref to populate
7290     return 0 unless ($remote);
7291
7292     ### authentication done.  time to authorize...
7293
7294     my $dbr = LJ::get_db_reader();
7295     my $sth = $dbr->prepare("SELECT pm.arg FROM priv_map pm, priv_list pl WHERE pm.prlid=pl.prlid AND pl.privcode=? AND pm.userid=?");
7296     $sth->execute($privcode, $remote->{'userid'});
7297
7298     my $match = 0;
7299     if (ref $ref eq "ARRAY") { @$ref = (); }
7300     if (ref $ref eq "HASH") { %$ref = (); }
7301     while (my ($arg) = $sth->fetchrow_array) {
7302         $match++;
7303         if (ref $ref eq "ARRAY") { push @$ref, $arg; }
7304         if (ref $ref eq "HASH") { $ref->{$arg} = 1; }
7305     }
7306     return $match;
7307 }
7308
7309 # $dom: 'L' == log, 'T' == talk, 'M' == modlog, 'S' == session,
7310 #       'R' == memory (remembrance), 'K' == keyword id,
7311 #       'P' == phone post, 'C' == pending comment
7312 #       'O' == pOrtal box id, 'V' == 'vgift', 'E' == ESN subscription id
7313 #       'Q' == Notification Inbox, 'G' == 'SMS messaGe'
7314 #       'D' == 'moDule embed contents', 'W' == 'Wish-list element'
7315 #       'F' == Photo ID, 'A' == Album ID, 'Y' == delaYed entries
7316 #       'I' == Fotki migration log ID, 'H' == pics tag id
7317 #
7318 # FIXME: both phonepost and vgift are ljcom.  need hooks. but then also
7319 #        need a separate namespace.  perhaps a separate function/table?
7320 sub alloc_user_counter
7321 {
7322     my ($u, $dom, $opts) = @_;
7323     $opts ||= {};
7324
7325     ##################################################################
7326     # IF YOU UPDATE THIS MAKE SURE YOU ADD INITIALIZATION CODE BELOW #
7327     return undef unless $dom =~ /^[LTMPSRKCOVEQGDWFAYIH]$/;             #
7328     ##################################################################
7329
7330     my $dbh = LJ::get_db_writer();
7331     return undef unless $dbh;
7332
7333     my $newmax;
7334     my $uid = $u->{'userid'}+0;
7335     return undef unless $uid;
7336     my $memkey = [$uid, "auc:$uid:$dom"];
7337
7338     # in a master-master DB cluster we need to be careful that in
7339     # an automatic failover case where one cluster is slightly behind
7340     # that the same counter ID isn't handed out twice.  use memcache
7341     # as a sanity check to record/check latest number handed out.
7342     my $memmax = int(LJ::MemCache::get($memkey) || 0);
7343
7344     my $rs = $dbh->do("UPDATE usercounter SET max=LAST_INSERT_ID(GREATEST(max,$memmax)+1) ".
7345                       "WHERE journalid=? AND area=?", undef, $uid, $dom);
7346     if ($rs > 0) {
7347         $newmax = $dbh->selectrow_array("SELECT LAST_INSERT_ID()");
7348
7349         # if we've got a supplied callback, lets check the counter
7350         # number for consistency.  If it fails our test, wipe
7351         # the counter row and start over, initializing a new one.
7352         # callbacks should return true to signal 'all is well.'
7353         if ($opts->{callback} && ref $opts->{callback} eq 'CODE') {
7354             my $rv = 0;
7355             eval { $rv = $opts->{callback}->($u, $newmax) };
7356             if ($@ or ! $rv) {
7357                 $dbh->do("DELETE FROM usercounter WHERE " .
7358                          "journalid=? AND area=?", undef, $uid, $dom);
7359                 return LJ::alloc_user_counter($u, $dom);
7360             }
7361         }
7362
7363         LJ::MemCache::set($memkey, $newmax);
7364         return $newmax;
7365     }
7366
7367     if ($opts->{recurse}) {
7368         # We shouldn't ever get here if all is right with the world.
7369         return undef;
7370     }
7371
7372     my $qry_map = {
7373         # for entries:
7374         'log'         => "SELECT MAX(jitemid) FROM log2     WHERE journalid=?",
7375         'logtext'     => "SELECT MAX(jitemid) FROM logtext2 WHERE journalid=?",
7376         'talk_nodeid' => "SELECT MAX(nodeid)  FROM talk2    WHERE nodetype='L' AND journalid=?",
7377         # for comments:
7378         'talk'     => "SELECT MAX(jtalkid) FROM talk2     WHERE journalid=?",
7379         'talktext' => "SELECT MAX(jtalkid) FROM talktext2 WHERE journalid=?",
7380     };
7381
7382     my $consider = sub {
7383         my @tables = @_;
7384         foreach my $t (@tables) {
7385             my $res = $u->selectrow_array($qry_map->{$t}, undef, $uid);
7386             $newmax = $res if $res > $newmax;
7387         }
7388     };
7389
7390     # Make sure the counter table is populated for this uid/dom.
7391     if ($dom eq "L") {
7392         # back in the ol' days IDs were reused (because of MyISAM)
7393         # so now we're extra careful not to reuse a number that has
7394         # foreign junk "attached".  turns out people like to delete
7395         # each entry by hand, but we do lazy deletes that are often
7396         # too lazy and a user can see old stuff come back alive
7397         $consider->("log", "logtext", "talk_nodeid");
7398     } elsif ($dom eq "T") {
7399         # just paranoia, not as bad as above.  don't think we've ever
7400         # run into cases of talktext without a talk, but who knows.
7401         # can't hurt.
7402         $consider->("talk", "talktext");
7403     } elsif ($dom eq "M") {
7404         $newmax = $u->selectrow_array("SELECT MAX(modid) FROM modlog WHERE journalid=?",
7405                                       undef, $uid);
7406     } elsif ($dom eq "S") {
7407         $newmax = $u->selectrow_array("SELECT MAX(sessid) FROM sessions WHERE userid=?",
7408                                       undef, $uid);
7409     } elsif ($dom eq "R") {
7410         $newmax = $u->selectrow_array("SELECT MAX(memid) FROM memorable2 WHERE userid=?",
7411                                       undef, $uid);
7412     } elsif ($dom eq "K") {
7413         $newmax = $u->selectrow_array("SELECT MAX(kwid) FROM userkeywords WHERE userid=?",
7414                                       undef, $uid);
7415     } elsif ($dom eq "P") {
7416         my $userblobmax = $u->selectrow_array("SELECT MAX(blobid) FROM userblob WHERE journalid=? AND domain=?",
7417                                               undef, $uid, LJ::get_blob_domainid("phonepost"));
7418         my $ppemax = $u->selectrow_array("SELECT MAX(blobid) FROM phonepostentry WHERE userid=?",
7419                                          undef, $uid);
7420         $newmax = ($ppemax > $userblobmax) ? $ppemax : $userblobmax;
7421     } elsif ($dom eq "C") {
7422         $newmax = $u->selectrow_array("SELECT MAX(pendcid) FROM pendcomments WHERE jid=?",
7423                                       undef, $uid);
7424     } elsif ($dom eq "O") {
7425         $newmax = $u->selectrow_array("SELECT MAX(pboxid) FROM portal_config WHERE userid=?",
7426                                       undef, $uid);
7427     } elsif ($dom eq "V") {
7428         $newmax = $u->selectrow_array("SELECT MAX(giftid) FROM vgifts WHERE userid=?",
7429                                       undef, $uid);
7430     } elsif ($dom eq "E") {
7431         $newmax = $u->selectrow_array("SELECT MAX(subid) FROM subs WHERE userid=?",
7432                                       undef, $uid);
7433     } elsif ($dom eq "Q") {
7434         $newmax = $u->selectrow_array("SELECT MAX(qid) FROM notifyqueue WHERE userid=?",
7435                                       undef, $uid);
7436     } elsif ($dom eq "G") {
7437         $newmax = $u->selectrow_array("SELECT MAX(msgid) FROM sms_msg WHERE userid=?",
7438                                       undef, $uid);
7439     } elsif ($dom eq "D") {
7440         $newmax = $u->selectrow_array("SELECT MAX(moduleid) FROM embedcontent WHERE userid=?",
7441                                       undef, $uid);
7442     } elsif ($dom eq "W") {
7443         $newmax = $u->selectrow_array("SELECT MAX(wishid) FROM wishlist2 WHERE userid=?",
7444                                       undef, $uid);
7445     } elsif ($dom eq "F") {
7446         $newmax = $u->selectrow_array("SELECT MAX(photo_id) FROM fotki_photos WHERE userid=?",
7447                                       undef, $uid);
7448     } elsif ($dom eq "A") {
7449         $newmax = $u->selectrow_array("SELECT MAX(album_id) FROM fotki_albums WHERE userid=?",
7450                                       undef, $uid);
7451     } elsif ($dom eq "Y") {
7452         $newmax = $u->selectrow_array("SELECT MAX(delayedid) FROM delayedlog2 WHERE journalid=?",
7453                                       undef, $uid);
7454     } elsif ( $dom eq 'I' ) {
7455         $newmax = $u->selectrow_array("SELECT MAX(logid) FROM fotki_migration_log WHERE userid=?",
7456                                       undef, $uid);
7457     } elsif ( $dom eq 'H' ) {
7458         $newmax = $u->selectrow_array("SELECT MAX(tag_id) FROM fotki_tags WHERE userid=?",
7459                                       undef, $uid);
7460     } else {
7461         die "No user counter initializer defined for area '$dom'.\n";
7462     }
7463     $newmax += 0;
7464     $dbh->do("INSERT IGNORE INTO usercounter (journalid, area, max) VALUES (?,?,?)",
7465              undef, $uid, $dom, $newmax) or return undef;
7466
7467     # The 2nd invocation of the alloc_user_counter sub should do the
7468     # intended incrementing.
7469     return LJ::alloc_user_counter($u, $dom, { recurse => 1 });
7470 }
7471
7472 # <LJFUNC>
7473 # name: LJ::make_user_active
7474 # des:  Record user activity per cluster, on [dbtable[clustertrack2]], to
7475 #       make per-activity cluster stats easier.
7476 # args: userid, type
7477 # des-userid: source userobj ref
7478 # des-type: currently unused
7479 # </LJFUNC>
7480 sub mark_user_active {
7481     my ($u, $type) = @_;  # not currently using type
7482     return 0 unless $u;   # do not auto-vivify $u
7483     my $uid = $u->{userid};
7484     return 0 unless $uid && $u->{clusterid};
7485
7486     # Update the clustertrack2 table, but not if we've done it for this
7487     # user in the last hour.  if no memcache servers are configured
7488     # we don't do the optimization and just always log the activity info
7489     if (@LJ::MEMCACHE_SERVERS == 0 ||
7490         LJ::MemCache::add("rate:tracked:$uid", 1, 3600)) {
7491
7492         return 0 unless $u->writer;
7493         $u->do("REPLACE INTO clustertrack2 SET ".
7494                "userid=?, timeactive=?, clusterid=?", undef,
7495                $uid, time(), $u->{clusterid}) or return 0;
7496     }
7497     return 1;
7498 }
7499
7500 # <LJFUNC>
7501 # name: LJ::get_shared_journals
7502 # des: Gets an array of shared journals a user has access to.
7503 # returns: An array of shared journals.
7504 # args: u
7505 # </LJFUNC>
7506 sub get_shared_journals
7507 {
7508     my $u = shift;
7509     my $ids = LJ::load_rel_target($u, 'A') || [];
7510
7511     # have to get usernames;
7512     my %users;
7513     LJ::load_userids_multiple([ map { $_, \$users{$_} } @$ids ], [$u]);
7514     return sort map { $_->{'user'} } values %users;
7515 }
7516
7517 ## my $text = LJ::ljuser_alias($u)
7518 ## returns note text (former 'alias') for current remote user
7519 sub ljuser_alias {
7520     my $user = shift;
7521
7522     return if $LJ::DISABLED{'aliases'};
7523
7524     my $remote = LJ::get_remote();
7525     return unless $remote;
7526     return unless $remote->get_cap('aliases');
7527
7528     my $u = LJ::load_user($user);
7529     return unless $u;
7530
7531     if (!$remote->{_aliases}) {
7532         my $prop_aliases = LJ::text_uncompress( $remote->prop('aliases') );
7533         $remote->{_aliases} = ($prop_aliases) ? LJ::JSON->from_json($prop_aliases) : {};
7534     }
7535     return $remote->{_aliases}->{ $u->{userid} };
7536 }
7537
7538 ##
7539 ## LJ::set_alias($u, $text, \$error)
7540 ## LJ::set_alias([ $u1, $text1, $u2, $text2], \$error);
7541 ##
7542 ## Sets notes (alias) text for user $u to the current $remote user
7543 ## $u is either user object or userid (number)
7544 ## If aliases cannot be updated, undef value is returned and optional \$error reference is set
7545 ## Use empty text for deleting alias
7546 ##
7547 sub set_alias {
7548     my $list = (ref $_[0] eq 'ARRAY') ? shift : [shift, shift];
7549     my $err = shift;
7550
7551     if ($LJ::DISABLED{'aliases'}) {
7552         $$err = "Notes (aliases) are disabled" if $err;
7553         return;
7554     }
7555
7556     my $remote = LJ::get_remote();
7557     unless ($remote) {
7558         $$err = "No remote user" if $err;
7559         return;
7560     }
7561     unless ($remote->get_cap('aliases')) {
7562         $$err = "Remote user can't manage notes (aliases)" if $err;
7563         return;
7564     }
7565
7566     ## load alias data
7567     if (!$remote->{_aliases}) {
7568         my $prop_aliases = LJ::text_uncompress( $remote->prop('aliases') );
7569         $remote->{_aliases} = $prop_aliases ? LJ::JSON->from_json($prop_aliases) : {};
7570     }
7571
7572     ## modify (edit, add or delete)
7573     for (my $i = 0; $i < @$list / 2; ++$i) {
7574         my $userid = $list->[$i * 2];
7575         my $alias  = $list->[$i * 2 + 1];
7576         $alias = substr($alias, 0, 400);
7577         $userid = $userid->{userid} if ref $userid;
7578         die "Numeric id is expected, not $userid" unless $userid =~ /^\d+$/;
7579
7580         if ($alias) {
7581             $remote->{_aliases}->{$userid} = $alias;
7582         } else {
7583             delete $remote->{_aliases}->{$userid};
7584         }
7585     }
7586
7587     ## save data back
7588     my $serialized_text = LJ::JSON->to_json($remote->{_aliases});
7589     $serialized_text = LJ::text_compress( $serialized_text ) unless $LJ::DISABLED{'aliases_compress'};
7590     if (length $serialized_text < 65536) {
7591         return $remote->set_prop( aliases => $serialized_text );
7592     } else {
7593         delete $remote->{_aliases}; ## drop unsuccessfully modified data
7594         $$err = BML::ml('widget.addalias.too.long') if $err;
7595         return 0;
7596     }
7597 }
7598
7599 ## my %all_aliases = LJ::get_all_aliases();
7600 ## Returns all aliases for current remote user as hash userid => alias
7601 sub get_all_aliases {
7602
7603     return if $LJ::DISABLED{'aliases'};
7604
7605     my $remote = shift || LJ::get_remote();
7606     return unless $remote and $remote->get_cap('aliases');
7607
7608     if (!$remote->{_aliases}) {
7609         my $prop_aliases = LJ::text_uncompress($remote->prop('aliases'));
7610         $remote->{_aliases} = ($prop_aliases) ? LJ::JSON->from_json($prop_aliases) : {};
7611     }
7612
7613     return %{$remote->{_aliases}};
7614 }
7615
7616 # <LJFUNC>
7617 # class: component
7618 # name: LJ::ljuser
7619 # des: Make link to userinfo/journal of user.
7620 # info: Returns the HTML for a userinfo/journal link pair for a given user
7621 #       name, just like LJUSER does in BML.  This is for files like cleanhtml.pl
7622 #       and ljpoll.pl which need this functionality too, but they aren't run as BML.
7623 # args: user, opts?
7624 # des-user: Username to link to, or user hashref.
7625 # des-opts: Optional hashref to control output.  Key 'full' when true causes
7626 #           a link to the mode=full userinfo.   Key 'type' when 'C' makes
7627 #           a community link, when 'Y' makes a syndicated account link,
7628 #           when 'I' makes an identity account link (e.g. OpenID),
7629 #           when 'N' makes a news account link, otherwise makes a user account
7630 #           link. If user parameter is a hashref, its 'journaltype' overrides
7631 #           this 'type'.  Key 'del', when true, makes a tag for a deleted user.
7632 #           If user parameter is a hashref, its 'statusvis' overrides 'del'.
7633 #           Key 'no_follow', when true, disables traversal of renamed users.
7634 # returns: HTML with a little head image & bold text link.
7635 # </LJFUNC>
7636
7637 my $ljuser_tmpl_path = join('/', $ENV{'LJHOME'}, 'templates', 'User');
7638 my $ljuser_cache     = {};
7639
7640 sub ljuser {
7641     my ($user, $opts) = @_;
7642     my ($u, $username, $journal_url, $striked);
7643     my ($journal_name, $journal, $userhead);
7644     my ($attrs, $color, $user_alias, %user);
7645     my $identity;
7646     my $profile_url;
7647
7648     if ( isu($user) ) {
7649         $u = $user;
7650         $username = $u->username;
7651     } else {
7652         $u = LJ::load_user($user);
7653         $username = $user;
7654     }
7655
7656     {
7657         if ( $u and LJ::isu($u) ) {
7658             # Traverse the renames to the final journal
7659             unless ( $opts->{'no_follow'} ) {
7660                 $u = $u->get_renamed_user;
7661                 $username = $u->username;
7662             }
7663
7664             last if $ljuser_cache->{$username};
7665
7666             # Mark accounts as deleted that aren't visible, memorial, locked, or
7667             # read-only
7668             if ( $u->statusvis !~ m![VMLO]! ) {
7669                $striked = 1;
7670             }
7671
7672             $journal_name = $username;
7673             $journal_url  = $u->journal_base . "/";
7674             ($userhead)   = $u->userhead($opts);
7675
7676             # Identity
7677             if ( $u->is_identity ) {
7678                 $identity  = $u->identity;
7679                 my $params = $identity ? $identity->ljuser_display_params($u, $opts) : {};
7680                 $profile_url  = $params->{'profile_url'}  || '';
7681                 $journal_url  = $params->{'journal_url'}  || $journal_url;
7682                 $journal_name = $params->{'journal_name'} || $journal_name;
7683             }
7684
7685             $profile_url  = $u->profile_url();
7686         } else {
7687             $username      = LJ::canonical_username($username);
7688
7689             last if $ljuser_cache->{$username};
7690
7691             $journal_url   = join('', $LJ::SITEROOT, '/userinfo.bml?user=', $username);
7692             $profile_url ||= $journal_url;
7693             $userhead      = 'userinfo.gif?v=17080';
7694         }
7695
7696         LJ::run_hooks( 'override_display_name', $u, \$journal_name );
7697         LJ::run_hooks( 'override_profile_url',  $u, \$profile_url );
7698         LJ::run_hooks( 'override_journal_url',  $u, \$journal_url );
7699     }
7700
7701     if ( $color = $opts->{'link_color'} ) {
7702         unless ( $color =~ /^#(?:[a-f0-9]{3}|[a-f0-9]{6})$/i ) {
7703             undef $color;
7704         }
7705     }
7706
7707     %user = %{ $ljuser_cache->{$username} ||= {
7708         attrs          => $attrs,
7709         bold           => 0,
7710         side_alias     => 0,
7711         inline_css     => 0,
7712         username       => $username,
7713         journal        => $journal_name,
7714         striked        => $striked,
7715         journal_url    => $journal_url,
7716         profile_url    => $profile_url,
7717         userhead_url   => $userhead,
7718         noctxpopup     => 0,
7719         is_identity    => $identity? 1 : 0,
7720     }};
7721
7722     $user{'noctxpopup'}   = 1                      if $opts->{'noctxpopup'};
7723     $user{'bold'}         = 1                      if $opts->{'bold'} or not exists $opts->{'bold'};
7724     $user{'inline_css'}   = 1                      if $opts->{'inline_css'};
7725     $user{'journal'}      = $opts->{'title'}       if $opts->{'title'};
7726     $user{'target'}       = $opts->{'target'}      if $opts->{'target'};
7727     $user{'profile_url'} .= '?mode=full'           if $opts->{'full'};
7728     $user{'profile_url'}  = $opts->{'profile_url'} if $opts->{'profile_url'};
7729     $user{'user_alias'}   = LJ::ehtml(LJ::ljuser_alias($username));
7730     $user{'alias'}        = $user{'user_alias'}?   1 : 0;
7731     $user{'color'}        = $color;
7732
7733     if ( $opts->{'side_alias'} and $user{'alias'} ) {
7734         $user{'side_alias'} = 1;
7735         $user{'alias'}      = 1;
7736     }
7737
7738     # Userhead
7739     unless ( $user{'userhead_url'} =~ m!^https?:\/\/! ) {
7740         $user{'userhead_url'} = join('',
7741             $opts->{'imgroot'} || $LJ::IMGPREFIX,
7742             '/', $user{'userhead_url'},
7743             '?v=', $LJ::CURRENT_VERSION
7744         );
7745     }
7746
7747     # FIXME: try to remove this
7748     if ( $opts->{'in_journal'} ) {
7749         my $cu = LJ::load_user($opts->{'in_journal'});
7750         if ( $cu ) {
7751             $user{'attrs'} = join('"', 'data-journal=', $cu->journal_base, '');
7752         }
7753     }
7754
7755     if ( $opts->{'raw'} ) {
7756         return \%user;
7757     } else {
7758         return LJ::Response::CachedTemplate->new(
7759             path   => $ljuser_tmpl_path,
7760             file   => 'Display.tmpl',
7761             params => \%user,
7762         )->raw_output();
7763     }
7764 }
7765
7766 sub set_email {
7767     my ($userid, $email) = @_;
7768
7769     my $dbh = LJ::get_db_writer();
7770     if ($LJ::DEBUG{'write_emails_to_user_table'}) {
7771         $dbh->do("UPDATE user SET email=? WHERE userid=?", undef,
7772                  $email, $userid);
7773     }
7774     $dbh->do("REPLACE INTO email (userid, email) VALUES (?, ?)",
7775              undef, $userid, $email);
7776
7777     # update caches
7778     LJ::memcache_kill($userid, "userid");
7779     LJ::MemCache::delete([$userid, "email:$userid"]);
7780     my $cache = $LJ::REQ_CACHE_USER_ID{$userid} or return;
7781     $cache->{'_email'} = $email;
7782 }
7783
7784 sub get_uids {
7785     my @friends_names = @_;
7786     my @ret;
7787     push @ret, grep { $_ } map { LJ::load_user($_) } @friends_names;
7788     return @ret;
7789 }
7790
7791 sub set_password {
7792     my ($userid, $password) = @_;
7793
7794     my $dbh = LJ::get_db_writer();
7795     if ($LJ::DEBUG{'write_passwords_to_user_table'}) {
7796         $dbh->do("UPDATE user SET password=? WHERE userid=?", undef,
7797                  $password, $userid);
7798     }
7799     $dbh->do("REPLACE INTO password (userid, password) VALUES (?, ?)",
7800              undef, $userid, $password);
7801
7802     # update caches
7803     LJ::memcache_kill($userid, "userid");
7804     LJ::MemCache::delete([$userid, "pw:$userid"]);
7805     my $cache = $LJ::REQ_CACHE_USER_ID{$userid} or return;
7806     $cache->{'_password'} = $password;
7807 }
7808
7809 sub update_user
7810 {
7811     my ($arg, $ref) = @_;
7812     my @uid;
7813
7814     if (ref $arg eq "ARRAY") {
7815         @uid = @$arg;
7816     } else {
7817         @uid = want_userid($arg);
7818     }
7819     @uid = grep { $_ } map { $_ + 0 } @uid;
7820     return 0 unless @uid;
7821
7822     my @sets;
7823     my @bindparams;
7824     my $used_raw = 0;
7825     while (my ($k, $v) = each %$ref) {
7826         if ($k eq "raw") {
7827             $used_raw = 1;
7828             push @sets, $v;
7829         } elsif ($k eq 'email') {
7830             set_email($_, $v) foreach @uid;
7831         } elsif ($k eq 'password') {
7832             set_password($_, $v) foreach @uid;
7833         } else {
7834             push @sets, "$k=?";
7835             push @bindparams, $v;
7836         }
7837     }
7838     return 1 unless @sets;
7839     my $dbh = LJ::get_db_writer();
7840     return 0 unless $dbh;
7841     {
7842         local $" = ",";
7843         my $where = @uid == 1 ? "userid=$uid[0]" : "userid IN (@uid)";
7844         $dbh->do("UPDATE user SET @sets WHERE $where", undef,
7845                  @bindparams);
7846         return 0 if $dbh->err;
7847     }
7848     if (@LJ::MEMCACHE_SERVERS) {
7849         LJ::memcache_kill($_, "userid") foreach @uid;
7850     }
7851
7852     if ($used_raw) {
7853         # for a load of userids from the master after update
7854         # so we pick up the values set via the 'raw' option
7855         require_master(sub { LJ::load_userids(@uid) });
7856     } else {
7857         foreach my $uid (@uid) {
7858             while (my ($k, $v) = each %$ref) {
7859                 my $cache = $LJ::REQ_CACHE_USER_ID{$uid} or next;
7860                 $cache->{$k} = $v;
7861             }
7862         }
7863     }
7864
7865     # log this updates
7866     LJ::run_hooks("update_user", userid => $_, fields => $ref)
7867         for @uid;
7868
7869     return 1;
7870 }
7871
7872 # <LJFUNC>
7873 # name: LJ::get_timezone
7874 # des: Gets the timezone offset for the user.
7875 # args: u, offsetref, fakedref
7876 # des-u: user object.
7877 # des-offsetref: reference to scalar to hold timezone offset;
7878 # des-fakedref: reference to scalar to hold whether this timezone was
7879 #               faked.  0 if it is the timezone specified by the user.
7880 # returns: nonzero if successful.
7881 # </LJFUNC>
7882 sub get_timezone {
7883     my ($u, $offsetref, $fakedref) = @_;
7884
7885     # See if the user specified their timezone
7886     if (my $tz = $u->prop('timezone')) {
7887         # If the eval fails, we'll fall through to guessing instead
7888         my $dt = eval {
7889             DateTime->from_epoch(
7890                                  epoch => time(),
7891                                  time_zone => $tz,
7892                                  );
7893         };
7894
7895         if ($dt) {
7896             $$offsetref = $dt->offset() / (60 * 60); # Convert from seconds to hours
7897             $$fakedref  = 0 if $fakedref;
7898
7899             return 1;
7900         }
7901     }
7902
7903     # Either the user hasn't set a timezone or we failed at
7904     # loading it.  We guess their current timezone's offset
7905     # by comparing the gmtime of their last post with the time
7906     # they specified on that post.
7907
7908     # first, check request cache
7909     my $timezone = $u->{_timezone_guess};
7910     if ($timezone) {
7911         $$offsetref = $timezone;
7912         return 1;
7913     }
7914
7915     # next, check memcache
7916     my $memkey = [$u->userid, 'timezone_guess:' . $u->userid];
7917     my $memcache_data = LJ::MemCacheProxy::get($memkey);
7918     if ($memcache_data) {
7919         # fill the request cache since it was empty
7920         $u->{_timezone_guess} = $memcache_data;
7921         $$offsetref = $memcache_data;
7922         return 1;
7923     }
7924
7925     # nothing in cache; check db
7926     my $dbcr = LJ::get_cluster_def_reader($u);
7927     return 0 unless $dbcr;
7928
7929     $$fakedref = 1 if $fakedref;
7930
7931     # grab the times on the last post that wasn't backdated.
7932     # (backdated is rlogtime == $LJ::EndOfTime)
7933     if (my $last_row = $dbcr->selectrow_hashref(
7934         qq{
7935             SELECT rlogtime, eventtime
7936             FROM log2
7937             WHERE journalid = ? AND rlogtime <> ?
7938             ORDER BY rlogtime LIMIT 1
7939         }, undef, $u->{userid}, $LJ::EndOfTime)) {
7940         my $logtime = $LJ::EndOfTime - $last_row->{'rlogtime'};
7941         my $eventtime = LJ::TimeUtil->mysqldate_to_time($last_row->{'eventtime'}, 1);
7942         my $hourdiff = ($eventtime - $logtime) / 3600;
7943
7944         # if they're up to a quarter hour behind, round up.
7945         $hourdiff = $hourdiff > 0 ? int($hourdiff + 0.25) : int($hourdiff - 0.25);
7946
7947         # if the offset is more than 24h in either direction, then the last
7948         # entry is probably unreliable. don't use any offset at all.
7949         $$offsetref = (-24 < $hourdiff && $hourdiff < 24) ? $hourdiff : 0;
7950
7951         # set the caches
7952         $u->{_timezone_guess} = $$offsetref;
7953         my $expire = 60*60*24; # 24 hours
7954         LJ::MemCacheProxy::set($memkey, $$offsetref, $expire);
7955     }
7956
7957     return 1;
7958 }
7959
7960 # returns undef on error, or otherwise arrayref of arrayrefs,
7961 # each of format [ year, month, day, count ] for all days with
7962 # non-zero count.  examples:
7963 #  [ [ 2003, 6, 5, 3 ], [ 2003, 6, 8, 4 ], ... ]
7964 #
7965 sub get_daycounts {
7966     my ( $u, $remote ) = @_;
7967
7968     # ['public'], ['all'], or [ 'gmask', $gmask ]
7969     my $kind;
7970     if ($remote) {
7971         my $viewall = 0;
7972         if ( LJ::is_web_context() && LJ::Request->get_param('viewall') &&
7973             LJ::check_priv( $remote, 'canview', '*' ) )
7974         {
7975             $viewall = 1;
7976             LJ::statushistory_add($u->{'userid'}, $remote->{'userid'},
7977                 "viewall", "calendar");
7978         }
7979
7980         if ( $remote->can_manage($u) ) {
7981             $kind = ['all'];
7982         } else {
7983             if ( my $gmask = LJ::get_groupmask($u, $remote) ) {
7984                 # friends case: allowmask == gmask == 1
7985                 $kind = [ 'gmask', $gmask ];
7986             } else {
7987                 $kind = ['public'];
7988             }
7989         }
7990     } else {
7991         $kind = ['public'];
7992     }
7993
7994     ##
7995     ## the first element of the array stored in memcache
7996     ## is the time of the creation of the list. The memcache is
7997     ## invalid if there are new entries in journal since that time.
7998     ##
7999     my $memkey = [ $u->userid, join( ':', 'dayct3', $u->userid, @$kind ) ];
8000     my $list = LJ::MemCache::get($memkey);
8001     if ($list) {
8002         my $list_create_time = shift @$list;
8003         return $list if $list_create_time >= $u->timeupdate;
8004     }
8005
8006     my $dbcr = LJ::get_cluster_def_reader($u) or return;
8007
8008     ## get lock to prevent multiple apache processes to execute the sql below.
8009     ## one process runs, the other wait for results
8010     my $release_lock = sub {
8011         $dbcr->do( 'SELECT RELEASE_LOCK(?)', undef, $memkey->[1] );
8012     };
8013
8014     my ($locked) = $dbcr->selectrow_array(
8015         'SELECT GET_LOCK(?,2)', undef, $memkey->[1] );
8016
8017     return [] unless $locked; ## 2 seconds expired
8018
8019     $list = LJ::MemCache::get($memkey);
8020     if ($list) {
8021         ## other process may have filled the data while we waited for the lock
8022         my $list_create_time = shift @$list;
8023         if ($list_create_time >= $u->timeupdate) {
8024             $release_lock->();
8025             return $list;
8026         }
8027     }
8028
8029     if ( LJ::is_enabled( 'dayct_month', $u ) ) {
8030         $release_lock->();
8031         my ( $min_year, $max_year ) = $dbcr->selectrow_array(
8032             'SELECT MIN(year), MAX(year) FROM log2 WHERE journalid=?',
8033             undef, $u->userid );
8034
8035         my $days = [];
8036
8037         foreach my $year ( $min_year .. $max_year ) {
8038             foreach my $month ( 1 .. 12 ) {
8039                 my $month_daycounts =
8040                     get_month_daycounts( $u, $kind, $year, $month );
8041                 push @$days, @$month_daycounts;
8042             }
8043         }
8044
8045         LJ::MemCache::set( $memkey, [ time, @$days ] );
8046         return $days;
8047     }
8048
8049     my ( $selecttype, $gmask ) = @$kind;
8050     my $secwhere;
8051     if ( $selecttype eq 'all' ) {
8052         $secwhere = '';
8053     } elsif ( $selecttype eq 'public' ) {
8054         $secwhere = 'AND security="public"';
8055     } elsif ( $selecttype eq 'gmask' ) {
8056         $secwhere = "AND ( security='public' OR " .
8057             "(security='usemask' AND allowmask & $gmask) )";
8058     }
8059
8060     my $sth = $dbcr->prepare("SELECT year, month, day, COUNT(*) ".
8061                              "FROM log2 WHERE journalid=? $secwhere " .
8062                              "GROUP BY year, month, day");
8063     $sth->execute( $u->userid );
8064     my $days = [];
8065     while ( my ( $y, $m, $d, $c ) = $sth->fetchrow_array ) {
8066         # we force each number from string scalars (from DBI) to int scalars,
8067         # so they store smaller in memcache
8068         push @$days, [ int($y), int($m), int($d), int($c) ];
8069     }
8070
8071     LJ::MemCache::set( $memkey, [time, @$days] );
8072
8073     $release_lock->();
8074     return $days;
8075 }
8076
8077 sub get_month_daycounts {
8078     my ( $u, $kind, $year, $month ) = @_;
8079
8080     my $memkind = join( ':', @$kind );
8081
8082     ##
8083     ## the first element of the array stored in memcache
8084     ## is the time of the creation of the list. The memcache is
8085     ## invalid if there are new entries in journal since that time.
8086     ##
8087     my $memkey_base =
8088         join( ':', 'dayct3', 'month', $year, $month, $u->userid, @$kind );
8089     my $memkey = [ $u->userid, $memkey_base ];
8090     my $memlockkey = [ $u->userid, $memkey_base . ':lock' ];
8091
8092     my $lock_acquired = 0;
8093
8094     my $lock = sub {
8095         return if $lock_acquired;
8096         $lock_acquired = 1;
8097
8098         return LJ::MemCache::add( $memlockkey, 1, 2 );
8099     };
8100
8101     my $unlock = sub {
8102         LJ::MemCache::delete($memlockkey);
8103         $lock_acquired = 0;
8104     };
8105
8106     my $list = LJ::MemCache::get($memkey);
8107     if ($list) {
8108         my $list_create_time = shift @$list;
8109         my $list_exptime     = shift @$list;
8110
8111         my $need_recalculate = 0;
8112
8113         my $timeupdate       = $u->timeupdate;
8114         my $timeupdate_year  = ( gmtime $timeupdate )[5] + 1900;
8115         my $timeupdate_month = ( gmtime $timeupdate )[4] + 1;
8116
8117         $need_recalculate = 1
8118             if $timeupdate_year == $year &&
8119             $timeupdate_month == $month &&
8120             $u->timeupdate > $list_create_time;
8121
8122         if ($need_recalculate) {
8123             $need_recalculate = 0 unless $lock->();
8124         }
8125
8126         return $list unless $need_recalculate;
8127     }
8128
8129     return [] unless $lock->();
8130
8131     my ( $selecttype, $gmask ) = @$kind;
8132     my $secwhere;
8133     if ( $selecttype eq 'all' ) {
8134         $secwhere = '';
8135     } elsif ( $selecttype eq 'public' ) {
8136         $secwhere = 'AND security="public"';
8137     } elsif ( $selecttype eq 'gmask' ) {
8138         $secwhere = "AND ( security='public' OR " .
8139             "(security='usemask' AND allowmask & $gmask) )";
8140     }
8141
8142     my $dbcr = LJ::get_cluster_def_reader($u);
8143
8144     my $sth = $dbcr->prepare("SELECT day, COUNT(*) ".
8145                              "FROM log2 WHERE journalid=? $secwhere AND " .
8146                              "year=? AND month=? " .
8147                              "GROUP BY day");
8148     $sth->execute( $u->userid, $year, $month );
8149     my $days = [];
8150     while ( my ( $d, $c ) = $sth->fetchrow_array ) {
8151         # we force each number from string scalars (from DBI) to int scalars,
8152         # so they store smaller in memcache
8153         push @$days, [ int($year), int($month), int($d), int($c) ];
8154     }
8155
8156     my $exptime = time + 3600 + int( rand(3600) );
8157     LJ::MemCache::set( $memkey, [ time, $exptime, @$days ] );
8158
8159     $unlock->();
8160     return $days;
8161 }
8162
8163 ## input: $u, $remote, $year, $month
8164 ## output: hashref with data for rendering calendar for given month,
8165 ##      days:       arrayref [ count of entries for each day]
8166 ##                  days[1] = count of entries for the 1st day, days[0] is always null
8167 ##      prev_month: arrayref [year, month] - previous month that has entries
8168 ##      next_month, prev_year, next_year - arrayref of the same format
8169 ##
8170 sub get_calendar_data_for_month {
8171     my ($u, $remote, $year, $month) = @_;
8172
8173     $remote ||= LJ::get_remote();
8174     unless ($year || $month) {
8175         ($month, $year) = (localtime)[4, 5];
8176         $year += 1900;
8177         $month++;
8178     }
8179
8180     my %ret = (journal => $u->user, year => $year, month => $month);
8181     my $days = LJ::get_daycounts($u, $remote);
8182     foreach my $d (@$days) {
8183         ## @$d = ($y, $m, $d, $count)
8184         if ($d->[0]==$year && $d->[1]==$month) {
8185             $ret{days}->[ $d->[2] ] = $d->[3]+0;
8186         }
8187     }
8188     ## $prev_month  = max(  grep { $day < Date($year, $month) }  @$days  );
8189     ## max @list    = List::Util::reduce {  ($a < $b) ? $b : $a } @list
8190     ## min @list    = List::Util::reduce { !($a < $b) ? $b : $a } @list
8191     my $current_month   = [$year, $month];
8192     my $less_year       = sub { my ($a, $b) = @_; return $a->[0]<$b->[0];  };
8193     my $less            = sub { my ($a, $b) = @_; return $a->[0]<$b->[0] || $a->[0]==$b->[0] && $a->[1]<$b->[1] };
8194     $ret{'prev_month'}  = List::Util::reduce {  $less->($a, $b) ? $b : $a } grep { $less->($_, $current_month) }        @$days;
8195     $ret{'next_month'}  = List::Util::reduce { !$less->($a, $b) ? $b : $a } grep { $less->($current_month, $_) }        @$days;
8196     $ret{'prev_year'}   = List::Util::reduce {  $less->($a, $b) ? $b : $a } grep { $less_year->($_, $current_month) }   @$days;
8197     $ret{'next_year'}   = List::Util::reduce { !$less->($a, $b) ? $b : $a } grep { $less_year->($current_month, $_) }   @$days;
8198     foreach my $k (qw/prev_month next_month prev_year next_year/) {
8199         if ($ret{$k}) {
8200             $ret{$k} = [ $ret{$k}->[0]+0, $ret{$k}->[1]+0];
8201         }
8202     }
8203
8204     return \%ret;
8205 }
8206
8207
8208 # <LJFUNC>
8209 # name: LJ::set_interests
8210 # des: Change a user's interests.
8211 # args: u, old, new
8212 # des-old: hashref of old interests (hashing being interest => intid)
8213 # des-new: listref of new interests
8214 # returns: 1 on success, undef on failure
8215 # </LJFUNC>
8216 sub set_interests {
8217     my ($u, $old, $new) = @_;
8218
8219     $u = LJ::want_user($u);
8220     my $userid = $u->{'userid'};
8221     return undef unless $userid;
8222
8223     return undef unless ref $old eq 'HASH';
8224     return undef unless ref $new eq 'ARRAY';
8225
8226     my $dbh = LJ::get_db_writer();
8227     my %int_new = ();
8228     my %int_del = %$old;  # assume deleting everything, unless in @$new
8229
8230     # user interests go in a different table than user interests,
8231     # though the schemas are the same so we can run the same queries on them
8232     my $uitable = $u->{'journaltype'} eq 'C' ? 'comminterests' : 'userinterests';
8233
8234     # track if we made changes to refresh memcache later.
8235     my $did_mod = 0;
8236
8237     my @valid_ints = LJ::validate_interest_list(@$new);
8238     foreach my $int (@valid_ints)
8239     {
8240         $int_new{$int} = 1 unless $old->{$int};
8241         delete $int_del{$int};
8242     }
8243
8244     ### were interests removed?
8245     if (%int_del)
8246     {
8247         ## easy, we know their IDs, so delete them en masse
8248         my $intid_in = join(", ", values %int_del);
8249         $dbh->do("DELETE FROM $uitable WHERE userid=$userid AND intid IN ($intid_in)");
8250         $dbh->do("UPDATE interests SET intcount=intcount-1 WHERE intid IN ($intid_in) AND intcount > 0");
8251         $did_mod = 1;
8252     }
8253
8254     ### do we have new interests to add?
8255     my @new_intids = ();  ## existing IDs we'll add for this user
8256     if (%int_new)
8257     {
8258         $did_mod = 1;
8259
8260         ## difficult, have to find intids of interests, and create new ints for interests
8261         ## that nobody has ever entered before
8262         my $int_in = join(", ", map { $dbh->quote($_); } keys %int_new);
8263         my %int_exist;
8264
8265         ## find existing IDs
8266         my $sth = $dbh->prepare("SELECT interest, intid FROM interests WHERE interest IN ($int_in)");
8267         $sth->execute;
8268         while (my ($intr, $intid) = $sth->fetchrow_array) {
8269             push @new_intids, $intid;       # - we'll add this later.
8270             delete $int_new{$intr};         # - so we don't have to make a new intid for
8271                                             #   this next pass.
8272         }
8273
8274         if (@new_intids) {
8275             my $sql = "";
8276             foreach my $newid (@new_intids) {
8277                 if ($sql) { $sql .= ", "; }
8278                 else { $sql = "REPLACE INTO $uitable (userid, intid) VALUES "; }
8279                 $sql .= "($userid, $newid)";
8280             }
8281             $dbh->do($sql);
8282
8283             my $intid_in = join(", ", @new_intids);
8284             $dbh->do("UPDATE interests SET intcount=intcount+1 WHERE intid IN ($intid_in)");
8285         }
8286     }
8287
8288     ### do we STILL have interests to add?  (must make new intids)
8289     if (%int_new)
8290     {
8291         foreach my $int (keys %int_new)
8292         {
8293             my $intid;
8294             my $qint = $dbh->quote($int);
8295
8296             $dbh->do("INSERT INTO interests (intid, intcount, interest) ".
8297                      "VALUES (NULL, 1, $qint)");
8298             if ($dbh->err) {
8299                 # somebody beat us to creating it.  find its id.
8300                 $intid = $dbh->selectrow_array("SELECT intid FROM interests WHERE interest=$qint");
8301                 $dbh->do("UPDATE interests SET intcount=intcount+1 WHERE intid=$intid");
8302             } else {
8303                 # newly created
8304                 $intid = $dbh->{'mysql_insertid'};
8305             }
8306             if ($intid) {
8307                 ## now we can actually insert it into the userinterests table:
8308                 $dbh->do("INSERT INTO $uitable (userid, intid) ".
8309                          "VALUES ($userid, $intid)");
8310                 push @new_intids, $intid;
8311             }
8312         }
8313     }
8314     LJ::run_hooks("set_interests", $u, \%int_del, \@new_intids); # interest => intid
8315
8316     # do migrations to clean up userinterests vs comminterests conflicts
8317     $u->lazy_interests_cleanup;
8318
8319     LJ::memcache_kill($u, "intids") if $did_mod;
8320     $u->{_cache_interests} = undef if $did_mod;
8321
8322     return 1;
8323 }
8324
8325 sub validate_interest_list {
8326     my $interrors = ref $_[0] eq "ARRAY" ? shift : [];
8327     my @ints = @_;
8328
8329     my @valid_ints = ();
8330     foreach my $int (@ints) {
8331         $int = lc($int);       # FIXME: use utf8?
8332         $int =~ s/^i like //;  # *sigh*
8333         next unless $int;
8334
8335         # Specific interest failures
8336         my ($bytes,$chars) = LJ::text_length($int);
8337         my @words = split(/\s+/, $int);
8338         my $word_ct = scalar @words;
8339
8340         my $error_string = '';
8341         if ($int =~ /[\<\>]/) {
8342             $int = LJ::ehtml($int);
8343             $error_string .= '.invalid';
8344         } else {
8345             $error_string .= '.bytes' if $bytes > LJ::BMAX_INTEREST;
8346             $error_string .= '.chars' if $chars > LJ::CMAX_INTEREST;
8347             $error_string .= '.words' if $word_ct > 4;
8348         }
8349
8350         if ($error_string) {
8351             $error_string = "error.interest$error_string";
8352             push @$interrors, [ $error_string,
8353                                 { int => $int,
8354                                   bytes => $bytes,
8355                                   bytes_max => LJ::BMAX_INTEREST,
8356                                   chars => $chars,
8357                                   chars_max => LJ::CMAX_INTEREST,
8358                                   words => $word_ct,
8359                                   words_max => 4
8360                                 }
8361                               ];
8362             next;
8363         }
8364         push @valid_ints, $int;
8365     }
8366     return @valid_ints;
8367 }
8368 sub interest_string_to_list {
8369     my $intstr = shift;
8370
8371     $intstr =~ s/^\s+//;  # strip leading space
8372     $intstr =~ s/\s+$//;  # strip trailing space
8373     $intstr =~ s/\n/,/g;  # newlines become commas
8374     $intstr =~ s/\s+/ /g; # strip duplicate spaces from the interest
8375
8376     # final list is ,-sep
8377     return grep { length } split (/\s*,\s*/, $intstr);
8378 }
8379
8380 # $opts is optional, with keys:
8381 #    forceids => 1   : don't use memcache for loading the intids
8382 #    forceints => 1   : don't use memcache for loading the interest rows
8383 #    justids => 1 : return arrayref of intids only, not names/counts
8384 # returns otherwise an arrayref of interest rows, sorted by interest name
8385 sub get_interests
8386 {
8387     my ($u, $opts) = @_;
8388     $opts ||= {};
8389     return undef unless $u;
8390
8391     # first check request cache inside $u
8392     if (my $ints = $u->{_cache_interests}) {
8393         if ($opts->{justids}) {
8394             return [ map { $_->[0] } @$ints ];
8395         }
8396         return $ints;
8397     }
8398
8399     my $uid = $u->{userid};
8400     my $uitable = $u->{'journaltype'} eq 'C' ? 'comminterests' : 'userinterests';
8401
8402     # load the ids
8403     my $ids;
8404     my $mk_ids = [$uid, "intids:$uid"];
8405     $ids = LJ::MemCache::get($mk_ids) unless $opts->{'forceids'};
8406     unless ($ids && ref $ids eq "ARRAY") {
8407         $ids = [];
8408         my $dbh = LJ::get_db_writer();
8409         my $sth = $dbh->prepare("SELECT intid FROM $uitable WHERE userid=?");
8410         $sth->execute($uid);
8411         push @$ids, $_ while ($_) = $sth->fetchrow_array;
8412         LJ::MemCache::add($mk_ids, $ids);
8413     }
8414
8415     # FIXME: set a 'justids' $u cache key in this case, then only return that
8416     #        later if 'justids' is requested?  probably not worth it.
8417     return $ids if $opts->{'justids'};
8418
8419     # load interest rows
8420     my %need;
8421     $need{$_} = 1 foreach @$ids;
8422     my @ret;
8423
8424     unless ($opts->{'forceints'}) {
8425         if (my $mc = LJ::MemCache::get_multi(map { [$_, "introw:$_"] } @$ids)) {
8426             while (my ($k, $v) = each %$mc) {
8427                 next unless $k =~ /^introw:(\d+)/;
8428                 delete $need{$1};
8429                 push @ret, $v;
8430             }
8431         }
8432     }
8433
8434     if (%need) {
8435         my $ids = join(",", map { $_+0 } keys %need);
8436         my $dbr = LJ::get_db_reader();
8437         my $sth = $dbr->prepare("SELECT intid, interest, intcount FROM interests ".
8438                                 "WHERE intid IN ($ids)");
8439         $sth->execute;
8440         my $memc_store = 0;
8441         while (my ($intid, $int, $count) = $sth->fetchrow_array) {
8442             # minimize latency... only store 25 into memcache at a time
8443             # (too bad we don't have set_multi.... hmmmm)
8444             my $aref = [$intid, $int, $count];
8445             if ($memc_store++ < 25) {
8446                 # if the count is fairly high, keep item in memcache longer,
8447                 # since count's not so important.
8448                 my $expire = $count < 10 ? 3600*12 : 3600*48;
8449                 LJ::MemCache::add([$intid, "introw:$intid"], $aref, $expire);
8450             }
8451             push @ret, $aref;
8452         }
8453     }
8454
8455     @ret = sort { $a->[1] cmp $b->[1] } @ret;
8456     return $u->{_cache_interests} = \@ret;
8457 }
8458
8459 # <LJFUNC>
8460 # name: LJ::modify_caps
8461 # des: Given a list of caps to add and caps to remove, updates a user's caps.
8462 # args: uuid, cap_add, cap_del, res
8463 # des-cap_add: arrayref of bit numbers to turn on
8464 # des-cap_del: arrayref of bit numbers to turn off
8465 # des-res: hashref returned from 'modify_caps' hook
8466 # returns: updated u object, retrieved from $dbh, then 'caps' key modified
8467 #          otherwise, returns 0 unless all hooks run properly.
8468 # </LJFUNC>
8469 sub modify_caps {
8470     my ($argu, $cap_add, $cap_del, $res) = @_;
8471     my $userid = LJ::want_userid($argu);
8472     return undef unless $userid;
8473
8474     $cap_add ||= [];
8475     $cap_del ||= [];
8476     my %cap_add_mod = ();
8477     my %cap_del_mod = ();
8478
8479     # convert capnames to bit numbers
8480     if (LJ::are_hooks("get_cap_bit")) {
8481         foreach my $bit (@$cap_add, @$cap_del) {
8482             next if $bit =~ /^\d+$/;
8483
8484             # bit is a magical reference into the array
8485             $bit = LJ::run_hook("get_cap_bit", $bit);
8486         }
8487     }
8488
8489     # get a u object directly from the db
8490     my $u = LJ::load_userid($userid, "force");
8491
8492     delete $u->{sup_enabled} if $u;
8493
8494     # add new caps
8495     my $newcaps = int($u->{'caps'});
8496     foreach (@$cap_add) {
8497         my $cap = 1 << $_;
8498
8499         # about to turn bit on, is currently off?
8500         $cap_add_mod{$_} = 1 unless $newcaps & $cap;
8501         $newcaps |= $cap;
8502     }
8503
8504     # remove deleted caps
8505     foreach (@$cap_del) {
8506         my $cap = 1 << $_;
8507
8508         # about to turn bit off, is it currently on?
8509         $cap_del_mod{$_} = 1 if $newcaps & $cap;
8510         $newcaps &= ~$cap;
8511     }
8512
8513     # run hooks for modified bits
8514     if (LJ::are_hooks("modify_caps")) {
8515         my @res = LJ::run_hooks("modify_caps",
8516                             { 'u' => $u,
8517                               'newcaps' => $newcaps,
8518                               'oldcaps' => $u->{'caps'},
8519                               'cap_on_req'  => { map { $_ => 1 } @$cap_add },
8520                               'cap_off_req' => { map { $_ => 1 } @$cap_del },
8521                               'cap_on_mod'  => \%cap_add_mod,
8522                               'cap_off_mod' => \%cap_del_mod,
8523                           });
8524
8525         # hook should return a status code
8526         foreach my $status (@res) {
8527             return undef unless ref $status and defined $status->[0];
8528         }
8529     }
8530
8531     # update user row
8532     return 0 unless LJ::update_user($u, { 'caps' => $newcaps });
8533
8534     $u->{caps} = $newcaps;
8535     $argu->{caps} = $newcaps if ref $argu; # temp hack
8536
8537     LJ::run_hooks("props_changed", $u, {caps => $newcaps});
8538
8539     return $u;
8540 }
8541
8542 # returns 1 if action is permitted.  0 if above rate or fail.
8543 # action isn't logged on fail.
8544 #
8545 # opts keys:
8546 #   -- "limit_by_ip" => "1.2.3.4"  (when used for checking rate)
8547 #   --
8548 sub rate_log
8549 {
8550     my ($u, $ratename, $count, $opts) = @_;
8551     my $rateperiod = LJ::get_cap($u, "rateperiod-$ratename");
8552     return 1 unless $rateperiod;
8553
8554     return 0 unless $u->writer;
8555
8556     my $rp = LJ::get_prop("rate", $ratename);
8557     return 0 unless $rp;
8558     $opts->{'rp'} = $rp;
8559
8560     my $now = time();
8561     $opts->{'now'} = $now;
8562     my $udbr = LJ::get_cluster_reader($u);
8563     my $ip = $udbr->quote($opts->{'limit_by_ip'} || "0.0.0.0");
8564     $opts->{'ip'} = $ip;
8565     return 0 unless LJ::rate_check($u, $ratename, $count, $opts);
8566
8567     # log current
8568     $count = $count + 0;
8569     $u->do("INSERT INTO ratelog (userid, rlid, evttime, ip, quantity) VALUES ".
8570            "($u->{'userid'}, $rp->{'id'}, $now, INET_ATON($ip), $count)");
8571
8572     # delete memcache, except in the case of rate limiting by ip
8573     unless ($opts->{limit_by_ip}) {
8574         LJ::MemCache::delete($u->rate_memkey($rp));
8575     }
8576
8577     return 1;
8578 }
8579
8580 # returns 1 if action is permitted.  0 if above rate or fail.
8581 sub rate_check {
8582     my ($u, $ratename, $count, $opts) = @_;
8583
8584     return 1 if grep { $_ eq $u->username } @LJ::NO_RATE_CHECK_USERS;
8585
8586     my $rateperiod = LJ::get_cap($u, "rateperiod-$ratename");
8587     return 1 unless $rateperiod;
8588
8589     my $rp = defined $opts->{'rp'} ? $opts->{'rp'}
8590              : LJ::get_prop("rate", $ratename);
8591     return 0 unless $rp;
8592
8593     my $now = defined $opts->{'now'} ? $opts->{'now'} : time();
8594     my $beforeperiod = $now - $rateperiod;
8595
8596     # check rate.  (okay per period)
8597     my $opp = LJ::get_cap($u, "rateallowed-$ratename");
8598     return 1 unless $opp;
8599
8600     # check memcache, except in the case of rate limiting by ip
8601     my $memkey = $u->rate_memkey($rp);
8602     unless ($opts->{limit_by_ip}) {
8603         my $attempts = LJ::MemCache::get($memkey);
8604         if ($attempts) {
8605             my $num_attempts = 0;
8606             foreach my $attempt (@$attempts) {
8607                 next if $attempt->{evttime} < $beforeperiod;
8608                 $num_attempts += $attempt->{quantity};
8609             }
8610
8611             return $num_attempts + $count > $opp ? 0 : 1;
8612         }
8613     }
8614
8615     return 0 unless $u->writer;
8616
8617     # delete inapplicable stuff (or some of it)
8618     $u->do("DELETE FROM ratelog WHERE userid=$u->{'userid'} AND rlid=$rp->{'id'} ".
8619            "AND evttime < $beforeperiod LIMIT 1000");
8620
8621     my $udbr = LJ::get_cluster_reader($u);
8622     my $ip = defined $opts->{'ip'}
8623              ? $opts->{'ip'}
8624              : $udbr->quote($opts->{'limit_by_ip'} || "0.0.0.0");
8625     my $sth = $udbr->prepare("SELECT evttime, quantity FROM ratelog WHERE ".
8626                              "userid=$u->{'userid'} AND rlid=$rp->{'id'} ".
8627                              "AND ip=INET_ATON($ip) ".
8628                              "AND evttime > $beforeperiod");
8629     $sth->execute;
8630
8631     my @memdata;
8632     my $sum = 0;
8633     while (my $data = $sth->fetchrow_hashref) {
8634         push @memdata, $data;
8635         $sum += $data->{quantity};
8636     }
8637
8638     # set memcache, except in the case of rate limiting by ip
8639     unless ($opts->{limit_by_ip}) {
8640         LJ::MemCache::set( $memkey => \@memdata || [] );
8641     }
8642
8643     # would this transaction go over the limit?
8644     if ($sum + $count > $opp) {
8645         # TODO: optionally log to rateabuse, unless caller is doing it themselves
8646         # somehow, like with the "loginstall" table.
8647         return 0;
8648     }
8649
8650     return 1;
8651 }
8652
8653
8654 sub login_ip_banned
8655 {
8656     my ($u, $ip) = @_;
8657     return 0 unless $u;
8658
8659     $ip ||= LJ::get_remote_ip();
8660     return 0 unless $ip;
8661
8662     my $udbr;
8663     my $rateperiod = LJ::get_cap($u, "rateperiod-failed_login");
8664     if ($rateperiod && ($udbr = LJ::get_cluster_reader($u))) {
8665         my $bantime = $udbr->selectrow_array("SELECT time FROM loginstall WHERE ".
8666                                              "userid=$u->{'userid'} AND ip=INET_ATON(?)",
8667                                              undef, $ip);
8668         if ($bantime && $bantime > time() - $rateperiod) {
8669             return 1;
8670         }
8671     }
8672     return 0;
8673 }
8674
8675 sub handle_bad_login
8676 {
8677     my ($u, $ip) = @_;
8678     return 1 unless $u;
8679
8680     $ip ||= LJ::get_remote_ip();
8681     return 1 unless $ip;
8682
8683     # an IP address is permitted such a rate of failures
8684     # until it's banned for a period of time.
8685     my $udbh;
8686     if (! LJ::rate_log($u, "failed_login", 1, { 'limit_by_ip' => $ip }) &&
8687         ($udbh = LJ::get_cluster_master($u)))
8688     {
8689         $udbh->do("REPLACE INTO loginstall (userid, ip, time) VALUES ".
8690                   "(?,INET_ATON(?),UNIX_TIMESTAMP())", undef, $u->{'userid'}, $ip);
8691     }
8692     return 1;
8693 }
8694
8695 # <LJFUNC>
8696 # name: LJ::userpic_count
8697 # des: Gets a count of userpics for a given user.
8698 # args: upics, idlist
8699 # des-upics: hashref to load pictures into, keys being the picids
8700 # des-idlist: [$u, $picid] or [[$u, $picid], [$u, $picid], +] objects
8701 #             also supports deprecated old method, of an array ref of picids.
8702 # </LJFUNC>
8703 sub userpic_count {
8704     my $u = shift or return undef;
8705
8706     if ($u->{'dversion'} > 6) {
8707         my $dbcr = LJ::get_cluster_def_reader($u) or return undef;
8708         return $dbcr->selectrow_array("SELECT COUNT(*) FROM userpic2 " .
8709                                       "WHERE userid=? AND state <> 'X'", undef, $u->{'userid'});
8710     }
8711
8712     my $dbh = LJ::get_db_writer() or return undef;
8713     return $dbh->selectrow_array("SELECT COUNT(*) FROM userpic " .
8714                                  "WHERE userid=? AND state <> 'X'", undef, $u->{'userid'});
8715 }
8716
8717 # <LJFUNC>
8718 # name: LJ::_friends_do
8719 # des: Runs given SQL, then deletes the given userid's friends from memcache.
8720 # args: uuserid, sql, args
8721 # des-uuserid: a userid or u object
8722 # des-sql: SQL to run via $dbh->do()
8723 # des-args: a list of arguments to pass use via: $dbh->do($sql, undef, @args)
8724 # returns: return false on error
8725 # </LJFUNC>
8726 sub _friends_do {
8727     my ($uuid, $sql, @args) = @_;
8728     my $uid = want_userid($uuid);
8729     return undef unless $uid && $sql;
8730
8731     my $dbh = LJ::get_db_writer() or return 0;
8732
8733     my $ret = $dbh->do($sql, undef, @args);
8734     return 0 if $dbh->err;
8735
8736     LJ::memcache_kill($uid, "friends");
8737
8738     # pass $uuid in case it's a $u object which mark_dirty wants
8739     LJ::mark_dirty($uuid, "friends");
8740
8741     return 1;
8742 }
8743
8744 # <LJFUNC>
8745 # name: LJ::add_friend
8746 # des: Simple interface to add a friend edge.
8747 # args: uuid, to_add, opts?
8748 # des-to_add: a single uuid or an arrayref of uuids to add (befriendees)
8749 # des-opts: hashref; 'defaultview' key means add target uuids to $uuid's Default View friends group,
8750 #                    'groupmask' key means use this group mask
8751 # returns: boolean; 1 on success (or already friend), 0 on failure (bogus args)
8752 # </LJFUNC>
8753 sub add_friend {
8754     my ($userid, $to_add, $opts) = @_;
8755
8756     $userid = LJ::want_userid($userid);
8757     return 0 unless $userid;
8758
8759     my @add_ids = ref $to_add eq 'ARRAY' ? map { LJ::want_userid($_) } @$to_add : ( LJ::want_userid($to_add) );
8760     return 0 unless @add_ids;
8761
8762     # clean widget cache
8763     my $widget_key = "friend_birthdays:" . $userid;
8764     LJ::MemCache::delete($widget_key);
8765
8766     my $friender = LJ::load_userid($userid);
8767
8768     # check action rate
8769     ## TODO: rate check of adding friends needs PM elaboration
8770     ## Remove '1 ||' when specification is complete
8771     unless (1 || $opts->{no_rate_check}){
8772         my $cond = ["ratecheck:add_friend:$userid",
8773                     [ $LJ::ADD_FRIEND_RATE_LIMIT || [ 1, 3600 ] ]
8774                    ];
8775         return 0 unless LJ::RateLimit->check($friender, [ $cond ]);
8776     }
8777
8778     my $sclient  = LJ::theschwartz();
8779
8780     my $fgcol = LJ::color_todb($opts->{'fgcolor'}) || LJ::color_todb("#000000");
8781     my $bgcol = LJ::color_todb($opts->{'bgcolor'});
8782     # in case the background color is #000000, in which case the || falls through
8783     # so only overwrite what we got if what we got was undef (invalid input)
8784     $bgcol = LJ::color_todb("#ffffff") unless defined $bgcol;
8785
8786     $opts ||= {};
8787
8788     my $groupmask = 1;
8789     if (defined $opts->{groupmask}) {
8790         $groupmask = $opts->{groupmask};
8791     } elsif ($opts->{'defaultview'}) {
8792         # TAG:FR:ljlib:add_friend_getdefviewmask
8793         my $group = LJ::get_friend_group($userid, { name => 'Default View' });
8794         my $grp = $group ? $group->{groupnum}+0 : 0;
8795         $groupmask |= (1 << $grp) if $grp;
8796     }
8797
8798     # part of the criteria for whether to fire befriended event
8799     my $notify = !$LJ::DISABLED{esn} && !$opts->{nonotify}
8800                  && $friender->is_visible && $friender->is_person;
8801
8802
8803     # load all users at once
8804     LJ::load_userids(@add_ids);
8805     foreach my $add_id (@add_ids) {
8806         LJ::RelationService->create_relation_to(
8807             $friender, $add_id, 'F',
8808             groupmask => $groupmask,
8809             fgcolor   => $fgcol,
8810             bgcolor   => $bgcol,
8811         );
8812
8813         my $friendee = LJ::load_userid($add_id);
8814         LJ::add_to_friend_list($friender, $friendee);
8815          __drop_short_lifetime_cache($friender, $friendee);
8816
8817         if ($sclient) {
8818             my @jobs;
8819
8820             # only fire event if the friender is a person and not banned and visible
8821             if ($notify && !$friendee->is_banned($friender)) {
8822                 require LJ::Event::BefriendedDelayed;
8823                 LJ::Event::BefriendedDelayed->send($friendee, $friender);
8824             }
8825
8826             push @jobs, TheSchwartz::Job->new(
8827                                               funcname => "LJ::NewWorker::TheSchwartz::FriendChange",
8828                                               arg      => [$userid, 'add', $add_id],
8829                                               ) unless $LJ::DISABLED{'friendchange-schwartz'};
8830
8831             $sclient->insert_jobs(@jobs) if @jobs;
8832
8833        }
8834     }
8835
8836     # WARNING: always returns "true". Check result of executing "REPLACE INTO friends ..." statement above.
8837     return 1;
8838 }
8839
8840 # <LJFUNC>
8841 # name: LJ::remove_friend
8842 # des: delete existing friends.
8843 # args: uuid, to_del
8844 # des-to_del: a single uuid or an arrayref of uuids to remove.
8845 # returns: boolean
8846 # </LJFUNC>
8847 sub remove_friend {
8848     my ($userid, $to_del, $opts) = @_;
8849
8850     $userid = LJ::want_userid($userid);
8851     return undef unless $userid;
8852
8853     my @del_ids = ref $to_del eq 'ARRAY' ? map { LJ::want_userid($_) } @$to_del : ( LJ::want_userid($to_del) );
8854     return 0 unless @del_ids;
8855
8856     my $u = LJ::load_userid($userid);
8857
8858     my $dbh = LJ::get_db_writer() or return 0;
8859
8860     my $sclient = LJ::theschwartz();
8861     # part of the criteria for whether to fire defriended event
8862     my $notify = !$LJ::DISABLED{esn} && !$opts->{nonotify} && $u->is_visible && $u->is_person;
8863
8864     foreach my $del_id (@del_ids) {
8865         LJ::RelationService->remove_relation_to( $u, $del_id, 'F' );
8866     }
8867
8868     LJ::load_userids(@del_ids);
8869     # delete friend-of memcache keys for anyone who was removed
8870     foreach my $fid (@del_ids) {
8871         my $friendee = LJ::load_userid($fid);
8872
8873         LJ::remove_from_friend_list($u, $friendee);
8874         __drop_short_lifetime_cache($u, $friendee);
8875
8876         if ($sclient) {
8877             my @jobs;
8878
8879             # only fire event if the friender is a person and not banned and visible
8880             if ($notify && !$friendee->has_banned($u)) {
8881                 require LJ::Event::DefriendedDelayed;
8882                 LJ::Event::DefriendedDelayed->send($friendee, $u);
8883             }
8884
8885             push @jobs, TheSchwartz::Job->new(
8886                                               funcname => "LJ::NewWorker::TheSchwartz::FriendChange",
8887                                               arg      => [$userid, 'del', $fid],
8888                                               ) unless $LJ::DISABLED{'friendchange-schwartz'};
8889
8890             $sclient->insert_jobs(@jobs);
8891
8892         }
8893     }
8894
8895     return 1;
8896 }
8897 *delete_friend_edge = \&LJ::remove_friend;
8898
8899 sub __drop_short_lifetime_cache {
8900     my ($u, $friend) = @_;
8901
8902     return unless $u;
8903     return unless $friend;
8904
8905     my @clean_clist = ('cfriends', 'member', 'mutual_cfriends');
8906     my @clean_flist = ('friends',  'mutual_friends', 'pfriends', 'friendof', 'mutual', 'yfriends');
8907
8908     my $remote = LJ::get_remote();
8909
8910     my $sub_drop = sub {
8911         my ($userid, $list_name) = @_;
8912
8913         my $cached = $list_name !~ /mutual/;
8914
8915         my $uid = 'logged';
8916         if (!$cached) {
8917             $uid = $remote ? $remote->userid : 'n';
8918         }
8919
8920         LJ::MemCache::delete("u:profile:l:$userid:$uid:$list_name:");
8921         LJ::MemCache::delete("u:profile:l:$userid:$uid:$list_name:150");
8922
8923         LJ::MemCache::delete("u:profile:l:$userid:n:$list_name:");
8924         LJ::MemCache::delete("u:profile:l:$userid:n:$list_name:150");
8925     };
8926
8927
8928     my $userid   = $u->userid;
8929     my $friendid = $friend->userid;
8930
8931     foreach my $list_name (@clean_flist) {
8932         $sub_drop->($userid, $list_name);
8933     }
8934
8935     foreach my $list_name (@clean_clist) {
8936         $sub_drop->($userid, $list_name);
8937     }
8938
8939     foreach my $list_name (@clean_flist) {
8940         $sub_drop->($friendid, $list_name);
8941     }
8942
8943     foreach my $list_name (@clean_clist) {
8944         $sub_drop->($friendid, $list_name);
8945     }
8946
8947 }
8948
8949 # <LJFUNC>
8950 # name: LJ::get_friends
8951 # des: Returns friends rows for a given user.
8952 # args: uuserid, mask?, memcache_only?, force?
8953 # des-uuserid: a userid or u object.
8954 # des-mask: a security mask to filter on.
8955 # des-memcache_only: flag, set to only return data from memcache
8956 # des-force: flag, set to ignore memcache and always hit DB.
8957 # returns: hashref; keys = friend userids
8958 #                   values = hashrefs of 'friends' columns and their values
8959 # </LJFUNC>
8960 sub get_friends {
8961     # TAG:FR:ljlib:get_friends
8962     my ($uuid, $mask, $memcache_only, $force) = @_;
8963     my $userid = LJ::want_userid($uuid);
8964     return undef unless $userid;
8965     return undef if $LJ::FORCE_EMPTY_FRIENDS{$userid};
8966
8967     my $u = LJ::load_userid($userid);
8968
8969     return LJ::RelationService->load_relation_destinations(
8970             $u, 'F',
8971                 uuid          => $uuid,
8972                 mask          => $mask,
8973                 memcache_only => $memcache_only,
8974                 force_db      => $force,
8975                 );
8976 }
8977
8978 # <LJFUNC>
8979 # name: LJ::get_friendofs
8980 # des: Returns userids of friendofs for a given user.
8981 # args: uuserid, opts?
8982 # des-opts: options hash, keys: 'force' => don't check memcache
8983 # returns: userid for friendofs
8984 # </LJFUNC>
8985 sub get_friendofs {
8986     # TAG:FR:ljlib:get_friends
8987     my ($uuid, $opts) = @_;
8988     my $userid = LJ::want_userid($uuid);
8989     return undef unless $userid;
8990
8991     my $u = LJ::load_userid($userid);
8992     return LJ::RelationService->find_relation_sources($u, 'F',
8993             nolimit        => $opts->{force} || 0,
8994             skip_memcached => $opts->{force},
8995             );
8996 }
8997
8998 # <LJFUNC>
8999 # name: LJ::fill_groups_xmlrpc
9000 # des: Fills a hashref (presumably to be sent to an XML-RPC client, e.g. FotoBilder)
9001 #      with user friend group information
9002 # args: u, ret
9003 # des-ret: a response hashref to fill with friend group data
9004 # returns: undef if called incorrectly, 1 otherwise
9005 # </LJFUNC>
9006 sub fill_groups_xmlrpc {
9007     my ($u, $ret) = @_;
9008     return undef unless ref $u && ref $ret;
9009
9010     # best interface ever...
9011     $RPC::XML::ENCODING = "utf-8";
9012
9013     # layer on friend group information in the following format:
9014     #
9015     # grp:1 => 'mygroup',
9016     # ...
9017     # grp:30 => 'anothergroup',
9018     #
9019     # grpu:whitaker => '0,1,2,3,4',
9020     # grpu:test => '0',
9021
9022     my $grp = LJ::get_friend_group($u) || {};
9023
9024     # we don't always have RPC::XML loaded (in web context), and it doesn't really
9025     # matter much anyway, since our only consumer is also perl which will take
9026     # the occasional ints back to strings.
9027     my $str = sub {
9028         my $str = shift;
9029         my $val = eval { RPC::XML::string->new($str); };
9030         return $val unless $@;
9031         return $str;
9032     };
9033
9034     $ret->{"grp:0"} = $str->("_all_");
9035     foreach my $bit (1..30) {
9036         next unless my $g = $grp->{$bit};
9037         $ret->{"grp:$bit"} = $str->($g->{groupname});
9038     }
9039
9040     my $fr = LJ::get_friends($u) || {};
9041     my $users = LJ::load_userids(keys %$fr);
9042     while (my ($fid, $f) = each %$fr) {
9043         my $u = $users->{$fid};
9044         next unless $u->{journaltype} =~ /[PSI]/;
9045
9046         my $fname = $u->{user};
9047         $ret->{"grpu:$fid:$fname"} =
9048             $str->(join(",", 0, grep { $grp->{$_} && $f->{groupmask} & 1 << $_ } 1..30));
9049     }
9050
9051     return 1;
9052 }
9053
9054 # <LJFUNC>
9055 # name: LJ::mark_dirty
9056 # des: Marks a given user as being $what type of dirty.
9057 # args: u, what
9058 # des-what: type of dirty being marked (e.g. 'friends')
9059 # returns: 1
9060 # </LJFUNC>
9061 sub mark_dirty {
9062     my ($uuserid, $what) = @_;
9063
9064     my $userid = LJ::want_userid($uuserid);
9065     return 1 if $LJ::REQ_CACHE_DIRTY{$what}->{$userid};
9066
9067     my $u = LJ::want_user($userid);
9068
9069     # friends dirtiness is only necessary to track
9070     # if we're exchange XMLRPC with fotobilder
9071     if ($what eq 'friends') {
9072         return 1 unless $LJ::FB_SITEROOT;
9073         my $sclient = LJ::theschwartz();
9074
9075         push @LJ::CLEANUP_HANDLERS, sub {
9076             if ($sclient) {
9077                 my $job = TheSchwartz::Job->new(
9078                                                 funcname => "LJ::Worker::UpdateFotobilderFriends",
9079                                                 coalesce => "uid:$u->{userid}",
9080                                                 arg      => $u->{userid},
9081                                                 );
9082                 $sclient->insert($job);
9083             } else {
9084                 die "No schwartz client found";
9085             }
9086         };
9087     }
9088
9089     $LJ::REQ_CACHE_DIRTY{$what}->{$userid}++;
9090
9091     return 1;
9092 }
9093
9094 # <LJFUNC>
9095 # name: LJ::delete_all_comments
9096 # des: deletes all comments from a post, permanently, for when a post is deleted
9097 # info: The tables [dbtable[talk2]], [dbtable[talkprop2]], [dbtable[talktext2]],
9098 #       are deleted from, immediately.
9099 # args: u, nodetype, nodeid
9100 # des-nodetype: The thread nodetype (probably 'L' for log items).
9101 # des-nodeid: The thread nodeid for the given nodetype (probably the jitemid
9102 #             from the [dbtable[log2]] row).
9103 # returns: boolean; success value
9104 # </LJFUNC>
9105 sub delete_all_comments {
9106     my ($u, $nodetype, $nodeid) = @_;
9107
9108     my $dbcm = LJ::get_cluster_master($u);
9109     return 0 unless $dbcm && $u->writer;
9110
9111     # delete comments
9112     my ($t, $loop) = (undef, 1);
9113     my $chunk_size = 200;
9114     while ($loop &&
9115            ($t = $dbcm->selectcol_arrayref("SELECT jtalkid FROM talk2 WHERE ".
9116                                            "nodetype=? AND journalid=? ".
9117                                            "AND nodeid=? LIMIT $chunk_size", undef,
9118                                            $nodetype, $u->{'userid'}, $nodeid))
9119            && $t && @$t)
9120     {
9121         my @batch = map { int $_ } @$t;
9122         my $in = join(',', @batch);
9123         return 1 unless $in;
9124
9125         LJ::run_hooks('report_cmt_delete', $u->{'userid'}, \@batch);
9126         LJ::run_hooks('report_cmt_text_delete', $u->{'userid'}, \@batch);
9127         foreach my $table (qw(talkprop2 talktext2 talk2)) {
9128             $u->do("DELETE FROM $table WHERE journalid=? AND jtalkid IN ($in)",
9129                    undef, $u->{'userid'});
9130         }
9131         # decrement memcache
9132         LJ::MemCache::decr([$u->{'userid'}, "talk2ct:$u->{'userid'}"], scalar(@$t));
9133         $loop = 0 unless @$t == $chunk_size;
9134     }
9135     return 1;
9136
9137 }
9138
9139 # is a user object (at least a hashref)
9140 sub isu {
9141     return unless ref $_[0];
9142     return 1 if UNIVERSAL::isa($_[0], "LJ::User");
9143
9144     if (ref $_[0] eq "HASH" && $_[0]->{userid}) {
9145         carp "User HASH objects are deprecated from use." if $LJ::IS_DEV_SERVER;
9146         return 1;
9147     }
9148 }
9149
9150 # create externally mapped user.
9151 # return uid of LJ user on success, undef on error.
9152 # opts = {
9153 #     extuser or extuserid (or both, but one is required.),
9154 #     caps
9155 # }
9156 # opts also can contain any additional options that create_account takes. (caps?)
9157 sub create_extuser
9158 {
9159     my ($type, $opts) = @_;
9160     return undef unless $type && $LJ::EXTERNAL_NAMESPACE{$type}->{id};
9161     return undef unless ref $opts &&
9162         ($opts->{extuser} || defined $opts->{extuserid});
9163
9164     my $uid;
9165     my $dbh = LJ::get_db_writer();
9166     return undef unless $dbh;
9167
9168     # make sure a mapping for this user doesn't already exist.
9169     $uid = LJ::get_extuser_uid( $type, $opts, 'force' );
9170     return $uid if $uid;
9171
9172     # increment ext_ counter until we successfully create an LJ account.
9173     # hard cap it at 10 tries. (arbitrary, but we really shouldn't have *any*
9174     # failures here, let alone 10 in a row.)
9175     for (1..10) {
9176         my $extuser = 'ext_' . LJ::alloc_global_counter( 'E' );
9177         $uid =
9178           LJ::create_account(
9179             { caps => $opts->{caps}, user => $extuser, name => $extuser } );
9180         last if $uid;
9181         select undef, undef, undef, .10;  # lets not thrash over this.
9182     }
9183     return undef unless $uid;
9184
9185     # add extuser mapping.
9186     my $sql = "INSERT INTO extuser SET userid=?, siteid=?";
9187     my @bind = ($uid, $LJ::EXTERNAL_NAMESPACE{$type}->{id});
9188
9189     if ($opts->{extuser}) {
9190         $sql .= ", extuser=?";
9191         push @bind, $opts->{extuser};
9192     }
9193
9194     if ($opts->{extuserid}) {
9195         $sql .= ", extuserid=? ";
9196         push @bind, $opts->{extuserid}+0;
9197     }
9198
9199     $dbh->do($sql, undef, @bind) or return undef;
9200     return $uid;
9201 }
9202
9203 sub priv_can_view {
9204     my ($url, $remote) = @_;
9205
9206     my $privilege = $LJ::PAGE_PRIVILEGES{$url} || $LJ::PAGE_PRIVILEGES{"$url/"};
9207
9208     return 0 unless $privilege;
9209
9210     my $priv = $privilege->{'priv'};
9211     my $arg  = $privilege->{'arg'};
9212     if ( LJ::check_priv($remote, $priv, $arg) ) {
9213         my $uri = LJ::Request->uri;
9214             my $args = LJ::Request->args;
9215             my $current_url = "$uri?$args";
9216             my $authas = LJ::Request->get_param('authas') || LJ::Request->post_param('authas');
9217             my $u = LJ::load_user($authas);
9218             LJ::statushistory_add($u, $remote, "view_settings", "$current_url" );
9219
9220         return 1;
9221     }
9222 }
9223
9224 # given an extuserid or extuser, return the LJ uid.
9225 # return undef if there is no mapping.
9226 sub get_extuser_uid
9227 {
9228     my ($type, $opts, $force) = @_;
9229     return undef unless $type && $LJ::EXTERNAL_NAMESPACE{$type}->{id};
9230     return undef unless ref $opts &&
9231         ($opts->{extuser} || defined $opts->{extuserid});
9232
9233     my $dbh = $force ? LJ::get_db_writer() : LJ::get_db_reader();
9234     return undef unless $dbh;
9235
9236     my $sql = "SELECT userid FROM extuser WHERE siteid=?";
9237     my @bind = ($LJ::EXTERNAL_NAMESPACE{$type}->{id});
9238
9239     if ($opts->{extuser}) {
9240         $sql .= " AND extuser=?";
9241         push @bind, $opts->{extuser};
9242     }
9243
9244     if ($opts->{extuserid}) {
9245         $sql .= $opts->{extuser} ? ' OR ' : ' AND ';
9246         $sql .= "extuserid=?";
9247         push @bind, $opts->{extuserid}+0;
9248     }
9249
9250     return $dbh->selectrow_array($sql, undef, @bind);
9251 }
9252
9253 # given a LJ userid/u, return a hashref of:
9254 # type, extuser, extuserid
9255 # returns undef if user isn't an externally mapped account.
9256 sub get_extuser_map
9257 {
9258     my $uid = LJ::want_userid(shift);
9259     return undef unless $uid;
9260
9261     my $dbr = LJ::get_db_reader();
9262     return undef unless $dbr;
9263
9264     my $sql = "SELECT * FROM extuser WHERE userid=?";
9265     my $ret = $dbr->selectrow_hashref($sql, undef, $uid);
9266     return undef unless $ret;
9267
9268     my $type = 'unknown';
9269     foreach ( keys %LJ::EXTERNAL_NAMESPACE ) {
9270         $type = $_ if $LJ::EXTERNAL_NAMESPACE{$_}->{id} == $ret->{siteid};
9271     }
9272
9273     $ret->{type} = $type;
9274     return $ret;
9275 }
9276
9277 # <LJFUNC>
9278 # name: LJ::create_account
9279 # des: Creates a new basic account.  <strong>Note:</strong> This function is
9280 #      not really too useful but should be extended to be useful so
9281 #      htdocs/create.bml can use it, rather than doing the work itself.
9282 # returns: integer of userid created, or 0 on failure.
9283 # args: opts
9284 # des-opts: hashref containing keys 'user', 'name', 'password', 'email', 'caps', 'journaltype'.
9285 # </LJFUNC>
9286 sub create_account {
9287     my $opts = shift;
9288     my $u = LJ::User->create(%$opts)
9289         or return 0;
9290
9291     return $u->id;
9292 }
9293
9294 # <LJFUNC>
9295 # name: LJ::new_account_cluster
9296 # des: Which cluster to put a new account on.  $DEFAULT_CLUSTER if it's
9297 #      a scalar, random element from [ljconfig[default_cluster]] if it's arrayref.
9298 #      also verifies that the database seems to be available.
9299 # returns: clusterid where the new account should be created; 0 on error
9300 #          (such as no clusters available).
9301 # </LJFUNC>
9302 sub new_account_cluster
9303 {
9304     # if it's not an arrayref, put it in an array ref so we can use it below
9305     my $clusters = ref $LJ::DEFAULT_CLUSTER ? $LJ::DEFAULT_CLUSTER : [ $LJ::DEFAULT_CLUSTER+0 ];
9306
9307     # select a random cluster from the set we've chosen in $LJ::DEFAULT_CLUSTER
9308     return LJ::random_cluster(@$clusters);
9309 }
9310
9311 # returns the clusterid of a random cluster which is up
9312 # -- accepts @clusters as an arg to enforce a subset, otherwise
9313 #    uses @LJ::CLUSTERS
9314 sub random_cluster {
9315     my @clusters = @_ ? @_ : @LJ::CLUSTERS;
9316
9317     # iterate through the new clusters from a random point
9318     my $size = @clusters;
9319     my $start = int(rand() * $size);
9320     foreach (1..$size) {
9321         my $cid = $clusters[$start++ % $size];
9322
9323         # verify that this cluster is in @LJ::CLUSTERS
9324         my @check = grep { $_ == $cid } @LJ::CLUSTERS;
9325         next unless scalar(@check) >= 1 && $check[0] == $cid;
9326
9327         # try this cluster to see if we can use it, return if so
9328         my $dbcm = LJ::get_cluster_master($cid);
9329         return $cid if $dbcm;
9330     }
9331
9332     # if we get here, we found no clusters that were up...
9333     return 0;
9334 }
9335
9336
9337 # name: LJ::make_journal
9338 # args: user, view, remote, opts
9339 # </LJFUNC>
9340 sub make_journal {
9341     my ($user, $view, $remote, $opts) = @_;
9342
9343     my $geta = $opts->{'getargs'};
9344
9345     if ($LJ::SERVER_DOWN) {
9346         if ($opts->{'vhost'} eq "customview") {
9347             return "<!-- LJ down for maintenance -->";
9348         }
9349         return LJ::server_down_html();
9350     }
9351
9352     my $u = $opts->{'u'} || LJ::load_user($user);
9353     unless ($u) {
9354         $opts->{'baduser'} = 1;
9355         return "<h1>Error</h1>No such user <b>$user</b>";
9356     }
9357     LJ::set_active_journal($u);
9358     LJ::Request->notes('ljentry' => $opts->{'ljentry'}->url) if $opts->{'ljentry'};
9359
9360     # S1 style hashref.  won't be loaded now necessarily,
9361     # only if via customview.
9362     my $style;
9363
9364     my ($styleid);
9365     if ($opts->{'styleid'}) {  # s1 styleid
9366         $styleid = $opts->{'styleid'}+0;
9367
9368         # if we have an explicit styleid, we have to load
9369         # it early so we can learn its type, so we can
9370         # know which uprops to load for its owner
9371         if ($LJ::ONLY_USER_VHOSTS && $opts->{vhost} eq "customview") {
9372             # reject this style if it's not trusted by the user, and we're showing
9373             # stuff on user domains
9374             my $ownerid = LJ::S1::get_style_userid_always($styleid);
9375             my $is_trusted = sub {
9376                 return 1 if $ownerid == $u->{userid};
9377                 return 1 if $ownerid == LJ::system_userid();
9378                 return 1 if $LJ::S1_CUSTOMVIEW_WHITELIST{"styleid-$styleid"};
9379                 return 1 if $LJ::S1_CUSTOMVIEW_WHITELIST{"userid-$ownerid"};
9380                 my $trust_list = eval { $u->prop("trusted_s1") };
9381                 return 1 if $trust_list =~ /\b$styleid\b/;
9382                 return 0;
9383             };
9384             unless ($is_trusted->()) {
9385                 $style = undef;
9386                 $styleid = 0;
9387             }
9388         }
9389     } else {
9390
9391         $view ||= "lastn";    # default view when none specified explicitly in URLs
9392         if ($LJ::viewinfo{$view} || $view eq "month" ||
9393             $view eq "entry" || $view eq "reply")  {
9394             $styleid = -1;    # to get past the return, then checked later for -1 and fixed, once user is loaded.
9395         } else {
9396             $opts->{'badargs'} = 1;
9397         }
9398     }
9399     return unless $styleid;
9400
9401
9402     $u->{'_journalbase'} = LJ::journal_base($u->{'user'}, $opts->{'vhost'});
9403
9404     my $eff_view = $LJ::viewinfo{$view}->{'styleof'} || $view;
9405     my $s1prop = "s1_${eff_view}_style";
9406
9407     my @needed_props = ("stylesys", "s2_style", "url", "urlname", "opt_nctalklinks",
9408                         "renamedto",  "opt_blockrobots", "opt_usesharedpic", "icbm",
9409                         "journaltitle", "journalsubtitle", "external_foaf_url",
9410                         "adult_content", "admin_content_flag", "community_reader_ids");
9411
9412     # S2 is more fully featured than S1, so sometimes we get here and $eff_view
9413     # is reply/month/entry/res and that means it *has* to be S2--S1 defaults to a
9414     # BML page to handle those, but we don't want to attempt to load a userprop
9415     # because now load_user_props dies if you try to load something invalid
9416     push @needed_props, $s1prop if $eff_view =~ /^(?:calendar|day|friends|lastn)$/;
9417
9418     # preload props the view creation code will need later (combine two selects)
9419     if (ref $LJ::viewinfo{$eff_view}->{'owner_props'} eq "ARRAY") {
9420         push @needed_props, @{$LJ::viewinfo{$eff_view}->{'owner_props'}};
9421     }
9422
9423     if ($eff_view eq "reply") {
9424         push @needed_props, "opt_logcommentips";
9425     }
9426
9427     $u->preload_props(@needed_props);
9428
9429     # FIXME: remove this after all affected accounts have been fixed
9430     # see http://zilla.livejournal.org/1443 for details
9431     if ($u->{$s1prop} =~ /^\D/) {
9432         $u->{$s1prop} = $LJ::USERPROP_DEF{$s1prop};
9433         $u->set_prop($s1prop, $u->{$s1prop});
9434     }
9435
9436     # if the remote is the user to be viewed, make sure the $remote
9437     # hashref has the value of $u's opt_nctalklinks (though with
9438     # LJ::load_user caching, this may be assigning between the same
9439     # underlying hashref)
9440     $remote->{'opt_nctalklinks'} = $u->{'opt_nctalklinks'} if
9441         ($remote && $remote->{'userid'} == $u->{'userid'});
9442
9443     my $stylesys = 1;
9444     if ($styleid == -1) {
9445
9446         my $get_styleinfo = sub {
9447
9448             my $get_s1_styleid = sub {
9449                 my $id = $u->{$s1prop};
9450                 LJ::run_hooks("s1_style_select", {
9451                     'styleid' => \$id,
9452                     'u' => $u,
9453                     'view' => $view,
9454                 });
9455                 return $id;
9456             };
9457
9458             # forced s2 style id
9459             if ($geta->{'s2id'}) {
9460
9461                 # get the owner of the requested style
9462                 my $style = LJ::S2::load_style( $geta->{s2id} );
9463                 my $owner = $style && $style->{userid} ? $style->{userid} : 0;
9464
9465                 # remote can use s2id on this journal if:
9466                 # owner of the style is remote or managed by remote OR
9467                 # owner of the style has s2styles cap and remote is viewing owner's journal
9468
9469                 if ($u->id == $owner && $u->get_cap("s2styles")) {
9470                     $opts->{'style_u'} = LJ::load_userid($owner);
9471                     return (2, $geta->{'s2id'});
9472                 }
9473
9474                 if ($remote && $remote->can_manage($owner)) {
9475                     # check is owned style still available: paid user possible became plus...
9476                     my $lay_id = $style->{layer}->{layout};
9477                     my $theme_id = $style->{layer}->{theme};
9478                     my %lay_info;
9479                     LJ::S2::load_layer_info(\%lay_info, [$style->{layer}->{layout}, $style->{layer}->{theme}]);
9480
9481                     if (LJ::S2::can_use_layer($remote, $lay_info{$lay_id}->{redist_uniq})
9482                         and LJ::S2::can_use_layer($remote, $lay_info{$theme_id}->{redist_uniq})) {
9483                         $opts->{'style_u'} = LJ::load_userid($owner);
9484                         return (2, $geta->{'s2id'});
9485                     } # else this style not allowed by policy
9486                 }
9487             }
9488
9489             # style=mine passed in GET?
9490             if ($remote && ( $geta->{'style'} eq 'mine' ||
9491                              $remote->opt_stylealwaysmine ) ) {
9492
9493                 # get remote props and decide what style remote uses
9494                 $remote->preload_props("stylesys", "s2_style");
9495
9496                 # remote using s2; make sure we pass down the $remote object as the style_u to
9497                 # indicate that they should use $remote to load the style instead of the regular $u
9498                 if ($remote->{'stylesys'} == 2 && $remote->{'s2_style'}) {
9499                     $opts->{'checkremote'} = 1;
9500                     $opts->{'style_u'} = $remote;
9501                     return (2, $remote->{'s2_style'});
9502                 }
9503
9504                 # remote using s1
9505                 return (1, $get_s1_styleid->());
9506             }
9507
9508             # resource URLs have the styleid in it
9509             if ($view eq "res" && $opts->{'pathextra'} =~ m!^/(\d+)/!) {
9510                 return (2, $1);
9511             }
9512
9513             my $forceflag = 0;
9514             LJ::run_hooks("force_s1", $u, \$forceflag);
9515
9516             # if none of the above match, they fall through to here
9517             if ( !$forceflag && $u->{'stylesys'} == 2 ) {
9518                 return (2, $u->{'s2_style'});
9519             }
9520
9521             # no special case and not s2, fall through to s1
9522             return (1, $get_s1_styleid->());
9523         };
9524
9525         if ($LJ::JOURNALS_WITH_FIXED_STYLE{$u->user}) {
9526             ($stylesys, $styleid) = (2, $u->{'s2_style'});
9527         } else {
9528             ($stylesys, $styleid) = $get_styleinfo->();
9529         }
9530     }
9531
9532     # transcode the tag filtering information into the tag getarg; this has to
9533     # be done above the s1shortcomings section so that we can fall through to that
9534     # style for lastn filtered by tags view
9535     if ($view eq 'lastn' && $opts->{pathextra} && $opts->{pathextra} =~ /^\/tag\/(.+)$/) {
9536         $opts->{getargs}->{tag} = $1;
9537         $opts->{pathextra} = undef;
9538     }
9539
9540     # do the same for security filtering
9541     elsif ($view eq 'lastn' && $opts->{pathextra} && $opts->{pathextra} =~ /^\/security\/(.+)$/) {
9542         $opts->{getargs}->{security} = $1;
9543         $opts->{pathextra} = undef;
9544     }
9545
9546     if (LJ::Request->is_inited) {
9547         LJ::Request->notes('journalid' => $u->{'userid'});
9548     }
9549
9550     my $notice = sub {
9551         my $msg = shift;
9552         my $status = shift;
9553
9554         my $url = "$LJ::SITEROOT/users/$user/";
9555         $opts->{'status'} = $status if $status;
9556
9557         my $head;
9558         my $journalbase = LJ::journal_base($user);
9559
9560         # Automatic Discovery of RSS/Atom
9561         $head .= qq{<link rel="alternate" type="application/rss+xml" title="RSS" href="$journalbase/data/rss" />\n};
9562         $head .= qq{<link rel="alternate" type="application/atom+xml" title="Atom" href="$journalbase/data/atom" />\n};
9563         $head .= qq{<link rel="service.feed" type="application/atom+xml" title="AtomAPI-enabled feed" href="$LJ::SITEROOT/interface/atom/feed" />\n};
9564         $head .= qq{<link rel="service.post" type="application/atom+xml" title="Create a new post" href="$LJ::SITEROOT/interface/atom/post" />\n};
9565
9566         # OpenID Server and Yadis
9567         $head .= $u->openid_tags;
9568
9569         # FOAF autodiscovery
9570         my $foafurl = $u->{external_foaf_url} ? LJ::eurl($u->{external_foaf_url}) : "$journalbase/data/foaf";
9571         $head .= qq{<link rel="meta" type="application/rdf+xml" title="FOAF" href="$foafurl" />\n};
9572
9573         if ($u->email_visible($remote)) {
9574             my $digest = Digest::SHA1::sha1_hex('mailto:' . $u->email_raw);
9575             $head .= qq{<meta name="foaf:maker" content="foaf:mbox_sha1sum '$digest'" />\n};
9576         }
9577
9578         return qq{
9579             <html>
9580             <head>
9581             $head
9582             </head>
9583             <body>
9584              <h1>Notice</h1>
9585              <p>$msg</p>
9586              <p>Instead, please use <nobr><a href=\"$url\">$url</a></nobr></p>
9587             </body>
9588             </html>
9589         }.("<!-- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -->\n" x 50);
9590     };
9591     my $error = sub {
9592         my $msg = shift;
9593         my $status = shift;
9594         $opts->{'status'} = $status if $status;
9595
9596         return qq{
9597             <h1>Error</h1>
9598             <p>$msg</p>
9599         }.("<!-- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -->\n" x 50);
9600     };
9601     if ($LJ::USER_VHOSTS && $opts->{'vhost'} eq "users" && $u->{'journaltype'} ne 'R' &&
9602         ! LJ::get_cap($u, "userdomain")) {
9603         return $notice->("URLs like <nobr><b>http://<i>username</i>.$LJ::USER_DOMAIN/" .
9604                          "</b></nobr> are not available for this user's account type.");
9605     }
9606     if ($opts->{'vhost'} eq "customview" && ! LJ::get_cap($u, "styles")) {
9607         return $notice->("This user's account type is not permitted to create and embed styles.");
9608     }
9609     if ($opts->{'vhost'} eq "community" && $u->{'journaltype'} !~ /[CR]/) {
9610         $opts->{'badargs'} = 1; # Output a generic 'bad URL' message if available
9611         return "<h1>Notice</h1><p>This account isn't a community journal.</p>";
9612     }
9613     if ($view eq "friendsfriends" && ! LJ::get_cap($u, "friendsfriendsview")) {
9614         my $inline;
9615         if ($inline .= LJ::run_hook("cprod_inline", $u, 'FriendsFriendsInline')) {
9616             return $inline;
9617         } else {
9618             return BML::ml('cprod.friendsfriendsinline.text.v1');
9619         }
9620     }
9621
9622     # signal to LiveJournal.pm that we can't handle this
9623     if (($stylesys == 1 || $geta->{'format'} eq 'light') &&
9624         ({ entry=>1, reply=>1, month=>1, tag=>1 }->{$view} || ($view eq 'lastn' && ($geta->{tag} || $geta->{security})))) {
9625
9626         # pick which fallback method (s2 or bml) we'll use by default, as configured with
9627         # $S1_SHORTCOMINGS
9628         my $fallback = $LJ::S1_SHORTCOMINGS ? "s2" : "bml";
9629
9630         # but if the user specifies which they want, override the fallback we picked
9631         if ($geta->{'fallback'} && $geta->{'fallback'} =~ /^s2|bml$/) {
9632             $fallback = $geta->{'fallback'};
9633         }
9634
9635         # if we are in this path, and they have style=mine set, it means
9636         # they either think they can get a S2 styled page but their account
9637         # type won't let them, or they really want this to fallback to bml
9638         if ($remote && ( $geta->{'style'} eq 'mine' ||
9639                          $remote->opt_stylealwaysmine ) ) {
9640             $fallback = 'bml';
9641         }
9642
9643         # If they specified ?format=light, it means they want a page easy
9644         # to deal with text-only or on a mobile device.  For now that means
9645         # render it in the lynx site scheme.
9646         if ($geta->{'format'} eq 'light') {
9647             $fallback = 'bml';
9648             LJ::Request->notes('bml_use_scheme' => 'lynx');
9649         }
9650
9651         # there are no BML handlers for these views, so force s2
9652         if ($view eq 'tag' || $view eq 'lastn') {
9653             $fallback = "s2";
9654         }
9655
9656         # fall back to BML unless we're using S2
9657         # fallback (the "s1shortcomings/layout")
9658         if ($fallback eq "bml") {
9659             ${$opts->{'handle_with_bml_ref'}} = 1;
9660             return;
9661         }
9662
9663         # S1 can't handle these views, so we fall back to a
9664         # system-owned S2 style (magic value "s1short") that renders
9665         # this content
9666         $stylesys = 2;
9667         $styleid = "s1short";
9668     }
9669
9670     # now, if there's a GET argument for tags, split those out
9671     if (exists $opts->{getargs}->{tag}) {
9672         my $tagfilter = $opts->{getargs}->{tag};
9673         return $error->("You must provide tags to filter by.", "404 Not Found")
9674             unless $tagfilter;
9675
9676         # error if disabled
9677         return $error->("Sorry, the tag system is currently disabled.", "404 Not Found")
9678             if $LJ::DISABLED{tags};
9679
9680         # throw an error if we're rendering in S1, but not for renamed accounts
9681         return $error->("Sorry, tag filtering is not supported within S1 styles.", "404 Not Found")
9682             if $stylesys == 1 && $view ne 'data' && $u->{journaltype} ne 'R';
9683
9684         # overwrite any tags that exist
9685         $opts->{tags} = [];
9686         return $error->("Sorry, the tag list specified is invalid.", "404 Not Found")
9687             unless LJ::Tags::is_valid_tagstring($tagfilter, $opts->{tags}, { omit_underscore_check => 1 });
9688
9689         # get user's tags so we know what remote can see, and setup an inverse mapping
9690         # from keyword to tag
9691         $opts->{tagids} = [];
9692         $opts->{'tagmap'} = {};
9693         my $tags = LJ::Tags::get_usertags($u, { remote => $remote });
9694
9695         my %kwref = ();
9696         foreach my $tagid (keys %$tags) {
9697             push @{$kwref{LJ::Text->normalize_tag_name ($tags->{$tagid}->{'name'})}}, $tagid;
9698         }
9699
9700         foreach my $tagname (@{$opts->{tags}}) {
9701             unless ($kwref{LJ::Text->normalize_tag_name ($tagname)}) {
9702                 LJ::Request->pnotes ('error' => 'e404');
9703                 LJ::Request->pnotes ('remote' => LJ::get_remote ());
9704                 $opts->{'handler_return'} = "404 Not Found";
9705                 return;
9706             }
9707             #return $error->("Sorry, one or more specified tags do not exist.", "404 Not Found")
9708             #    unless $kwref{$tagname};
9709             push @{$opts->{'tagids'}}, @{$kwref{LJ::Text->normalize_tag_name ($tagname)}};
9710             $opts->{'tagmap'}->{$tagname} = $kwref{LJ::Text->normalize_tag_name ($tagname)};
9711         }
9712
9713         $opts->{tagmode} = $opts->{getargs}->{mode} eq 'and' ? 'and' : 'or';
9714     }
9715
9716     # validate the security filter
9717     if (exists $opts->{getargs}->{security}) {
9718         my $securityfilter = $opts->{getargs}->{security};
9719         return $error->("You must provide a security level to filter by.", "404 Not Found")
9720             unless $securityfilter;
9721
9722         return $error->("This feature is not available for your account level.", "403 Forbidden")
9723             unless LJ::get_cap($remote, "security_filter") || LJ::get_cap($u, "security_filter");
9724
9725         # error if disabled
9726         return $error->("Sorry, the security-filtering system is currently disabled.", "404 Not Found")
9727             unless LJ::is_enabled("security_filter");
9728
9729         # throw an error if we're rendering in S1, but not for renamed accounts
9730         return $error->("Sorry, security filtering is not supported within S1 styles.", "404 Not Found")
9731             if $stylesys == 1 && $view ne 'data' && !$u->is_redirect;
9732
9733         # check the filter itself
9734         if ($securityfilter =~ /^(?:public|friends|private)$/i) {
9735             $opts->{'securityfilter'} = lc($securityfilter);
9736
9737         } elsif ($securityfilter =~ /^group:(.+)$/i) {
9738             my $groupres = LJ::get_friend_group($u, { 'name' => $1});
9739
9740             if ($groupres && (LJ::u_equals($u, $remote)
9741                               || LJ::get_groupmask($u, $remote) & (1 << $groupres->{groupnum}))) {
9742                 $opts->{securityfilter} = $groupres->{groupnum};
9743             }
9744         }
9745
9746         return $error->("You have specified an invalid security setting, the friends group you specified does not exist, or you are not a member of that group.", "404 Not Found")
9747             unless defined $opts->{securityfilter};
9748
9749     }
9750
9751     unless ($geta->{'viewall'} && LJ::check_priv($remote, "canview", "suspended") ||
9752             $opts->{'pathextra'} =~ m#/(\d+)/stylesheet$#) { ## don't check style sheets
9753         if ($u->is_deleted){
9754             my $warning = LJ::Lang::get_text(LJ::Lang::get_effective_lang(),
9755                                     'journal.deleted', undef, {username => $u->username})
9756                        || LJ::Lang::get_text($LJ::DEFAULT_LANG,
9757                                     'journal.deleted', undef, {username => $u->username});
9758             LJ::Request->pnotes ('error' => 'deleted');
9759             LJ::Request->pnotes ('remote' => LJ::get_remote ());
9760             $opts->{'handler_return'} = "404 Not Found";
9761             return;
9762             #return $error->($warning, "404 Not Found");
9763
9764         }
9765         if ($u->is_suspended) {
9766             LJ::Request->pnotes ('error' => 'suspended');
9767             LJ::Request->pnotes ('remote' => LJ::get_remote ());
9768             $opts->{'handler_return'} = "403 Forbidden";
9769             return;
9770         }
9771         #return $error->("This journal has been suspended.", "403 Forbidden") if ($u->is_suspended);
9772
9773         my $entry = $opts->{ljentry};
9774
9775         if ($entry && $entry->is_suspended_for($remote)) {
9776             LJ::Request->pnotes ('error' => 'suspended_post');
9777             LJ::Request->pnotes ('remote' => LJ::get_remote ());
9778             $opts->{'handler_return'} = "403 Forbidden";
9779             return;
9780         }
9781
9782         return $error->("This entry has been suspended. You can visit the journal <a href='" . $u->journal_base . "/'>here</a>.", "403 Forbidden")
9783             if $entry && $entry->is_suspended_for($remote);
9784     }
9785     if ($u->is_expunged) {
9786         LJ::Request->pnotes ('error' => 'expunged');
9787         LJ::Request->pnotes ('remote' => LJ::get_remote ());
9788         $opts->{'handler_return'} = "410 Gone";
9789         return;
9790     }
9791
9792     return $error->("This user has no journal here.", "404 Not here") if $u->{'journaltype'} eq "I" && $view ne "friends";
9793
9794     $opts->{'view'} = $view;
9795
9796     # what charset we put in the HTML
9797     $opts->{'saycharset'} ||= "utf-8";
9798
9799     if ($view eq 'data') {
9800         return LJ::Feed::make_feed($u, $remote, $opts);
9801     }
9802
9803     if ($stylesys == 2) {
9804         LJ::Request->notes('codepath' => "s2.$view") if LJ::Request->is_inited;
9805
9806         eval { LJ::S2->can("dostuff") };  # force Class::Autouse
9807         my $mj = LJ::S2::make_journal($u, $styleid, $view, $remote, $opts);
9808
9809         # intercept flag to handle_with_bml_ref and instead use S1 shortcomings
9810         # if BML is disabled
9811         if ($opts->{'handle_with_bml_ref'} && ${$opts->{'handle_with_bml_ref'}} &&
9812             ($LJ::S1_SHORTCOMINGS || $geta->{fallback} eq "s2"))
9813         {
9814             # kill the flag
9815             ${$opts->{'handle_with_bml_ref'}} = 0;
9816
9817             # and proceed with s1shortcomings (which looks like BML) instead of BML
9818             $mj = LJ::S2::make_journal($u, "s1short", $view, $remote, $opts);
9819         }
9820
9821         return $mj;
9822     }
9823
9824     # Everything from here on down is S1.  FIXME: this should be moved to LJ::S1::make_journal
9825     # to be more like LJ::S2::make_journal.
9826     LJ::Request->notes('codepath' => "s1.$view") if LJ::Request->is_inited;
9827     $u->{'_s1styleid'} = $styleid + 0;
9828
9829     # For embedded polls
9830     BML::set_language($LJ::LANGS[0] || 'en', \&LJ::Lang::get_text);
9831
9832     # load the user-related S1 data  (overrides and colors)
9833     my $s1uc;
9834     my $is_s1uc_valid = sub {
9835         ## Storable::thaw takes valid date, undef or empty string;
9836         ## dies on invalid data
9837         return
9838             eval {
9839                 Storable::thaw($_[0]->{'color_stor'});
9840                 Storable::thaw($_[0]->{'override_stor'});
9841                 1;
9842             };
9843     };
9844     my $s1uc_memkey = [$u->{'userid'}, "s1uc:$u->{'userid'}"];
9845     if ($u->{'useoverrides'} eq "Y" || $u->{'themeid'} == 0) {
9846         $s1uc = LJ::MemCache::get($s1uc_memkey);
9847         undef($s1uc) if $s1uc && !$is_s1uc_valid->($s1uc);
9848
9849         unless ($s1uc) {
9850             my $db;
9851             my $setmem = 1;
9852             if (@LJ::MEMCACHE_SERVERS) {
9853                 $db = LJ::get_cluster_def_reader($u);
9854             } else {
9855                 $db = LJ::get_cluster_reader($u);
9856                 $setmem = 0;
9857             }
9858             $s1uc = $db->selectrow_hashref("SELECT * FROM s1usercache WHERE userid=?",
9859                                            undef, $u->{'userid'});
9860             undef($s1uc) if $s1uc && !$is_s1uc_valid->($s1uc);
9861             LJ::MemCache::set($s1uc_memkey, $s1uc) if $s1uc && $setmem;
9862         }
9863     }
9864
9865     # we should have our cache row!  we'll update it in a second.
9866     my $dbcm;
9867     if (! $s1uc) {
9868         $u->do("INSERT IGNORE INTO s1usercache (userid) VALUES (?)", undef, $u->{'userid'});
9869         $s1uc = {};
9870     }
9871
9872     # conditionally rebuild parts of our cache that are missing
9873     my %update;
9874
9875     # is the overrides cache old or missing?
9876     my $dbh;
9877     if ($u->{'useoverrides'} eq "Y" && (! $s1uc->{'override_stor'} ||
9878                                         $s1uc->{'override_cleanver'} < $LJ::S1::CLEANER_VERSION)) {
9879
9880         my $overrides = LJ::S1::get_overrides($u);
9881         $update{'override_stor'} = LJ::CleanHTML::clean_s1_style($overrides);
9882         $update{'override_cleanver'} = $LJ::S1::CLEANER_VERSION;
9883     }
9884
9885     # is the color cache here if it's a custom user theme?
9886     if ($u->{'themeid'} == 0 && ! $s1uc->{'color_stor'}) {
9887         my $col = {};
9888         $dbh ||= LJ::get_db_writer();
9889         my $sth = $dbh->prepare("SELECT coltype, color FROM themecustom WHERE user=?");
9890         $sth->execute($u->{'user'});
9891         $col->{$_->{'coltype'}} = $_->{'color'} while $_ = $sth->fetchrow_hashref;
9892         $update{'color_stor'} = Storable::nfreeze($col);
9893     }
9894
9895     # save the updates
9896     if (%update) {
9897         my $set;
9898         foreach my $k (keys %update) {
9899             $s1uc->{$k} = $update{$k};
9900             $set .= ", " if $set;
9901             $set .= "$k=" . $u->quote($update{$k});
9902         }
9903         my $rv = $u->do("UPDATE s1usercache SET $set WHERE userid=?", undef, $u->{'userid'});
9904         LJ::MemCache::set($s1uc_memkey, $s1uc);
9905     }
9906
9907     # load the style
9908     my $viewref = $view eq "" ? \$view : undef;
9909     $style ||= $LJ::viewinfo{$view}->{'nostyle'} ? {} :
9910         LJ::S1::load_style($styleid, $viewref);
9911
9912     my %vars = ();
9913
9914     # apply the style
9915     foreach (keys %$style) {
9916         $vars{$_} = $style->{$_};
9917     }
9918
9919     # apply the overrides
9920     if ($opts->{'nooverride'}==0 && $u->{'useoverrides'} eq "Y") {
9921         my $tw = Storable::thaw($s1uc->{'override_stor'});
9922         foreach (keys %$tw) {
9923             $vars{$_} = $tw->{$_};
9924         }
9925     }
9926
9927     # apply the color theme
9928     $@ = '';
9929     my $cols = $u->{'themeid'}
9930                 ? LJ::S1::get_themeid($u->{'themeid'})
9931                 : Storable::thaw($s1uc->{'color_stor'});
9932     foreach (keys %$cols) {
9933         $vars{"color-$_"} = $cols->{$_};
9934     }
9935
9936     # instruct some function to make this specific view type
9937     return unless defined $LJ::viewinfo{$view}->{'creator'};
9938     my $ret = "";
9939
9940     # call the view creator w/ the buffer to fill and the construction variables
9941     my $res = $LJ::viewinfo{$view}->{'creator'}->(\$ret, $u, \%vars, $remote, $opts);
9942
9943     if ($LJ::USE_S1w2 && $LJ::USE_S1w2->($view, $u, $remote)) {
9944         # S1w2 is an experimental version of S1 that acts as if it were an S2 style,
9945         # getting all of its necessary data from the S2 data structures rather than
9946         # fetching the data itself and duplicating all of that logic.
9947         # It should ideally generate exactly the same output as traditional S1 with
9948         # the same input data, but until this has been tested thoroughly it's
9949         # disabled by default.
9950
9951         # We render S1w2 in addition to traditional S1 so that we can see if there
9952         # is any difference.
9953         my $s1result = $ret;
9954         $ret = "";
9955
9956         require "ljviews-s1-using-s2.pl"; # Load on demand
9957         $LJ::S1w2::viewcreator{$view}->(\$ret, $u, \%vars, $remote, $opts);
9958
9959         if ($s1result ne $ret) {
9960             warn "S1w2 differed from S1 when rendering a $view page for $u->{user} with ".($remote ? $remote->{user} : "an anonymous user")." watching";
9961
9962             # Optionally produce a diff between S1 and S1w2
9963             # NOTE: This _make_diff function hits the filesystem and forks a diff process.
9964             #   It's only useful/sensible on a low-load development server.
9965             if ($LJ::SHOW_S1w2_DIFFS) {
9966                 $ret .= "<plaintext>".LJ::S1w2::_make_diff($s1result, $ret);
9967             }
9968         }
9969
9970     }
9971
9972     unless ($res) {
9973         my $errcode = $opts->{'errcode'};
9974         my $errmsg = {
9975             'nodb' => 'Database temporarily unavailable during maintenance.',
9976             'nosyn' => 'No syndication URL available.',
9977         }->{$errcode};
9978         return "<!-- $errmsg -->" if ($opts->{'vhost'} eq "customview");
9979
9980         # If not customview, set the error response code.
9981         $opts->{'status'} = {
9982             'nodb' => '503 Maintenance',
9983             'nosyn' => '404 Not Found',
9984         }->{$errcode} || '500 Server Error';
9985         return $errmsg;
9986     }
9987
9988     if ($opts->{'redir'}) {
9989         return undef;
9990     }
9991
9992     # clean up attributes which we weren't able to quickly verify
9993     # as safe in the Storable-stored clean copy of the style.
9994     $ret =~ s/\%\%\[attr\[(.+?)\]\]\%\%/LJ::CleanHTML::s1_attribute_clean($1)/eg;
9995
9996     # return it...
9997     return $ret;
9998 }
9999
10000 # <LJFUNC>
10001 # name: LJ::canonical_username
10002 # des: normalizes username.
10003 # info:
10004 # args: user
10005 # returns: the canonical username given, or blank if the username is not well-formed
10006 # </LJFUNC>
10007 sub canonical_username
10008 {
10009     my $user = shift;
10010     if ($user =~ /^\s*([A-Za-z0-9_\-]{1,15})\s*$/) {
10011         # perl 5.8 bug:  $user = lc($1) sometimes causes corruption when $1 points into $user.
10012         $user = $1;
10013         $user = lc($user);
10014         $user =~ s/-/_/g;
10015         return $user;
10016     }
10017     return "";  # not a good username.
10018 }
10019
10020 # <LJFUNC>
10021 # name: LJ::get_userid
10022 # des: Returns a userid given a username.
10023 # info: Results cached in memory.  On miss, does DB call.  Not advised
10024 #       to use this many times in a row... only once or twice perhaps
10025 #       per request.  Tons of serialized db requests, even when small,
10026 #       are slow.  Opposite of [func[LJ::get_username]].
10027 # args: user
10028 # des-user: Username whose userid to look up.
10029 # returns: Userid, or 0 if invalid user.
10030 # </LJFUNC>
10031 sub get_userid {
10032     my $user = shift;
10033
10034     $user = LJ::canonical_username($user);
10035
10036     if (exists $LJ::PRELOADED_USER_IDS{$user} && !$LJ::IS_DEV_SERVER) { return $LJ::PRELOADED_USER_IDS{$user}; }
10037     if ($LJ::CACHE_USERID{$user}) { return $LJ::CACHE_USERID{$user}; }
10038
10039     my $userid = LJ::MemCacheProxy::get("uidof:$user");
10040     return $LJ::CACHE_USERID{$user} = $userid if $userid;
10041
10042     my $dbr = LJ::get_db_reader();
10043     $userid = $dbr->selectrow_array("SELECT userid FROM useridmap WHERE user=?", undef, $user);
10044
10045     # implicitly create an account if we're using an external
10046     # auth mechanism
10047     if (! $userid && ref $LJ::AUTH_EXISTS eq "CODE")
10048     {
10049         $userid = LJ::create_account({ 'user' => $user,
10050                                        'name' => $user,
10051                                        'password' => '', });
10052     }
10053
10054     if ($userid) {
10055         $LJ::CACHE_USERID{$user} = $userid;
10056         LJ::MemCacheProxy::set("uidof:$user", $userid);
10057     }
10058
10059     return ($userid+0);
10060 }
10061
10062 # TODO: Rewrite that function in more optimal way!
10063 sub get_userid_multi {
10064     my($users) = @_;
10065     my @res;
10066
10067     for my $user ( @$users ) {
10068         my $userid = LJ::get_userid( $user );
10069         push @res, $userid if $userid;
10070     }
10071
10072     return @res;
10073 }
10074
10075 # <LJFUNC>
10076 # name: LJ::want_user
10077 # des: Returns user object when passed either userid or user object. Useful to functions that
10078 #      want to accept either.
10079 # args: user
10080 # des-user: Either a userid or a user hash with the userid in its 'userid' key.
10081 # returns: The user object represented by said userid or username.
10082 # </LJFUNC>
10083 sub want_user
10084 {
10085     my $uuid = shift;
10086     return undef unless $uuid;
10087     return $uuid if ref $uuid;
10088     return LJ::load_userid($uuid) if $uuid =~ /^\d+$/;
10089     Carp::croak("Bogus caller of LJ::want_user with non-ref/non-numeric parameter: $uuid");
10090 }
10091
10092 # <LJFUNC>
10093 # name: LJ::get_username
10094 # des: Returns a username given a userid.
10095 # info: Results cached in memory.  On miss, does DB call.  Not advised
10096 #       to use this many times in a row... only once or twice perhaps
10097 #       per request.  Tons of serialized db requests, even when small,
10098 #       are slow.  Opposite of [func[LJ::get_userid]].
10099 # args: user
10100 # des-user: Username whose userid to look up.
10101 # returns: Userid, or 0 if invalid user.
10102 # </LJFUNC>
10103 sub get_username {
10104     my $userid = shift;
10105     $userid += 0;
10106
10107     # Checked the cache first.
10108     if ($LJ::CACHE_USERNAME{$userid}) { return $LJ::CACHE_USERNAME{$userid}; }
10109
10110     # if we're using memcache, it's faster to just query memcache for
10111     # an entire $u object and just return the username.  otherwise, we'll
10112     # go ahead and query useridmap
10113     if (@LJ::MEMCACHE_SERVERS) {
10114         my $u = LJ::load_userid($userid);
10115         return undef unless $u;
10116
10117         $LJ::CACHE_USERNAME{$userid} = $u->{'user'};
10118         return $u->{'user'};
10119     }
10120
10121     my $dbr = LJ::get_db_reader();
10122     my $user = $dbr->selectrow_array("SELECT user FROM useridmap WHERE userid=?", undef, $userid);
10123
10124     # Fall back to master if it doesn't exist.
10125     unless (defined $user) {
10126         my $dbh = LJ::get_db_writer();
10127         $user = $dbh->selectrow_array("SELECT user FROM useridmap WHERE userid=?", undef, $userid);
10128     }
10129
10130     return undef unless defined $user;
10131
10132     $LJ::CACHE_USERNAME{$userid} = $user;
10133     return $user;
10134 }
10135
10136 # <LJFUNC>
10137 # name: LJ::can_manage_other
10138 # des: Given a user and a target user, will determine if the first user is an
10139 #      admin for the target user, but not if the two are the same.
10140 # args: remote, u
10141 # des-remote: user object or userid of user to try and authenticate
10142 # des-u: user object or userid of target user
10143 # returns: bool: true if authorized, otherwise fail
10144 # </LJFUNC>
10145 sub can_manage_other {
10146     my ($remote, $u) = @_;
10147     return 0 if LJ::want_userid($remote) == LJ::want_userid($u);
10148     $remote = LJ::want_user($remote);
10149     return $remote && $remote->can_manage($u);
10150 }
10151
10152 sub can_delete_journal_item {
10153     my ($remote, $u, $itemid) = @_;
10154     $remote = LJ::want_user($remote);
10155
10156     return 0 unless $remote;
10157
10158     return 0 unless $remote->can_manage($u);
10159     # here admin or supermaintainer
10160
10161     return 0 if $LJ::JOURNALS_WITH_PROTECTED_CONTENT{ $u->{user} } and !LJ::is_friend($u, $remote);
10162
10163     return 1;
10164 }
10165
10166
10167 # <LJFUNC>
10168 # name: LJ::get_remote
10169 # des: authenticates the user at the remote end based on their cookies
10170 #      and returns a hashref representing them.
10171 # args: opts?
10172 # des-opts: 'criterr': scalar ref to set critical error flag.  if set, caller
10173 #           should stop processing whatever it's doing and complain
10174 #           about an invalid login with a link to the logout page.
10175 #           'ignore_ip': ignore IP address of remote for IP-bound sessions
10176 # returns: hashref containing 'user' and 'userid' if valid user, else
10177 #          undef.
10178 # </LJFUNC>
10179 sub get_remote {
10180     my $opts = ref $_[0] eq "HASH" ? shift : {};
10181
10182     return $LJ::CACHE_REMOTE if $LJ::CACHED_REMOTE && ! $opts->{'ignore_ip'};
10183
10184     my $no_remote = sub {
10185         LJ::User->set_remote(undef);
10186         return undef;
10187     };
10188
10189     # can't have a remote user outside of web context
10190     return $no_remote->() unless LJ::Request->is_inited;
10191
10192     my $get_as = LJ::Request->get_param('as');
10193     if ( $LJ::IS_DEV_SERVER && $get_as =~ /^\w{1,15}$/ ) {
10194         my $ru = LJ::load_user($get_as);
10195
10196         # might be undef, to allow for "view as logged out":
10197         LJ::set_remote($ru);
10198         return $ru;
10199     }
10200
10201     my $criterr = $opts->{criterr} || do { my $d; \$d; };
10202     $$criterr = 0;
10203
10204     $LJ::CACHE_REMOTE_BOUNCE_URL = "";
10205
10206     # set this flag if any of their ljsession cookies contained the ".FS"
10207     # opt to use the fast server.  if we later find they're not logged
10208     # in and set it, or set it with a free account, then we give them
10209     # the invalid cookies error.
10210     my $tried_fast = 0;
10211     my $sessobj = LJ::Session->session_from_cookies(
10212         tried_fast   => \$tried_fast,
10213         redirect_ref => \$LJ::CACHE_REMOTE_BOUNCE_URL,
10214         ignore_ip    => $opts->{ignore_ip},
10215     );
10216
10217     my $u = $sessobj ? $sessobj->owner : undef;
10218
10219     # inform the caller that this user is faking their fast-server cookie
10220     # attribute.
10221     if ($tried_fast && ! LJ::get_cap($u, "fastserver")) {
10222         $$criterr = 1;
10223     }
10224
10225     return $no_remote->() unless $sessobj;
10226
10227     # renew soon-to-expire sessions
10228     $sessobj->try_renew;
10229
10230     # augment hash with session data;
10231     $u->{'_session'} = $sessobj;
10232
10233     # keep track of activity for the user we just loaded from db/memcache
10234     # - if necessary, this code will actually run in Apache's cleanup handler
10235     #   so latency won't affect the user
10236     if (@LJ::MEMCACHE_SERVERS && ! $LJ::DISABLED{active_user_tracking}) {
10237         push @LJ::CLEANUP_HANDLERS, sub { $u->note_activity('A') };
10238     }
10239
10240     LJ::User->set_remote($u);
10241     LJ::Request->notes("ljuser" => $u->{'user'});
10242     return $u;
10243 }
10244
10245 # returns either $remote or the authenticated user that $remote is working with
10246 sub get_effective_remote {
10247     my $authas_arg = shift || "authas";
10248
10249     return undef unless LJ::is_web_context();
10250
10251     my $remote = LJ::get_remote();
10252     return undef unless $remote;
10253
10254     my $authas = $BMLCodeBlock::GET{authas} || $BMLCodeBlock::POST{authas} || $remote->user;
10255     return $remote if $authas eq $remote->user;
10256
10257     return LJ::get_authas_user($authas);
10258 }
10259
10260 # returns URL we have to bounce the remote user to in order to
10261 # get their domain cookie
10262 sub remote_bounce_url {
10263     return $LJ::CACHE_REMOTE_BOUNCE_URL;
10264 }
10265
10266 sub set_remote {
10267     my $remote = shift;
10268     LJ::User->set_remote($remote);
10269     1;
10270 }
10271
10272 sub unset_remote
10273 {
10274     LJ::User->unset_remote;
10275     1;
10276 }
10277
10278 sub get_active_journal
10279 {
10280     return $LJ::ACTIVE_JOURNAL;
10281 }
10282
10283 sub set_active_journal
10284 {
10285     $LJ::ACTIVE_JOURNAL = shift;
10286 }
10287
10288 # Checks if they are flagged as having a bad password and redirects
10289 # to changepassword.bml.  If returl is on it returns the URL to
10290 # redirect to vs doing the redirect itself.  Useful in non-BML context
10291 # and for QuickReply links
10292 sub bad_password_redirect {
10293     my $opts = shift;
10294
10295     my $remote = LJ::get_remote();
10296     return undef unless $remote;
10297
10298     return undef if $LJ::DISABLED{'force_pass_change'};
10299
10300     return undef unless $remote->prop('badpassword');
10301
10302     my $redir = "$LJ::SITEROOT/changepassword.bml";
10303     unless (defined $opts->{'returl'}) {
10304         return BML::redirect($redir);
10305     } else {
10306         return $redir;
10307     }
10308 }
10309
10310 # Returns HTML to display user search results
10311 # Args: %args
10312 # des-args:
10313 #           users    => hash ref of userid => u object like LJ::load userids
10314 #                       returns or array ref of user objects
10315 #           userids  => array ref of userids to include in results, ignored
10316 #                       if users is defined
10317 #           timesort => set to 1 to sort by last updated instead
10318 #                       of username
10319 #           perpage  => Enable pagination and how many users to display on
10320 #                       each page
10321 #           curpage  => What page of results to display
10322 #           navbar   => Scalar reference for paging bar
10323 #           pickwd   => userpic keyword to display instead of default if it
10324 #                       exists for the user
10325 #           self_link => Sub ref to generate link to use for pagination
10326 sub user_search_display {
10327     my %args = @_;
10328
10329     my $loaded_users;
10330     unless (defined $args{users}) {
10331         $loaded_users = LJ::load_userids(@{$args{userids}});
10332     } else {
10333         if (ref $args{users} eq 'HASH') { # Assume this is direct from LJ::load_userids
10334             $loaded_users = $args{users};
10335         } elsif (ref $args{users} eq 'ARRAY') { # They did a grep on it or something
10336             foreach (@{$args{users}}) {
10337                 $loaded_users->{$_->{userid}} = $_;
10338             }
10339         } else {
10340             return undef;
10341         }
10342     }
10343
10344     # If we're sorting by last updated, we need to load that
10345     # info for all users before the sort.  If sorting by
10346     # username we can load it for a subset of users later,
10347     # if paginating.
10348     my $updated;
10349     my @display;
10350
10351     if ($args{timesort}) {
10352         $updated = LJ::get_timeupdate_multi(keys %$loaded_users);
10353         @display = sort { $updated->{$b->{userid}} <=> $updated->{$a->{userid}} } values %$loaded_users;
10354     } else {
10355         @display = sort { $a->{user} cmp $b->{user} } values %$loaded_users;
10356     }
10357
10358     if (defined $args{perpage}) {
10359         my %items = BML::paging(\@display, $args{curpage}, $args{perpage});
10360
10361         # Fancy paging bar
10362         my $opts;
10363         $opts->{self_link} = $args{self_link} if $args{self_link};
10364         ${$args{navbar}} = LJ::paging_bar($items{'page'}, $items{'pages'}, $opts);
10365
10366         # Now pull out the set of users to display
10367         @display = @{$items{'items'}};
10368     }
10369
10370     # If we aren't sorting by time updated, load last updated time for the
10371     # set of users we are displaying.
10372     $updated = LJ::get_timeupdate_multi(map { $_->{userid} } @display)
10373         unless $args{timesort};
10374
10375     # Allow caller to specify a custom userpic to use instead
10376     # of the user's default all userpics
10377     my $get_picid = sub {
10378         my $u = shift;
10379         return $u->{'defaultpicid'} unless $args{'pickwd'};
10380         return LJ::get_picid_from_keyword($u, $args{'pickwd'});
10381     };
10382
10383     my $ret;
10384     foreach my $u (@display) {
10385         # We should always have loaded user objects, but it seems
10386         # when the site is overloaded we don't always load the users
10387         # we request.
10388         next unless LJ::isu($u);
10389
10390         $ret .= "<div style='width: 300px; height: 105px; overflow: hidden; float: left; ";
10391         $ret .= "border-bottom: 1px solid <?altcolor2?>; margin-bottom: 10px; padding-bottom: 5px; margin-right: 10px'>";
10392         $ret .= "<table style='height: 105px'><tr>";
10393
10394         $ret .= "<td style='width: 100px; text-align: center;'>";
10395         $ret .= "<a href='/allpics.bml?user=$u->{user}'>";
10396         if (my $picid = $get_picid->($u)) {
10397             $ret .= "<img src='$LJ::USERPIC_ROOT/$picid/$u->{userid}' alt='$u->{user} userpic' style='border: 1px solid #000;' />";
10398         } else {
10399             $ret .= "<img src='$LJ::STATPREFIX/horizon/nouserpic.png?v=2621' alt='no default userpic' style='border: 1px solid #000;' width='100' height='100' />";
10400         }
10401         $ret .= "</a>";
10402
10403         $ret .= "</td><td style='padding-left: 5px;' valign='top'><table>";
10404
10405         $ret .= "<tr><td class='searchusername' colspan='2' style='text-align: left;'>";
10406         $ret .= $u->ljuser_display({ head_size => $args{head_size} });
10407         $ret .= "</td></tr><tr>";
10408
10409         if ($u->{name}) {
10410             $ret .= "<td width='1%' style='font-size: smaller' valign='top'>Name:</td><td style='font-size: smaller'><a href='" . $u->profile_url . "'>";
10411             $ret .= LJ::ehtml($u->{name});
10412             $ret .= "</a>";
10413             $ret .= "</td></tr><tr>";
10414         }
10415
10416         if (my $jtitle = $u->prop('journaltitle')) {
10417             $ret .= "<td width='1%' style='font-size: smaller' valign='top'>Journal:</td><td style='font-size: smaller'><a href='" . $u->journal_base . "'>";
10418             $ret .= LJ::ehtml($jtitle) . "</a>";
10419             $ret .= "</td></tr>";
10420         }
10421
10422         $ret .= "<tr><td colspan='2' style='text-align: left; font-size: smaller' class='lastupdated'>";
10423
10424         if ($updated->{$u->{'userid'}} > 0) {
10425             $ret .= "Updated ";
10426             $ret .= LJ::TimeUtil->ago_text(time() - $updated->{$u->{'userid'}});
10427         } else {
10428             $ret .= "Never updated";
10429         }
10430
10431         $ret .= "</td></tr>";
10432
10433         $ret .= "</table>";
10434         $ret .= "</td></tr>";
10435         $ret .= "</table></div>";
10436     }
10437
10438     return $ret;
10439 }
10440
10441 # returns the country that the remote IP address comes from
10442 # undef is returned if the country cannot be determined from the IP
10443 sub country_of_remote_ip {
10444     my $ip = LJ::get_remote_ip();
10445     return undef unless $ip;
10446
10447     if (LJ::GeoLocation->can('get_country_info_by_ip')) {
10448         ## use module LJ::GeoLocation if it's installed
10449         return LJ::GeoLocation->get_country_info_by_ip($ip)
10450     } elsif (eval "use IP::Country::Fast; 1;") {
10451         my $reg = IP::Country::Fast->new();
10452         my $country = $reg->inet_atocc($ip);
10453
10454         # "**" is returned if the IP is private
10455         return undef if $country eq "**";
10456         return $country;
10457     }
10458
10459     return undef;
10460 }
10461
10462 sub get_aggregated_user {
10463     my ($row, $opts) = @_;
10464
10465     my $user = eval { LJ::load_userid($row->{userid}) };
10466
10467     return unless $user;
10468
10469     return unless $opts->{attrs} && ref $opts->{attrs};
10470
10471     my @identity_methods;
10472
10473     foreach my $method (@{$opts->{attrs}}) {
10474         if($method =~ /^identity_(.+)/) {
10475             push @identity_methods, $1;
10476             next;
10477         }
10478
10479         my @result = eval {$user->$method};
10480         ($row->{$method}) = @result > 1 ? \@result : @result;
10481     }
10482
10483     return unless (@identity_methods && $user->is_identity);
10484
10485     my $i = $user->identity;
10486
10487     foreach my $method (@identity_methods) {
10488         my @result = eval {$i->$method};
10489         ($row->{'identity_'.$method}) = @result > 1 ? \@result : @result;
10490     }
10491 }
10492
10493 # Return friends with type
10494 # Types:
10495 #   C -> Community
10496 #   P -> Personal
10497 #   I -> Identity
10498 #   Y -> Syndicated
10499 #   S -> Shared
10500 #   N -> News
10501 sub get_friends_with_type {
10502     my ($u, $options) = @_;
10503
10504     my $types = $options->{types};
10505     my $limit = $options->{limit};
10506
10507     die "no user" unless $u;
10508     die "no type" unless $types;
10509
10510     my %allow_list = map { $_ => 1 } @$types;
10511
10512     #
10513     # Exclude some friends types to type  P.
10514     #
10515     if ($allow_list{'P'}) {
10516         my %types_data = map { $_ => 1 } @$types;
10517
10518         my @types_list = ('I', 'Y', 'N', 'C');
10519         my @types_to_load = ();
10520
10521         #
10522         # May do not need to exclude  all friends
10523         #
10524         foreach my $type (@types_list) {
10525             push @types_to_load, $type
10526                 unless $types_data{$type};
10527         }
10528
10529         my @exclude = get_friends_with_type($u, { types => \@types_to_load,
10530                                                   limit => $limit });
10531
10532         my %exclude_list = map { $_ => 1 } @exclude;
10533         my @friends = $u->friend_uids(limit => $limit);
10534         my @list =  grep { !$exclude_list{$_}  } @friends;
10535
10536         return @list;
10537     }
10538
10539     #mnenonic User:FriendsList:
10540     my @keys = map { "u:fl:" . $u->userid . ":$_"} @$types ;
10541
10542     my $redis = LJ::Redis->get_connection();
10543     if ($redis) {
10544         my @list = ();
10545         foreach my $key (@keys) {
10546             my @result = $redis->smembers($key);
10547             push @list, @result if @result;
10548         }
10549
10550         return @list if @list;
10551     }
10552
10553     # get and set a list
10554
10555     my @friends = $u->friend_uids();
10556     my $friends_data = LJ::get_journal_short_info_multi(@friends);
10557
10558     my @typed_journals = ();
10559     my %put_in_cache = ();
10560     foreach my $friend (@friends) {
10561         my $friend_info = $friends_data->{$friend};
10562         next if $friend_info->{statusvis} eq 'X' ||
10563                 $friend_info->{clusterid} == 0;
10564
10565         my $type = $friend_info->{journaltype};
10566         next unless $allow_list{$type};
10567
10568         push @{$put_in_cache{$type}}, $friend if $redis;
10569         push @typed_journals, $friend;
10570     }
10571
10572     if ($redis) {
10573         foreach my $type (keys %put_in_cache) {
10574             my $key = "u:fl:" . $u->userid . ":$type";
10575             $redis->sadd($key, @{$put_in_cache{$type}});
10576             $redis->expire($key, 60 * 60);
10577         }
10578     }
10579
10580     return @typed_journals;
10581 }
10582
10583 sub remove_from_friend_list {
10584     my ($u, $friend) = @_;
10585
10586     my $type = $friend->journaltype;
10587     my $key  = "u:fl:" . $u->userid . ":$type";
10588     my $redis = LJ::Redis->get_connection();
10589     if ($redis) {
10590         $redis->srem($key, $friend);
10591     }
10592 }
10593
10594 sub add_to_friend_list {
10595     my ($u, $friend) = @_;
10596
10597     my $type = $friend->journaltype;
10598     my $key  = "u:fl:" . $u->userid . ":$type";
10599     my $redis = LJ::Redis->get_connection();
10600
10601     if ($redis && $redis->exists($key)) {
10602         $redis->sadd($key, $friend);
10603     }
10604 }
10605
10606 sub get_journal_short_info_multi {
10607     my @userids = @_;
10608     my @keys = ();
10609
10610     foreach my $userid (@userids) {
10611         push @keys, "u:s:$userid";
10612     }
10613
10614     my %final_result = ();
10615
10616     my $result = LJ::MemCache::get_multi(@keys);
10617
10618     my @users_to_load = ();
10619     foreach my $userid (@userids) {
10620         my $data = delete $result->{"u:s:$userid"};
10621         unless ($data) {
10622             push @users_to_load, $userid;
10623         } else {
10624             my %user_result = ();
10625
10626             my ($status, $cid, $type) = split(/:/, $data);
10627             $user_result{statusvis}    = $status;
10628             $user_result{clusterid}    = $cid;
10629             $user_result{journaltype}  = $type;
10630
10631             $final_result{$userid} = \%user_result;
10632         }
10633     }
10634
10635     my $users = LJ::load_userids(@users_to_load);
10636
10637     foreach my $userid (@users_to_load) {
10638         my $user = $users->{$userid};
10639
10640         if ($user) {
10641             my $status  = $user->{statusvis};
10642             my $cid     = $user->{clusterid};
10643             my $type    = $user->{journaltype};
10644
10645             my %user_result = ();
10646
10647             $user_result{statusvis}    = $status;
10648             $user_result{clusterid}    = $cid;
10649             $user_result{journaltype}  = $type;
10650
10651             $final_result{$userid} = \%user_result;
10652
10653             my $cache = join(':', $status, $cid, $type);
10654             my $expire_time = time + 60*60*24*30;
10655             LJ::MemCache::set("u:s:$userid", $cache, $expire_time);
10656         }
10657     }
10658
10659     return \%final_result;
10660 }
10661
10662 1;