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     return $lastpublic if $opts{from_redis};
3904
3905     my $err;
3906
3907     my $is_person = $u->is_person;
3908
3909     my $req = {
3910         'userid'      => $u->userid,
3911         'clusterid'   => $u->clusterid,
3912         'skip'        => 0,
3913         'itemshow'    => 1,
3914         'friendsview' => 1,
3915         'security'    => "public",
3916         'load_props'  => $is_person ? 1 : 0,
3917         'err'         => \$err,
3918     };
3919
3920     $lastpublic = 0;
3921
3922     my ($skip, $itemshow) = (0, 10);
3923
3924     until ( $lastpublic ) {
3925
3926         my @entries = ();
3927         $req->{'entry_objects'} = \@entries;
3928
3929         $req->{'skip'}     = $skip;
3930         $req->{'itemshow'} = $is_person ? $itemshow : 1;
3931
3932         LJ::get_recent_items($req);
3933
3934         if ($err) {
3935             warn "Error loading recent_entries: $err";
3936             undef $lastpublic;
3937             last;
3938         }
3939
3940         last unless @entries;
3941
3942         foreach my $entry (@entries) {
3943             unless( $is_person && $entry->prop('repost') && $entry->prop('repost') eq 'e' ) {
3944                 $lastpublic = LJ::TimeUtil->mysqldate_to_time($entry->{logtime}, 0);
3945                 last;
3946             }
3947         }
3948
3949         $skip += $itemshow;
3950     }
3951
3952     if (defined $lastpublic) {
3953         $u->{$attr} = $lastpublic;
3954         $redis->set($key, $lastpublic) if $redis;
3955     }
3956
3957     return $lastpublic;
3958 }
3959
3960
3961 sub get_last_public_entry_time_multi {
3962     my ($class, $uids) = @_;
3963
3964     return unless $uids && @$uids;
3965
3966     my $redis = LJ::Redis->get_connection || return;
3967
3968     my @keys = map {"lpt.$_"} @$uids;
3969
3970     my @res = $redis->mget(@keys);
3971
3972     my $res = { map { $uids->[$_] => $res[$_] } (0..$#res) };
3973
3974     return $res;
3975 }
3976
3977 # set the last public entry time
3978 # do it only if key already exists, i.e. if somebody has already request it
3979 sub set_last_public_entry_time {
3980     my ($u, $lastpublic) = @_;
3981
3982     my $key  = "lpt.".$u->id;
3983     my $attr = '_cache_last_public_time';
3984
3985     $u->{$attr} = $lastpublic;
3986
3987     my $redis = LJ::Redis->get_connection || return;
3988
3989     return unless $redis->exists($key);
3990     $redis->set($key, $lastpublic);
3991
3992 }
3993
3994 # delete last public entry time
3995 sub del_last_public_entry_time {
3996     my ($u) = @_;
3997
3998     my $key  = "lpt.".$u->id;
3999     my $attr = '_cache_last_public_time';
4000
4001     delete $u->{$attr};
4002
4003     my $redis = LJ::Redis->get_connection || return;
4004     $redis->del($key);
4005 }
4006
4007 # can this user use ESN?
4008 sub can_use_esn {
4009     my $u = shift;
4010     return 0 if $LJ::DISABLED{esn};
4011     my $disable = $LJ::DISABLED{esn_ui};
4012     return 1 unless $disable;
4013
4014     if (ref $disable eq 'CODE') {
4015         return $disable->($u) ? 0 : 1;
4016     }
4017
4018     return $disable ? 0 : 1;
4019 }
4020
4021 sub can_use_sms {
4022     my $u = shift;
4023     return LJ::SMS->can_use_sms($u);
4024 }
4025
4026 sub can_use_ljphoto {
4027     my $u = shift;
4028
4029     return $u->is_personal ? 1 : 0;
4030 }
4031
4032 sub can_upload_photo {
4033     my $u = shift;
4034
4035     return 0 unless $u->can_use_ljphoto();
4036     return $u->get_cap('disk_quota') ? 1 : 0;
4037 }
4038
4039 sub ajax_auth_token {
4040     my $u = shift;
4041     return LJ::Auth->ajax_auth_token($u, @_);
4042 }
4043
4044 sub check_ajax_auth_token {
4045     my $u = shift;
4046     return LJ::Auth->check_ajax_auth_token($u, @_);
4047 }
4048
4049 # returns username
4050 *username = \&user;
4051 sub user {
4052     my $u = shift;
4053     return $u->{user};
4054 }
4055
4056 sub user_url_arg {
4057     my $u = shift;
4058     return "I,$u->{userid}" if $u->{journaltype} eq "I";
4059     return $u->{user};
4060 }
4061
4062 # returns username for display
4063 sub display_username {
4064     my $u = shift;
4065     my $need_cut = shift || 0;
4066
4067     my $username = $u->{user};
4068     if ($u->is_identity){
4069         $username = $u->display_name;
4070         if ($need_cut){
4071             my $short_name = substr ($username, 0, 16);
4072             if ($username eq $short_name) {
4073                 $username = $short_name;
4074             } else {
4075                 $username = $short_name . "...";
4076             }
4077         }
4078     }
4079
4080     return LJ::ehtml($username);
4081 }
4082
4083 # returns the user-specified name of a journal exactly as entered
4084 sub name_orig {
4085     my $u = shift;
4086     return $u->{name};
4087 }
4088
4089 # returns the user-specified name of a journal in valid UTF-8
4090 sub name_raw {
4091     my $u = shift;
4092     LJ::text_out(\$u->{name});
4093     return $u->{name};
4094 }
4095
4096 # returns the user-specified name of a journal in valid UTF-8
4097 # and with HTML escaped
4098 sub name_html {
4099     my $u = shift;
4100     return LJ::ehtml($u->name_raw);
4101 }
4102
4103 # userid
4104 *userid = \&id;
4105 sub id {
4106     my $u = shift;
4107     return int($u->{userid});
4108 }
4109
4110 sub clusterid {
4111     my $u = shift;
4112     return $u->{clusterid};
4113 }
4114
4115 # class method, returns { clusterid => [ uid, uid ], ... }
4116 sub split_by_cluster {
4117     my $class = shift;
4118
4119     my @uids = @_;
4120     my $us = LJ::load_userids(@uids);
4121
4122     my %clusters;
4123     foreach my $u (values %$us) {
4124         next unless $u;
4125         push @{$clusters{$u->clusterid}}, $u->id;
4126     }
4127
4128     return \%clusters;
4129 }
4130
4131 ## Returns current userhead for user.
4132 sub userhead {
4133     my $u    = shift;
4134     my $opts = +shift || {};
4135
4136     my $userhead_override;
4137     LJ::run_hooks( 'override_userhead', $u, \$userhead_override );
4138     return ( $userhead_override, 16, 16 ) if $userhead_override;
4139
4140     my $head_size = $opts->{head_size};
4141
4142     my $userhead   = 'userinfo.gif?v=17080';
4143     my $userhead_w = 16;
4144     my $userhead_h = undef;
4145
4146     ## special icon?
4147     my ($icon, $size) = LJ::run_hook("head_icon",
4148                                      $u, head_size => $head_size);
4149     if ($icon){
4150         ## yeap.
4151         $userhead = $icon;
4152         $userhead_w = $size || 16;
4153         $userhead_h = $userhead_w;
4154         return $userhead, $userhead_w, $userhead_h;
4155     }
4156
4157     ## default way
4158     if (!$LJ::IS_SSL && ($icon = $u->custom_usericon)) {
4159         $userhead = $icon;
4160         $userhead_w = 16;
4161     } elsif ($u->is_community) {
4162         if ($head_size) {
4163             $userhead = "comm_${head_size}.gif";
4164             $userhead_w = $head_size;
4165         } else {
4166             $userhead = "community.gif?v=556";
4167             $userhead_w = 16;
4168         }
4169     } elsif ($u->is_syndicated) {
4170         if ($head_size) {
4171             $userhead = "syn_${head_size}.gif";
4172             $userhead_w = $head_size;
4173         } else {
4174             $userhead = "syndicated.gif?v=6283";
4175             $userhead_w = 16;
4176         }
4177     } elsif ($u->is_news) {
4178         if ($head_size) {
4179             $userhead = "news_${head_size}.gif";
4180             $userhead_w = $head_size;
4181         } else {
4182             $userhead = "newsinfo.gif?v=2990";
4183             $userhead_w = 16;
4184         }
4185     } elsif ($u->is_identity) {
4186         my $ident  = $u->identity;
4187         my $params = $ident ? $ident->ljuser_display_params($u, $opts) : {};
4188         $userhead     = $params->{'userhead'}     || $userhead;
4189         $userhead_w   = $params->{'userhead_w'}   || $userhead_w;
4190         $userhead_h   = $params->{'userhead_h'}   || $userhead_h;
4191     } else {
4192         if ($head_size) {
4193             $userhead = "user_${head_size}.gif";
4194             $userhead_w = $head_size;
4195         } else {
4196             $userhead = "userinfo.gif?v=17080";
4197             $userhead_w = 16;
4198         }
4199     }
4200     $userhead_h ||= $userhead_w;
4201     return $userhead, $userhead_w, $userhead_h;
4202 }
4203
4204 sub userhead_url {
4205     my $u = shift;
4206     my ($userhead) = $u->userhead;
4207     return undef unless $userhead;
4208     return $userhead if $userhead =~ m|^https?://|;
4209     return join '', $LJ::IMGPREFIX, '/', $userhead, '?v=', $LJ::CURRENT_VERSION;
4210 }
4211
4212 sub bio {
4213     my $u = shift;
4214     return LJ::get_bio($u);
4215 }
4216
4217 # if bio_absent is set to "yes", bio won't be updated
4218 sub set_bio {
4219     my ($u, $text, $bio_absent) = @_;
4220     $bio_absent = "" unless $bio_absent;
4221
4222     my $oldbio = $u->bio;
4223     my $newbio = $bio_absent eq "yes" ? $oldbio : $text;
4224     my $has_bio = ($newbio =~ /\S/) ? "Y" : "N";
4225
4226     my %update = (
4227         'has_bio' => $has_bio,
4228     );
4229     LJ::update_user($u, \%update);
4230
4231     # update their bio text
4232     if (($oldbio ne $text) && $bio_absent ne "yes") {
4233         if ($has_bio eq "N") {
4234             $u->do("DELETE FROM userbio WHERE userid=?", undef, $u->id);
4235             $u->dudata_set('B', 0, 0);
4236         } else {
4237             $u->do("REPLACE INTO userbio (userid, bio) VALUES (?, ?)",
4238                    undef, $u->id, $text);
4239             $u->dudata_set('B', 0, length($text));
4240         }
4241         LJ::MemCache::set([$u->id, "bio:" . $u->id], $text);
4242     }
4243 }
4244
4245 sub opt_ctxpopup {
4246     my $u = shift;
4247
4248     # if unset, default to on
4249     my $prop = $u->raw_prop('opt_ctxpopup') || 'Y';
4250
4251     return $prop eq 'Y';
4252 }
4253
4254 # opt_imagelinks format:
4255 # 0|1 - replace images with placeholders at friends page
4256 # :   - delimiter
4257 # 0|1 - replace images with placeholders in comments at entry page
4258 sub get_opt_imagelinks {
4259     my $u = shift;
4260     my $opt = $u->prop("opt_imagelinks") || "0:0";
4261     $opt = "0:0" unless $opt;
4262     $opt = "1:0" unless $opt =~ /^\d\:\d$/;
4263     return $opt;
4264 }
4265
4266 sub opt_placeholders_comments {
4267     my $u = shift;
4268     my $opt = $u->get_opt_imagelinks;
4269
4270     if ( $opt =~ /^\d\:(\d)$/ ) {
4271         return $1;
4272     }
4273
4274     return 0;
4275 }
4276
4277 sub get_opt_videolinks {
4278     my $u = shift;
4279     my $opt = $u->raw_prop("opt_embedplaceholders") || "0:0";
4280     $opt = "0:0" if ! $opt || $opt eq 'N';
4281     $opt = "1:0" unless $opt =~ /^\d\:\d$/;
4282     return $opt;
4283 }
4284
4285 sub opt_embedplaceholders {
4286     my $u = shift;
4287     my $opt = $u->get_opt_videolinks;
4288
4289     if ( $opt =~ /^(\d)\:\d$/ ) {
4290         return $1;
4291     }
4292
4293     return 0;
4294 }
4295
4296 sub opt_videoplaceholders_comments {
4297     my $u = shift;
4298     my $opt = $u->get_opt_videolinks;
4299
4300     if ( $opt =~ /^\d\:(\d)$/ ) {
4301         return $1;
4302     }
4303
4304     return 0;
4305 }
4306
4307 sub opt_getting_started {
4308     my $u = shift;
4309
4310     # if unset, default to on
4311     my $prop = $u->raw_prop('opt_getting_started') || 'Y';
4312
4313     return $prop;
4314 }
4315
4316 sub opt_stylealwaysmine {
4317     my $u = shift;
4318
4319     return 0 unless $u->can_use_stylealwaysmine;
4320     return $u->raw_prop('opt_stylealwaysmine') eq 'Y' ? 1 : 0;
4321 }
4322
4323 sub can_use_stylealwaysmine {
4324     my $u = shift;
4325     my $ret = 0;
4326
4327     return 0 if $LJ::DISABLED{stylealwaysmine};
4328     $ret = LJ::run_hook("can_use_stylealwaysmine", $u);
4329     return $ret;
4330 }
4331
4332 sub opt_commentsstylemine {
4333     my $u = shift;
4334
4335     return 0 unless $u->can_use_commentsstylemine;
4336
4337     if ( $u->raw_prop('opt_stylemine') ) {
4338         $u->set_prop( opt_stylemine => 0 );
4339         $u->set_prop( opt_commentsstylemine => 'Y' );
4340     }
4341
4342     return $u->raw_prop('opt_commentsstylemine') eq 'Y'? 1 : 0;
4343 }
4344
4345 sub can_use_commentsstylemine {
4346     return 0 unless LJ::is_enabled('comments_style_mine');
4347     return 1;
4348 }
4349
4350 sub has_enabled_getting_started {
4351     my $u = shift;
4352
4353     return $u->opt_getting_started eq 'Y' ? 1 : 0;
4354 }
4355
4356
4357 # ***                                                                      *** #
4358 # ***************************** OBSOLETE ************************************* #
4359 # ***                                                                      *** #
4360 # This method sends messages using djabberd servers
4361 # which have been changed with Ejabberd. So method is obsolete.
4362 # Code to send messages to Ejabberd is in cgi-bin/LJ/NotificationMethod/IM.pm
4363 #
4364 #
4365 # find what servers a user is logged in to, and send them an IM
4366 # returns true if sent, false if failure or user not logged on
4367 # Please do not call from web context
4368 sub send_im {
4369     my ($self, %opts) = @_;
4370
4371     croak "Can't call in web context" if LJ::is_web_context();
4372
4373     my $from = delete $opts{from};
4374     my $msg  = delete $opts{message} or croak "No message specified";
4375
4376     croak "No from or bot jid defined" unless $from || $LJ::JABBER_BOT_JID;
4377
4378     my @resources = keys %{LJ::Jabber::Presence->get_resources($self)} or return 0;
4379
4380     my $res = $resources[0] or return 0; # FIXME: pick correct server based on priority?
4381     my $pres = LJ::Jabber::Presence->new($self, $res) or return 0;
4382     my $ip = $LJ::JABBER_SERVER_IP || '127.0.0.1';
4383
4384     my $sock = IO::Socket::INET->new(PeerAddr => "${ip}:5200")
4385         or return 0;
4386
4387     my $vhost = $LJ::DOMAIN;
4388
4389     my $to_jid   = $self->user   . '@' . $LJ::DOMAIN;
4390     my $from_jid = $from ? $from->user . '@' . $LJ::DOMAIN : $LJ::JABBER_BOT_JID;
4391
4392     my $emsg = LJ::exml($msg);
4393     my $stanza = LJ::eurl(qq{<message to="$to_jid" from="$from_jid"><body>$emsg</body></message>});
4394
4395     print $sock "send_stanza $vhost $to_jid $stanza\n";
4396
4397     my $start_time = time();
4398
4399     while (1) {
4400         my $rin = '';
4401         vec($rin, fileno($sock), 1) = 1;
4402         select(my $rout=$rin, undef, undef, 1);
4403         if (vec($rout, fileno($sock), 1)) {
4404             my $ln = <$sock>;
4405             return 1 if $ln =~ /^OK/;
4406         }
4407
4408         last if time() > $start_time + 5;
4409     }
4410
4411     return 0;
4412 }
4413
4414 # returns whether or not the user is online on jabber
4415 sub jabber_is_online {
4416     my $u = shift;
4417
4418     return keys %{LJ::Jabber::Presence->get_resources($u)} ? 1 : 0;
4419 }
4420
4421 sub esn_inbox_default_expand {
4422     my $u = shift;
4423
4424     my $prop = $u->raw_prop('esn_inbox_default_expand');
4425     return $prop ne 'N';
4426 }
4427
4428 sub rate_log {
4429     my ($u, $ratename, $count, $opts) = @_;
4430     LJ::rate_log($u, $ratename, $count, $opts);
4431 }
4432
4433 sub rate_check {
4434     my ($u, $ratename, $count, $opts) = @_;
4435     LJ::rate_check($u, $ratename, $count, $opts);
4436 }
4437
4438 sub statusvis {
4439     my $u = shift;
4440     return $u->{statusvis};
4441 }
4442
4443 sub statusvisdate {
4444     my $u = shift;
4445     return $u->{statusvisdate};
4446 }
4447
4448 sub statusvisdate_unix {
4449     my $u = shift;
4450     return LJ::TimeUtil->mysqldate_to_time($u->{statusvisdate});
4451 }
4452
4453 # returns list of all previous statuses of the journal
4454 # in order from newest to oldest
4455 sub get_previous_statusvis {
4456     my $u = shift;
4457
4458     my $records = LJ::User::Userlog->get_records( $u,
4459         'action' => 'accountstatus' );
4460
4461     my @statusvis;
4462     foreach my $record (@$records) {
4463         push @statusvis, $record->extra_unpacked->{'old'};
4464     }
4465
4466     return @statusvis;
4467 }
4468
4469 # set_statusvis only change statusvis parameter, all accompanied actions are done in set_* methods
4470 sub set_statusvis {
4471     my ($u, $statusvis) = @_;
4472
4473     LJ::MemCache::delete('u:s:' . $u->userid);
4474
4475     croak "Invalid statusvis: $statusvis"
4476         unless $statusvis =~ /^(?:
4477             V|       # visible
4478             D|       # deleted
4479             X|       # expunged
4480             S|       # suspended
4481             L|       # locked
4482             M|       # memorial
4483             O|       # read-only
4484             R        # renamed
4485                                 )$/x;
4486
4487     # log the change to userlog, but only in case we have a valid clusterid;
4488     # this check addresses the case when an expunged user gets suspended
4489     if ( $u->clusterid ) {
4490         # remote looked up by create()
4491         LJ::User::UserlogRecord::AccountStatus->create( $u,
4492             'old' => $u->statusvis, 'new' => $statusvis );
4493     }
4494
4495     # do update
4496     my $ret = LJ::update_user($u, { statusvis => $statusvis,
4497                                  raw => 'statusvisdate=NOW()' });
4498
4499     LJ::run_hooks("props_changed", $u, {statusvis => $statusvis});
4500
4501     $u->fb_push;
4502
4503     return $ret;
4504 }
4505
4506 sub set_visible {
4507     my $u = shift;
4508
4509     LJ::run_hooks("account_will_be_visible", $u);
4510     return $u->set_statusvis('V');
4511 }
4512
4513 sub set_deleted {
4514     my $u = shift;
4515     my $res = $u->set_statusvis('D');
4516
4517     # run any account cancellation hooks
4518     LJ::run_hooks("account_delete", $u);
4519     return $res;
4520 }
4521
4522 sub set_expunged {
4523     my $u = shift;
4524     return $u->set_statusvis('X');
4525 }
4526
4527 sub set_suspended {
4528     my ($u, $who, $reason, $errref, $public_reason) = @_;
4529     die "Not enough parameters for LJ::User::set_suspended call" unless $who and $reason;
4530
4531     my $res = $u->set_statusvis('S');
4532     unless ($res) {
4533         $$errref = "DB error while setting statusvis to 'S'" if ref $errref;
4534         return $res;
4535     }
4536
4537     LJ::statushistory_add($u, $who, "suspend", $reason);
4538
4539     # close all spamreports on this user
4540     my $dbh = LJ::get_db_writer();
4541     $dbh->do("UPDATE spamreports SET state='closed' WHERE posterid = ? AND state='open'", undef, $u->userid);
4542
4543     # close all botreports on this user
4544     require LJ::BotReport;
4545     LJ::BotReport->close_requests($u->userid);
4546
4547     #
4548     LJ::run_hooks("account_cancel", $u);
4549     LJ::run_hooks("account_suspend", $u);
4550
4551     if ($public_reason) {
4552         LJ::statushistory_add($u, $who, "suspend_reason", $public_reason);
4553         $u->set_prop('suspend_reason' => $public_reason);
4554     }
4555
4556     if (my $err = LJ::run_hook("cdn_purge_userpics", $u)) {
4557         $$errref = $err if ref $errref and $err;
4558         return 0;
4559     }
4560
4561     return $res; # success
4562 }
4563
4564 # sets a user to visible, but also does all of the stuff necessary when a suspended account is unsuspended
4565 # this can only be run on a suspended account
4566 sub set_unsuspended {
4567     my ($u, $who, $reason, $errref) = @_;
4568     die "Not enough parameters for LJ::User::set_unsuspended call" unless $who and $reason;
4569
4570     unless ($u->is_suspended) {
4571         $$errref = "User isn't suspended" if ref $errref;
4572         return 0;
4573     }
4574
4575     my $res = $u->set_statusvis('V');
4576     unless ($res) {
4577         $$errref = "DB error while setting statusvis to 'V'" if ref $errref;
4578         return $res;
4579     }
4580
4581     LJ::statushistory_add($u, $who, "unsuspend", $reason);
4582     LJ::run_hooks("account_unsuspend", $u);
4583
4584     return $res; # success
4585 }
4586
4587 sub set_locked {
4588     my $u = shift;
4589     return $u->set_statusvis('L');
4590 }
4591
4592 sub set_memorial {
4593     my $u = shift;
4594     return $u->set_statusvis('M');
4595 }
4596
4597 sub set_readonly {
4598     my $u = shift;
4599     return $u->set_statusvis('O');
4600 }
4601
4602 sub set_renamed {
4603     my $u = shift;
4604     return $u->set_statusvis('R');
4605 }
4606
4607 # returns if this user is considered visible
4608 sub is_visible {
4609     my $u = shift;
4610     return ($u->statusvis eq 'V' && $u->clusterid != 0);
4611 }
4612
4613 sub is_deleted {
4614     my $u = shift;
4615     return $u->statusvis eq 'D';
4616 }
4617
4618 sub is_expunged {
4619     my $u = shift;
4620     return $u->statusvis eq 'X' || $u->clusterid == 0;
4621 }
4622
4623 sub is_suspended {
4624     my $u = shift;
4625     return $u->statusvis eq 'S';
4626 }
4627
4628 sub is_locked {
4629     my $u = shift;
4630     return $u->statusvis eq 'L';
4631 }
4632
4633 sub is_memorial {
4634     my $u = shift;
4635     return $u->statusvis eq 'M';
4636 }
4637
4638 sub is_readonly {
4639     my $u = shift;
4640     return $u->statusvis eq 'O';
4641 }
4642
4643 sub is_renamed {
4644     my $u = shift;
4645     return $u->statusvis eq 'R';
4646 }
4647
4648 sub caps {
4649     my $u = shift;
4650     return $u->{caps};
4651 }
4652
4653 sub is_sup {
4654     my $u = shift;
4655     return $u->in_class('sup_user') && !$u->in_class('sup_optout');
4656 }
4657
4658 *get_post_count = \&number_of_posts;
4659 sub number_of_posts {
4660     my ($u, %opts) = @_;
4661
4662     # to count only a subset of all posts
4663     if (%opts) {
4664         $opts{return} = 'count';
4665         return $u->get_post_ids(%opts);
4666     }
4667
4668     my $memkey = [$u->{userid}, "log2ct:$u->{userid}"];
4669     my $expire = time() + 3600*24*2; # 2 days
4670     return LJ::MemCache::get_or_set($memkey, sub {
4671         return $u->selectrow_array("SELECT COUNT(*) FROM log2 WHERE journalid=?",
4672                                    undef, $u->{userid});
4673     }, $expire);
4674 }
4675
4676 # return the number if public posts
4677 sub number_of_public_posts {
4678     my ($u) = @_;
4679     my $memkey = [$u->{userid}, "log2publicct:$u->{userid}"];
4680     my $expire = time() + 300;  # 5 min
4681     return LJ::MemCache::get_or_set($memkey, sub {
4682         return $u->get_post_ids(return => 'count', security => 'public');
4683     }, $expire);
4684 }
4685
4686
4687 # return the number of posts that the user actually posted themselves
4688 sub number_of_posted_posts {
4689     my $u = shift;
4690
4691     my $num = $u->number_of_posts;
4692     $num-- if LJ::run_hook('user_has_auto_post', $u);
4693
4694     return $num;
4695 }
4696
4697 # <LJFUNC>
4698 # name: LJ::get_post_ids
4699 # des: Given a user object and some options, return the number of posts or the
4700 #      posts'' IDs (jitemids) that match.
4701 # returns: number of matching posts, <strong>or</strong> IDs of
4702 #          matching posts (default).
4703 # args: u, opts
4704 # des-opts: 'security' - [public|private|usemask]
4705 #           'allowmask' - integer for friends-only or custom groups
4706 #           'start_date' - UTC date after which to look for match
4707 #           'end_date' - UTC date before which to look for match
4708 #           'return' - if 'count' just return the count
4709 #           TODO: Add caching?
4710 # </LJFUNC>
4711 sub get_post_ids {
4712     my ($u, %opts) = @_;
4713
4714     my $query = 'SELECT';
4715     my @vals; # parameters to query
4716
4717     if ($opts{'start_date'} || $opts{'end_date'}) {
4718         croak "start or end date not defined"
4719             if (!$opts{'start_date'} || !$opts{'end_date'});
4720
4721         if (!($opts{'start_date'} >= 0) || !($opts{'end_date'} >= 0) ||
4722             !($opts{'start_date'} <= $LJ::EndOfTime) ||
4723             !($opts{'end_date'} <= $LJ::EndOfTime) ) {
4724             return undef;
4725         }
4726     }
4727
4728     # return count or jitemids
4729     if ($opts{'return'} eq 'count') {
4730         $query .= " COUNT(*)";
4731     } else {
4732         $query .= " jitemid";
4733     }
4734
4735     # from the journal entries table for this user
4736     $query .= " FROM log2 WHERE journalid=?";
4737     push(@vals, $u->{userid});
4738
4739     # filter by security
4740     if ($opts{'security'}) {
4741         $query .= " AND security=?";
4742         push(@vals, $opts{'security'});
4743         # If friends-only or custom
4744         if ($opts{'security'} eq 'usemask' && $opts{'allowmask'}) {
4745             $query .= " AND allowmask=?";
4746             push(@vals, $opts{'allowmask'});
4747         }
4748     }
4749
4750     if ($opts{posterid}){
4751         $query .= " AND posterid = ? ";
4752         push @vals => $opts{posterid};
4753     }
4754     if ($opts{afterid}){
4755         $query .= " AND jitemid > ? ";
4756         push @vals => $opts{afterid};
4757     }
4758
4759     # filter by date, use revttime as it is indexed
4760     if ($opts{'start_date'} && $opts{'end_date'}) {
4761         # revttime is reverse event time
4762         my $s_date = $LJ::EndOfTime - $opts{'start_date'};
4763         my $e_date = $LJ::EndOfTime - $opts{'end_date'};
4764         $query .= " AND revttime<?";
4765         push(@vals, $s_date);
4766         $query .= " AND revttime>?";
4767         push(@vals, $e_date);
4768     }
4769
4770     # return count or jitemids
4771     if ($opts{'return'} eq 'count') {
4772         return $u->selectrow_array($query, undef, @vals);
4773     } else {
4774         my $jitemids = $u->selectcol_arrayref($query, undef, @vals) || [];
4775         die $u->errstr if $u->err;
4776         return @$jitemids;
4777     }
4778 }
4779
4780 sub password {
4781     my $u = shift;
4782     return unless $u->is_person;
4783     $u->{_password} ||= LJ::MemCache::get_or_set([$u->{userid}, "pw:$u->{userid}"], sub {
4784         my $dbh = LJ::get_db_writer() or die "Couldn't get db master";
4785         return $dbh->selectrow_array("SELECT password FROM password WHERE userid=?",
4786                                      undef, $u->id);
4787     });
4788     return $u->{_password};
4789 }
4790
4791 sub journaltype {
4792     my $u = shift;
4793     return $u->{journaltype};
4794 }
4795
4796 sub set_password {
4797     my ($u, $password) = @_;
4798     return LJ::set_password($u->id, $password);
4799 }
4800
4801 sub set_email {
4802     my ($u, $email) = @_;
4803     return LJ::set_email($u->id, $email);
4804 }
4805
4806 sub fb_push {
4807     my $u = shift;
4808     eval {
4809         if ($u) {
4810             require LJ::FBInterface;
4811             LJ::FBInterface->push_user_info( $u->id );
4812         }
4813     };
4814     warn "Error running fb_push: $@\n" if $@ && $LJ::IS_DEV_SERVER;
4815 }
4816
4817 sub grant_priv {
4818     my ($u, $priv, $arg) = @_;
4819     $arg ||= "";
4820     my $dbh = LJ::get_db_writer();
4821
4822     return 1 if LJ::check_priv($u, $priv, $arg);
4823
4824     my $privid = $dbh->selectrow_array("SELECT prlid FROM priv_list".
4825                                        " WHERE privcode = ?", undef, $priv);
4826     return 0 unless $privid;
4827
4828     $dbh->do("INSERT INTO priv_map (userid, prlid, arg) VALUES (?, ?, ?)",
4829              undef, $u->id, $privid, $arg);
4830     return 0 if $dbh->err;
4831
4832     undef $u->{'_privloaded'}; # to force reloading of privs later
4833     return 1;
4834 }
4835
4836 sub revoke_priv {
4837     my ($u, $priv, $arg) = @_;
4838     $arg ||="";
4839     my $dbh = LJ::get_db_writer();
4840
4841     return 1 unless LJ::check_priv($u, $priv, $arg);
4842
4843     my $privid = $dbh->selectrow_array("SELECT prlid FROM priv_list".
4844                                        " WHERE privcode = ?", undef, $priv);
4845     return 0 unless $privid;
4846
4847     $dbh->do("DELETE FROM priv_map WHERE userid = ? AND prlid = ? AND arg = ?",
4848              undef, $u->id, $privid, $arg);
4849     return 0 if $dbh->err;
4850
4851     undef $u->{'_privloaded'}; # to force reloading of privs later
4852     undef $u->{'_priv'};
4853     return 1;
4854 }
4855
4856 sub revoke_priv_all {
4857     my ($u, $priv) = @_;
4858     my $dbh = LJ::get_db_writer();
4859
4860     my $privid = $dbh->selectrow_array("SELECT prlid FROM priv_list".
4861                                        " WHERE privcode = ?", undef, $priv);
4862     return 0 unless $privid;
4863
4864     $dbh->do("DELETE FROM priv_map WHERE userid = ? AND prlid = ?",
4865              undef, $u->id, $privid);
4866     return 0 if $dbh->err;
4867
4868     undef $u->{'_privloaded'}; # to force reloading of privs later
4869     undef $u->{'_priv'};
4870     return 1;
4871 }
4872
4873 # must be called whenever birthday, location, journal modtime, journaltype, etc.
4874 # changes.  see LJ/Directory/PackedUserRecord.pm
4875 sub invalidate_directory_record {
4876     my $u = shift;
4877
4878     # Future: ?
4879     # LJ::try_our_best_to("invalidate_directory_record", $u->id);
4880     # then elsewhere, map that key to subref.  if primary run fails,
4881     # put in schwartz, then have one worker (misc-deferred) to
4882     # redo...
4883
4884     my $dbs = defined $LJ::USERSEARCH_DB_WRITER ? LJ::get_dbh($LJ::USERSEARCH_DB_WRITER) : LJ::get_db_writer();
4885     $dbs->do("UPDATE usersearch_packdata SET good_until=0 WHERE userid=?",
4886              undef, $u->id);
4887 }
4888
4889 # Used to promote communities in interest search results
4890 sub render_promo_of_community {
4891     my ($comm, $style) = @_;
4892
4893     return undef unless $comm;
4894
4895     $style ||= 'Vertical';
4896
4897     # get the ljuser link
4898     my $commljuser = $comm->ljuser_display;
4899
4900     # link to journal
4901     my $journal_base = $comm->journal_base;
4902
4903     # get default userpic if any
4904     my $userpic = $comm->userpic;
4905     my $userpic_html = '';
4906     if ($userpic) {
4907         my $userpic_url = $userpic->url;
4908         $userpic_html = qq { <a href="$journal_base"><img src="$userpic_url" /></a> };
4909     }
4910
4911     my $blurb = $comm->prop('comm_promo_blurb') || '';
4912
4913     my $join_link = "$LJ::SITEROOT/community/join.bml?comm=$comm->{user}";
4914     my $watch_link = "$LJ::SITEROOT/friends/add.bml?user=$comm->{user}";
4915     my $read_link = $comm->journal_base;
4916
4917     LJ::need_res("stc/lj_base.css");
4918
4919     # if horizontal, userpic needs to come before everything
4920     my $box_class;
4921     my $comm_display;
4922
4923     if (lc $style eq 'horizontal') {
4924         $box_class = 'Horizontal';
4925         $comm_display = qq {
4926             <div class="Userpic">$userpic_html</div>
4927             <div class="Title">Community Promo</div>
4928             <div class="CommLink">$commljuser</div>
4929         };
4930     } else {
4931         $box_class = 'Vertical';
4932         $comm_display = qq {
4933             <div class="Title">Community Promo</div>
4934             <div class="CommLink">$commljuser</div>
4935             <div class="Userpic">$userpic_html</div>
4936         };
4937     }
4938
4939
4940     my $html = qq {
4941         <div class="CommunityPromoBox">
4942             <div class="$box_class">
4943                 $comm_display
4944                 <div class="Blurb">$blurb</div>
4945                 <div class="Links"><a href="$join_link">Join</a> | <a href="$watch_link">Watch</a> |
4946                     <a href="$read_link">Read</a></div>
4947
4948                 <div class='ljclear'>&nbsp;</div>
4949             </div>
4950         </div>
4951     };
4952
4953     return $html;
4954 }
4955
4956 sub can_expunge {
4957     my $u = shift;
4958
4959     my $statusvisdate = $u->statusvisdate_unix;
4960
4961     # check admin flag "this journal must not be expunged for abuse team
4962     # investigation". hack: if flag is on, then set statusvisdate to now,
4963     # so that the next time worker bin/worker/expunge-users won't check
4964     # this user again.
4965     #
4966     # optimization concern: isn't it too much strain checking this prop
4967     # for every user? well, we've got to check this prop for every user
4968     # that seems eligible anyway, and moveucluster isn't supposed to send
4969     # us users who got too recent statusvisdate or something.
4970     if ($u->prop('dont_expunge_journal')) {
4971         LJ::update_user($u, { raw => 'statusvisdate=NOW()' });
4972         return 0;
4973     }
4974
4975     if ($u->is_deleted) {
4976         my $expunge_days =
4977             LJ::conf_test($LJ::DAYS_BEFORE_EXPUNGE) || 30;
4978
4979         return 0 unless $statusvisdate < time() - 86400 * $expunge_days;
4980
4981         return 1;
4982     }
4983
4984     if ($u->is_suspended) {
4985         return 0 if $LJ::DISABLED{'expunge_suspended'};
4986
4987         my $expunge_days =
4988             LJ::conf_test($LJ::DAYS_BEFORE_EXPUNGE_SUSPENDED) || 30;
4989
4990         return 0 unless $statusvisdate < time() - 86400 * $expunge_days;
4991
4992         return 1;
4993     }
4994
4995     return 0;
4996 }
4997
4998 # Check to see if the user can use eboxes at all
4999 sub can_use_ebox {
5000     my $u = shift;
5001
5002     return ref $LJ::DISABLED{ebox} ? !$LJ::DISABLED{ebox}->($u) : !$LJ::DISABLED{ebox};
5003 }
5004
5005 # Allow users to choose eboxes if:
5006 # 1. The entire ebox feature isn't disabled AND
5007 # 2. The option to choose eboxes isn't disabled OR
5008 # 3. The option to choose eboxes is disabled AND
5009 # 4. The user already has eboxes turned on
5010 sub can_use_ebox_ui {
5011     my $u = shift;
5012     my $allow_ebox = 1;
5013
5014     if ($LJ::DISABLED{ebox_option}) {
5015         $allow_ebox = $u->prop('journal_box_entries');
5016     }
5017
5018     return $u->can_use_ebox && $allow_ebox;
5019 }
5020
5021 # return hashref with intname => intid
5022 sub interests {
5023     my $u = shift;
5024     my $uints = LJ::get_interests($u);
5025     my %interests;
5026
5027     foreach my $int (@$uints) {
5028         $interests{$int->[1]} = $int->[0];  # $interests{name} = intid
5029     }
5030
5031     return \%interests;
5032 }
5033
5034 sub interest_list {
5035     my $u = shift;
5036
5037     return map { $_->[1] } @{ LJ::get_interests($u) };
5038 }
5039
5040 sub interest_count {
5041     my $u = shift;
5042
5043     # FIXME: fall back to SELECT COUNT(*) if not cached already?
5044     return scalar @{LJ::get_interests($u, { justids => 1 })};
5045 }
5046
5047 sub set_interests {
5048     my $u = shift;
5049     LJ::set_interests($u, @_);
5050 }
5051
5052 sub lazy_interests_cleanup {
5053     my $u = shift;
5054
5055     my $dbh = LJ::get_db_writer();
5056
5057     if ($u->is_community) {
5058         $dbh->do("INSERT IGNORE INTO comminterests SELECT * FROM userinterests WHERE userid=?", undef, $u->id);
5059         $dbh->do("DELETE FROM userinterests WHERE userid=?", undef, $u->id);
5060     } else {
5061         $dbh->do("INSERT IGNORE INTO userinterests SELECT * FROM comminterests WHERE userid=?", undef, $u->id);
5062         $dbh->do("DELETE FROM comminterests WHERE userid=?", undef, $u->id);
5063     }
5064
5065     LJ::memcache_kill($u, "intids");
5066     return 1;
5067 }
5068
5069 # this will return a hash of information about this user.
5070 # this is useful for JavaScript endpoints which need to dump
5071 # JSON data about users.
5072 sub info_for_js {
5073     my $u = shift;
5074
5075     my %ret = (
5076                username         => $u->user,
5077                display_username => $u->display_username,
5078                display_name     => $u->display_name,
5079                userid           => $u->userid,
5080                url_journal      => $u->journal_base,
5081                url_profile      => $u->profile_url,
5082                url_allpics      => $u->allpics_base,
5083                is_comm          => $u->is_comm,
5084                is_person        => $u->is_person,
5085                is_syndicated    => $u->is_syndicated,
5086                is_identity      => $u->is_identity,
5087                is_shared        => $u->is_shared,
5088                );
5089     # Without url_message "Send Message" link should not display
5090     $ret{url_message} = $u->message_url unless ($u->opt_usermsg eq 'N');
5091
5092     LJ::run_hook("extra_info_for_js", $u, \%ret);
5093
5094     my $up = $u->userpic;
5095
5096     if ($up) {
5097         $ret{url_userpic} = $up->url;
5098         $ret{userpic_w}   = $up->width;
5099         $ret{userpic_h}   = $up->height;
5100     }
5101
5102     return %ret;
5103 }
5104
5105 sub postreg_completed {
5106     my $u = shift;
5107
5108     return 0 unless $u->bio;
5109     return 0 unless $u->interest_count;
5110     return 1;
5111 }
5112
5113 # return if $target is banned from $u's journal
5114 *has_banned = \&is_banned;
5115 sub is_banned {
5116     my ($u, $target) = @_;
5117     return LJ::is_banned($target->userid, $u->userid);
5118 }
5119
5120 sub ban_user {
5121     my ($u, $ban_u) = @_;
5122
5123     my $remote = LJ::get_remote();
5124     LJ::User::UserlogRecord::BanSet->create( $u,
5125         'bannedid' => $ban_u->userid, 'remote' => $remote );
5126
5127     LJ::run_hooks('ban_set', $u, $ban_u);
5128
5129     $ban_u->clear_cache_friends($u);
5130
5131     return LJ::set_rel($u->id, $ban_u->id, 'B');
5132 }
5133
5134 sub ban_user_multi {
5135     my ($u, @banlist) = @_;
5136
5137     my $us = LJ::load_userids(@banlist);
5138     my $remote = LJ::get_remote();
5139
5140     foreach my $banuid (@banlist) {
5141
5142         next unless $us->{$banuid};
5143
5144         LJ::User::UserlogRecord::BanSet->create( $u,
5145             'bannedid' => $banuid, 'remote' => $remote );
5146
5147         LJ::run_hooks('ban_set', $u, $us->{$banuid}) if $us->{$banuid};
5148
5149         $us->{$banuid}->clear_cache_friends($u);
5150     }
5151
5152     LJ::set_rel_multi(map { [$u->id, $_, 'B'] } @banlist);
5153
5154     return 1;
5155 }
5156
5157 sub unban_user_multi {
5158     my ($u, @unbanlist) = @_;
5159
5160     my $us = LJ::load_userids(@unbanlist);
5161     my $remote = LJ::get_remote();
5162
5163     foreach my $banuid (@unbanlist) {
5164
5165         next unless $us->{$banuid};
5166
5167         LJ::User::UserlogRecord::BanUnset->create( $u,
5168             'bannedid' => $banuid, 'remote' => $remote );
5169
5170         LJ::run_hooks('ban_unset', $u, $us->{$banuid}) if $us->{$banuid};
5171
5172         $us->{$banuid}->clear_cache_friends($u);
5173
5174     }
5175
5176     LJ::clear_rel_multi(map { [$u->id, $_, 'B'] } @unbanlist);
5177
5178     return 1;
5179 }
5180
5181 # returns if this user's polls are clustered
5182 sub polls_clustered {
5183     my $u = shift;
5184     return $u->dversion >= 8;
5185 }
5186
5187 sub dversion {
5188     my $u = shift;
5189     return $u->{dversion};
5190 }
5191
5192 # take a user on dversion 7 and upgrade them to dversion 8 (clustered polls)
5193 sub upgrade_to_dversion_8 {
5194     my $u = shift;
5195     my $dbh = shift;
5196     my $dbhslo = shift;
5197     my $dbcm = shift;
5198
5199     # If user has been purged, go ahead and update version
5200     # Otherwise move their polls
5201     my $ok = $u->is_expunged ? 1 : LJ::Poll->make_polls_clustered($u, $dbh, $dbhslo, $dbcm);
5202
5203     LJ::update_user($u, { 'dversion' => 8 }) if $ok;
5204
5205     return $ok;
5206 }
5207
5208 # returns if this user can join an adult community or not
5209 # adultref will hold the value of the community's adult content flag
5210 sub can_join_adult_comm {
5211     my ($u, %opts) = @_;
5212
5213     return 1 unless LJ::is_enabled('content_flag');
5214
5215     my $adultref = $opts{adultref};
5216     my $comm = $opts{comm} or croak "No community passed";
5217
5218     my $adult_content = $comm->adult_content_calculated;
5219     $$adultref = $adult_content;
5220
5221     if ($adult_content eq "concepts" && ($u->is_child || !$u->best_guess_age) && $LJ::DISABLED{'remove_adult_concepts'}) {
5222         return 0;
5223     } elsif ($adult_content eq "explicit" && ($u->is_minor || !$u->best_guess_age)) {
5224         return 0;
5225     }
5226
5227     return 1;
5228 }
5229
5230
5231 sub is_in_beta {
5232     my ($u, $key) = @_;
5233     return LJ::BetaFeatures->user_in_beta( $u => $key );
5234 }
5235
5236 # return the user's timezone based on the prop if it's defined, otherwise best guess
5237 sub timezone {
5238     my $u = shift;
5239
5240     return $u->{'__timezone_offset'}
5241             if exists $u->{'__timezone_offset'};
5242
5243     my $offset = 0;
5244     LJ::get_timezone($u, \$offset);
5245
5246     $u->{'__timezone_offset'} = $offset;
5247     return $offset;
5248 }
5249
5250 # returns a DateTime object corresponding to a user's "now"
5251 sub time_now {
5252     my $u = shift;
5253
5254     my $now = DateTime->now;
5255
5256     # if user has timezone, use it!
5257     my $tz = $u->prop("timezone");
5258     return $now unless $tz;
5259
5260     $now = eval { DateTime->from_epoch(
5261                                        epoch => time(),
5262                                        time_zone => $tz,
5263                                        );
5264               };
5265
5266     return $now;
5267 }
5268
5269 sub can_admin_content_flagging {
5270     my $u = shift;
5271
5272     return 0 unless LJ::is_enabled("content_flag");
5273     return 1 if $LJ::IS_DEV_SERVER;
5274     return LJ::check_priv($u, "siteadmin", "contentflag");
5275 }
5276
5277 sub can_see_content_flag_button {
5278     my $u = shift;
5279     my %opts = @_;
5280
5281     return 0 unless LJ::is_enabled("content_flag");
5282
5283     my $content = $opts{content};
5284
5285     # user can't flag any journal they manage nor any entry they posted
5286     # user also can't flag non-public entries
5287     if (LJ::isu($content)) {
5288         return 0 if $u->can_manage($content);
5289     } elsif ($content->isa("LJ::Entry")) {
5290         return 0 if $u->equals($content->poster);
5291         return 0 unless $content->security eq "public";
5292     }
5293
5294     # user can't flag anything if their account isn't at least one month old
5295     my $one_month = 60*60*24*30;
5296     return 0 unless time() - $u->timecreate >= $one_month;
5297
5298     return 1;
5299 }
5300
5301 sub can_flag_content {
5302     my $u = shift;
5303     my %opts = @_;
5304
5305     return 0 unless $u->can_see_content_flag_button(%opts);
5306     return 0 if LJ::sysban_check("contentflag", $u->user);
5307     return 0 unless $u->rate_check("ctflag", 1);
5308     return 1;
5309 }
5310
5311 # sometimes when the app throws errors, we want to display "nice"
5312 # text to end-users, while allowing admins to view the actual error message
5313 sub show_raw_errors {
5314     my $u = shift;
5315
5316     return 1 if $LJ::IS_DEV_SERVER;
5317
5318     return 1 if LJ::check_priv($u, "supporthelp");
5319     return 1 if LJ::check_priv($u, "supportviewscreened");
5320     return 1 if LJ::check_priv($u, "siteadmin");
5321
5322     return 0;
5323 }
5324
5325 # defined by the user
5326 # returns 'none', 'concepts' or 'explicit'
5327 sub adult_content {
5328     my $u = shift;
5329
5330     my $prop_value = $u->prop('adult_content');
5331
5332     return $prop_value ? $prop_value : "none";
5333 }
5334
5335 # defined by an admin
5336 sub admin_content_flag {
5337     my $u = shift;
5338
5339     return $u->prop('admin_content_flag');
5340 }
5341
5342 # uses both user- and admin-defined props to figure out the adult content level
5343 sub adult_content_calculated {
5344     my $u = shift;
5345
5346     $u->preload_props(qw/admin_content_flag adult_content/);
5347     return "explicit" if $u->admin_content_flag eq "explicit_adult";
5348     return $u->adult_content;
5349 }
5350
5351 sub show_graphic_previews {
5352     my $u = shift;
5353
5354     my $prop_value = $u->prop('show_graphic_previews');
5355
5356     my $hook_rv = LJ::run_hook("override_show_graphic_previews", $u, $prop_value);
5357     return $hook_rv if defined $hook_rv;
5358
5359     if (!$prop_value) {
5360         return "on";
5361     } elsif ($prop_value eq "explicit_on") {
5362         return "on";
5363     } elsif ($prop_value eq "explicit_off") {
5364         return "off";
5365     }
5366
5367     return "off";
5368 }
5369
5370 sub should_show_graphic_previews {
5371     my $u = shift;
5372
5373     return $u->show_graphic_previews eq "on" ? 1 : 0;
5374 }
5375
5376 # name: can_super_manage
5377 # des: Given a target user and determines that the user is an supermaintainer of community
5378 # returns: bool: true if supermaitainer, otherwise fail
5379 # args: u
5380 # des-u: user object or userid of community
5381 sub can_super_manage {
5382     my $remote  = shift;
5383     my $u       = LJ::want_user(shift);
5384
5385     return undef unless $remote && $u;
5386
5387     # is same user?
5388     return 1 if LJ::u_equals($u, $remote);
5389
5390     # do not allow suspended users manage other accounts
5391     return 0 if $remote->is_suspended;
5392
5393     # people/syn/rename accounts can only be managed by the one account
5394     return undef if $u->{journaltype} =~ /^[PYR]$/;
5395
5396     # check for supermaintainer access
5397     return 1 if LJ::RelationService->is_relation_to($u, $remote, 'S');
5398
5399     # not passed checks, return false
5400     return undef;
5401 }
5402
5403 # name: can_moderate
5404 # des: Given a target user and determines that the user is an moderator for the target user
5405 # returns: bool: true if authorized, otherwise fail
5406 # args: u
5407 # des-u: user object or userid of target user
5408 sub can_moderate {
5409     my $remote  = shift;
5410     my $u       = LJ::want_user(shift);
5411
5412     return undef unless $remote && $u;
5413
5414     # can moderate only community
5415     return undef unless $u->is_community;
5416
5417     # do not allow suspended users manage other accounts
5418     return 0 if $remote->is_suspended;
5419
5420     # people/syn/rename accounts can only be managed by the one account
5421     return undef if $u->{journaltype} =~ /^[PYR]$/;
5422
5423     # check for moderate access
5424     return 1 if LJ::RelationService->is_relation_to($u, $remote, 'M');
5425
5426     # passed not checks, return false
5427     return undef;
5428 }
5429
5430 # name: can_manage
5431 # des: Given a target user and determines that the user is an admin for the taget  user
5432 # returns: bool: true if authorized, otherwise fail
5433 # args: u
5434 # des-u: user object or userid of target user
5435 sub can_manage {
5436     my $remote  = shift;
5437     my $u       = LJ::want_user(shift);
5438
5439     return undef unless $remote && $u;
5440
5441     # is same user?
5442     return 1 if LJ::u_equals($u, $remote);
5443
5444     # people/syn/rename accounts can only be managed by the one account
5445     return undef if $u->{journaltype} =~ /^[PYR]$/;
5446
5447     # do not allow suspended users manage other accounts
5448     return 0 if $remote->is_suspended;
5449
5450     # check for supermaintainer
5451     return 1 if $remote->can_super_manage($u);
5452
5453     return 0 unless LJ::RelationService->is_relation_to($u, $remote, 'A');
5454
5455     # passed checks, return true
5456     return 1;
5457 }
5458
5459 sub can_sweep {
5460     my $remote  = shift;
5461     my $u       = LJ::want_user(shift);
5462
5463     return undef unless $remote && $u;
5464
5465     # is same user?
5466     return 1 if LJ::u_equals($u, $remote);
5467
5468     # do not allow suspended users to be watchers of other accounts.
5469     return 0 if $remote->is_suspended;
5470
5471     # only personal journals can have watchers
5472     return undef unless $u->journaltype eq 'P';
5473
5474     # check for admin access
5475     return undef unless LJ::check_rel($u, $remote, 'W');
5476
5477     return 1;
5478 }
5479
5480 sub hide_adult_content {
5481     my $u = shift;
5482
5483     my $prop_value = $u->prop('hide_adult_content');
5484
5485     if (($u->is_child || !$u->best_guess_age) && $LJ::DISABLED{'remove_adult_concepts'}) {
5486         return "concepts";
5487     }
5488
5489     if ($u->is_minor && $prop_value ne "concepts") {
5490         return "explicit";
5491     }
5492
5493     return $prop_value ? $prop_value : "none";
5494 }
5495
5496 # returns a number that represents the user's chosen search filtering level
5497 # 0 = no filtering
5498 # 1-10 = moderate filtering
5499 # >10 = strict filtering
5500 sub safe_search {
5501     my $u = shift;
5502
5503     my $prop_value = $u->prop('safe_search');
5504
5505     # current user 18+ default is 0
5506     # current user <18 default is 10
5507     # new user default (prop value is "nu_default") is 10
5508     return 0 if $prop_value eq "none";
5509     return $prop_value if $prop_value && $prop_value =~ /^\d+$/;
5510     return 0 if $prop_value ne "nu_default" && $u->best_guess_age && !$u->is_minor;
5511     return 10;
5512 }
5513
5514 # determine if the user in "for_u" should see $u in a search result
5515 sub should_show_in_search_results {
5516     my $u = shift;
5517     my %opts = @_;
5518
5519     return 1 unless LJ::is_enabled("content_flag") && LJ::is_enabled("safe_search");
5520
5521     my $adult_content = $u->adult_content_calculated;
5522     my $admin_flag = $u->admin_content_flag;
5523
5524     my $for_u = $opts{for};
5525     unless (LJ::isu($for_u)) {
5526         return $adult_content ne "none" || $admin_flag ? 0 : 1;
5527     }
5528
5529     my $safe_search = $for_u->safe_search;
5530     return 1 if $safe_search == 0;
5531
5532     my $adult_content_flag_level = $LJ::CONTENT_FLAGS{$adult_content} ? $LJ::CONTENT_FLAGS{$adult_content}->{safe_search_level} : 0;
5533     my $admin_flag_level = $LJ::CONTENT_FLAGS{$admin_flag} ? $LJ::CONTENT_FLAGS{$admin_flag}->{safe_search_level} : 0;
5534
5535     return 0 if $adult_content_flag_level && ($safe_search >= $adult_content_flag_level);
5536     return 0 if $admin_flag_level && ($safe_search >= $admin_flag_level);
5537     return 1;
5538 }
5539
5540 sub equals {
5541     my ($u, $target) = @_;
5542
5543     return LJ::u_equals($u, $target);
5544 }
5545
5546 sub tags {
5547     my $u = shift;
5548
5549     return LJ::Tags::get_usertags($u);
5550 }
5551
5552 sub newpost_minsecurity {
5553     my $u = shift;
5554
5555     my $val = $u->raw_prop('newpost_minsecurity') || 'public';
5556
5557     $val = 'friends'
5558         if ($u->journaltype ne 'P' && $val eq 'private');
5559
5560     return $val;
5561 }
5562
5563 sub third_party_notify_list {
5564     my $u = shift;
5565
5566     my $val = $u->prop('third_party_notify_list');
5567     my @services = split(',', $val);
5568
5569     return @services;
5570 }
5571
5572 # Check if the user's notify list contains a particular service
5573 sub third_party_notify_list_contains {
5574     my $u = shift;
5575     my $val = shift;
5576
5577     return 1 if grep { $_ eq $val } $u->third_party_notify_list;
5578
5579     return 0;
5580 }
5581
5582 # Add a service to a user's notify list
5583 sub third_party_notify_list_add {
5584     my $u = shift;
5585     my $svc = shift;
5586     return 0 unless $svc;
5587
5588     # Is it already there?
5589     return 1 if $u->third_party_notify_list_contains($svc);
5590
5591     # Create the new list of services
5592     my @cur_services = $u->third_party_notify_list;
5593     push @cur_services, $svc;
5594     my $svc_list = join(',', @cur_services);
5595
5596     # Trim a service from the list if it is too long
5597     if (length $svc_list > 255) {
5598         shift @cur_services;
5599         $svc_list = join(',', @cur_services)
5600     }
5601
5602     # Set it
5603     $u->set_prop('third_party_notify_list', $svc_list);
5604     return 1;
5605 }
5606
5607 # Remove a service to a user's notify list
5608 sub third_party_notify_list_remove {
5609     my $u = shift;
5610     my $svc = shift;
5611     return 0 unless $svc;
5612
5613     # Is it even there?
5614     return 1 unless $u->third_party_notify_list_contains($svc);
5615
5616     # Remove it!
5617     $u->set_prop('third_party_notify_list',
5618                  join(',',
5619                       grep { $_ ne $svc } $u->third_party_notify_list
5620                       )
5621                  );
5622     return 1;
5623 }
5624
5625 # can $u add existing tags to $targetu's entries?
5626 sub can_add_tags_to {
5627     my ($u, $targetu) = @_;
5628
5629     return LJ::Tags::can_add_tags($targetu, $u);
5630 }
5631
5632 sub qct_value_for_ads {
5633     my $u = shift;
5634
5635     return 0 unless LJ::is_enabled("content_flag");
5636
5637     my $adult_content = $u->adult_content_calculated;
5638     my $admin_flag = $u->admin_content_flag;
5639
5640     if ($LJ::CONTENT_FLAGS{$adult_content} && $LJ::CONTENT_FLAGS{$adult_content}->{qct_value_for_ads}) {
5641         return $LJ::CONTENT_FLAGS{$adult_content}->{qct_value_for_ads};
5642     }
5643     if ($LJ::CONTENT_FLAGS{$admin_flag} && $LJ::CONTENT_FLAGS{$admin_flag}->{qct_value_for_ads}) {
5644         return $LJ::CONTENT_FLAGS{$admin_flag}->{qct_value_for_ads};
5645     }
5646
5647     return 0;
5648 }
5649
5650 sub should_block_robots {
5651     my $u = shift;
5652
5653     return 1 if $u->prop('opt_blockrobots');
5654
5655     return 0 unless LJ::is_enabled("content_flag");
5656
5657     my $adult_content = $u->adult_content_calculated;
5658     my $admin_flag = $u->admin_content_flag;
5659
5660     return 1 if $LJ::CONTENT_FLAGS{$adult_content} && $LJ::CONTENT_FLAGS{$adult_content}->{block_robots};
5661     return 1 if $LJ::CONTENT_FLAGS{$admin_flag} && $LJ::CONTENT_FLAGS{$admin_flag}->{block_robots};
5662     return 0;
5663 }
5664
5665 # memcache key that holds the number of times a user performed one of the rate-limited actions
5666 sub rate_memkey {
5667     my ($u, $rp) = @_;
5668
5669     return [$u->id, "rate:" . $u->id . ":$rp->{id}"];
5670 }
5671
5672 sub opt_exclude_from_verticals {
5673     my $u = shift;
5674
5675     my $prop_val = $u->prop('opt_exclude_from_verticals');
5676
5677     return $prop_val if $prop_val =~ /^(?:entries)$/;
5678     return "none";
5679 }
5680
5681 sub set_opt_exclude_from_verticals {
5682     my $u = shift;
5683     my $val = shift;
5684
5685     # only set the "none" value if the prop is currently set to something (explicit off)
5686     my $prop_val = $val ? "entries" : undef;
5687     $prop_val = "none" if !$val && $u->prop('opt_exclude_from_verticals');
5688
5689     $u->set_prop( opt_exclude_from_verticals => $prop_val );
5690
5691     return;
5692 }
5693
5694 # prepare OpenId part of html-page, if needed
5695 sub openid_tags {
5696     my $u = shift;
5697
5698     my $head = '';
5699
5700     # OpenID Server and Yadis
5701     if (LJ::OpenID->server_enabled and defined $u) {
5702         my $journalbase = $u->journal_base;
5703         $head .= qq{<link rel="openid2.provider" href="$LJ::OPENID_SERVER" />\n};
5704         $head .= qq{<link rel="openid.server" href="$LJ::OPENID_SERVER" />\n};
5705         $head .= qq{<meta http-equiv="X-XRDS-Location" content="$journalbase/data/yadis" />\n};
5706     }
5707
5708     return $head;
5709 }
5710
5711 # return the number of comments a user has posted
5712 sub num_comments_posted {
5713     my $u = shift;
5714
5715     my $ret = $u->prop('talkleftct2');
5716
5717     unless (defined $ret) {
5718         my $dbr = LJ::get_cluster_reader($u);
5719         $ret = $dbr->selectrow_array(qq{
5720             SELECT COUNT(*) FROM talkleft WHERE userid=?
5721         }, undef, $u->id);
5722
5723         $u->set_prop('talkleftct2' => $ret);
5724     }
5725
5726     return $ret;
5727 }
5728
5729 # increase the number of comments a user has posted by 1
5730 sub incr_num_comments_posted {
5731     my $u = shift;
5732
5733     $u->set_prop('talkleftct2' => $u->num_comments_posted + 1);
5734 }
5735
5736 # return the number of comments a user has received
5737 sub num_comments_received {
5738     my $u = shift;
5739     my %opts = @_;
5740
5741     my $userid = $u->id;
5742     my $memkey = [$userid, "talk2ct:$userid"];
5743     my $count = LJ::MemCache::get($memkey);
5744     unless ($count) {
5745         my $dbcr = $opts{dbh} || LJ::get_cluster_reader($u);
5746         my $expire = time() + 3600*24*2; # 2 days;
5747         $count = $dbcr->selectrow_array("SELECT COUNT(*) FROM talk2 ".
5748                                         "WHERE journalid=?", undef, $userid);
5749         LJ::MemCache::set($memkey, $count, $expire) if defined $count;
5750     }
5751
5752     return $count;
5753 }
5754
5755 # returns undef if there shouldn't be an option for this user
5756 # B = show ads [B]oth to logged-out traffic on the user's journal and on the user's app pages
5757 # J = show ads only to logged-out traffic on the user's [J]ournal
5758 # A = show ads only on the user's [A]pp pages
5759 sub ad_visibility {
5760     my $u = shift;
5761
5762     return undef unless LJ::is_enabled("basic_ads") && LJ::run_hook("user_is_basic", $u);
5763     return 'J' unless LJ::is_enabled("basic_ad_options") && $u->is_personal;
5764
5765     my $prop_val = $u->prop("ad_visibility");
5766     return $prop_val =~ /^[BJA]$/ ? $prop_val : 'B';
5767 }
5768
5769 sub wants_ads_on_app {
5770     my $u = shift;
5771
5772     my $ad_visibility = $u->ad_visibility;
5773     return $ad_visibility eq "B" || $ad_visibility eq "A" ? 1 : 0;
5774 }
5775
5776 sub wants_ads_in_journal {
5777     my $u = shift;
5778
5779     my $ad_visibility = $u->ad_visibility;
5780     return $ad_visibility eq "B" || $ad_visibility eq "J" ? 1 : 0;
5781 }
5782
5783 # format unixtimestamp according to the user's timezone setting
5784 sub format_time {
5785     my $u = shift;
5786     my $time = shift;
5787
5788     return undef unless $time;
5789
5790     return eval { DateTime->from_epoch(epoch=>$time, time_zone=>$u->prop("timezone"))->ymd('-') } ||
5791                   DateTime->from_epoch(epoch => $time)->ymd('-');
5792 }
5793
5794 sub support_points_count {
5795     my $u = shift;
5796
5797     my $dbr = LJ::get_db_reader();
5798     my $userid = $u->id;
5799     my $count;
5800
5801     $count = $u->{_supportpointsum};
5802     return $count if defined $count;
5803
5804     my $memkey = [$userid, "supportpointsum:$userid"];
5805     $count = LJ::MemCache::get($memkey);
5806     if (defined $count) {
5807         $u->{_supportpointsum} = $count;
5808         return $count;
5809     }
5810
5811     $count = $dbr->selectrow_array("SELECT totpoints FROM supportpointsum WHERE userid=?", undef, $userid) || 0;
5812     $u->{_supportpointsum} = $count;
5813     LJ::MemCache::set($memkey, $count, 60*5);
5814
5815     return $count;
5816 }
5817
5818 sub can_be_nudged_by {
5819     my ($u, $nudger) = @_;
5820
5821     return 0 unless LJ::is_enabled("nudge");
5822     return 0 if $u->equals($nudger);
5823     return 0 unless $u->is_personal;
5824     return 0 unless $u->is_visible;
5825     return 0 if $u->prop("opt_no_nudge");
5826     return 0 unless $u->is_mutual_friend($nudger);
5827     return 0 unless time() - $u->timeupdate >= 604800; # updated in the past week
5828
5829     return 1;
5830 }
5831
5832 sub should_show_schools_to {
5833     my ($u, $targetu) = @_;
5834
5835     return 0 unless LJ::is_enabled("schools");
5836     return 1 if $u->prop('opt_showschools') eq '' || $u->prop('opt_showschools') eq 'Y';
5837     return 1 if $u->prop('opt_showschools') eq 'F' && $u->has_friend($targetu);
5838
5839     return 0;
5840 }
5841
5842 sub can_be_text_messaged_by {
5843     my ($u, $sender) = @_;
5844
5845     return 0 unless $u->get_cap("textmessaging");
5846
5847     my $tminfo = LJ::TextMessage->tm_info($u);
5848
5849     ## messaging is disabled for some providers
5850     my $provider = $tminfo ? $tminfo->{provider} : '';
5851     return 0 if $provider eq 'beeline';
5852     return 0 if $provider eq 'megafon';
5853
5854     ##
5855     my $security = $tminfo && $tminfo->{security} ? $tminfo->{security} : "none";
5856     return 0 if $security eq "none";
5857     return 1 if $security eq "all";
5858
5859     if ($sender) {
5860         return 1 if $security eq "reg";
5861         return 1 if $security eq "friends" && $u->has_friend($sender);
5862     }
5863
5864     return 0;
5865 }
5866
5867 # <LJFUNC>
5868 # name: LJ::User::rename_identity
5869 # des: Change an identity user's 'identity', update DB,
5870 #      clear memcache and log change.
5871 # args: user
5872 # returns: Success or failure.
5873 # </LJFUNC>
5874 sub rename_identity {
5875     my $u = shift;
5876     return 0 unless ($u && $u->is_identity && $u->is_expunged);
5877
5878     my $id = $u->identity;
5879     return 0 unless $id;
5880
5881     my $dbh = LJ::get_db_writer();
5882
5883     # generate a new identity value that looks like ex_oldidvalue555
5884     my $tempid = sub {
5885         my $ident = shift;
5886         my $idtype = shift;
5887         my $temp = (length($ident) > 249) ? substr($ident, 0, 249) : $ident;
5888         my $exid;
5889
5890         for (1..10) {
5891             $exid = "ex_$temp" . int(rand(999));
5892
5893             # check to see if this identity already exists
5894             unless ($dbh->selectrow_array("SELECT COUNT(*) FROM identitymap WHERE identity=? AND idtype=? LIMIT 1", undef, $exid, $idtype)) {
5895                 # name doesn't already exist, use this one
5896                 last;
5897             }
5898             # name existed, try and get another
5899
5900             if ($_ >= 10) {
5901                 return 0;
5902             }
5903         }
5904         return $exid;
5905     };
5906
5907     my $from = $id->value;
5908     my $to = $tempid->($id->value, $id->typeid);
5909
5910     return 0 unless $to;
5911
5912     $dbh->do("UPDATE identitymap SET identity=? WHERE identity=? AND idtype=?",
5913              undef, $to, $from, $id->typeid);
5914
5915     LJ::memcache_kill($u, "userid");
5916
5917     LJ::User::InfoHistory->add( $u, 'identity', $from );
5918
5919     return 1;
5920 }
5921
5922 #<LJFUNC>
5923 # name: LJ::User::get_renamed_user
5924 # des: Get the actual user of a renamed user
5925 # args: user
5926 # returns: user
5927 # </LJFUNC>
5928 sub get_renamed_user {
5929     my $u = shift;
5930     my %opts = @_;
5931     my $hops = $opts{hops} || 5;
5932
5933     # Traverse the renames to the final journal
5934     if ($u) {
5935         while ($u and $u->journaltype eq 'R' and $hops-- > 0) {
5936             my $rt = $u->prop("renamedto");
5937             last unless length $rt;
5938             if ($rt =~ /^https?:\/\//){
5939                 if ( my $newu = LJ::User->new_from_url($rt) ) {
5940                     $u = $newu;
5941                 } else {
5942                     warn $u->username . " links to non-existent user at $rt";
5943                     return $u;
5944                 }
5945             } else {
5946                 if ( my $newu = LJ::load_user($rt) ) {
5947                     $u = $newu;
5948                 } else {
5949                     warn $u->username . " links to non-existent user at $rt";
5950                     return $u;
5951                 }
5952             }
5953         }
5954     }
5955
5956     return $u;
5957 }
5958
5959 sub dismissed_page_notices {
5960     my $u = shift;
5961
5962     my $val = $u->prop("dismissed_page_notices");
5963     my @notices = split(",", $val);
5964
5965     return @notices;
5966 }
5967
5968 sub has_dismissed_page_notice {
5969     my $u = shift;
5970     my $notice_string = shift;
5971
5972     return 1 if grep { $_ eq $notice_string } $u->dismissed_page_notices;
5973     return 0;
5974 }
5975
5976 # add a page notice to a user's dismissed page notices list
5977 sub dismissed_page_notices_add {
5978     my $u = shift;
5979     my $notice_string = shift;
5980     return 0 unless $notice_string && $LJ::VALID_PAGE_NOTICES{$notice_string};
5981
5982     # is it already there?
5983     return 1 if $u->has_dismissed_page_notice($notice_string);
5984
5985     # create the new list of dismissed page notices
5986     my @cur_notices = $u->dismissed_page_notices;
5987     push @cur_notices, $notice_string;
5988     my $cur_notices_string = join(",", @cur_notices);
5989
5990     # remove the oldest notice if the list is too long
5991     if (length $cur_notices_string > 255) {
5992         shift @cur_notices;
5993         $cur_notices_string = join(",", @cur_notices);
5994     }
5995
5996     # set it
5997     $u->set_prop("dismissed_page_notices", $cur_notices_string);
5998
5999     return 1;
6000 }
6001
6002 # remove a page notice from a user's dismissed page notices list
6003 sub dismissed_page_notices_remove {
6004     my $u = shift;
6005     my $notice_string = shift;
6006     return 0 unless $notice_string && $LJ::VALID_PAGE_NOTICES{$notice_string};
6007
6008     # is it even there?
6009     return 0 unless $u->has_dismissed_page_notice($notice_string);
6010
6011     # remove it
6012     $u->set_prop("dismissed_page_notices", join(",", grep { $_ ne $notice_string } $u->dismissed_page_notices));
6013
6014     return 1;
6015 }
6016
6017 sub custom_usericon {
6018     my ($u) = @_;
6019
6020     ## Get user's selected userhead
6021     my $selected_uh_id = 0;
6022     my $url = $u->prop('custom_usericon') || '';
6023     if (
6024            $url =~ /userhead/
6025         && $url !~ /v=\d+/
6026         && (my ($uh_id) = ($selected_uh_id) = $url =~ m/\/userhead\/(\d+)$/)
6027     ) {
6028         my $uh = LJ::UserHead->get_userhead ($uh_id);
6029         if ($uh) {
6030             my $uh_fs = LJ::FileStore->get_path_info ( path => "/userhead/".$uh->get_uh_id );
6031             $url .= "?v=".$uh_fs->{'change_time'} if $uh_fs->{'change_time'};
6032         }
6033     }
6034
6035     ## Check for individual userhead
6036     my $indiv_uh_id = 0;
6037     my $propval = $u->prop ('custom_usericon_individual');
6038     if ($propval) {
6039         ## If it buyed we need to check exp date
6040         my $individual_uh_info = LJ::JSON->from_json ($propval);
6041         if ($individual_uh_info->{'date_exp'} > time) {
6042             my ($uh_id) = ($indiv_uh_id) = $individual_uh_info->{'uh_id'} =~ m#uh-(\d+)#;
6043             my $uh = LJ::UserHead->get_userhead ($uh_id);
6044             if ($uh && $selected_uh_id == $indiv_uh_id) {
6045                 my $uh_fs = LJ::FileStore->get_path_info ( path => "/userhead/".$uh_id );
6046                 $url = $LJ::FILEPREFIX."/userhead/".$uh_id;
6047                 $url .= "?v=".$uh_fs->{'change_time'} if $uh_fs->{'change_time'};
6048             }
6049         } else {
6050             ## If indiv userhead was selected and date is expired, set userhead to default
6051             if ($selected_uh_id == $indiv_uh_id) {
6052                 $u->set_custom_usericon (undef);
6053             }
6054         }
6055     }
6056
6057     $url =~ s#^http://files\.livejournal\.com#$LJ::FILEPREFIX#;
6058
6059     return $url;
6060 }
6061
6062 sub custom_usericon_appid {
6063     my ($u) = @_;
6064     return $u->prop('custom_usericon_appid') || 0;
6065 }
6066
6067 sub set_custom_usericon {
6068     my ($u, $url, %opts) = @_;
6069
6070     $u->set_prop( 'custom_usericon' => $url );
6071
6072     if ($opts{application_id}) {
6073         $u->set_prop( 'custom_usericon_appid' => $opts{application_id});
6074     } else {
6075         $u->clear_prop( 'custom_usericon_appid' );
6076     }
6077 }
6078
6079 sub _subscriptions_count {
6080     my ($u) = @_;
6081
6082     my $set = LJ::Subscription::GroupSet->fetch_for_user($u, sub { 0 });
6083
6084     return $set->{'active_count'};
6085 }
6086
6087 sub subscriptions_count {
6088     my ($u) = @_;
6089
6090     my $cached = LJ::MemCache::get('subscriptions_count:'.$u->id);
6091     return $cached if defined $cached;
6092
6093     my $count = $u->_subscriptions_count;
6094     LJ::MemCache::set('subscriptions_count:'.$u->id, $count);
6095     return $count;
6096 }
6097
6098 sub packed_props {
6099     my ($u) = @_;
6100     return $u->{'packed_props'};
6101 }
6102
6103 sub set_packed_props {
6104     my ($u, $newprops) = @_;
6105
6106     LJ::update_user($u, { 'packed_props' => $newprops });
6107     $u->{'packed_props'} = 1;
6108 }
6109
6110 sub init_userprop_def {
6111     my ($class) = @_;
6112
6113     # defaults for S1 style IDs in config file are magic: really
6114     # uniq strings representing style IDs, so on first use, we need
6115     # to map them
6116     unless ($LJ::CACHED_S1IDMAP) {
6117         my $pubsty = LJ::S1::get_public_styles();
6118         foreach (values %$pubsty) {
6119             my $k = "s1_$_->{'type'}_style";
6120             my $needval = "$_->{'type'}/$_->{'styledes'}";
6121             next unless $LJ::USERPROP_DEF{$k} eq $needval;
6122
6123             $LJ::USERPROP_DEF{$k} = $_->{'styleid'};
6124         }
6125
6126         $LJ::CACHED_S1IDMAP = 1;
6127     }
6128 }
6129
6130 sub reset_cache {
6131     my $u = shift;
6132
6133     my $dbcm = LJ::get_cluster_master($u);
6134     return 0 unless $dbcm;
6135
6136     my @keys = qw(
6137         bio:*
6138         cctry_uid:*
6139         commsettings:*
6140         dayct:*
6141         fgrp:*
6142         friendofs:*
6143         friendofs2:*
6144         friends:*
6145         friends2:*
6146         ident:*
6147         inbox:newct:*
6148         intids:*
6149         invites:*
6150         jablastseen:*
6151         jabuser:*
6152         kws:*
6153         lastcomm:*
6154         linkobj:*
6155         log2ct:*
6156         log2lt:*
6157         logtag:*
6158         mcrate:*
6159         memct:*
6160         memkwcnt:*
6161         memkwid:*
6162         msn:mutual_friends_wlids:uid=*
6163         prtcfg:*
6164         pw:*
6165         rate:tracked:*
6166         rcntalk:*
6167         s1overr:*
6168         s1uc:*
6169         saui:*
6170         subscriptions_count:*
6171         supportpointsum:*
6172         synd:*
6173         tags2:*
6174         talk2ct:*
6175         talkleftct:*
6176         tc:*
6177         timeactive:*
6178         timezone_guess:*
6179         tu:*
6180         txtmsgsecurity:*
6181         uid2uniqs:*
6182         upiccom:*
6183         upicinf:*
6184         upicquota:*
6185         upicurl:*
6186         userid:*
6187     );
6188
6189     foreach my $key (@keys) {
6190         $key =~ s/\*/$u->{userid}/g;
6191         LJ::MemCacheProxy::delete([ $u->{userid}, $key ]);
6192     }
6193
6194     my $bio = $dbcm->selectrow_array('SELECT bio FROM userbio WHERE userid = ?', undef, $u->{userid});
6195     if ($bio =~ /\S/ && $u->{has_bio} ne 'Y') {
6196         LJ::update_user($u, { has_bio => 'Y' });
6197     }
6198
6199     $u->do("UPDATE s1usercache SET override_stor = NULL WHERE userid = ?", undef, $u->{userid});
6200
6201     my $dbh = LJ::get_db_writer();
6202     my $themeids = $dbh->selectcol_arrayref('SELECT moodthemeid FROM moodthemes WHERE ownerid = ?', undef, $u->{userid});
6203     if ($themeids && @$themeids) {
6204         foreach my $themeid (@$themeids) {
6205             LJ::MemCache::delete([ $themeid, "moodthemedata:$themeid" ]);
6206         }
6207     }
6208
6209     my $picids = $dbcm->selectcol_arrayref('SELECT picid FROM userpic2 WHERE userid = ?', undef, $u->{userid});
6210     if ($picids && @$picids) {
6211         foreach my $picid (@$picids) {
6212             LJ::MemCache::delete([ $picid, "mogp.up.$picid" ]);
6213             LJ::MemCache::delete([ $picid, "mogp.up.$picid.alt" ]); # alt-zone (only zone at this time)
6214         }
6215     }
6216
6217     my $s2ids = $dbh->selectcol_arrayref('SELECT styleid FROM s2styles WHERE userid = ?', undef, $u->{userid});
6218     if ($s2ids && @$s2ids) {
6219         foreach my $s2id (@$s2ids) {
6220             LJ::MemCache::delete([ $s2id, "s2s:$s2id" ]);
6221             LJ::MemCache::delete([ $s2id, "s2sl:$s2id" ]);
6222         }
6223     }
6224
6225     my $s2lids = $dbcm->selectcol_arrayref('SELECT s2lid FROM s2stylelayers2 WHERE userid = ?', undef, $u->{userid});
6226     if ($s2lids) {
6227         # put it in a hash to remove duplicates so we don't purge one layer twice
6228         my %s2lids = ( map { $_ => 1 } grep { $_ } @$s2lids );
6229         if (keys %s2lids) {
6230             foreach my $s2lid (keys %s2lids) {
6231                 LJ::MemCache::delete([ $s2lid, "s2lo:$s2lid" ]);
6232                 LJ::MemCache::delete([ $s2lid, "s2c:$s2lid" ]);
6233             }
6234         }
6235     }
6236
6237     return 1;
6238 }
6239
6240 ## Check for activity user at last N days
6241 ## args: days - how many days to check
6242 ## return:
6243 ##      1 - user logs in the last 'days' days
6244 ##      0 - user NOT logs in the last 'days' days
6245 sub check_activity {
6246     my $u    = shift;
6247     my $days = shift;
6248
6249     return 0 unless $days;
6250
6251     my $sth = $u->prepare ("SELECT logintime FROM loginlog WHERE userid=? ORDER BY logintime DESC");
6252     $sth->execute ($u->userid);
6253
6254     if (my @row = $sth->fetchrow_array) {
6255         my $logintime = $row[0];
6256         return 1 if time - $logintime < $days * 86400;
6257     }
6258
6259     return 0;
6260 }
6261
6262 sub is_in_whitelist_for_spam {
6263     my $u = shift;
6264     return $u->prop('in_whitelist_for_spam');
6265 }
6266
6267 sub is_spamprotection_enabled {
6268     my $u = shift;
6269     return 0 if $LJ::DISABLED{'spam_button'};
6270     my $spamprotection = $u->prop('spamprotection');
6271     return 0 if $spamprotection eq 'N';
6272     return 1;
6273 }
6274
6275 sub check_non_whitelist_enabled {
6276     my $u = shift;
6277     return 0 if $LJ::DISABLED{'spam_button'};
6278     return 0 unless $u->is_community;
6279     return 0 if $u->prop("moderated") eq 'N';
6280     my $check_non_whitelist = $u->prop('check_non_whitelist');
6281     return 1 if defined($check_non_whitelist) && $check_non_whitelist eq 'Y';
6282     return 0;
6283 }
6284
6285 # return sticky entries existing
6286 sub has_sticky_entry {
6287     my ($self) = @_;
6288     my $sticky_id  = $self->prop("sticky_entry_id");
6289     if ($sticky_id) {
6290         return 1;
6291     }
6292     return 0;
6293 }
6294
6295 # returns sticky entry jitemid
6296 sub get_sticky_entry_id {
6297     my ($self) = @_;
6298     return $self->prop("sticky_entry_id") || '';
6299 }
6300
6301 # returns sticky entry jitemid
6302 sub remove_sticky_entry_id {
6303     my ($self) = @_;
6304     my $ownerid = $self->userid;
6305     LJ::MemCache::delete([$ownerid, "log2lt:$ownerid"]);
6306     $self->clear_prop("sticky_entry_id");
6307 }
6308
6309 # set sticky entry?
6310 sub set_sticky_id {
6311     my ($self, $itemid) = @_;
6312     die "itemid is not set" unless ($itemid);
6313
6314     my $ownerid = $self->userid;
6315     LJ::MemCache::delete([$ownerid, "log2lt:$ownerid"]);
6316     $self->set_prop( sticky_entry_id => $itemid );
6317 }
6318
6319 # set socical influence  information
6320 sub set_social_influence {
6321     my ($self, $social_influence_infornation) = @_;
6322
6323     # update user cached 'social_influence_info'
6324     $self->{'__social_influence_info'} = $social_influence_infornation;
6325
6326     my $new_prop_value = LJ::JSON->to_json($social_influence_infornation) ;
6327     $self->set_prop( 'social_influence_info' => $new_prop_value);
6328 }
6329
6330 # get socical influence  information
6331 sub get_social_influence {
6332     my ($self) = @_;
6333
6334     # Does user contains cache?
6335     if ( !$self->{'__social_influence_info'} ) {
6336         my $prop_value = $self->prop("social_influence_info");
6337         if (!$prop_value) {
6338             return {};
6339         }
6340
6341         $self->{'__social_influence_info'} = LJ::JSON->from_json($prop_value);
6342     }
6343     return $self->{'__social_influence_info'};
6344 }
6345
6346 sub push_subscriptions {
6347     my $u    = shift;
6348     my %opts = @_;
6349
6350     $u->{push_subscriptions} = LJ::PushNotification::Storage->get_all($u)
6351         if !$u->{push_subscriptions} || $opts{flush};
6352
6353     return keys %{$u->{push_subscriptions}};
6354 }
6355
6356 sub push_subscription {
6357     my $u = shift;
6358     my $key = shift;
6359     return $u->{push_subscriptions}{$key} || {};
6360 }
6361
6362 sub disable_promo_announce {
6363     my $u = shift;
6364     $u->set_prop('promo_announce_disabled', 1);
6365 }
6366
6367 sub promo_announce_disabled {
6368     my $u = shift;
6369     return $u->prop('promo_announce_disabled') || 0;
6370 }
6371
6372 sub spam_counter {
6373     my $u = shift;
6374     return $u->prop('spam_counter') || 0;
6375 }
6376
6377 sub clear_spam_counter {
6378     my ($u) = @_;
6379     $u->set_prop('spam_counter', 0);
6380 }
6381
6382 # If true, user migrated old friends to friends and subscriptions
6383 sub is_migrated_to_friends_and_subscriptions {
6384     my ($u) = @_;
6385     return $u->prop('migrated_to_friends_and_subscriptions');
6386 }
6387
6388 sub admin_api_access {
6389     my ($u, $method) = @_;
6390
6391     return unless LJ::isu($u) && $method;
6392
6393     my $privilege = $LJ::API_PRIVILEGES{$method};
6394
6395     my $priv = $privilege->{'priv'};
6396     my $arg  = $privilege->{'arg'};
6397
6398     if ( LJ::check_priv($u, $priv, $arg) ) {
6399         return 1;
6400     }
6401
6402     return 0;
6403 }
6404
6405 package LJ;
6406
6407 use Carp;
6408
6409 # <LJFUNC>
6410 # name: LJ::get_authas_list
6411 # des: Get a list of usernames a given user can authenticate as.
6412 # returns: an array of usernames.
6413 # args: u, opts?
6414 # des-opts: Optional hashref.  keys are:
6415 #           - type: 'P' to only return users of journaltype 'P'.
6416 #                   'S' return users of Supermaintainer type instead Maintainer type.
6417 #           - cap:  cap to filter users on.
6418 # </LJFUNC>
6419 sub get_authas_list {
6420     my ($u, $opts) = @_;
6421
6422     return unless $u;
6423
6424     # used to accept a user type, now accept an opts hash
6425     $opts = { 'type' => $opts } unless ref $opts;
6426
6427     # Two valid types, Personal or Community
6428     $opts->{'type'} = undef unless $opts->{'type'} =~ m/^(P|C|S)$/;
6429
6430     my $ids = LJ::load_rel_target($u, 'S') || [];
6431     if ($opts->{'type'} ne 'S') {
6432         my $a_ids = LJ::load_rel_target($u, 'A') || [];
6433         push @$ids, @$a_ids;
6434     }
6435     return $u->{'user'} unless $ids && @$ids;
6436
6437     $opts->{'type'} = '' if $opts->{'type'} eq 'S';
6438
6439     # load_userids_multiple
6440     my %users;
6441     LJ::load_userids_multiple([ map { $_, \$users{$_} } @$ids ], [$u]);
6442
6443     return map { $_->{'user'} }
6444                grep { ! $opts->{'cap'} || LJ::get_cap($_, $opts->{'cap'}) }
6445                grep { ! $opts->{'type'} || $opts->{'type'} eq $_->{'journaltype'} }
6446
6447                # unless overridden, hide non-visible/non-read-only journals. always display the user's acct
6448                grep { $opts->{'showall'} || $_->is_visible || $_->is_readonly || LJ::u_equals($_, $u) }
6449
6450                # can't work as an expunged account
6451                grep { $_ && ref $_ eq 'LJ::User' && %$_ && !$_->is_expunged && $_->{clusterid} > 0 }
6452                $u,  sort { $a->{'user'} cmp $b->{'user'} } values %users;
6453 }
6454
6455 # <LJFUNC>
6456 # name: LJ::get_postto_list
6457 # des: Get the list of usernames a given user can post to.
6458 # returns: an array of usernames
6459 # args: u, opts?
6460 # des-opts: Optional hashref.  keys are:
6461 #           - type: 'P' to only return users of journaltype 'P'.
6462 #           - cap:  cap to filter users on.
6463 # </LJFUNC>
6464 sub get_postto_list {
6465     my ($u, $opts) = @_;
6466
6467     # used to accept a user type, now accept an opts hash
6468     $opts = { 'type' => $opts } unless ref $opts;
6469
6470     # only one valid type right now
6471     $opts->{'type'} = 'P' if $opts->{'type'};
6472
6473     my $ids = LJ::load_rel_target($u, 'P');
6474     return undef unless $ids;
6475
6476     # load_userids_multiple
6477     my %users;
6478     LJ::load_userids_multiple([ map { $_, \$users{$_} } @$ids ], [$u]);
6479
6480     return $u->{'user'}, sort map { $_->{'user'} }
6481                          grep { ! $opts->{'cap'} || LJ::get_cap($_, $opts->{'cap'}) }
6482                          grep { ! $opts->{'type'} || $opts->{'type'} eq $_->{'journaltype'} }
6483                          grep { $_->clusterid > 0 }
6484                          grep { $_->is_visible }
6485                          values %users;
6486 }
6487
6488 # <LJFUNC>
6489 # name: LJ::trusted
6490 # des: Checks to see if the remote user can use javascript in S2 layers.
6491 # returns: boolean; 1 if remote user can use javascript
6492 # args: userid
6493 # des-userid: id of user to check
6494 # </LJFUNC>
6495 sub trusted {
6496     my ($userid) = @_;
6497
6498     my $u = LJ::load_userid($userid);
6499     return 0 unless $u;
6500
6501     return $u->prop('javascript');
6502 }
6503
6504 # <LJFUNC>
6505 # name: LJ::can_view
6506 # des: Checks to see if the remote user can view a given journal entry.
6507 #      <b>Note:</b> This is meant for use on single entries at a time,
6508 #      not for calling many times on every entry in a journal.
6509 # returns: boolean; 1 if remote user can see item
6510 # args: remote, item
6511 # des-item: Hashref from the 'log' table.
6512 # </LJFUNC>
6513 sub can_view {
6514     my $remote = shift;
6515     my $item = shift;
6516
6517     # public is okay
6518     return 1 if $item->{'security'} eq "public";
6519
6520     # must be logged in otherwise
6521     return 0 unless $remote;
6522
6523     my $userid = int($item->{'ownerid'} || $item->{'journalid'});
6524     my $u = LJ::load_userid($userid);
6525     my $journal_name = $u ? $u->user : '';
6526     my $remoteid = int($remote->{'userid'});
6527
6528     # owners can always see their own.
6529     return 1 if $remote->can_manage($userid);
6530
6531     # author in community can always see their post
6532     return 1 if $remoteid == $item->{'posterid'} and not $LJ::JOURNALS_WITH_PROTECTED_CONTENT{ $journal_name };;
6533
6534     # other people can't read private
6535     return 0 if ($item->{'security'} eq "private");
6536
6537     # should be 'usemask' security from here out, otherwise
6538     # assume it's something new and return 0
6539     return 0 unless ($item->{'security'} eq "usemask");
6540
6541     # if it's usemask, we have to refuse non-personal journals,
6542     # so we have to load the user
6543     return 0 unless $remote->{'journaltype'} eq 'P' || $remote->{'journaltype'} eq 'I';
6544
6545     # TAG:FR:ljlib:can_view  (turn off bit 0 for just watching?  hmm.)
6546     my $gmask = LJ::get_groupmask($userid, $remoteid);
6547     my $allowed = (int($gmask) & int($item->{'allowmask'}));
6548     return $allowed ? 1 : 0;  # no need to return matching mask
6549 }
6550
6551 # <LJFUNC>
6552 # name: LJ::wipe_major_memcache
6553 # des: invalidate all major memcache items associated with a given user.
6554 # args: u
6555 # returns: nothing
6556 # </LJFUNC>
6557 sub wipe_major_memcache
6558 {
6559     my $u = shift;
6560     my $userid = LJ::want_userid($u);
6561     foreach my $key ("userid","bio","talk2ct","log2ct",
6562                      "log2lt","memkwid","s1overr","s1uc","fgrp",
6563                      "friends","friendofs","tu","upicinf","upiccom",
6564                      "upicurl", "intids", "memct", "lastcomm")
6565     {
6566         LJ::memcache_kill($userid, $key);
6567     }
6568 }
6569
6570 # <LJFUNC>
6571 # name: LJ::load_user_props
6572 # des: Given a user hashref, loads the values of the given named properties
6573 #      into that user hashref.
6574 # args: u, opts?, propname*
6575 # des-opts: hashref of opts.  set key 'cache' to use memcache.
6576 # des-propname: the name of a property from the [dbtable[userproplist]] table.
6577 # </LJFUNC>
6578 sub load_user_props {
6579     my ($u, @props) = @_;
6580     return unless ref $u;
6581
6582     my $opts = ref $props[0]? shift @props : {};
6583     unless ( delete $opts->{'reload'} ) {
6584         @props = grep { not exists $u->{$_} } @props;
6585     }
6586
6587     LJ::load_user_props_multi([$u], \@props, $opts);
6588 }
6589
6590 sub load_user_props_multi {
6591     my ($users, $props, $opts) = @_;
6592     my $use_master = $opts->{'use_master'};
6593
6594     $props = [grep { defined and not ref } @$props];
6595     return unless @$props;
6596
6597     $users = { map { $_->{'userid'} => $_ } grep { $_->{'statusvis'} ne 'X' and $_->{'clusterid'} } grep { ref } @$users };
6598     return unless %$users;
6599
6600     $LJ::COUNT_LOAD_PROPS_MULTI++;
6601
6602     my $groups = LJ::User::PropStorage->get_handler_multi(\@$props);
6603     my $memcache_available = @LJ::MEMCACHE_SERVERS;
6604     $use_master = $memcache_available || $use_master;
6605     my $memc_expire = time() + 3600 * 24;
6606
6607     LJ::User->init_userprop_def;
6608
6609     foreach my $handler (keys %$groups) {
6610         my %propkeys = map { $_ => $LJ::USERPROP_DEF{$_} || '' } @{ $groups->{$handler} };
6611
6612         # if there is no memcache, or if the handler doesn't wish to use
6613         # memcache, hit the storage directly, update the user object,
6614         # and get straight to the next handler
6615         if ( not $memcache_available or not defined $handler->use_memcache ) {
6616             foreach my $u (values %$users) {
6617                 my $propmap = {
6618                     %propkeys,
6619                     %{  $handler->get_props($u, $groups->{$handler},
6620                             {
6621                                 use_master => $use_master
6622                             }
6623                         ) || {}
6624                     },
6625                 };
6626
6627                 _extend_user_object->($u, $propmap);
6628             }
6629
6630             next;
6631         }
6632
6633         # now let's find out what we're going to do with memcache
6634         my $memcache_policy = $handler->use_memcache;
6635
6636         if ( $memcache_policy eq 'lite' ) {
6637             my %memkeys;
6638             my $propmaps = LJ::MemCacheProxy::get_multi(map {
6639                 [
6640                     ($_ => ($memkeys{$_} = $handler->memcache_key($users->{$_})))
6641                 ]
6642             } keys %$users);
6643
6644             my ($userid, $v);
6645             my $rmemkeys = { map { $memkeys{$_} => $_ } keys %memkeys };
6646
6647             while (($userid, $v) = each %$propmaps) {
6648                 next unless $v;
6649                 $userid = $rmemkeys->{$userid};
6650
6651                 delete $memkeys{$userid}; # Loading is successfull
6652
6653                 # Hack to init keys for empty props
6654                 my $packed = {
6655                     %propkeys,
6656                     %{ LJ::User::PropStorage->unpack_from_memcache($v) },
6657                 };
6658
6659                 _extend_user_object($users->{$userid}, $packed);
6660             }
6661
6662             while (($userid, $v) = each %memkeys) {
6663                 my $propmap = $handler->get_props(
6664                     $users->{$userid}, [],
6665                     { 'use_master' => $use_master }
6666                 );
6667
6668                 _extend_user_object($users->{$userid}, { %propkeys, %$propmap });
6669
6670                 my $packed = LJ::User::PropStorage->pack_for_memcache($propmap);
6671                 LJ::MemCache::set([$userid, $v], $packed, $memc_expire);
6672             }
6673         } elsif ( $memcache_policy eq 'blob' ) {
6674             my $handled_props = $groups->{$handler};
6675
6676             foreach my $u (values %$users) {
6677                 my $propmap_memc = $handler->fetch_props_memcache($u, $handled_props);
6678
6679                 _extend_user_object($u, { %propkeys, %$propmap_memc });
6680
6681                 my @load_from_db = grep { !exists $propmap_memc->{$_} }
6682                                    @$handled_props;
6683
6684                 # if we can avoid hitting the db, avoid it
6685                 next unless @load_from_db;
6686
6687                 my $propmap_db = $handler->get_props(
6688                     $u, \@load_from_db,
6689                     { 'use_master' => $use_master }
6690                 );
6691
6692                 _extend_user_object($u, $propmap_db);
6693
6694                 # now, update memcache
6695                 $handler->store_props_memcache( $u, $propmap_db );
6696             }
6697         }
6698     }
6699 }
6700
6701 sub _extend_user_object {
6702     my ($u, $propmap) = @_;
6703     return unless ref $u;
6704     return unless ref $propmap eq 'HASH';
6705     my ($k, $v);
6706
6707     $u->{$k} = $v while ($k, $v) = each %$propmap;
6708 }
6709
6710
6711 # <LJFUNC>
6712 # name: LJ::load_userids
6713 # des: Simple interface to [func[LJ::load_userids_multiple]].
6714 # args: userids
6715 # returns: hashref with keys ids, values $u refs.
6716 # </LJFUNC>
6717 sub load_userids {
6718     my %u;
6719     LJ::load_userids_multiple([ map { $_ => \$u{$_} } @_ ]);
6720     return \%u;
6721 }
6722
6723 # <LJFUNC>
6724 # name: LJ::load_userids_multiple
6725 # des: Loads a number of users at once, efficiently.
6726 # info: loads a few users at once, their userids given in the keys of $map
6727 #       listref (not hashref: can't have dups).  values of $map listref are
6728 #       scalar refs to put result in.  $have is an optional listref of user
6729 #       object caller already has, but is too lazy to sort by themselves.
6730 #       <strong>Note</strong>: The $have parameter is deprecated,
6731 #       as is $memcache_only; but it is still preserved for now.
6732 #       Really, this whole API (i.e. LJ::load_userids_multiple) is clumsy.
6733 #       Use [func[LJ::load_userids]] instead.
6734 # args: map, have, memcache_only?
6735 # des-map: Arrayref of pairs (userid, destination scalarref).
6736 # des-have: Arrayref of user objects caller already has.
6737 # des-memcache_only: Flag to only retrieve data from memcache.
6738 # returns: Nothing.
6739 # </LJFUNC>
6740 sub load_userids_multiple {
6741     # the $have parameter is deprecated, as is $memcache_only, but it's still preserved for now.
6742     # actually this whole API is crap.  use LJ::load_userids() instead.
6743     my ($map, undef, $memcache_only) = @_;
6744
6745     my $sth;
6746     my @have;
6747     my %need;
6748     while (@$map) {
6749         my $id = shift @$map;
6750         my $ref = shift @$map;
6751         next unless int($id);
6752         push @{$need{$id}}, $ref;
6753
6754         if ($LJ::REQ_CACHE_USER_ID{$id}) {
6755             push @have, $LJ::REQ_CACHE_USER_ID{$id};
6756         }
6757     }
6758
6759     my $satisfy = sub {
6760         my $u = shift;
6761         return unless ref $u eq "LJ::User";
6762
6763         # this could change the $u returned to an
6764         # existing one we already have loaded in memory,
6765         # once it's been upgraded.  then everybody points
6766         # to the same one.
6767         $u = _set_u_req_cache($u);
6768
6769         foreach (@{$need{$u->{'userid'}}}) {
6770             # check if existing target is defined and not what we already have.
6771             if (my $eu = $$_) {
6772                 LJ::assert_is($u->{userid}, $eu->{userid});
6773             }
6774             $$_ = $u;
6775         }
6776
6777         delete $need{$u->{'userid'}};
6778     };
6779
6780     unless ($LJ::_PRAGMA_FORCE_MASTER) {
6781         foreach my $u (@have) {
6782             $satisfy->($u);
6783         }
6784
6785         if (%need) {
6786             foreach (LJ::memcache_get_u(map { [$_,"userid:$_"] } keys %need)) {
6787                 $satisfy->($_);
6788             }
6789         }
6790     }
6791
6792     if (%need && ! $memcache_only) {
6793         my $db = @LJ::MEMCACHE_SERVERS || $LJ::_PRAGMA_FORCE_MASTER ?
6794             LJ::get_db_writer() : LJ::get_db_reader();
6795
6796         _load_user_raw($db, "userid", [ keys %need ], sub {
6797             my $u = shift;
6798             LJ::memcache_set_u($u);
6799             $satisfy->($u);
6800         });
6801     }
6802 }
6803
6804 # des-db:  $dbh/$dbr
6805 # des-key:  either "userid" or "user"  (the WHERE part)
6806 # des-vals: value or arrayref of values for key to match on
6807 # des-hook: optional code ref to run for each $u
6808 # returns: last $u found
6809 sub _load_user_raw
6810 {
6811     my ($db, $key, $vals, $hook) = @_;
6812     $hook ||= sub {};
6813     $vals = [ $vals ] unless ref $vals eq "ARRAY";
6814
6815     my $use_isam;
6816     unless ($LJ::CACHE_NO_ISAM{user} || scalar(@$vals) > 10) {
6817         eval { $db->do("HANDLER user OPEN"); };
6818         if ($@ || $db->err) {
6819             $LJ::CACHE_NO_ISAM{user} = 1;
6820         } else {
6821             $use_isam = 1;
6822         }
6823     }
6824
6825     my $last;
6826
6827     if ($use_isam) {
6828         $key = "PRIMARY" if $key eq "userid";
6829         foreach my $v (@$vals) {
6830             my $sth = $db->prepare("HANDLER user READ `$key` = (?) LIMIT 1");
6831             $sth->execute($v);
6832             my $row = $sth->fetchrow_hashref;
6833             if ($row) {
6834                 my $u = LJ::User->new_from_row($row);
6835                 $hook->($u);
6836                 $last = $u;
6837             }
6838         }
6839         $db->do("HANDLER user close");
6840     } else {
6841         my $in = join(", ", map { $db->quote($_) } @$vals);
6842         my $sth = $db->prepare("SELECT * FROM user WHERE $key IN ($in)");
6843         $sth->execute;
6844         while (my $row = $sth->fetchrow_hashref) {
6845             my $u = LJ::User->new_from_row($row);
6846             $hook->($u);
6847             $last = $u;
6848         }
6849     }
6850
6851     return $last;
6852 }
6853
6854 sub _set_u_req_cache {
6855     my $u = shift or die "no u to set";
6856
6857     # if we have an existing user singleton, upgrade it with
6858     # the latested data, but keep using its address
6859     if (my $eu = $LJ::REQ_CACHE_USER_ID{$u->{'userid'}}) {
6860         LJ::assert_is($eu->{userid}, $u->{userid});
6861
6862         $eu->{$_} = $u->{$_} foreach keys %$u;
6863         $u = $eu;
6864     }
6865     $LJ::REQ_CACHE_USER_NAME{$u->{'user'}} = $u;
6866     $LJ::REQ_CACHE_USER_ID{$u->{'userid'}} = $u;
6867     return $u;
6868 }
6869
6870 sub load_user_or_identity {
6871     my $arg = shift;
6872
6873     my $user = LJ::canonical_username($arg);
6874     return LJ::load_user($user) if $user;
6875
6876     # return undef if not dot in arg (can't be a URL)
6877     return undef unless $arg =~ /\./;
6878
6879     my $dbh = LJ::get_db_writer();
6880     my $url = lc($arg);
6881     $url = "http://$url" unless $url =~ m!^http://!;
6882     $url .= "/" unless $url =~ m!/$!;
6883     my $uid = $dbh->selectrow_array("SELECT userid FROM identitymap WHERE idtype=? AND identity=?",
6884                                     undef, 'O', $url);
6885     return LJ::load_userid($uid) if $uid;
6886     return undef;
6887 }
6888
6889 # load either a username, or a "I,<userid>" parameter.
6890 sub load_user_arg {
6891     my ($arg) = @_;
6892     my $user = LJ::canonical_username($arg);
6893     return LJ::load_user($user) if length $user;
6894     if ($arg =~ /^I,(\d+)$/) {
6895         my $u = LJ::load_userid($1);
6896         return $u if $u->is_identity;
6897     }
6898     return; # undef/()
6899 }
6900
6901 # <LJFUNC>
6902 # name: LJ::load_user
6903 # des: Loads a user record, from the [dbtable[user]] table, given a username.
6904 # args: user, force?
6905 # des-user: Username of user to load.
6906 # des-force: if set to true, won't return cached user object and will
6907 #            query a dbh.
6908 # returns: Hashref, with keys being columns of [dbtable[user]] table.
6909 # </LJFUNC>
6910 sub load_user {
6911     my ($user, $force) = @_;
6912
6913     $user = LJ::canonical_username($user);
6914     return undef unless length $user;
6915
6916     my $get_user = sub {
6917         my $use_dbh = shift;
6918         my $db = $use_dbh ? LJ::get_db_writer() : LJ::get_db_reader();
6919         my $u = _load_user_raw($db, "user", $user)
6920             or return undef;
6921
6922         # set caches since we got a u from the master
6923         LJ::memcache_set_u($u) if $use_dbh;
6924
6925         return _set_u_req_cache($u);
6926     };
6927
6928     # caller is forcing a master, return now
6929     return $get_user->("master") if $force || $LJ::_PRAGMA_FORCE_MASTER;
6930
6931     my $u;
6932
6933     # return process cache if we have one
6934     if ($u = $LJ::REQ_CACHE_USER_NAME{$user}) {
6935         return $u;
6936     }
6937
6938     # check memcache
6939     {
6940         my $uid;
6941         if (exists $LJ::PRELOADED_USER_IDS{$user} && !$LJ::IS_DEV_SERVER) {
6942             $uid = $LJ::PRELOADED_USER_IDS{$user};
6943         } else {
6944             $uid = LJ::MemCacheProxy::get("uidof:$user");
6945         }
6946
6947         $u = LJ::memcache_get_u([$uid, "userid:$uid"]) if $uid;
6948         return _set_u_req_cache($u) if $u;
6949     }
6950
6951     # try to load from master if using memcache, otherwise from slave
6952     $u = $get_user->(scalar @LJ::MEMCACHE_SERVERS);
6953     return $u if $u;
6954
6955     # setup LDAP handler if this is the first time
6956     if ($LJ::LDAP_HOST && ! $LJ::AUTH_EXISTS) {
6957         require LJ::LDAP;
6958         $LJ::AUTH_EXISTS = sub {
6959             my $user = shift;
6960             my $rec = LJ::LDAP::load_ldap_user($user);
6961             return $rec ? $rec : undef;
6962         };
6963     }
6964
6965     # if user doesn't exist in the LJ database, it's possible we're using
6966     # an external authentication source and we should create the account
6967     # implicitly.
6968     my $lu;
6969     if (ref $LJ::AUTH_EXISTS eq "CODE" && ($lu = $LJ::AUTH_EXISTS->($user)))
6970     {
6971         my $name = ref $lu eq "HASH" ? ($lu->{'nick'} || $lu->{name} || $user) : $user;
6972         if (LJ::create_account({
6973             'user' => $user,
6974             'name' => $name,
6975             'email' => ref $lu eq "HASH" ? $lu->email_raw : "",
6976             'password' => "",
6977         }))
6978         {
6979             # this should pull from the master, since it was _just_ created
6980             return $get_user->("master");
6981         }
6982     }
6983
6984     return undef;
6985 }
6986
6987 sub load_users {
6988     my @users = @_;
6989
6990     my %need = map {$_ => 1} @users;
6991
6992     ## skip loaded
6993     my %loaded;
6994
6995     foreach my $user ( @users ) {
6996         if (my $u = $LJ::REQ_CACHE_USER_NAME{$user}) {
6997             $loaded{$u->userid} = $u;
6998             delete $need{$u->userid};
6999         }
7000     }
7001
7002     ## username to userid and load
7003     my $us = LJ::load_userids( LJ::get_userid_multi( [keys %need] ) );
7004
7005     while ( my ($k, $v) = each %loaded ) {
7006         $us->{$k} = $v;
7007     }
7008
7009     return $us;
7010 }
7011
7012 # <LJFUNC>
7013 # name: LJ::u_equals
7014 # des: Compares two user objects to see if they are the same user.
7015 # args: userobj1, userobj2
7016 # des-userobj1: First user to compare.
7017 # des-userobj2: Second user to compare.
7018 # returns: Boolean, true if userobj1 and userobj2 are defined and have equal userids.
7019 # </LJFUNC>
7020 sub u_equals {
7021     my ($u1, $u2) = @_;
7022     return $u1 && $u2 && $u1->{'userid'} == $u2->{'userid'};
7023 }
7024
7025 # <LJFUNC>
7026 # name: LJ::load_userid
7027 # des: Loads a user record, from the [dbtable[user]] table, given a userid.
7028 # args: userid, force?
7029 # des-userid: Userid of user to load.
7030 # des-force: if set to true, won't return cached user object and will
7031 #            query a dbh
7032 # returns: Hashref with keys being columns of [dbtable[user]] table.
7033 # </LJFUNC>
7034 sub load_userid {
7035     my ($userid, $force) = @_;
7036     return undef unless $userid;
7037
7038     my $get_user = sub {
7039         my $use_dbh = shift;
7040         my $db = $use_dbh ? LJ::get_db_writer() : LJ::get_db_reader();
7041         my $u = _load_user_raw($db, "userid", $userid)
7042             or return undef;
7043
7044         LJ::memcache_set_u($u) if $use_dbh;
7045         return _set_u_req_cache($u);
7046     };
7047
7048     # user is forcing master, return now
7049     return $get_user->("master") if $force || $LJ::_PRAGMA_FORCE_MASTER;
7050
7051     my $u;
7052
7053     # check process cache
7054     $u = $LJ::REQ_CACHE_USER_ID{$userid};
7055     if ($u) {
7056         return $u;
7057     }
7058
7059     # check memcache
7060     $u = LJ::memcache_get_u([$userid,"userid:$userid"]);
7061     return _set_u_req_cache($u) if $u;
7062
7063     # get from master if using memcache
7064     return $get_user->("master") if @LJ::MEMCACHE_SERVERS;
7065
7066     # check slave
7067     $u = $get_user->();
7068     return $u if $u;
7069
7070     # if we didn't get a u from the reader, fall back to master
7071     return $get_user->("master");
7072 }
7073
7074 sub memcache_get_u
7075 {
7076     my @keys = @_;
7077     my @ret;
7078     my $users = LJ::MemCacheProxy::get_multi(@keys) || {};
7079     while (my ($key, $ar) = each %$users) {
7080         my $row = LJ::MemCache::array_to_hash("user", $ar, $key)
7081             or next;
7082         my $u = LJ::User->new_from_row($row);
7083         push @ret, $u;
7084     }
7085     return wantarray ? @ret : $ret[0];
7086 }
7087
7088 sub memcache_set_u
7089 {
7090     my $u = shift;
7091     return unless $u;
7092     my $expire = time() + 1800;
7093     my $ar = LJ::MemCache::hash_to_array("user", $u);
7094     return unless $ar;
7095     LJ::MemCacheProxy::set([$u->{'userid'}, "userid:$u->{'userid'}"], $ar, $expire);
7096     LJ::MemCacheProxy::set("uidof:$u->{user}", $u->{userid});
7097 }
7098
7099 # <LJFUNC>
7100 # name: LJ::get_bio
7101 # des: gets a user bio, from DB or memcache.
7102 # args: u, force
7103 # des-force: true to get data from cluster master.
7104 # returns: string
7105 # </LJFUNC>
7106 sub get_bio {
7107     my ($u, $force) = @_;
7108     return unless $u && $u->{'has_bio'} eq "Y";
7109
7110     my $bio;
7111
7112     my $memkey = [$u->{'userid'}, "bio:$u->{'userid'}"];
7113     unless ($force) {
7114         my $bio = LJ::MemCache::get($memkey);
7115         return $bio if defined $bio;
7116     }
7117
7118     # not in memcache, fall back to disk
7119     my $db = @LJ::MEMCACHE_SERVERS || $force ?
7120       LJ::get_cluster_def_reader($u) : LJ::get_cluster_reader($u);
7121     $bio = $db->selectrow_array("SELECT bio FROM userbio WHERE userid=?",
7122                                 undef, $u->{'userid'});
7123
7124     # set in memcache
7125     LJ::MemCache::add($memkey, $bio);
7126
7127     return $bio;
7128 }
7129
7130 # <LJFUNC>
7131 # name: LJ::journal_base
7132 # des: Returns URL of a user's journal.
7133 # info: The tricky thing is that users with underscores in their usernames
7134 #       can't have some_user.example.com as a hostname, so that's changed into
7135 #       some-user.example.com.
7136 # args: uuser, vhost?
7137 # des-uuser: LJ::User object, user hashref or username of user whose URL to make.
7138 # des-vhost: What type of URL.  Acceptable options: "users", to make a
7139 #            http://user.example.com/ URL; "tilde" for http://example.com/~user/;
7140 #            "community" for http://example.com/community/user; or the default
7141 #            will be http://example.com/users/user.  If unspecified and uuser
7142 #            is a user hashref, then the best/preferred vhost will be chosen.
7143 # returns: scalar; a URL.
7144 # </LJFUNC>
7145 sub journal_base
7146 {
7147     my ($user, $vhost) = @_;
7148
7149     return unless $user;
7150
7151     if (LJ::are_hooks("journal_base")) {
7152         ## We must pass a real LJ::User object into hook
7153         if (isu($user)) {
7154             ## $user is either LJ::User object or plain hash with 'userid' field
7155             if (!UNIVERSAL::isa($user, "LJ::User")) {
7156                 $user = LJ::load_userid($user->{userid});
7157             }
7158         } else {
7159             ## $user is plain username
7160             $user = LJ::load_user($user);
7161         }
7162
7163         return $user->{'journal_base'}
7164             if $user->{'journal_base'};
7165         my $hookurl = LJ::run_hook("journal_base", $user, $vhost);
7166         $user->{'journal_base'} = $hookurl if (isu($user) && $hookurl);
7167         return $hookurl if $hookurl;
7168     }
7169
7170     if (isu($user)) {
7171         my $u = $user;
7172         $user = $u->{'user'};
7173         unless (defined $vhost) {
7174             if ($LJ::FRONTPAGE_JOURNAL eq $user) {
7175                 $vhost = "front";
7176             } elsif ($u->{'journaltype'} eq "P") {
7177                 $vhost = "";
7178             }
7179
7180         }
7181     }
7182
7183     if ($vhost eq "users") {
7184         my $he_user = $user;
7185         $he_user =~ s/_/-/g;
7186         return "http://$he_user.$LJ::USER_DOMAIN";
7187     } elsif ($vhost eq "tilde") {
7188         return "$LJ::SITEROOT/~$user";
7189     } elsif ($vhost eq "community") {
7190         return "$LJ::SITEROOT/community/$user";
7191     } elsif ($vhost eq "front") {
7192         return $LJ::SITEROOT;
7193     } elsif ($vhost =~ /^other:(.+)/) {
7194         return "http://$1";
7195     } else {
7196         return "$LJ::SITEROOT/users/$user";
7197     }
7198 }
7199
7200
7201 # <LJFUNC>
7202 # name: LJ::load_user_privs
7203 # class:
7204 # des: loads all of the given privs for a given user into a hashref, inside
7205 #      the user record.  See also [func[LJ::check_priv]].
7206 # args: u, priv, arg?
7207 # des-priv: Priv names to load (see [dbtable[priv_list]]).
7208 # des-arg: Optional argument.  See also [func[LJ::check_priv]].
7209 # returns: boolean
7210 # </LJFUNC>
7211 sub load_user_privs {
7212     my $remote = shift;
7213     my @privs = @_;
7214     return unless $remote and @privs;
7215
7216     # return if we've already loaded these privs for this user.
7217     @privs = grep { ! $remote->{'_privloaded'}->{$_} } @privs;
7218     return unless @privs;
7219
7220     my $dbr = LJ::get_db_reader();
7221     return unless $dbr;
7222     foreach (@privs) { $remote->{'_privloaded'}->{$_}++; }
7223     @privs = map { $dbr->quote($_) } @privs;
7224     my $sth = $dbr->prepare("SELECT pl.privcode, pm.arg ".
7225                             "FROM priv_map pm, priv_list pl ".
7226                             "WHERE pm.prlid=pl.prlid AND ".
7227                             "pl.privcode IN (" . join(',',@privs) . ") ".
7228                             "AND pm.userid=$remote->{'userid'}");
7229     $sth->execute;
7230     while (my ($priv, $arg) = $sth->fetchrow_array) {
7231         unless (defined $arg) { $arg = ""; }  # NULL -> ""
7232         $remote->{'_priv'}->{$priv}->{$arg} = 1;
7233     }
7234 }
7235
7236 # <LJFUNC>
7237 # name: LJ::check_priv
7238 # des: Check to see if a user has a certain privilege.
7239 # info: Usually this is used to check the privs of a $remote user.
7240 #       See [func[LJ::get_remote]].  As such, a $u argument of undef
7241 #       is okay to pass: 0 will be returned, as an unknown user can't
7242 #       have any rights.
7243 # args: u, priv, arg?
7244 # des-priv: Priv name to check for (see [dbtable[priv_list]])
7245 # des-arg: Optional argument.  If defined, function only returns true
7246 #          when $remote has a priv of type $priv also with arg $arg, not
7247 #          just any priv of type $priv, which is the behavior without
7248 #          an $arg. Arg can be "*", for all args.
7249 # returns: boolean; true if user has privilege
7250 # </LJFUNC>
7251 sub check_priv {
7252     my ($u, $priv, $arg) = @_;
7253     return 0 unless $u;
7254
7255     LJ::run_hook ("update_counter", {
7256         counter => "check_priv",
7257     });
7258
7259     LJ::load_user_privs($u, $priv)
7260         unless $u->{'_privloaded'}->{$priv};
7261
7262     # no access if they don't have the priv
7263     return 0 unless defined $u->{'_priv'}->{$priv};
7264
7265     # at this point we know they have the priv
7266     return 1 unless defined $arg;
7267
7268     # check if they have the right arguments
7269     return 1 if defined $u->{'_priv'}->{$priv}->{$arg};
7270     return 1 if defined $u->{'_priv'}->{$priv}->{"*"};
7271
7272     # don't have the right argument
7273     return 0;
7274 }
7275
7276 #
7277 #
7278 # <LJFUNC>
7279 # name: LJ::users_by_priv
7280 # class:
7281 # des: Return users with a certain privilege.
7282 # args: priv, arg?
7283 # des-args: user privilege to searching. arg can be "*" for all args.
7284 # return: Userids or empty list.
7285 # TODO Add store to MemCache
7286 sub users_by_priv {
7287     my ($priv, $arg) = @_;
7288
7289     my $dbr = LJ::get_db_reader();
7290     return unless $dbr;
7291
7292     return unless $priv;
7293     $arg ||= '*';
7294     my $users = $dbr->selectcol_arrayref ("SELECT userid FROM priv_list pl, priv_map pm
7295                                            WHERE pl.prlid = pm.prlid
7296                                                 AND privcode = ?
7297                                                 AND arg = ?
7298                                         ", undef, $priv, $arg);
7299
7300     return unless ref $users eq 'ARRAY';
7301     return $users;
7302 }
7303
7304 #
7305 #
7306 # <LJFUNC>
7307 # name: LJ::remote_has_priv
7308 # des: Check to see if the given remote user has a certain privilege.
7309 # </LJFUNC>
7310 sub remote_has_priv {
7311     my $remote = shift;
7312     my $privcode = shift;     # required.  priv code to check for.
7313     my $ref = shift;  # optional, arrayref or hashref to populate
7314     return 0 unless ($remote);
7315
7316     ### authentication done.  time to authorize...
7317
7318     my $dbr = LJ::get_db_reader();
7319     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=?");
7320     $sth->execute($privcode, $remote->{'userid'});
7321
7322     my $match = 0;
7323     if (ref $ref eq "ARRAY") { @$ref = (); }
7324     if (ref $ref eq "HASH") { %$ref = (); }
7325     while (my ($arg) = $sth->fetchrow_array) {
7326         $match++;
7327         if (ref $ref eq "ARRAY") { push @$ref, $arg; }
7328         if (ref $ref eq "HASH") { $ref->{$arg} = 1; }
7329     }
7330     return $match;
7331 }
7332
7333 # $dom: 'L' == log, 'T' == talk, 'M' == modlog, 'S' == session,
7334 #       'R' == memory (remembrance), 'K' == keyword id,
7335 #       'P' == phone post, 'C' == pending comment
7336 #       'O' == pOrtal box id, 'V' == 'vgift', 'E' == ESN subscription id
7337 #       'Q' == Notification Inbox, 'G' == 'SMS messaGe'
7338 #       'D' == 'moDule embed contents', 'W' == 'Wish-list element'
7339 #       'F' == Photo ID, 'A' == Album ID, 'Y' == delaYed entries
7340 #       'I' == Fotki migration log ID, 'H' == pics tag id
7341 #
7342 # FIXME: both phonepost and vgift are ljcom.  need hooks. but then also
7343 #        need a separate namespace.  perhaps a separate function/table?
7344 sub alloc_user_counter
7345 {
7346     my ($u, $dom, $opts) = @_;
7347     $opts ||= {};
7348
7349     ##################################################################
7350     # IF YOU UPDATE THIS MAKE SURE YOU ADD INITIALIZATION CODE BELOW #
7351     return undef unless $dom =~ /^[LTMPSRKCOVEQGDWFAYIH]$/;             #
7352     ##################################################################
7353
7354     my $dbh = LJ::get_db_writer();
7355     return undef unless $dbh;
7356
7357     my $newmax;
7358     my $uid = $u->{'userid'}+0;
7359     return undef unless $uid;
7360     my $memkey = [$uid, "auc:$uid:$dom"];
7361
7362     # in a master-master DB cluster we need to be careful that in
7363     # an automatic failover case where one cluster is slightly behind
7364     # that the same counter ID isn't handed out twice.  use memcache
7365     # as a sanity check to record/check latest number handed out.
7366     my $memmax = int(LJ::MemCache::get($memkey) || 0);
7367
7368     my $rs = $dbh->do("UPDATE usercounter SET max=LAST_INSERT_ID(GREATEST(max,$memmax)+1) ".
7369                       "WHERE journalid=? AND area=?", undef, $uid, $dom);
7370     if ($rs > 0) {
7371         $newmax = $dbh->selectrow_array("SELECT LAST_INSERT_ID()");
7372
7373         # if we've got a supplied callback, lets check the counter
7374         # number for consistency.  If it fails our test, wipe
7375         # the counter row and start over, initializing a new one.
7376         # callbacks should return true to signal 'all is well.'
7377         if ($opts->{callback} && ref $opts->{callback} eq 'CODE') {
7378             my $rv = 0;
7379             eval { $rv = $opts->{callback}->($u, $newmax) };
7380             if ($@ or ! $rv) {
7381                 $dbh->do("DELETE FROM usercounter WHERE " .
7382                          "journalid=? AND area=?", undef, $uid, $dom);
7383                 return LJ::alloc_user_counter($u, $dom);
7384             }
7385         }
7386
7387         LJ::MemCache::set($memkey, $newmax);
7388         return $newmax;
7389     }
7390
7391     if ($opts->{recurse}) {
7392         # We shouldn't ever get here if all is right with the world.
7393         return undef;
7394     }
7395
7396     my $qry_map = {
7397         # for entries:
7398         'log'         => "SELECT MAX(jitemid) FROM log2     WHERE journalid=?",
7399         'logtext'     => "SELECT MAX(jitemid) FROM logtext2 WHERE journalid=?",
7400         'talk_nodeid' => "SELECT MAX(nodeid)  FROM talk2    WHERE nodetype='L' AND journalid=?",
7401         # for comments:
7402         'talk'     => "SELECT MAX(jtalkid) FROM talk2     WHERE journalid=?",
7403         'talktext' => "SELECT MAX(jtalkid) FROM talktext2 WHERE journalid=?",
7404     };
7405
7406     my $consider = sub {
7407         my @tables = @_;
7408         foreach my $t (@tables) {
7409             my $res = $u->selectrow_array($qry_map->{$t}, undef, $uid);
7410             $newmax = $res if $res > $newmax;
7411         }
7412     };
7413
7414     # Make sure the counter table is populated for this uid/dom.
7415     if ($dom eq "L") {
7416         # back in the ol' days IDs were reused (because of MyISAM)
7417         # so now we're extra careful not to reuse a number that has
7418         # foreign junk "attached".  turns out people like to delete
7419         # each entry by hand, but we do lazy deletes that are often
7420         # too lazy and a user can see old stuff come back alive
7421         $consider->("log", "logtext", "talk_nodeid");
7422     } elsif ($dom eq "T") {
7423         # just paranoia, not as bad as above.  don't think we've ever
7424         # run into cases of talktext without a talk, but who knows.
7425         # can't hurt.
7426         $consider->("talk", "talktext");
7427     } elsif ($dom eq "M") {
7428         $newmax = $u->selectrow_array("SELECT MAX(modid) FROM modlog WHERE journalid=?",
7429                                       undef, $uid);
7430     } elsif ($dom eq "S") {
7431         $newmax = $u->selectrow_array("SELECT MAX(sessid) FROM sessions WHERE userid=?",
7432                                       undef, $uid);
7433     } elsif ($dom eq "R") {
7434         $newmax = $u->selectrow_array("SELECT MAX(memid) FROM memorable2 WHERE userid=?",
7435                                       undef, $uid);
7436     } elsif ($dom eq "K") {
7437         $newmax = $u->selectrow_array("SELECT MAX(kwid) FROM userkeywords WHERE userid=?",
7438                                       undef, $uid);
7439     } elsif ($dom eq "P") {
7440         my $userblobmax = $u->selectrow_array("SELECT MAX(blobid) FROM userblob WHERE journalid=? AND domain=?",
7441                                               undef, $uid, LJ::get_blob_domainid("phonepost"));
7442         my $ppemax = $u->selectrow_array("SELECT MAX(blobid) FROM phonepostentry WHERE userid=?",
7443                                          undef, $uid);
7444         $newmax = ($ppemax > $userblobmax) ? $ppemax : $userblobmax;
7445     } elsif ($dom eq "C") {
7446         $newmax = $u->selectrow_array("SELECT MAX(pendcid) FROM pendcomments WHERE jid=?",
7447                                       undef, $uid);
7448     } elsif ($dom eq "O") {
7449         $newmax = $u->selectrow_array("SELECT MAX(pboxid) FROM portal_config WHERE userid=?",
7450                                       undef, $uid);
7451     } elsif ($dom eq "V") {
7452         $newmax = $u->selectrow_array("SELECT MAX(giftid) FROM vgifts WHERE userid=?",
7453                                       undef, $uid);
7454     } elsif ($dom eq "E") {
7455         $newmax = $u->selectrow_array("SELECT MAX(subid) FROM subs WHERE userid=?",
7456                                       undef, $uid);
7457     } elsif ($dom eq "Q") {
7458         $newmax = $u->selectrow_array("SELECT MAX(qid) FROM notifyqueue WHERE userid=?",
7459                                       undef, $uid);
7460     } elsif ($dom eq "G") {
7461         $newmax = $u->selectrow_array("SELECT MAX(msgid) FROM sms_msg WHERE userid=?",
7462                                       undef, $uid);
7463     } elsif ($dom eq "D") {
7464         $newmax = $u->selectrow_array("SELECT MAX(moduleid) FROM embedcontent WHERE userid=?",
7465                                       undef, $uid);
7466     } elsif ($dom eq "W") {
7467         $newmax = $u->selectrow_array("SELECT MAX(wishid) FROM wishlist2 WHERE userid=?",
7468                                       undef, $uid);
7469     } elsif ($dom eq "F") {
7470         $newmax = $u->selectrow_array("SELECT MAX(photo_id) FROM fotki_photos WHERE userid=?",
7471                                       undef, $uid);
7472     } elsif ($dom eq "A") {
7473         $newmax = $u->selectrow_array("SELECT MAX(album_id) FROM fotki_albums WHERE userid=?",
7474                                       undef, $uid);
7475     } elsif ($dom eq "Y") {
7476         $newmax = $u->selectrow_array("SELECT MAX(delayedid) FROM delayedlog2 WHERE journalid=?",
7477                                       undef, $uid);
7478     } elsif ( $dom eq 'I' ) {
7479         $newmax = $u->selectrow_array("SELECT MAX(logid) FROM fotki_migration_log WHERE userid=?",
7480                                       undef, $uid);
7481     } elsif ( $dom eq 'H' ) {
7482         $newmax = $u->selectrow_array("SELECT MAX(tag_id) FROM fotki_tags WHERE userid=?",
7483                                       undef, $uid);
7484     } else {
7485         die "No user counter initializer defined for area '$dom'.\n";
7486     }
7487     $newmax += 0;
7488     $dbh->do("INSERT IGNORE INTO usercounter (journalid, area, max) VALUES (?,?,?)",
7489              undef, $uid, $dom, $newmax) or return undef;
7490
7491     # The 2nd invocation of the alloc_user_counter sub should do the
7492     # intended incrementing.
7493     return LJ::alloc_user_counter($u, $dom, { recurse => 1 });
7494 }
7495
7496 # <LJFUNC>
7497 # name: LJ::make_user_active
7498 # des:  Record user activity per cluster, on [dbtable[clustertrack2]], to
7499 #       make per-activity cluster stats easier.
7500 # args: userid, type
7501 # des-userid: source userobj ref
7502 # des-type: currently unused
7503 # </LJFUNC>
7504 sub mark_user_active {
7505     my ($u, $type) = @_;  # not currently using type
7506     return 0 unless $u;   # do not auto-vivify $u
7507     my $uid = $u->{userid};
7508     return 0 unless $uid && $u->{clusterid};
7509
7510     # Update the clustertrack2 table, but not if we've done it for this
7511     # user in the last hour.  if no memcache servers are configured
7512     # we don't do the optimization and just always log the activity info
7513     if (@LJ::MEMCACHE_SERVERS == 0 ||
7514         LJ::MemCache::add("rate:tracked:$uid", 1, 3600)) {
7515
7516         return 0 unless $u->writer;
7517         $u->do("REPLACE INTO clustertrack2 SET ".
7518                "userid=?, timeactive=?, clusterid=?", undef,
7519                $uid, time(), $u->{clusterid}) or return 0;
7520     }
7521     return 1;
7522 }
7523
7524 # <LJFUNC>
7525 # name: LJ::get_shared_journals
7526 # des: Gets an array of shared journals a user has access to.
7527 # returns: An array of shared journals.
7528 # args: u
7529 # </LJFUNC>
7530 sub get_shared_journals
7531 {
7532     my $u = shift;
7533     my $ids = LJ::load_rel_target($u, 'A') || [];
7534
7535     # have to get usernames;
7536     my %users;
7537     LJ::load_userids_multiple([ map { $_, \$users{$_} } @$ids ], [$u]);
7538     return sort map { $_->{'user'} } values %users;
7539 }
7540
7541 ## my $text = LJ::ljuser_alias($u)
7542 ## returns note text (former 'alias') for current remote user
7543 sub ljuser_alias {
7544
7545     return if $LJ::DISABLED{'aliases'};
7546
7547     my $user = shift;
7548     my $remote = shift;
7549     $remote = LJ::get_remote() unless isu($remote);
7550
7551     return unless $remote;
7552     return unless $remote->get_cap('aliases');
7553
7554     my $u = LJ::load_user($user);
7555     return unless $u;
7556
7557     if (!$remote->{_aliases}) {
7558         my $prop_aliases = LJ::text_uncompress( $remote->prop('aliases') );
7559         $remote->{_aliases} = ($prop_aliases) ? LJ::JSON->from_json($prop_aliases) : {};
7560     }
7561     return $remote->{_aliases}->{ $u->{userid} };
7562 }
7563
7564 ##
7565 ## LJ::set_alias($u, $text, \$error)
7566 ## LJ::set_alias([ $u1, $text1, $u2, $text2], \$error);
7567 ##
7568 ## Sets notes (alias) text for user $u to the current $remote user
7569 ## $u is either user object or userid (number)
7570 ## If aliases cannot be updated, undef value is returned and optional \$error reference is set
7571 ## Use empty text for deleting alias
7572 ##
7573 sub set_alias {
7574     my $list = (ref $_[0] eq 'ARRAY') ? shift : [shift, shift];
7575     my $err = shift;
7576
7577     if ($LJ::DISABLED{'aliases'}) {
7578         $$err = "Notes (aliases) are disabled" if $err;
7579         return;
7580     }
7581
7582     my $remote = LJ::get_remote();
7583     unless ($remote) {
7584         $$err = "No remote user" if $err;
7585         return;
7586     }
7587     unless ($remote->get_cap('aliases')) {
7588         $$err = "Remote user can't manage notes (aliases)" if $err;
7589         return;
7590     }
7591
7592     ## load alias data
7593     if (!$remote->{_aliases}) {
7594         my $prop_aliases = LJ::text_uncompress( $remote->prop('aliases') );
7595         $remote->{_aliases} = $prop_aliases ? LJ::JSON->from_json($prop_aliases) : {};
7596     }
7597
7598     ## modify (edit, add or delete)
7599     for (my $i = 0; $i < @$list / 2; ++$i) {
7600         my $userid = $list->[$i * 2];
7601         my $alias  = $list->[$i * 2 + 1];
7602         $alias = substr($alias, 0, 400);
7603         $userid = $userid->{userid} if ref $userid;
7604         die "Numeric id is expected, not $userid" unless $userid =~ /^\d+$/;
7605
7606         if ($alias) {
7607             $remote->{_aliases}->{$userid} = $alias;
7608         } else {
7609             delete $remote->{_aliases}->{$userid};
7610         }
7611     }
7612
7613     ## save data back
7614     my $serialized_text = LJ::JSON->to_json($remote->{_aliases});
7615     $serialized_text = LJ::text_compress( $serialized_text ) unless $LJ::DISABLED{'aliases_compress'};
7616     if (length $serialized_text < 65536) {
7617         return $remote->set_prop( aliases => $serialized_text );
7618     } else {
7619         delete $remote->{_aliases}; ## drop unsuccessfully modified data
7620         $$err = BML::ml('widget.addalias.too.long') if $err;
7621         return 0;
7622     }
7623 }
7624
7625 ## my %all_aliases = LJ::get_all_aliases();
7626 ## Returns all aliases for current remote user as hash userid => alias
7627 sub get_all_aliases {
7628
7629     return if $LJ::DISABLED{'aliases'};
7630
7631     my $remote = shift;
7632     $remote = LJ::get_remote() unless isu($remote);
7633     return unless $remote and $remote->get_cap('aliases');
7634
7635     if (!$remote->{_aliases}) {
7636         my $prop_aliases = LJ::text_uncompress($remote->prop('aliases'));
7637         $remote->{_aliases} = ($prop_aliases) ? LJ::JSON->from_json($prop_aliases) : {};
7638     }
7639
7640     return %{$remote->{_aliases}};
7641 }
7642
7643 # <LJFUNC>
7644 # class: component
7645 # name: LJ::ljuser
7646 # des: Make link to userinfo/journal of user.
7647 # info: Returns the HTML for a userinfo/journal link pair for a given user
7648 #       name, just like LJUSER does in BML.  This is for files like cleanhtml.pl
7649 #       and ljpoll.pl which need this functionality too, but they aren't run as BML.
7650 # args: user, opts?
7651 # des-user: Username to link to, or user hashref.
7652 # des-opts: Optional hashref to control output.  Key 'full' when true causes
7653 #           a link to the mode=full userinfo.   Key 'type' when 'C' makes
7654 #           a community link, when 'Y' makes a syndicated account link,
7655 #           when 'I' makes an identity account link (e.g. OpenID),
7656 #           when 'N' makes a news account link, otherwise makes a user account
7657 #           link. If user parameter is a hashref, its 'journaltype' overrides
7658 #           this 'type'.  Key 'del', when true, makes a tag for a deleted user.
7659 #           If user parameter is a hashref, its 'statusvis' overrides 'del'.
7660 #           Key 'no_follow', when true, disables traversal of renamed users.
7661 # returns: HTML with a little head image & bold text link.
7662 # </LJFUNC>
7663
7664 my $ljuser_tmpl_path = join('/', $ENV{'LJHOME'}, 'templates', 'User');
7665 my $ljuser_cache     = {};
7666
7667 sub ljuser {
7668     my ($user, $opts) = @_;
7669     my ($u, $username, $journal_url, $striked);
7670     my ($journal_name, $journal, $userhead);
7671     my ($attrs, $color, $user_alias, %user);
7672     my $identity;
7673     my $profile_url;
7674
7675     if ( isu($user) ) {
7676         $u = $user;
7677         $username = $u->username;
7678     } else {
7679         $u = LJ::load_user($user);
7680         $username = $user;
7681     }
7682
7683     {
7684         if ( $u and LJ::isu($u) ) {
7685             # Traverse the renames to the final journal
7686             unless ( $opts->{'no_follow'} ) {
7687                 $u = $u->get_renamed_user;
7688                 $username = $u->username;
7689             }
7690
7691             last if $ljuser_cache->{$username};
7692
7693             # Mark accounts as deleted that aren't visible, memorial, locked, or
7694             # read-only
7695             if ( $u->statusvis !~ m![VMLO]! ) {
7696                $striked = 1;
7697             }
7698
7699             $journal_name = $username;
7700             $journal_url  = $u->journal_base . "/";
7701             ($userhead)   = $u->userhead($opts);
7702
7703             # Identity
7704             if ( $u->is_identity ) {
7705                 $identity  = $u->identity;
7706                 my $params = $identity ? $identity->ljuser_display_params($u, $opts) : {};
7707                 $profile_url  = $params->{'profile_url'}  || '';
7708                 $journal_url  = $params->{'journal_url'}  || $journal_url;
7709                 $journal_name = $params->{'journal_name'} || $journal_name;
7710             }
7711
7712             $profile_url  = $u->profile_url();
7713         } else {
7714             $username      = LJ::canonical_username($username);
7715
7716             last if $ljuser_cache->{$username};
7717
7718             $journal_url   = join('', $LJ::SITEROOT, '/userinfo.bml?user=', $username);
7719             $profile_url ||= $journal_url;
7720             $userhead      = 'userinfo.gif?v=17080';
7721         }
7722
7723         LJ::run_hooks( 'override_display_name', $u, \$journal_name );
7724         LJ::run_hooks( 'override_profile_url',  $u, \$profile_url );
7725         LJ::run_hooks( 'override_journal_url',  $u, \$journal_url );
7726     }
7727
7728     if ( $color = $opts->{'link_color'} ) {
7729         unless ( $color =~ /^#(?:[a-f0-9]{3}|[a-f0-9]{6})$/i ) {
7730             undef $color;
7731         }
7732     }
7733
7734     %user = %{ $ljuser_cache->{$username} ||= {
7735         attrs          => $attrs,
7736         bold           => 0,
7737         side_alias     => 0,
7738         inline_css     => 0,
7739         username       => $username,
7740         journal        => $journal_name,
7741         striked        => $striked,
7742         journal_url    => $journal_url,
7743         profile_url    => $profile_url,
7744         userhead_url   => $userhead,
7745         noctxpopup     => 0,
7746         is_identity    => $identity? 1 : 0,
7747     }};
7748
7749     $user{'noctxpopup'}   = 1                      if $opts->{'noctxpopup'};
7750     $user{'bold'}         = 1                      if $opts->{'bold'} or not exists $opts->{'bold'};
7751     $user{'inline_css'}   = 1                      if $opts->{'inline_css'};
7752     $user{'journal'}      = $opts->{'title'}       if $opts->{'title'};
7753     $user{'target'}       = $opts->{'target'}      if $opts->{'target'};
7754     $user{'profile_url'} .= '?mode=full'           if $opts->{'full'};
7755     $user{'profile_url'}  = $opts->{'profile_url'} if $opts->{'profile_url'};
7756     $user{'user_alias'}   = LJ::ehtml(LJ::ljuser_alias($username));
7757     $user{'alias'}        = $user{'user_alias'}?   1 : 0;
7758     $user{'color'}        = $color;
7759
7760     if ( $opts->{'side_alias'} and $user{'alias'} ) {
7761         $user{'side_alias'} = 1;
7762         $user{'alias'}      = 1;
7763     }
7764
7765     # Userhead
7766     unless ( $user{'userhead_url'} =~ m!^https?:\/\/! ) {
7767         $user{'userhead_url'} = join('',
7768             $opts->{'imgroot'} || $LJ::IMGPREFIX,
7769             '/', $user{'userhead_url'},
7770             '?v=', $LJ::CURRENT_VERSION
7771         );
7772     }
7773
7774     # FIXME: try to remove this
7775     if ( $opts->{'in_journal'} ) {
7776         my $cu = LJ::load_user($opts->{'in_journal'});
7777         if ( $cu ) {
7778             $user{'attrs'} = join('"', 'data-journal=', $cu->journal_base, '');
7779         }
7780     }
7781
7782     if ( $opts->{'raw'} ) {
7783         return \%user;
7784     } else {
7785         return LJ::Response::CachedTemplate->new(
7786             path   => $ljuser_tmpl_path,
7787             file   => 'Display.tmpl',
7788             params => \%user,
7789         )->raw_output();
7790     }
7791 }
7792
7793 sub set_email {
7794     my ($userid, $email) = @_;
7795
7796     my $dbh = LJ::get_db_writer();
7797     if ($LJ::DEBUG{'write_emails_to_user_table'}) {
7798         $dbh->do("UPDATE user SET email=? WHERE userid=?", undef,
7799                  $email, $userid);
7800     }
7801     $dbh->do("REPLACE INTO email (userid, email) VALUES (?, ?)",
7802              undef, $userid, $email);
7803
7804     # update caches
7805     LJ::memcache_kill($userid, "userid");
7806     LJ::MemCache::delete([$userid, "email:$userid"]);
7807     my $cache = $LJ::REQ_CACHE_USER_ID{$userid} or return;
7808     $cache->{'_email'} = $email;
7809 }
7810
7811 sub get_uids {
7812     my @friends_names = @_;
7813     my @ret;
7814     push @ret, grep { $_ } map { LJ::load_user($_) } @friends_names;
7815     return @ret;
7816 }
7817
7818 sub set_password {
7819     my ($userid, $password) = @_;
7820
7821     my $dbh = LJ::get_db_writer();
7822     if ($LJ::DEBUG{'write_passwords_to_user_table'}) {
7823         $dbh->do("UPDATE user SET password=? WHERE userid=?", undef,
7824                  $password, $userid);
7825     }
7826     $dbh->do("REPLACE INTO password (userid, password) VALUES (?, ?)",
7827              undef, $userid, $password);
7828
7829     # update caches
7830     LJ::memcache_kill($userid, "userid");
7831     LJ::MemCache::delete([$userid, "pw:$userid"]);
7832     my $cache = $LJ::REQ_CACHE_USER_ID{$userid} or return;
7833     $cache->{'_password'} = $password;
7834 }
7835
7836 sub update_user
7837 {
7838     my ($arg, $ref) = @_;
7839     my @uid;
7840
7841     if (ref $arg eq "ARRAY") {
7842         @uid = @$arg;
7843     } else {
7844         @uid = want_userid($arg);
7845     }
7846     @uid = grep { $_ } map { $_ + 0 } @uid;
7847     return 0 unless @uid;
7848
7849     my @sets;
7850     my @bindparams;
7851     my $used_raw = 0;
7852     while (my ($k, $v) = each %$ref) {
7853         if ($k eq "raw") {
7854             $used_raw = 1;
7855             push @sets, $v;
7856         } elsif ($k eq 'email') {
7857             set_email($_, $v) foreach @uid;
7858         } elsif ($k eq 'password') {
7859             set_password($_, $v) foreach @uid;
7860         } else {
7861             push @sets, "$k=?";
7862             push @bindparams, $v;
7863         }
7864     }
7865     return 1 unless @sets;
7866     my $dbh = LJ::get_db_writer();
7867     return 0 unless $dbh;
7868     {
7869         local $" = ",";
7870         my $where = @uid == 1 ? "userid=$uid[0]" : "userid IN (@uid)";
7871         $dbh->do("UPDATE user SET @sets WHERE $where", undef,
7872                  @bindparams);
7873         return 0 if $dbh->err;
7874     }
7875     if (@LJ::MEMCACHE_SERVERS) {
7876         LJ::memcache_kill($_, "userid") foreach @uid;
7877     }
7878
7879     if ($used_raw) {
7880         # for a load of userids from the master after update
7881         # so we pick up the values set via the 'raw' option
7882         require_master(sub { LJ::load_userids(@uid) });
7883     } else {
7884         foreach my $uid (@uid) {
7885             while (my ($k, $v) = each %$ref) {
7886                 my $cache = $LJ::REQ_CACHE_USER_ID{$uid} or next;
7887                 $cache->{$k} = $v;
7888             }
7889         }
7890     }
7891
7892     # log this updates
7893     LJ::run_hooks("update_user", userid => $_, fields => $ref)
7894         for @uid;
7895
7896     return 1;
7897 }
7898
7899 # <LJFUNC>
7900 # name: LJ::get_timezone
7901 # des: Gets the timezone offset for the user.
7902 # args: u, offsetref, fakedref
7903 # des-u: user object.
7904 # des-offsetref: reference to scalar to hold timezone offset;
7905 # des-fakedref: reference to scalar to hold whether this timezone was
7906 #               faked.  0 if it is the timezone specified by the user.
7907 # returns: nonzero if successful.
7908 # </LJFUNC>
7909 sub get_timezone {
7910     my ($u, $offsetref, $fakedref) = @_;
7911
7912     # See if the user specified their timezone
7913     if (my $tz = $u->prop('timezone')) {
7914         # If the eval fails, we'll fall through to guessing instead
7915         my $dt = eval {
7916             DateTime->from_epoch(
7917                                  epoch => time(),
7918                                  time_zone => $tz,
7919                                  );
7920         };
7921
7922         if ($dt) {
7923             $$offsetref = $dt->offset() / (60 * 60); # Convert from seconds to hours
7924             $$fakedref  = 0 if $fakedref;
7925
7926             return 1;
7927         }
7928     }
7929
7930     # Either the user hasn't set a timezone or we failed at
7931     # loading it.  We guess their current timezone's offset
7932     # by comparing the gmtime of their last post with the time
7933     # they specified on that post.
7934
7935     # first, check request cache
7936     my $timezone = $u->{_timezone_guess};
7937     if ($timezone) {
7938         $$offsetref = $timezone;
7939         return 1;
7940     }
7941
7942     # next, check memcache
7943     my $memkey = [$u->userid, 'timezone_guess:' . $u->userid];
7944     my $memcache_data = LJ::MemCacheProxy::get($memkey);
7945     if ($memcache_data) {
7946         # fill the request cache since it was empty
7947         $u->{_timezone_guess} = $memcache_data;
7948         $$offsetref = $memcache_data;
7949         return 1;
7950     }
7951
7952     # nothing in cache; check db
7953     my $dbcr = LJ::get_cluster_def_reader($u);
7954     return 0 unless $dbcr;
7955
7956     $$fakedref = 1 if $fakedref;
7957
7958     # grab the times on the last post that wasn't backdated.
7959     # (backdated is rlogtime == $LJ::EndOfTime)
7960     if (my $last_row = $dbcr->selectrow_hashref(
7961         qq{
7962             SELECT rlogtime, eventtime
7963             FROM log2
7964             WHERE journalid = ? AND rlogtime <> ?
7965             ORDER BY rlogtime LIMIT 1
7966         }, undef, $u->{userid}, $LJ::EndOfTime)) {
7967         my $logtime = $LJ::EndOfTime - $last_row->{'rlogtime'};
7968         my $eventtime = LJ::TimeUtil->mysqldate_to_time($last_row->{'eventtime'}, 1);
7969         my $hourdiff = ($eventtime - $logtime) / 3600;
7970
7971         # if they're up to a quarter hour behind, round up.
7972         $hourdiff = $hourdiff > 0 ? int($hourdiff + 0.25) : int($hourdiff - 0.25);
7973
7974         # if the offset is more than 24h in either direction, then the last
7975         # entry is probably unreliable. don't use any offset at all.
7976         $$offsetref = (-24 < $hourdiff && $hourdiff < 24) ? $hourdiff : 0;
7977
7978         # set the caches
7979         $u->{_timezone_guess} = $$offsetref;
7980         my $expire = 60*60*24; # 24 hours
7981         LJ::MemCacheProxy::set($memkey, $$offsetref, $expire);
7982     }
7983
7984     return 1;
7985 }
7986
7987 # returns undef on error, or otherwise arrayref of arrayrefs,
7988 # each of format [ year, month, day, count ] for all days with
7989 # non-zero count.  examples:
7990 #  [ [ 2003, 6, 5, 3 ], [ 2003, 6, 8, 4 ], ... ]
7991 #
7992 sub get_daycounts {
7993     my ( $u, $remote ) = @_;
7994
7995     # ['public'], ['all'], or [ 'gmask', $gmask ]
7996     my $kind;
7997     if ($remote) {
7998         my $viewall = 0;
7999         if ( LJ::is_web_context() && LJ::Request->get_param('viewall') &&
8000             LJ::check_priv( $remote, 'canview', '*' ) )
8001         {
8002             $viewall = 1;
8003             LJ::statushistory_add($u->{'userid'}, $remote->{'userid'},
8004                 "viewall", "calendar");
8005         }
8006
8007         if ( $remote->can_manage($u) ) {
8008             $kind = ['all'];
8009         } else {
8010             if ( my $gmask = LJ::get_groupmask($u, $remote) ) {
8011                 # friends case: allowmask == gmask == 1
8012                 $kind = [ 'gmask', $gmask ];
8013             } else {
8014                 $kind = ['public'];
8015             }
8016         }
8017     } else {
8018         $kind = ['public'];
8019     }
8020
8021     ##
8022     ## the first element of the array stored in memcache
8023     ## is the time of the creation of the list. The memcache is
8024     ## invalid if there are new entries in journal since that time.
8025     ##
8026     my $memkey = [ $u->userid, join( ':', 'dayct3', $u->userid, @$kind ) ];
8027     my $list = LJ::MemCache::get($memkey);
8028     if ($list) {
8029         my $list_create_time = shift @$list;
8030         return $list if $list_create_time >= $u->timeupdate;
8031     }
8032
8033     my $dbcr = LJ::get_cluster_def_reader($u) or return;
8034
8035     ## get lock to prevent multiple apache processes to execute the sql below.
8036     ## one process runs, the other wait for results
8037     my $release_lock = sub {
8038         $dbcr->do( 'SELECT RELEASE_LOCK(?)', undef, $memkey->[1] );
8039     };
8040
8041     my ($locked) = $dbcr->selectrow_array(
8042         'SELECT GET_LOCK(?,2)', undef, $memkey->[1] );
8043
8044     return [] unless $locked; ## 2 seconds expired
8045
8046     $list = LJ::MemCache::get($memkey);
8047     if ($list) {
8048         ## other process may have filled the data while we waited for the lock
8049         my $list_create_time = shift @$list;
8050         if ($list_create_time >= $u->timeupdate) {
8051             $release_lock->();
8052             return $list;
8053         }
8054     }
8055
8056     if ( LJ::is_enabled( 'dayct_month', $u ) ) {
8057         $release_lock->();
8058         my ( $min_year, $max_year ) = $dbcr->selectrow_array(
8059             'SELECT MIN(year), MAX(year) FROM log2 WHERE journalid=?',
8060             undef, $u->userid );
8061
8062         my $days = [];
8063
8064         foreach my $year ( $min_year .. $max_year ) {
8065             foreach my $month ( 1 .. 12 ) {
8066                 my $month_daycounts =
8067                     get_month_daycounts( $u, $kind, $year, $month );
8068                 push @$days, @$month_daycounts;
8069             }
8070         }
8071
8072         LJ::MemCache::set( $memkey, [ time, @$days ] );
8073         return $days;
8074     }
8075
8076     my ( $selecttype, $gmask ) = @$kind;
8077     my $secwhere;
8078     if ( $selecttype eq 'all' ) {
8079         $secwhere = '';
8080     } elsif ( $selecttype eq 'public' ) {
8081         $secwhere = 'AND security="public"';
8082     } elsif ( $selecttype eq 'gmask' ) {
8083         $secwhere = "AND ( security='public' OR " .
8084             "(security='usemask' AND allowmask & $gmask) )";
8085     }
8086
8087     my $sth = $dbcr->prepare("SELECT year, month, day, COUNT(*) ".
8088                              "FROM log2 WHERE journalid=? $secwhere " .
8089                              "GROUP BY year, month, day");
8090     $sth->execute( $u->userid );
8091     my $days = [];
8092     while ( my ( $y, $m, $d, $c ) = $sth->fetchrow_array ) {
8093         # we force each number from string scalars (from DBI) to int scalars,
8094         # so they store smaller in memcache
8095         push @$days, [ int($y), int($m), int($d), int($c) ];
8096     }
8097
8098     LJ::MemCache::set( $memkey, [time, @$days] );
8099
8100     $release_lock->();
8101     return $days;
8102 }
8103
8104 sub get_month_daycounts {
8105     my ( $u, $kind, $year, $month ) = @_;
8106
8107     my $memkind = join( ':', @$kind );
8108
8109     ##
8110     ## the first element of the array stored in memcache
8111     ## is the time of the creation of the list. The memcache is
8112     ## invalid if there are new entries in journal since that time.
8113     ##
8114     my $memkey_base =
8115         join( ':', 'dayct3', 'month', $year, $month, $u->userid, @$kind );
8116     my $memkey = [ $u->userid, $memkey_base ];
8117     my $memlockkey = [ $u->userid, $memkey_base . ':lock' ];
8118
8119     my $lock_acquired = 0;
8120
8121     my $lock = sub {
8122         return if $lock_acquired;
8123         $lock_acquired = 1;
8124
8125         return LJ::MemCache::add( $memlockkey, 1, 2 );
8126     };
8127
8128     my $unlock = sub {
8129         LJ::MemCache::delete($memlockkey);
8130         $lock_acquired = 0;
8131     };
8132
8133     my $list = LJ::MemCache::get($memkey);
8134     if ($list) {
8135         my $list_create_time = shift @$list;
8136         my $list_exptime     = shift @$list;
8137
8138         my $need_recalculate = 0;
8139
8140         my $timeupdate       = $u->timeupdate;
8141         my $timeupdate_year  = ( gmtime $timeupdate )[5] + 1900;
8142         my $timeupdate_month = ( gmtime $timeupdate )[4] + 1;
8143
8144         $need_recalculate = 1
8145             if $timeupdate_year == $year &&
8146             $timeupdate_month == $month &&
8147             $u->timeupdate > $list_create_time;
8148
8149         if ($need_recalculate) {
8150             $need_recalculate = 0 unless $lock->();
8151         }
8152
8153         return $list unless $need_recalculate;
8154     }
8155
8156     return [] unless $lock->();
8157
8158     my ( $selecttype, $gmask ) = @$kind;
8159     my $secwhere;
8160     if ( $selecttype eq 'all' ) {
8161         $secwhere = '';
8162     } elsif ( $selecttype eq 'public' ) {
8163         $secwhere = 'AND security="public"';
8164     } elsif ( $selecttype eq 'gmask' ) {
8165         $secwhere = "AND ( security='public' OR " .
8166             "(security='usemask' AND allowmask & $gmask) )";
8167     }
8168
8169     my $dbcr = LJ::get_cluster_def_reader($u);
8170
8171     my $sth = $dbcr->prepare("SELECT day, COUNT(*) ".
8172                              "FROM log2 WHERE journalid=? $secwhere AND " .
8173                              "year=? AND month=? " .
8174                              "GROUP BY day");
8175     $sth->execute( $u->userid, $year, $month );
8176     my $days = [];
8177     while ( my ( $d, $c ) = $sth->fetchrow_array ) {
8178         # we force each number from string scalars (from DBI) to int scalars,
8179         # so they store smaller in memcache
8180         push @$days, [ int($year), int($month), int($d), int($c) ];
8181     }
8182
8183     my $exptime = time + 3600 + int( rand(3600) );
8184     LJ::MemCache::set( $memkey, [ time, $exptime, @$days ] );
8185
8186     $unlock->();
8187     return $days;
8188 }
8189
8190 ## input: $u, $remote, $year, $month
8191 ## output: hashref with data for rendering calendar for given month,
8192 ##      days:       arrayref [ count of entries for each day]
8193 ##                  days[1] = count of entries for the 1st day, days[0] is always null
8194 ##      prev_month: arrayref [year, month] - previous month that has entries
8195 ##      next_month, prev_year, next_year - arrayref of the same format
8196 ##
8197 sub get_calendar_data_for_month {
8198     my ($u, $remote, $year, $month) = @_;
8199
8200     $remote ||= LJ::get_remote();
8201     unless ($year || $month) {
8202         ($month, $year) = (localtime)[4, 5];
8203         $year += 1900;
8204         $month++;
8205     }
8206
8207     my %ret = (journal => $u->user, year => $year, month => $month);
8208     my $days = LJ::get_daycounts($u, $remote);
8209     foreach my $d (@$days) {
8210         ## @$d = ($y, $m, $d, $count)
8211         if ($d->[0]==$year && $d->[1]==$month) {
8212             $ret{days}->[ $d->[2] ] = $d->[3]+0;
8213         }
8214     }
8215     ## $prev_month  = max(  grep { $day < Date($year, $month) }  @$days  );
8216     ## max @list    = List::Util::reduce {  ($a < $b) ? $b : $a } @list
8217     ## min @list    = List::Util::reduce { !($a < $b) ? $b : $a } @list
8218     my $current_month   = [$year, $month];
8219     my $less_year       = sub { my ($a, $b) = @_; return $a->[0]<$b->[0];  };
8220     my $less            = sub { my ($a, $b) = @_; return $a->[0]<$b->[0] || $a->[0]==$b->[0] && $a->[1]<$b->[1] };
8221     $ret{'prev_month'}  = List::Util::reduce {  $less->($a, $b) ? $b : $a } grep { $less->($_, $current_month) }        @$days;
8222     $ret{'next_month'}  = List::Util::reduce { !$less->($a, $b) ? $b : $a } grep { $less->($current_month, $_) }        @$days;
8223     $ret{'prev_year'}   = List::Util::reduce {  $less->($a, $b) ? $b : $a } grep { $less_year->($_, $current_month) }   @$days;
8224     $ret{'next_year'}   = List::Util::reduce { !$less->($a, $b) ? $b : $a } grep { $less_year->($current_month, $_) }   @$days;
8225     foreach my $k (qw/prev_month next_month prev_year next_year/) {
8226         if ($ret{$k}) {
8227             $ret{$k} = [ $ret{$k}->[0]+0, $ret{$k}->[1]+0];
8228         }
8229     }
8230
8231     return \%ret;
8232 }
8233
8234
8235 # <LJFUNC>
8236 # name: LJ::set_interests
8237 # des: Change a user's interests.
8238 # args: u, old, new
8239 # des-old: hashref of old interests (hashing being interest => intid)
8240 # des-new: listref of new interests
8241 # returns: 1 on success, undef on failure
8242 # </LJFUNC>
8243 sub set_interests {
8244     my ($u, $old, $new) = @_;
8245
8246     $u = LJ::want_user($u);
8247     my $userid = $u->{'userid'};
8248     return undef unless $userid;
8249
8250     return undef unless ref $old eq 'HASH';
8251     return undef unless ref $new eq 'ARRAY';
8252
8253     my $dbh = LJ::get_db_writer();
8254     my %int_new = ();
8255     my %int_del = %$old;  # assume deleting everything, unless in @$new
8256
8257     # user interests go in a different table than user interests,
8258     # though the schemas are the same so we can run the same queries on them
8259     my $uitable = $u->{'journaltype'} eq 'C' ? 'comminterests' : 'userinterests';
8260
8261     # track if we made changes to refresh memcache later.
8262     my $did_mod = 0;
8263
8264     my @valid_ints = LJ::validate_interest_list(@$new);
8265     foreach my $int (@valid_ints)
8266     {
8267         $int_new{$int} = 1 unless $old->{$int};
8268         delete $int_del{$int};
8269     }
8270
8271     ### were interests removed?
8272     if (%int_del)
8273     {
8274         ## easy, we know their IDs, so delete them en masse
8275         my $intid_in = join(", ", values %int_del);
8276         $dbh->do("DELETE FROM $uitable WHERE userid=$userid AND intid IN ($intid_in)");
8277         $dbh->do("UPDATE interests SET intcount=intcount-1 WHERE intid IN ($intid_in) AND intcount > 0");
8278         $did_mod = 1;
8279     }
8280
8281     ### do we have new interests to add?
8282     my @new_intids = ();  ## existing IDs we'll add for this user
8283     if (%int_new)
8284     {
8285         $did_mod = 1;
8286
8287         ## difficult, have to find intids of interests, and create new ints for interests
8288         ## that nobody has ever entered before
8289         my $int_in = join(", ", map { $dbh->quote($_); } keys %int_new);
8290         my %int_exist;
8291
8292         ## find existing IDs
8293         my $sth = $dbh->prepare("SELECT interest, intid FROM interests WHERE interest IN ($int_in)");
8294         $sth->execute;
8295         while (my ($intr, $intid) = $sth->fetchrow_array) {
8296             push @new_intids, $intid;       # - we'll add this later.
8297             delete $int_new{$intr};         # - so we don't have to make a new intid for
8298                                             #   this next pass.
8299         }
8300
8301         if (@new_intids) {
8302             my $sql = "";
8303             foreach my $newid (@new_intids) {
8304                 if ($sql) { $sql .= ", "; }
8305                 else { $sql = "REPLACE INTO $uitable (userid, intid) VALUES "; }
8306                 $sql .= "($userid, $newid)";
8307             }
8308             $dbh->do($sql);
8309
8310             my $intid_in = join(", ", @new_intids);
8311             $dbh->do("UPDATE interests SET intcount=intcount+1 WHERE intid IN ($intid_in)");
8312         }
8313     }
8314
8315     ### do we STILL have interests to add?  (must make new intids)
8316     if (%int_new)
8317     {
8318         foreach my $int (keys %int_new)
8319         {
8320             my $intid;
8321             my $qint = $dbh->quote($int);
8322
8323             $dbh->do("INSERT INTO interests (intid, intcount, interest) ".
8324                      "VALUES (NULL, 1, $qint)");
8325             if ($dbh->err) {
8326                 # somebody beat us to creating it.  find its id.
8327                 $intid = $dbh->selectrow_array("SELECT intid FROM interests WHERE interest=$qint");
8328                 $dbh->do("UPDATE interests SET intcount=intcount+1 WHERE intid=$intid");
8329             } else {
8330                 # newly created
8331                 $intid = $dbh->{'mysql_insertid'};
8332             }
8333             if ($intid) {
8334                 ## now we can actually insert it into the userinterests table:
8335                 $dbh->do("INSERT INTO $uitable (userid, intid) ".
8336                          "VALUES ($userid, $intid)");
8337                 push @new_intids, $intid;
8338             }
8339         }
8340     }
8341     LJ::run_hooks("set_interests", $u, \%int_del, \@new_intids); # interest => intid
8342
8343     # do migrations to clean up userinterests vs comminterests conflicts
8344     $u->lazy_interests_cleanup;
8345
8346     LJ::memcache_kill($u, "intids") if $did_mod;
8347     $u->{_cache_interests} = undef if $did_mod;
8348
8349     return 1;
8350 }
8351
8352 sub validate_interest_list {
8353     my $interrors = ref $_[0] eq "ARRAY" ? shift : [];
8354     my @ints = @_;
8355
8356     my @valid_ints = ();
8357     foreach my $int (@ints) {
8358         $int = lc($int);       # FIXME: use utf8?
8359         $int =~ s/^i like //;  # *sigh*
8360         next unless $int;
8361
8362         # Specific interest failures
8363         my ($bytes,$chars) = LJ::text_length($int);
8364         my @words = split(/\s+/, $int);
8365         my $word_ct = scalar @words;
8366
8367         my $error_string = '';
8368         if ($int =~ /[\<\>]/) {
8369             $int = LJ::ehtml($int);
8370             $error_string .= '.invalid';
8371         } else {
8372             $error_string .= '.bytes' if $bytes > LJ::BMAX_INTEREST;
8373             $error_string .= '.chars' if $chars > LJ::CMAX_INTEREST;
8374             $error_string .= '.words' if $word_ct > 4;
8375         }
8376
8377         if ($error_string) {
8378             $error_string = "error.interest$error_string";
8379             push @$interrors, [ $error_string,
8380                                 { int => $int,
8381                                   bytes => $bytes,
8382                                   bytes_max => LJ::BMAX_INTEREST,
8383                                   chars => $chars,
8384                                   chars_max => LJ::CMAX_INTEREST,
8385                                   words => $word_ct,
8386                                   words_max => 4
8387                                 }
8388                               ];
8389             next;
8390         }
8391         push @valid_ints, $int;
8392     }
8393     return @valid_ints;
8394 }
8395 sub interest_string_to_list {
8396     my $intstr = shift;
8397
8398     $intstr =~ s/^\s+//;  # strip leading space
8399     $intstr =~ s/\s+$//;  # strip trailing space
8400     $intstr =~ s/\n/,/g;  # newlines become commas
8401     $intstr =~ s/\s+/ /g; # strip duplicate spaces from the interest
8402
8403     # final list is ,-sep
8404     return grep { length } split (/\s*,\s*/, $intstr);
8405 }
8406
8407 # $opts is optional, with keys:
8408 #    forceids => 1   : don't use memcache for loading the intids
8409 #    forceints => 1   : don't use memcache for loading the interest rows
8410 #    justids => 1 : return arrayref of intids only, not names/counts
8411 # returns otherwise an arrayref of interest rows, sorted by interest name
8412 sub get_interests
8413 {
8414     my ($u, $opts) = @_;
8415     $opts ||= {};
8416     return undef unless $u;
8417
8418     # first check request cache inside $u
8419     if (my $ints = $u->{_cache_interests}) {
8420         if ($opts->{justids}) {
8421             return [ map { $_->[0] } @$ints ];
8422         }
8423         return $ints;
8424     }
8425
8426     my $uid = $u->{userid};
8427     my $uitable = $u->{'journaltype'} eq 'C' ? 'comminterests' : 'userinterests';
8428
8429     # load the ids
8430     my $ids;
8431     my $mk_ids = [$uid, "intids:$uid"];
8432     $ids = LJ::MemCache::get($mk_ids) unless $opts->{'forceids'};
8433     unless ($ids && ref $ids eq "ARRAY") {
8434         $ids = [];
8435         my $dbh = LJ::get_db_writer();
8436         my $sth = $dbh->prepare("SELECT intid FROM $uitable WHERE userid=?");
8437         $sth->execute($uid);
8438         push @$ids, $_ while ($_) = $sth->fetchrow_array;
8439         LJ::MemCache::add($mk_ids, $ids);
8440     }
8441
8442     # FIXME: set a 'justids' $u cache key in this case, then only return that
8443     #        later if 'justids' is requested?  probably not worth it.
8444     return $ids if $opts->{'justids'};
8445
8446     # load interest rows
8447     my %need;
8448     $need{$_} = 1 foreach @$ids;
8449     my @ret;
8450
8451     unless ($opts->{'forceints'}) {
8452         if (my $mc = LJ::MemCache::get_multi(map { [$_, "introw:$_"] } @$ids)) {
8453             while (my ($k, $v) = each %$mc) {
8454                 next unless $k =~ /^introw:(\d+)/;
8455                 delete $need{$1};
8456                 push @ret, $v;
8457             }
8458         }
8459     }
8460
8461     if (%need) {
8462         my $ids = join(",", map { $_+0 } keys %need);
8463         my $dbr = LJ::get_db_reader();
8464         my $sth = $dbr->prepare("SELECT intid, interest, intcount FROM interests ".
8465                                 "WHERE intid IN ($ids)");
8466         $sth->execute;
8467         my $memc_store = 0;
8468         while (my ($intid, $int, $count) = $sth->fetchrow_array) {
8469             # minimize latency... only store 25 into memcache at a time
8470             # (too bad we don't have set_multi.... hmmmm)
8471             my $aref = [$intid, $int, $count];
8472             if ($memc_store++ < 25) {
8473                 # if the count is fairly high, keep item in memcache longer,
8474                 # since count's not so important.
8475                 my $expire = $count < 10 ? 3600*12 : 3600*48;
8476                 LJ::MemCache::add([$intid, "introw:$intid"], $aref, $expire);
8477             }
8478             push @ret, $aref;
8479         }
8480     }
8481
8482     @ret = sort { $a->[1] cmp $b->[1] } @ret;
8483     return $u->{_cache_interests} = \@ret;
8484 }
8485
8486 # <LJFUNC>
8487 # name: LJ::modify_caps
8488 # des: Given a list of caps to add and caps to remove, updates a user's caps.
8489 # args: uuid, cap_add, cap_del, res
8490 # des-cap_add: arrayref of bit numbers to turn on
8491 # des-cap_del: arrayref of bit numbers to turn off
8492 # des-res: hashref returned from 'modify_caps' hook
8493 # returns: updated u object, retrieved from $dbh, then 'caps' key modified
8494 #          otherwise, returns 0 unless all hooks run properly.
8495 # </LJFUNC>
8496 sub modify_caps {
8497     my ($argu, $cap_add, $cap_del, $res) = @_;
8498     my $userid = LJ::want_userid($argu);
8499     return undef unless $userid;
8500
8501     $cap_add ||= [];
8502     $cap_del ||= [];
8503     my %cap_add_mod = ();
8504     my %cap_del_mod = ();
8505
8506     # convert capnames to bit numbers
8507     if (LJ::are_hooks("get_cap_bit")) {
8508         foreach my $bit (@$cap_add, @$cap_del) {
8509             next if $bit =~ /^\d+$/;
8510
8511             # bit is a magical reference into the array
8512             $bit = LJ::run_hook("get_cap_bit", $bit);
8513         }
8514     }
8515
8516     # get a u object directly from the db
8517     my $u = LJ::load_userid($userid, "force");
8518
8519     delete $u->{sup_enabled} if $u;
8520
8521     # add new caps
8522     my $newcaps = int($u->{'caps'});
8523     foreach (@$cap_add) {
8524         my $cap = 1 << $_;
8525
8526         # about to turn bit on, is currently off?
8527         $cap_add_mod{$_} = 1 unless $newcaps & $cap;
8528         $newcaps |= $cap;
8529     }
8530
8531     # remove deleted caps
8532     foreach (@$cap_del) {
8533         my $cap = 1 << $_;
8534
8535         # about to turn bit off, is it currently on?
8536         $cap_del_mod{$_} = 1 if $newcaps & $cap;
8537         $newcaps &= ~$cap;
8538     }
8539
8540     # run hooks for modified bits
8541     if (LJ::are_hooks("modify_caps")) {
8542         my @res = LJ::run_hooks("modify_caps",
8543                             { 'u' => $u,
8544                               'newcaps' => $newcaps,
8545                               'oldcaps' => $u->{'caps'},
8546                               'cap_on_req'  => { map { $_ => 1 } @$cap_add },
8547                               'cap_off_req' => { map { $_ => 1 } @$cap_del },
8548                               'cap_on_mod'  => \%cap_add_mod,
8549                               'cap_off_mod' => \%cap_del_mod,
8550                           });
8551
8552         # hook should return a status code
8553         foreach my $status (@res) {
8554             return undef unless ref $status and defined $status->[0];
8555         }
8556     }
8557
8558     # update user row
8559     return 0 unless LJ::update_user($u, { 'caps' => $newcaps });
8560
8561     $u->{caps} = $newcaps;
8562     $argu->{caps} = $newcaps if ref $argu; # temp hack
8563
8564     LJ::run_hooks("props_changed", $u, {caps => $newcaps});
8565
8566     return $u;
8567 }
8568
8569 # returns 1 if action is permitted.  0 if above rate or fail.
8570 # action isn't logged on fail.
8571 #
8572 # opts keys:
8573 #   -- "limit_by_ip" => "1.2.3.4"  (when used for checking rate)
8574 #   --
8575 sub rate_log
8576 {
8577     my ($u, $ratename, $count, $opts) = @_;
8578     my $rateperiod = LJ::get_cap($u, "rateperiod-$ratename");
8579     return 1 unless $rateperiod;
8580
8581     return 0 unless $u->writer;
8582
8583     my $rp = LJ::get_prop("rate", $ratename);
8584     return 0 unless $rp;
8585     $opts->{'rp'} = $rp;
8586
8587     my $now = time();
8588     $opts->{'now'} = $now;
8589     my $udbr = LJ::get_cluster_reader($u);
8590     my $ip = $udbr->quote($opts->{'limit_by_ip'} || "0.0.0.0");
8591     $opts->{'ip'} = $ip;
8592     return 0 unless LJ::rate_check($u, $ratename, $count, $opts);
8593
8594     # log current
8595     $count = $count + 0;
8596     $u->do("INSERT INTO ratelog (userid, rlid, evttime, ip, quantity) VALUES ".
8597            "($u->{'userid'}, $rp->{'id'}, $now, INET_ATON($ip), $count)");
8598
8599     # delete memcache, except in the case of rate limiting by ip
8600     unless ($opts->{limit_by_ip}) {
8601         LJ::MemCache::delete($u->rate_memkey($rp));
8602     }
8603
8604     return 1;
8605 }
8606
8607 # returns 1 if action is permitted.  0 if above rate or fail.
8608 sub rate_check {
8609     my ($u, $ratename, $count, $opts) = @_;
8610
8611     return 1 if grep { $_ eq $u->username } @LJ::NO_RATE_CHECK_USERS;
8612
8613     my $rateperiod = LJ::get_cap($u, "rateperiod-$ratename");
8614     return 1 unless $rateperiod;
8615
8616     my $rp = defined $opts->{'rp'} ? $opts->{'rp'}
8617              : LJ::get_prop("rate", $ratename);
8618     return 0 unless $rp;
8619
8620     my $now = defined $opts->{'now'} ? $opts->{'now'} : time();
8621     my $beforeperiod = $now - $rateperiod;
8622
8623     # check rate.  (okay per period)
8624     my $opp = LJ::get_cap($u, "rateallowed-$ratename");
8625     return 1 unless $opp;
8626
8627     # check memcache, except in the case of rate limiting by ip
8628     my $memkey = $u->rate_memkey($rp);
8629     unless ($opts->{limit_by_ip}) {
8630         my $attempts = LJ::MemCache::get($memkey);
8631         if ($attempts) {
8632             my $num_attempts = 0;
8633             foreach my $attempt (@$attempts) {
8634                 next if $attempt->{evttime} < $beforeperiod;
8635                 $num_attempts += $attempt->{quantity};
8636             }
8637
8638             return $num_attempts + $count > $opp ? 0 : 1;
8639         }
8640     }
8641
8642     return 0 unless $u->writer;
8643
8644     # delete inapplicable stuff (or some of it)
8645     $u->do("DELETE FROM ratelog WHERE userid=$u->{'userid'} AND rlid=$rp->{'id'} ".
8646            "AND evttime < $beforeperiod LIMIT 1000");
8647
8648     my $udbr = LJ::get_cluster_reader($u);
8649     my $ip = defined $opts->{'ip'}
8650              ? $opts->{'ip'}
8651              : $udbr->quote($opts->{'limit_by_ip'} || "0.0.0.0");
8652     my $sth = $udbr->prepare("SELECT evttime, quantity FROM ratelog WHERE ".
8653                              "userid=$u->{'userid'} AND rlid=$rp->{'id'} ".
8654                              "AND ip=INET_ATON($ip) ".
8655                              "AND evttime > $beforeperiod");
8656     $sth->execute;
8657
8658     my @memdata;
8659     my $sum = 0;
8660     while (my $data = $sth->fetchrow_hashref) {
8661         push @memdata, $data;
8662         $sum += $data->{quantity};
8663     }
8664
8665     # set memcache, except in the case of rate limiting by ip
8666     unless ($opts->{limit_by_ip}) {
8667         LJ::MemCache::set( $memkey => \@memdata || [] );
8668     }
8669
8670     # would this transaction go over the limit?
8671     if ($sum + $count > $opp) {
8672         # TODO: optionally log to rateabuse, unless caller is doing it themselves
8673         # somehow, like with the "loginstall" table.
8674         return 0;
8675     }
8676
8677     return 1;
8678 }
8679
8680
8681 sub login_ip_banned
8682 {
8683     my ($u, $ip) = @_;
8684     return 0 unless $u;
8685
8686     $ip ||= LJ::get_remote_ip();
8687     return 0 unless $ip;
8688
8689     my $udbr;
8690     my $rateperiod = LJ::get_cap($u, "rateperiod-failed_login");
8691     if ($rateperiod && ($udbr = LJ::get_cluster_reader($u))) {
8692         my $bantime = $udbr->selectrow_array("SELECT time FROM loginstall WHERE ".
8693                                              "userid=$u->{'userid'} AND ip=INET_ATON(?)",
8694                                              undef, $ip);
8695         if ($bantime && $bantime > time() - $rateperiod) {
8696             return 1;
8697         }
8698     }
8699     return 0;
8700 }
8701
8702 sub handle_bad_login
8703 {
8704     my ($u, $ip) = @_;
8705     return 1 unless $u;
8706
8707     $ip ||= LJ::get_remote_ip();
8708     return 1 unless $ip;
8709
8710     # an IP address is permitted such a rate of failures
8711     # until it's banned for a period of time.
8712     my $udbh;
8713     if (! LJ::rate_log($u, "failed_login", 1, { 'limit_by_ip' => $ip }) &&
8714         ($udbh = LJ::get_cluster_master($u)))
8715     {
8716         $udbh->do("REPLACE INTO loginstall (userid, ip, time) VALUES ".
8717                   "(?,INET_ATON(?),UNIX_TIMESTAMP())", undef, $u->{'userid'}, $ip);
8718     }
8719     return 1;
8720 }
8721
8722 # <LJFUNC>
8723 # name: LJ::userpic_count
8724 # des: Gets a count of userpics for a given user.
8725 # args: upics, idlist
8726 # des-upics: hashref to load pictures into, keys being the picids
8727 # des-idlist: [$u, $picid] or [[$u, $picid], [$u, $picid], +] objects
8728 #             also supports deprecated old method, of an array ref of picids.
8729 # </LJFUNC>
8730 sub userpic_count {
8731     my $u = shift or return undef;
8732
8733     if ($u->{'dversion'} > 6) {
8734         my $dbcr = LJ::get_cluster_def_reader($u) or return undef;
8735         return $dbcr->selectrow_array("SELECT COUNT(*) FROM userpic2 " .
8736                                       "WHERE userid=? AND state <> 'X'", undef, $u->{'userid'});
8737     }
8738
8739     my $dbh = LJ::get_db_writer() or return undef;
8740     return $dbh->selectrow_array("SELECT COUNT(*) FROM userpic " .
8741                                  "WHERE userid=? AND state <> 'X'", undef, $u->{'userid'});
8742 }
8743
8744 # <LJFUNC>
8745 # name: LJ::_friends_do
8746 # des: Runs given SQL, then deletes the given userid's friends from memcache.
8747 # args: uuserid, sql, args
8748 # des-uuserid: a userid or u object
8749 # des-sql: SQL to run via $dbh->do()
8750 # des-args: a list of arguments to pass use via: $dbh->do($sql, undef, @args)
8751 # returns: return false on error
8752 # </LJFUNC>
8753 sub _friends_do {
8754     my ($uuid, $sql, @args) = @_;
8755     my $uid = want_userid($uuid);
8756     return undef unless $uid && $sql;
8757
8758     my $dbh = LJ::get_db_writer() or return 0;
8759
8760     my $ret = $dbh->do($sql, undef, @args);
8761     return 0 if $dbh->err;
8762
8763     LJ::memcache_kill($uid, "friends");
8764
8765     return 1;
8766 }
8767
8768 # <LJFUNC>
8769 # name: LJ::add_friend
8770 # des: Simple interface to add a friend edge.
8771 # args: uuid, to_add, opts?
8772 # des-to_add: a single uuid or an arrayref of uuids to add (befriendees)
8773 # des-opts: hashref; 'defaultview' key means add target uuids to $uuid's Default View friends group,
8774 #                    'groupmask' key means use this group mask
8775 # returns: boolean; 1 on success (or already friend), 0 on failure (bogus args)
8776 # </LJFUNC>
8777 sub add_friend {
8778     my ($userid, $to_add, $opts) = @_;
8779
8780     $userid = LJ::want_userid($userid);
8781     return 0 unless $userid;
8782
8783     my @add_ids = ref $to_add eq 'ARRAY' ? map { LJ::want_userid($_) } @$to_add : ( LJ::want_userid($to_add) );
8784     return 0 unless @add_ids;
8785
8786     # clean widget cache
8787     my $widget_key = "friend_birthdays:" . $userid;
8788     LJ::MemCache::delete($widget_key);
8789
8790     my $friender = LJ::load_userid($userid);
8791
8792     # check action rate
8793     ## TODO: rate check of adding friends needs PM elaboration
8794     ## Remove '1 ||' when specification is complete
8795     unless (1 || $opts->{no_rate_check}){
8796         my $cond = ["ratecheck:add_friend:$userid",
8797                     [ $LJ::ADD_FRIEND_RATE_LIMIT || [ 1, 3600 ] ]
8798                    ];
8799         return 0 unless LJ::RateLimit->check($friender, [ $cond ]);
8800     }
8801
8802     my $sclient  = LJ::theschwartz();
8803
8804     my $fgcol = LJ::color_todb($opts->{'fgcolor'}) || LJ::color_todb("#000000");
8805     my $bgcol = LJ::color_todb($opts->{'bgcolor'});
8806     # in case the background color is #000000, in which case the || falls through
8807     # so only overwrite what we got if what we got was undef (invalid input)
8808     $bgcol = LJ::color_todb("#ffffff") unless defined $bgcol;
8809
8810     $opts ||= {};
8811
8812     my $groupmask = 1;
8813     if (defined $opts->{groupmask}) {
8814         $groupmask = $opts->{groupmask};
8815     } elsif ($opts->{'defaultview'}) {
8816         # TAG:FR:ljlib:add_friend_getdefviewmask
8817         my $group = LJ::get_friend_group($userid, { name => 'Default View' });
8818         my $grp = $group ? $group->{groupnum}+0 : 0;
8819         $groupmask |= (1 << $grp) if $grp;
8820     }
8821
8822     # part of the criteria for whether to fire befriended event
8823     my $notify = !$LJ::DISABLED{esn} && !$opts->{nonotify}
8824                  && $friender->is_visible && $friender->is_person;
8825
8826
8827     # load all users at once
8828     LJ::load_userids(@add_ids);
8829     foreach my $add_id (@add_ids) {
8830         LJ::RelationService->create_relation_to(
8831             $friender, $add_id, 'F',
8832             groupmask => $groupmask,
8833             fgcolor   => $fgcol,
8834             bgcolor   => $bgcol,
8835         );
8836
8837         my $friendee = LJ::load_userid($add_id);
8838         LJ::add_to_friend_list($friender, $friendee);
8839          __drop_short_lifetime_cache($friender, $friendee);
8840
8841         if ($sclient) {
8842             my @jobs;
8843
8844             # only fire event if the friender is a person and not banned and visible
8845             if ($notify && !$friendee->is_banned($friender)) {
8846                 require LJ::Event::BefriendedDelayed;
8847                 LJ::Event::BefriendedDelayed->send($friendee, $friender);
8848             }
8849
8850             push @jobs, TheSchwartz::Job->new(
8851                                               funcname => "LJ::NewWorker::TheSchwartz::FriendChange",
8852                                               arg      => [$userid, 'add', $add_id],
8853                                               ) unless $LJ::DISABLED{'friendchange-schwartz'};
8854
8855             $sclient->insert_jobs(@jobs) if @jobs;
8856
8857        }
8858     }
8859
8860     # WARNING: always returns "true". Check result of executing "REPLACE INTO friends ..." statement above.
8861     return 1;
8862 }
8863
8864 # <LJFUNC>
8865 # name: LJ::remove_friend
8866 # des: delete existing friends.
8867 # args: uuid, to_del
8868 # des-to_del: a single uuid or an arrayref of uuids to remove.
8869 # returns: boolean
8870 # </LJFUNC>
8871 sub remove_friend {
8872     my ($userid, $to_del, $opts) = @_;
8873
8874     $userid = LJ::want_userid($userid);
8875     return undef unless $userid;
8876
8877     my @del_ids = ref $to_del eq 'ARRAY' ? map { LJ::want_userid($_) } @$to_del : ( LJ::want_userid($to_del) );
8878     return 0 unless @del_ids;
8879
8880     my $u = LJ::load_userid($userid);
8881
8882     my $dbh = LJ::get_db_writer() or return 0;
8883
8884     my $sclient = LJ::theschwartz();
8885     # part of the criteria for whether to fire defriended event
8886     my $notify = !$LJ::DISABLED{esn} && !$opts->{nonotify} && $u->is_visible && $u->is_person;
8887
8888     foreach my $del_id (@del_ids) {
8889         LJ::RelationService->remove_relation_to( $u, $del_id, 'F' );
8890     }
8891
8892     LJ::load_userids(@del_ids);
8893     # delete friend-of memcache keys for anyone who was removed
8894     foreach my $fid (@del_ids) {
8895         my $friendee = LJ::load_userid($fid);
8896
8897         LJ::remove_from_friend_list($u, $friendee);
8898         __drop_short_lifetime_cache($u, $friendee);
8899
8900         if ($sclient) {
8901             my @jobs;
8902
8903             # only fire event if the friender is a person and not banned and visible
8904             if ($notify && !$friendee->has_banned($u)) {
8905                 require LJ::Event::DefriendedDelayed;
8906                 LJ::Event::DefriendedDelayed->send($friendee, $u);
8907             }
8908
8909             push @jobs, TheSchwartz::Job->new(
8910                                               funcname => "LJ::NewWorker::TheSchwartz::FriendChange",
8911                                               arg      => [$userid, 'del', $fid],
8912                                               ) unless $LJ::DISABLED{'friendchange-schwartz'};
8913
8914             $sclient->insert_jobs(@jobs);
8915
8916         }
8917     }
8918
8919     return 1;
8920 }
8921 *delete_friend_edge = \&LJ::remove_friend;
8922
8923 sub __drop_short_lifetime_cache {
8924     my ($u, $friend) = @_;
8925
8926     return unless $u;
8927     return unless $friend;
8928
8929     my @clean_clist = ('cfriends', 'member', 'mutual_cfriends');
8930     my @clean_flist = ('friends',  'mutual_friends', 'pfriends', 'friendof', 'mutual', 'yfriends');
8931
8932     my $remote = LJ::get_remote();
8933
8934     my $sub_drop = sub {
8935         my ($userid, $list_name) = @_;
8936
8937         my $cached = $list_name !~ /mutual/;
8938
8939         my $uid = 'logged';
8940         if (!$cached) {
8941             $uid = $remote ? $remote->userid : 'n';
8942         }
8943
8944         LJ::MemCache::delete("u:profile:l:$userid:$uid:$list_name:");
8945         LJ::MemCache::delete("u:profile:l:$userid:$uid:$list_name:150");
8946
8947         LJ::MemCache::delete("u:profile:l:$userid:n:$list_name:");
8948         LJ::MemCache::delete("u:profile:l:$userid:n:$list_name:150");
8949     };
8950
8951
8952     my $userid   = $u->userid;
8953     my $friendid = $friend->userid;
8954
8955     foreach my $list_name (@clean_flist) {
8956         $sub_drop->($userid, $list_name);
8957     }
8958
8959     foreach my $list_name (@clean_clist) {
8960         $sub_drop->($userid, $list_name);
8961     }
8962
8963     foreach my $list_name (@clean_flist) {
8964         $sub_drop->($friendid, $list_name);
8965     }
8966
8967     foreach my $list_name (@clean_clist) {
8968         $sub_drop->($friendid, $list_name);
8969     }
8970
8971 }
8972
8973 # <LJFUNC>
8974 # name: LJ::get_friends
8975 # des: Returns friends rows for a given user.
8976 # args: uuserid, mask?, memcache_only?, force?
8977 # des-uuserid: a userid or u object.
8978 # des-mask: a security mask to filter on.
8979 # des-memcache_only: flag, set to only return data from memcache
8980 # des-force: flag, set to ignore memcache and always hit DB.
8981 # returns: hashref; keys = friend userids
8982 #                   values = hashrefs of 'friends' columns and their values
8983 # </LJFUNC>
8984 sub get_friends {
8985     # TAG:FR:ljlib:get_friends
8986     my ($uuid, $mask, $memcache_only, $force) = @_;
8987     my $userid = LJ::want_userid($uuid);
8988     return undef unless $userid;
8989     return undef if $LJ::FORCE_EMPTY_FRIENDS{$userid};
8990
8991     my $u = LJ::load_userid($userid);
8992
8993     return LJ::RelationService->load_relation_destinations(
8994             $u, 'F',
8995                 uuid          => $uuid,
8996                 mask          => $mask,
8997                 memcache_only => $memcache_only,
8998                 force_db      => $force,
8999                 );
9000 }
9001
9002 # <LJFUNC>
9003 # name: LJ::get_friendofs
9004 # des: Returns userids of friendofs for a given user.
9005 # args: uuserid, opts?
9006 # des-opts: options hash, keys: 'force' => don't check memcache
9007 # returns: userid for friendofs
9008 # </LJFUNC>
9009 sub get_friendofs {
9010     # TAG:FR:ljlib:get_friends
9011     my ($uuid, $opts) = @_;
9012     my $userid = LJ::want_userid($uuid);
9013     return undef unless $userid;
9014
9015     my $u = LJ::load_userid($userid);
9016     return LJ::RelationService->find_relation_sources($u, 'F',
9017             nolimit        => $opts->{force} || 0,
9018             skip_memcached => $opts->{force},
9019             );
9020 }
9021
9022 # <LJFUNC>
9023 # name: LJ::fill_groups_xmlrpc
9024 # des: Fills a hashref (presumably to be sent to an XML-RPC client, e.g. FotoBilder)
9025 #      with user friend group information
9026 # args: u, ret
9027 # des-ret: a response hashref to fill with friend group data
9028 # returns: undef if called incorrectly, 1 otherwise
9029 # </LJFUNC>
9030 sub fill_groups_xmlrpc {
9031     my ($u, $ret) = @_;
9032     return undef unless ref $u && ref $ret;
9033
9034     # best interface ever...
9035     $RPC::XML::ENCODING = "utf-8";
9036
9037     # layer on friend group information in the following format:
9038     #
9039     # grp:1 => 'mygroup',
9040     # ...
9041     # grp:30 => 'anothergroup',
9042     #
9043     # grpu:whitaker => '0,1,2,3,4',
9044     # grpu:test => '0',
9045
9046     my $grp = LJ::get_friend_group($u) || {};
9047
9048     # we don't always have RPC::XML loaded (in web context), and it doesn't really
9049     # matter much anyway, since our only consumer is also perl which will take
9050     # the occasional ints back to strings.
9051     my $str = sub {
9052         my $str = shift;
9053         my $val = eval { RPC::XML::string->new($str); };
9054         return $val unless $@;
9055         return $str;
9056     };
9057
9058     $ret->{"grp:0"} = $str->("_all_");
9059     foreach my $bit (1..30) {
9060         next unless my $g = $grp->{$bit};
9061         $ret->{"grp:$bit"} = $str->($g->{groupname});
9062     }
9063
9064     my $fr = LJ::get_friends($u) || {};
9065     my $users = LJ::load_userids(keys %$fr);
9066     while (my ($fid, $f) = each %$fr) {
9067         my $u = $users->{$fid};
9068         next unless $u->{journaltype} =~ /[PSI]/;
9069
9070         my $fname = $u->{user};
9071         $ret->{"grpu:$fid:$fname"} =
9072             $str->(join(",", 0, grep { $grp->{$_} && $f->{groupmask} & 1 << $_ } 1..30));
9073     }
9074
9075     return 1;
9076 }
9077
9078 # <LJFUNC>
9079 # name: LJ::delete_all_comments
9080 # des: deletes all comments from a post, permanently, for when a post is deleted
9081 # info: The tables [dbtable[talk2]], [dbtable[talkprop2]], [dbtable[talktext2]],
9082 #       are deleted from, immediately.
9083 # args: u, nodetype, nodeid
9084 # des-nodetype: The thread nodetype (probably 'L' for log items).
9085 # des-nodeid: The thread nodeid for the given nodetype (probably the jitemid
9086 #             from the [dbtable[log2]] row).
9087 # returns: boolean; success value
9088 # </LJFUNC>
9089 sub delete_all_comments {
9090     my ($u, $nodetype, $nodeid) = @_;
9091
9092     my $dbcm = LJ::get_cluster_master($u);
9093     return 0 unless $dbcm && $u->writer;
9094
9095     # delete comments
9096     my ($t, $loop) = (undef, 1);
9097     my $chunk_size = 200;
9098     while ($loop &&
9099            ($t = $dbcm->selectcol_arrayref("SELECT jtalkid FROM talk2 WHERE ".
9100                                            "nodetype=? AND journalid=? ".
9101                                            "AND nodeid=? LIMIT $chunk_size", undef,
9102                                            $nodetype, $u->{'userid'}, $nodeid))
9103            && $t && @$t)
9104     {
9105         my @batch = map { int $_ } @$t;
9106         my $in = join(',', @batch);
9107         return 1 unless $in;
9108
9109         LJ::run_hooks('report_cmt_delete', $u->{'userid'}, \@batch);
9110         LJ::run_hooks('report_cmt_text_delete', $u->{'userid'}, \@batch);
9111         foreach my $table (qw(talkprop2 talktext2 talk2)) {
9112             $u->do("DELETE FROM $table WHERE journalid=? AND jtalkid IN ($in)",
9113                    undef, $u->{'userid'});
9114         }
9115         # decrement memcache
9116         LJ::MemCache::decr([$u->{'userid'}, "talk2ct:$u->{'userid'}"], scalar(@$t));
9117         $loop = 0 unless @$t == $chunk_size;
9118     }
9119     return 1;
9120
9121 }
9122
9123 # is a user object (at least a hashref)
9124 sub isu {
9125     return unless ref $_[0];
9126     return 1 if UNIVERSAL::isa($_[0], "LJ::User");
9127
9128     if (ref $_[0] eq "HASH" && $_[0]->{userid}) {
9129         carp "User HASH objects are deprecated from use." if $LJ::IS_DEV_SERVER;
9130         return 1;
9131     }
9132 }
9133
9134 # create externally mapped user.
9135 # return uid of LJ user on success, undef on error.
9136 # opts = {
9137 #     extuser or extuserid (or both, but one is required.),
9138 #     caps
9139 # }
9140 # opts also can contain any additional options that create_account takes. (caps?)
9141 sub create_extuser
9142 {
9143     my ($type, $opts) = @_;
9144     return undef unless $type && $LJ::EXTERNAL_NAMESPACE{$type}->{id};
9145     return undef unless ref $opts &&
9146         ($opts->{extuser} || defined $opts->{extuserid});
9147
9148     my $uid;
9149     my $dbh = LJ::get_db_writer();
9150     return undef unless $dbh;
9151
9152     # make sure a mapping for this user doesn't already exist.
9153     $uid = LJ::get_extuser_uid( $type, $opts, 'force' );
9154     return $uid if $uid;
9155
9156     # increment ext_ counter until we successfully create an LJ account.
9157     # hard cap it at 10 tries. (arbitrary, but we really shouldn't have *any*
9158     # failures here, let alone 10 in a row.)
9159     for (1..10) {
9160         my $extuser = 'ext_' . LJ::alloc_global_counter( 'E' );
9161         $uid =
9162           LJ::create_account(
9163             { caps => $opts->{caps}, user => $extuser, name => $extuser } );
9164         last if $uid;
9165         select undef, undef, undef, .10;  # lets not thrash over this.
9166     }
9167     return undef unless $uid;
9168
9169     # add extuser mapping.
9170     my $sql = "INSERT INTO extuser SET userid=?, siteid=?";
9171     my @bind = ($uid, $LJ::EXTERNAL_NAMESPACE{$type}->{id});
9172
9173     if ($opts->{extuser}) {
9174         $sql .= ", extuser=?";
9175         push @bind, $opts->{extuser};
9176     }
9177
9178     if ($opts->{extuserid}) {
9179         $sql .= ", extuserid=? ";
9180         push @bind, $opts->{extuserid}+0;
9181     }
9182
9183     $dbh->do($sql, undef, @bind) or return undef;
9184     return $uid;
9185 }
9186
9187 sub priv_can_view {
9188     my ($url, $remote) = @_;
9189
9190     my $privilege = $LJ::PAGE_PRIVILEGES{$url} || $LJ::PAGE_PRIVILEGES{"$url/"};
9191
9192     return 0 unless $privilege;
9193
9194     my $priv = $privilege->{'priv'};
9195     my $arg  = $privilege->{'arg'};
9196     if ( LJ::check_priv($remote, $priv, $arg) ) {
9197         my $uri = LJ::Request->uri;
9198             my $args = LJ::Request->args;
9199             my $current_url = "$uri?$args";
9200             my $authas = LJ::Request->get_param('authas') || LJ::Request->post_param('authas');
9201             my $u = LJ::load_user($authas);
9202             LJ::statushistory_add($u, $remote, "view_settings", "$current_url" );
9203
9204         return 1;
9205     }
9206 }
9207 # given an extuserid or extuser, return the LJ uid.
9208 # return undef if there is no mapping.
9209 sub get_extuser_uid
9210 {
9211     my ($type, $opts, $force) = @_;
9212     return undef unless $type && $LJ::EXTERNAL_NAMESPACE{$type}->{id};
9213     return undef unless ref $opts &&
9214         ($opts->{extuser} || defined $opts->{extuserid});
9215
9216     my $dbh = $force ? LJ::get_db_writer() : LJ::get_db_reader();
9217     return undef unless $dbh;
9218
9219     my $sql = "SELECT userid FROM extuser WHERE siteid=?";
9220     my @bind = ($LJ::EXTERNAL_NAMESPACE{$type}->{id});
9221
9222     if ($opts->{extuser}) {
9223         $sql .= " AND extuser=?";
9224         push @bind, $opts->{extuser};
9225     }
9226
9227     if ($opts->{extuserid}) {
9228         $sql .= $opts->{extuser} ? ' OR ' : ' AND ';
9229         $sql .= "extuserid=?";
9230         push @bind, $opts->{extuserid}+0;
9231     }
9232
9233     return $dbh->selectrow_array($sql, undef, @bind);
9234 }
9235
9236 # given a LJ userid/u, return a hashref of:
9237 # type, extuser, extuserid
9238 # returns undef if user isn't an externally mapped account.
9239 sub get_extuser_map
9240 {
9241     my $uid = LJ::want_userid(shift);
9242     return undef unless $uid;
9243
9244     my $dbr = LJ::get_db_reader();
9245     return undef unless $dbr;
9246
9247     my $sql = "SELECT * FROM extuser WHERE userid=?";
9248     my $ret = $dbr->selectrow_hashref($sql, undef, $uid);
9249     return undef unless $ret;
9250
9251     my $type = 'unknown';
9252     foreach ( keys %LJ::EXTERNAL_NAMESPACE ) {
9253         $type = $_ if $LJ::EXTERNAL_NAMESPACE{$_}->{id} == $ret->{siteid};
9254     }
9255
9256     $ret->{type} = $type;
9257     return $ret;
9258 }
9259
9260 # <LJFUNC>
9261 # name: LJ::create_account
9262 # des: Creates a new basic account.  <strong>Note:</strong> This function is
9263 #      not really too useful but should be extended to be useful so
9264 #      htdocs/create.bml can use it, rather than doing the work itself.
9265 # returns: integer of userid created, or 0 on failure.
9266 # args: opts
9267 # des-opts: hashref containing keys 'user', 'name', 'password', 'email', 'caps', 'journaltype'.
9268 # </LJFUNC>
9269 sub create_account {
9270     my $opts = shift;
9271     my $u = LJ::User->create(%$opts)
9272         or return 0;
9273
9274     return $u->id;
9275 }
9276
9277 # <LJFUNC>
9278 # name: LJ::new_account_cluster
9279 # des: Which cluster to put a new account on.  $DEFAULT_CLUSTER if it's
9280 #      a scalar, random element from [ljconfig[default_cluster]] if it's arrayref.
9281 #      also verifies that the database seems to be available.
9282 # returns: clusterid where the new account should be created; 0 on error
9283 #          (such as no clusters available).
9284 # </LJFUNC>
9285 sub new_account_cluster
9286 {
9287     # if it's not an arrayref, put it in an array ref so we can use it below
9288     my $clusters = ref $LJ::DEFAULT_CLUSTER ? $LJ::DEFAULT_CLUSTER : [ $LJ::DEFAULT_CLUSTER+0 ];
9289
9290     # select a random cluster from the set we've chosen in $LJ::DEFAULT_CLUSTER
9291     return LJ::random_cluster(@$clusters);
9292 }
9293
9294 # returns the clusterid of a random cluster which is up
9295 # -- accepts @clusters as an arg to enforce a subset, otherwise
9296 #    uses @LJ::CLUSTERS
9297 sub random_cluster {
9298     my @clusters = @_ ? @_ : @LJ::CLUSTERS;
9299
9300     # iterate through the new clusters from a random point
9301     my $size = @clusters;
9302     my $start = int(rand() * $size);
9303     foreach (1..$size) {
9304         my $cid = $clusters[$start++ % $size];
9305
9306         # verify that this cluster is in @LJ::CLUSTERS
9307         my @check = grep { $_ == $cid } @LJ::CLUSTERS;
9308         next unless scalar(@check) >= 1 && $check[0] == $cid;
9309
9310         # try this cluster to see if we can use it, return if so
9311         my $dbcm = LJ::get_cluster_master($cid);
9312         return $cid if $dbcm;
9313     }
9314
9315     # if we get here, we found no clusters that were up...
9316     return 0;
9317 }
9318
9319
9320 # name: LJ::make_journal
9321 # args: user, view, remote, opts
9322 # </LJFUNC>
9323 sub make_journal {
9324     my ($user, $view, $remote, $opts) = @_;
9325
9326     my $geta = $opts->{'getargs'};
9327
9328     if ($LJ::SERVER_DOWN) {
9329         if ($opts->{'vhost'} eq "customview") {
9330             return "<!-- LJ down for maintenance -->";
9331         }
9332         return LJ::server_down_html();
9333     }
9334
9335     my $u = $opts->{'u'} || LJ::load_user($user);
9336     unless ($u) {
9337         $opts->{'baduser'} = 1;
9338         return "<h1>Error</h1>No such user <b>$user</b>";
9339     }
9340     LJ::set_active_journal($u);
9341     LJ::Request->notes('ljentry' => $opts->{'ljentry'}->url) if $opts->{'ljentry'};
9342
9343     # S1 style hashref.  won't be loaded now necessarily,
9344     # only if via customview.
9345     my $style;
9346
9347     my ($styleid);
9348     if ($opts->{'styleid'}) {  # s1 styleid
9349         $styleid = $opts->{'styleid'}+0;
9350
9351         # if we have an explicit styleid, we have to load
9352         # it early so we can learn its type, so we can
9353         # know which uprops to load for its owner
9354         if ($LJ::ONLY_USER_VHOSTS && $opts->{vhost} eq "customview") {
9355             # reject this style if it's not trusted by the user, and we're showing
9356             # stuff on user domains
9357             my $ownerid = LJ::S1::get_style_userid_always($styleid);
9358             my $is_trusted = sub {
9359                 return 1 if $ownerid == $u->{userid};
9360                 return 1 if $ownerid == LJ::system_userid();
9361                 return 1 if $LJ::S1_CUSTOMVIEW_WHITELIST{"styleid-$styleid"};
9362                 return 1 if $LJ::S1_CUSTOMVIEW_WHITELIST{"userid-$ownerid"};
9363                 my $trust_list = eval { $u->prop("trusted_s1") };
9364                 return 1 if $trust_list =~ /\b$styleid\b/;
9365                 return 0;
9366             };
9367             unless ($is_trusted->()) {
9368                 $style = undef;
9369                 $styleid = 0;
9370             }
9371         }
9372     } else {
9373
9374         $view ||= "lastn";    # default view when none specified explicitly in URLs
9375         if ($LJ::viewinfo{$view} || $view eq "month" ||
9376             $view eq "entry" || $view eq "reply")  {
9377             $styleid = -1;    # to get past the return, then checked later for -1 and fixed, once user is loaded.
9378         } else {
9379             $opts->{'badargs'} = 1;
9380         }
9381     }
9382     return unless $styleid;
9383
9384
9385     $u->{'_journalbase'} = LJ::journal_base($u->{'user'}, $opts->{'vhost'});
9386
9387     my $eff_view = $LJ::viewinfo{$view}->{'styleof'} || $view;
9388     my $s1prop = "s1_${eff_view}_style";
9389
9390     my @needed_props = ("stylesys", "s2_style", "url", "urlname", "opt_nctalklinks",
9391                         "renamedto",  "opt_blockrobots", "opt_usesharedpic", "icbm",
9392                         "journaltitle", "journalsubtitle", "external_foaf_url",
9393                         "adult_content", "admin_content_flag", "community_reader_ids");
9394
9395     # S2 is more fully featured than S1, so sometimes we get here and $eff_view
9396     # is reply/month/entry/res and that means it *has* to be S2--S1 defaults to a
9397     # BML page to handle those, but we don't want to attempt to load a userprop
9398     # because now load_user_props dies if you try to load something invalid
9399     push @needed_props, $s1prop if $eff_view =~ /^(?:calendar|day|friends|lastn)$/;
9400
9401     # preload props the view creation code will need later (combine two selects)
9402     if (ref $LJ::viewinfo{$eff_view}->{'owner_props'} eq "ARRAY") {
9403         push @needed_props, @{$LJ::viewinfo{$eff_view}->{'owner_props'}};
9404     }
9405
9406     if ($eff_view eq "reply") {
9407         push @needed_props, "opt_logcommentips";
9408     }
9409
9410     $u->preload_props(@needed_props);
9411
9412     # FIXME: remove this after all affected accounts have been fixed
9413     # see http://zilla.livejournal.org/1443 for details
9414     if ($u->{$s1prop} =~ /^\D/) {
9415         $u->{$s1prop} = $LJ::USERPROP_DEF{$s1prop};
9416         $u->set_prop($s1prop, $u->{$s1prop});
9417     }
9418
9419     # if the remote is the user to be viewed, make sure the $remote
9420     # hashref has the value of $u's opt_nctalklinks (though with
9421     # LJ::load_user caching, this may be assigning between the same
9422     # underlying hashref)
9423     $remote->{'opt_nctalklinks'} = $u->{'opt_nctalklinks'} if
9424         ($remote && $remote->{'userid'} == $u->{'userid'});
9425
9426     my $stylesys = 1;
9427     if ($styleid == -1) {
9428
9429         my $get_styleinfo = sub {
9430
9431             my $get_s1_styleid = sub {
9432                 my $id = $u->{$s1prop};
9433                 LJ::run_hooks("s1_style_select", {
9434                     'styleid' => \$id,
9435                     'u' => $u,
9436                     'view' => $view,
9437                 });
9438                 return $id;
9439             };
9440
9441             # forced s2 style id
9442             if ($geta->{'s2id'}) {
9443
9444                 # get the owner of the requested style
9445                 my $style = LJ::S2::load_style( $geta->{s2id} );
9446                 my $owner = $style && $style->{userid} ? $style->{userid} : 0;
9447
9448                 # remote can use s2id on this journal if:
9449                 # owner of the style is remote or managed by remote OR
9450                 # owner of the style has s2styles cap and remote is viewing owner's journal
9451
9452                 if ($u->id == $owner && $u->get_cap("s2styles")) {
9453                     $opts->{'style_u'} = LJ::load_userid($owner);
9454                     return (2, $geta->{'s2id'});
9455                 }
9456
9457                 if ($remote && $remote->can_manage($owner)) {
9458                     # check is owned style still available: paid user possible became plus...
9459                     my $lay_id = $style->{layer}->{layout};
9460                     my $theme_id = $style->{layer}->{theme};
9461                     my %lay_info;
9462                     LJ::S2::load_layer_info(\%lay_info, [$style->{layer}->{layout}, $style->{layer}->{theme}]);
9463
9464                     if (LJ::S2::can_use_layer($remote, $lay_info{$lay_id}->{redist_uniq})
9465                         and LJ::S2::can_use_layer($remote, $lay_info{$theme_id}->{redist_uniq})) {
9466                         $opts->{'style_u'} = LJ::load_userid($owner);
9467                         return (2, $geta->{'s2id'});
9468                     } # else this style not allowed by policy
9469                 }
9470             }
9471
9472             # style=mine passed in GET?
9473             if ($remote && ( $geta->{'style'} eq 'mine' ||
9474                              $remote->opt_stylealwaysmine ) ) {
9475
9476                 # get remote props and decide what style remote uses
9477                 $remote->preload_props("stylesys", "s2_style");
9478
9479                 # remote using s2; make sure we pass down the $remote object as the style_u to
9480                 # indicate that they should use $remote to load the style instead of the regular $u
9481                 if ($remote->{'stylesys'} == 2 && $remote->{'s2_style'}) {
9482                     $opts->{'checkremote'} = 1;
9483                     $opts->{'style_u'} = $remote;
9484                     return (2, $remote->{'s2_style'});
9485                 }
9486
9487                 # remote using s1
9488                 return (1, $get_s1_styleid->());
9489             }
9490
9491             # resource URLs have the styleid in it
9492             if ($view eq "res" && $opts->{'pathextra'} =~ m!^/(\d+)/!) {
9493                 return (2, $1);
9494             }
9495
9496             my $forceflag = 0;
9497             LJ::run_hooks("force_s1", $u, \$forceflag);
9498
9499             # if none of the above match, they fall through to here
9500             if ( !$forceflag && $u->{'stylesys'} == 2 ) {
9501                 return (2, $u->{'s2_style'});
9502             }
9503
9504             # no special case and not s2, fall through to s1
9505             return (1, $get_s1_styleid->());
9506         };
9507
9508         if ($LJ::JOURNALS_WITH_FIXED_STYLE{$u->user}) {
9509             ($stylesys, $styleid) = (2, $u->{'s2_style'});
9510         } else {
9511             ($stylesys, $styleid) = $get_styleinfo->();
9512         }
9513     }
9514
9515     # transcode the tag filtering information into the tag getarg; this has to
9516     # be done above the s1shortcomings section so that we can fall through to that
9517     # style for lastn filtered by tags view
9518     if ($view eq 'lastn' && $opts->{pathextra} && $opts->{pathextra} =~ /^\/tag\/(.+)$/) {
9519         $opts->{getargs}->{tag} = $1;
9520         $opts->{pathextra} = undef;
9521     }
9522
9523     # do the same for security filtering
9524     elsif ($view eq 'lastn' && $opts->{pathextra} && $opts->{pathextra} =~ /^\/security\/(.+)$/) {
9525         $opts->{getargs}->{security} = $1;
9526         $opts->{pathextra} = undef;
9527     }
9528
9529     if (LJ::Request->is_inited) {
9530         LJ::Request->notes('journalid' => $u->{'userid'});
9531     }
9532
9533     my $notice = sub {
9534         my $msg = shift;
9535         my $status = shift;
9536
9537         my $url = "$LJ::SITEROOT/users/$user/";
9538         $opts->{'status'} = $status if $status;
9539
9540         my $head;
9541         my $journalbase = LJ::journal_base($user);
9542
9543         # Automatic Discovery of RSS/Atom
9544         $head .= qq{<link rel="alternate" type="application/rss+xml" title="RSS" href="$journalbase/data/rss" />\n};
9545         $head .= qq{<link rel="alternate" type="application/atom+xml" title="Atom" href="$journalbase/data/atom" />\n};
9546         $head .= qq{<link rel="service.feed" type="application/atom+xml" title="AtomAPI-enabled feed" href="$LJ::SITEROOT/interface/atom/feed" />\n};
9547         $head .= qq{<link rel="service.post" type="application/atom+xml" title="Create a new post" href="$LJ::SITEROOT/interface/atom/post" />\n};
9548
9549         # OpenID Server and Yadis
9550         $head .= $u->openid_tags;
9551
9552         # FOAF autodiscovery
9553         my $foafurl = $u->{external_foaf_url} ? LJ::eurl($u->{external_foaf_url}) : "$journalbase/data/foaf";
9554         $head .= qq{<link rel="meta" type="application/rdf+xml" title="FOAF" href="$foafurl" />\n};
9555
9556         if ($u->email_visible($remote)) {
9557             my $digest = Digest::SHA1::sha1_hex('mailto:' . $u->email_raw);
9558             $head .= qq{<meta name="foaf:maker" content="foaf:mbox_sha1sum '$digest'" />\n};
9559         }
9560
9561         return qq{
9562             <html>
9563             <head>
9564             $head
9565             </head>
9566             <body>
9567              <h1>Notice</h1>
9568              <p>$msg</p>
9569              <p>Instead, please use <nobr><a href=\"$url\">$url</a></nobr></p>
9570             </body>
9571             </html>
9572         }.("<!-- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -->\n" x 50);
9573     };
9574     my $error = sub {
9575         my $msg = shift;
9576         my $status = shift;
9577         $opts->{'status'} = $status if $status;
9578
9579         return qq{
9580             <h1>Error</h1>
9581             <p>$msg</p>
9582         }.("<!-- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -->\n" x 50);
9583     };
9584     if ($LJ::USER_VHOSTS && $opts->{'vhost'} eq "users" && $u->{'journaltype'} ne 'R' &&
9585         ! LJ::get_cap($u, "userdomain")) {
9586         return $notice->("URLs like <nobr><b>http://<i>username</i>.$LJ::USER_DOMAIN/" .
9587                          "</b></nobr> are not available for this user's account type.");
9588     }
9589     if ($opts->{'vhost'} eq "customview" && ! LJ::get_cap($u, "styles")) {
9590         return $notice->("This user's account type is not permitted to create and embed styles.");
9591     }
9592     if ($opts->{'vhost'} eq "community" && $u->{'journaltype'} !~ /[CR]/) {
9593         $opts->{'badargs'} = 1; # Output a generic 'bad URL' message if available
9594         return "<h1>Notice</h1><p>This account isn't a community journal.</p>";
9595     }
9596     if ($view eq "friendsfriends" && ! LJ::get_cap($u, "friendsfriendsview")) {
9597         my $inline;
9598         if ($inline .= LJ::run_hook("cprod_inline", $u, 'FriendsFriendsInline')) {
9599             return $inline;
9600         } else {
9601             return BML::ml('cprod.friendsfriendsinline.text.v1');
9602         }
9603     }
9604
9605     # signal to LiveJournal.pm that we can't handle this
9606     if (($stylesys == 1 || $geta->{'format'} eq 'light') &&
9607         ({ entry=>1, reply=>1, month=>1, tag=>1 }->{$view} || ($view eq 'lastn' && ($geta->{tag} || $geta->{security})))) {
9608
9609         # pick which fallback method (s2 or bml) we'll use by default, as configured with
9610         # $S1_SHORTCOMINGS
9611         my $fallback = $LJ::S1_SHORTCOMINGS ? "s2" : "bml";
9612
9613         # but if the user specifies which they want, override the fallback we picked
9614         if ($geta->{'fallback'} && $geta->{'fallback'} =~ /^s2|bml$/) {
9615             $fallback = $geta->{'fallback'};
9616         }
9617
9618         # if we are in this path, and they have style=mine set, it means
9619         # they either think they can get a S2 styled page but their account
9620         # type won't let them, or they really want this to fallback to bml
9621         if ($remote && ( $geta->{'style'} eq 'mine' ||
9622                          $remote->opt_stylealwaysmine ) ) {
9623             $fallback = 'bml';
9624         }
9625
9626         # If they specified ?format=light, it means they want a page easy
9627         # to deal with text-only or on a mobile device.  For now that means
9628         # render it in the lynx site scheme.
9629         if ($geta->{'format'} eq 'light') {
9630             $fallback = 'bml';
9631             LJ::Request->notes('bml_use_scheme' => 'lynx');
9632         }
9633
9634         # there are no BML handlers for these views, so force s2
9635         if ($view eq 'tag' || $view eq 'lastn') {
9636             $fallback = "s2";
9637         }
9638
9639         # fall back to BML unless we're using S2
9640         # fallback (the "s1shortcomings/layout")
9641         if ($fallback eq "bml") {
9642             ${$opts->{'handle_with_bml_ref'}} = 1;
9643             return;
9644         }
9645
9646         # S1 can't handle these views, so we fall back to a
9647         # system-owned S2 style (magic value "s1short") that renders
9648         # this content
9649         $stylesys = 2;
9650         $styleid = "s1short";
9651     }
9652
9653     # now, if there's a GET argument for tags, split those out
9654     if (exists $opts->{getargs}->{tag}) {
9655         my $tagfilter = $opts->{getargs}->{tag};
9656         return $error->("You must provide tags to filter by.", "404 Not Found")
9657             unless defined $tagfilter;
9658
9659         # error if disabled
9660         return $error->("Sorry, the tag system is currently disabled.", "404 Not Found")
9661             if $LJ::DISABLED{tags};
9662
9663         # throw an error if we're rendering in S1, but not for renamed accounts
9664         return $error->("Sorry, tag filtering is not supported within S1 styles.", "404 Not Found")
9665             if $stylesys == 1 && $view ne 'data' && $u->{journaltype} ne 'R';
9666
9667         # overwrite any tags that exist
9668         $opts->{tags} = [];
9669         return $error->("Sorry, the tag list specified is invalid.", "404 Not Found")
9670             unless LJ::Tags::is_valid_tagstring($tagfilter, $opts->{tags}, { omit_underscore_check => 1 });
9671
9672         # get user's tags so we know what remote can see, and setup an inverse mapping
9673         # from keyword to tag
9674         $opts->{tagids} = [];
9675         $opts->{'tagmap'} = {};
9676         my $tags = LJ::Tags::get_usertags($u, { remote => $remote });
9677
9678         my %kwref = ();
9679         foreach my $tagid (keys %$tags) {
9680             push @{$kwref{LJ::Text->normalize_tag_name ($tags->{$tagid}->{'name'})}}, $tagid;
9681         }
9682
9683         foreach my $tagname (@{$opts->{tags}}) {
9684             unless ($kwref{LJ::Text->normalize_tag_name ($tagname)}) {
9685                 LJ::Request->pnotes ('error' => 'e404');
9686                 LJ::Request->pnotes ('remote' => LJ::get_remote ());
9687                 $opts->{'handler_return'} = "404 Not Found";
9688                 return;
9689             }
9690             #return $error->("Sorry, one or more specified tags do not exist.", "404 Not Found")
9691             #    unless $kwref{$tagname};
9692             push @{$opts->{'tagids'}}, @{$kwref{LJ::Text->normalize_tag_name ($tagname)}};
9693             $opts->{'tagmap'}->{$tagname} = $kwref{LJ::Text->normalize_tag_name ($tagname)};
9694         }
9695
9696         $opts->{tagmode} = $opts->{getargs}->{mode} eq 'and' ? 'and' : 'or';
9697     }
9698
9699     # validate the security filter
9700     if (exists $opts->{getargs}->{security}) {
9701         my $securityfilter = $opts->{getargs}->{security};
9702         return $error->("You must provide a security level to filter by.", "404 Not Found")
9703             unless $securityfilter;
9704
9705         return $error->("This feature is not available for your account level.", "403 Forbidden")
9706             unless LJ::get_cap($remote, "security_filter") || LJ::get_cap($u, "security_filter");
9707
9708         # error if disabled
9709         return $error->("Sorry, the security-filtering system is currently disabled.", "404 Not Found")
9710             unless LJ::is_enabled("security_filter");
9711
9712         # throw an error if we're rendering in S1, but not for renamed accounts
9713         return $error->("Sorry, security filtering is not supported within S1 styles.", "404 Not Found")
9714             if $stylesys == 1 && $view ne 'data' && !$u->is_redirect;
9715
9716         # check the filter itself
9717         if ($securityfilter =~ /^(?:public|friends|private)$/i) {
9718             $opts->{'securityfilter'} = lc($securityfilter);
9719
9720         } elsif ($securityfilter =~ /^group:(.+)$/i) {
9721             my $groupres = LJ::get_friend_group($u, { 'name' => $1});
9722
9723             if ($groupres && (LJ::u_equals($u, $remote)
9724                               || LJ::get_groupmask($u, $remote) & (1 << $groupres->{groupnum}))) {
9725                 $opts->{securityfilter} = $groupres->{groupnum};
9726             }
9727         }
9728
9729         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")
9730             unless defined $opts->{securityfilter};
9731
9732     }
9733
9734     unless ($geta->{'viewall'} && LJ::check_priv($remote, "canview", "suspended") ||
9735             $opts->{'pathextra'} =~ m#/(\d+)/stylesheet$#) { ## don't check style sheets
9736         if ($u->is_deleted){
9737             my $warning = LJ::Lang::get_text(LJ::Lang::get_effective_lang(),
9738                                     'journal.deleted', undef, {username => $u->username})
9739                        || LJ::Lang::get_text($LJ::DEFAULT_LANG,
9740                                     'journal.deleted', undef, {username => $u->username});
9741             LJ::Request->pnotes ('error' => 'deleted');
9742             LJ::Request->pnotes ('remote' => LJ::get_remote ());
9743             $opts->{'handler_return'} = "404 Not Found";
9744             return;
9745             #return $error->($warning, "404 Not Found");
9746
9747         }
9748         if ($u->is_suspended) {
9749             LJ::Request->pnotes ('error' => 'suspended');
9750             LJ::Request->pnotes ('remote' => LJ::get_remote ());
9751             $opts->{'handler_return'} = "403 Forbidden";
9752             return;
9753         }
9754         #return $error->("This journal has been suspended.", "403 Forbidden") if ($u->is_suspended);
9755
9756         my $entry = $opts->{ljentry};
9757
9758         if ($entry && $entry->is_suspended_for($remote)) {
9759             LJ::Request->pnotes ('error' => 'suspended_post');
9760             LJ::Request->pnotes ('remote' => LJ::get_remote ());
9761             $opts->{'handler_return'} = "403 Forbidden";
9762             return;
9763         }
9764
9765         return $error->("This entry has been suspended. You can visit the journal <a href='" . $u->journal_base . "/'>here</a>.", "403 Forbidden")
9766             if $entry && $entry->is_suspended_for($remote);
9767     }
9768     if ($u->is_expunged) {
9769         LJ::Request->pnotes ('error' => 'expunged');
9770         LJ::Request->pnotes ('remote' => LJ::get_remote ());
9771         $opts->{'handler_return'} = "410 Gone";
9772         return;
9773     }
9774
9775     return $error->("This user has no journal here.", "404 Not here") if $u->{'journaltype'} eq "I" && $view ne "friends";
9776
9777     $opts->{'view'} = $view;
9778
9779     # what charset we put in the HTML
9780     $opts->{'saycharset'} ||= "utf-8";
9781
9782     if ($view eq 'data') {
9783         return LJ::Feed::make_feed($u, $remote, $opts);
9784     }
9785
9786     if ($stylesys == 2) {
9787         LJ::Request->notes('codepath' => "s2.$view") if LJ::Request->is_inited;
9788
9789         eval { LJ::S2->can("dostuff") };  # force Class::Autouse
9790         my $mj = LJ::S2::make_journal($u, $styleid, $view, $remote, $opts);
9791
9792         # intercept flag to handle_with_bml_ref and instead use S1 shortcomings
9793         # if BML is disabled
9794         if ($opts->{'handle_with_bml_ref'} && ${$opts->{'handle_with_bml_ref'}} &&
9795             ($LJ::S1_SHORTCOMINGS || $geta->{fallback} eq "s2"))
9796         {
9797             # kill the flag
9798             ${$opts->{'handle_with_bml_ref'}} = 0;
9799
9800             # and proceed with s1shortcomings (which looks like BML) instead of BML
9801             $mj = LJ::S2::make_journal($u, "s1short", $view, $remote, $opts);
9802         }
9803
9804         return $mj;
9805     }
9806
9807     # Everything from here on down is S1.  FIXME: this should be moved to LJ::S1::make_journal
9808     # to be more like LJ::S2::make_journal.
9809     LJ::Request->notes('codepath' => "s1.$view") if LJ::Request->is_inited;
9810     $u->{'_s1styleid'} = $styleid + 0;
9811
9812     # For embedded polls
9813     BML::set_language($LJ::LANGS[0] || 'en', \&LJ::Lang::get_text);
9814
9815     # load the user-related S1 data  (overrides and colors)
9816     my $s1uc;
9817     my $is_s1uc_valid = sub {
9818         ## Storable::thaw takes valid date, undef or empty string;
9819         ## dies on invalid data
9820         return
9821             eval {
9822                 Storable::thaw($_[0]->{'color_stor'});
9823                 Storable::thaw($_[0]->{'override_stor'});
9824                 1;
9825             };
9826     };
9827     my $s1uc_memkey = [$u->{'userid'}, "s1uc:$u->{'userid'}"];
9828     if ($u->{'useoverrides'} eq "Y" || $u->{'themeid'} == 0) {
9829         $s1uc = LJ::MemCache::get($s1uc_memkey);
9830         undef($s1uc) if $s1uc && !$is_s1uc_valid->($s1uc);
9831
9832         unless ($s1uc) {
9833             my $db;
9834             my $setmem = 1;
9835             if (@LJ::MEMCACHE_SERVERS) {
9836                 $db = LJ::get_cluster_def_reader($u);
9837             } else {
9838                 $db = LJ::get_cluster_reader($u);
9839                 $setmem = 0;
9840             }
9841             $s1uc = $db->selectrow_hashref("SELECT * FROM s1usercache WHERE userid=?",
9842                                            undef, $u->{'userid'});
9843             undef($s1uc) if $s1uc && !$is_s1uc_valid->($s1uc);
9844             LJ::MemCache::set($s1uc_memkey, $s1uc) if $s1uc && $setmem;
9845         }
9846     }
9847
9848     # we should have our cache row!  we'll update it in a second.
9849     my $dbcm;
9850     if (! $s1uc) {
9851         $u->do("INSERT IGNORE INTO s1usercache (userid) VALUES (?)", undef, $u->{'userid'});
9852         $s1uc = {};
9853     }
9854
9855     # conditionally rebuild parts of our cache that are missing
9856     my %update;
9857
9858     # is the overrides cache old or missing?
9859     my $dbh;
9860     if ($u->{'useoverrides'} eq "Y" && (! $s1uc->{'override_stor'} ||
9861                                         $s1uc->{'override_cleanver'} < $LJ::S1::CLEANER_VERSION)) {
9862
9863         my $overrides = LJ::S1::get_overrides($u);
9864         $update{'override_stor'} = LJ::CleanHTML::clean_s1_style($overrides);
9865         $update{'override_cleanver'} = $LJ::S1::CLEANER_VERSION;
9866     }
9867
9868     # is the color cache here if it's a custom user theme?
9869     if ($u->{'themeid'} == 0 && ! $s1uc->{'color_stor'}) {
9870         my $col = {};
9871         $dbh ||= LJ::get_db_writer();
9872         my $sth = $dbh->prepare("SELECT coltype, color FROM themecustom WHERE user=?");
9873         $sth->execute($u->{'user'});
9874         $col->{$_->{'coltype'}} = $_->{'color'} while $_ = $sth->fetchrow_hashref;
9875         $update{'color_stor'} = Storable::nfreeze($col);
9876     }
9877
9878     # save the updates
9879     if (%update) {
9880         my $set;
9881         foreach my $k (keys %update) {
9882             $s1uc->{$k} = $update{$k};
9883             $set .= ", " if $set;
9884             $set .= "$k=" . $u->quote($update{$k});
9885         }
9886         my $rv = $u->do("UPDATE s1usercache SET $set WHERE userid=?", undef, $u->{'userid'});
9887         LJ::MemCache::set($s1uc_memkey, $s1uc);
9888     }
9889
9890     # load the style
9891     my $viewref = $view eq "" ? \$view : undef;
9892     $style ||= $LJ::viewinfo{$view}->{'nostyle'} ? {} :
9893         LJ::S1::load_style($styleid, $viewref);
9894
9895     my %vars = ();
9896
9897     # apply the style
9898     foreach (keys %$style) {
9899         $vars{$_} = $style->{$_};
9900     }
9901
9902     # apply the overrides
9903     if ($opts->{'nooverride'}==0 && $u->{'useoverrides'} eq "Y") {
9904         my $tw = Storable::thaw($s1uc->{'override_stor'});
9905         foreach (keys %$tw) {
9906             $vars{$_} = $tw->{$_};
9907         }
9908     }
9909
9910     # apply the color theme
9911     $@ = '';
9912     my $cols = $u->{'themeid'}
9913                 ? LJ::S1::get_themeid($u->{'themeid'})
9914                 : Storable::thaw($s1uc->{'color_stor'});
9915     foreach (keys %$cols) {
9916         $vars{"color-$_"} = $cols->{$_};
9917     }
9918
9919     # instruct some function to make this specific view type
9920     return unless defined $LJ::viewinfo{$view}->{'creator'};
9921     my $ret = "";
9922
9923     # call the view creator w/ the buffer to fill and the construction variables
9924     my $res = $LJ::viewinfo{$view}->{'creator'}->(\$ret, $u, \%vars, $remote, $opts);
9925
9926     if ($LJ::USE_S1w2 && $LJ::USE_S1w2->($view, $u, $remote)) {
9927         # S1w2 is an experimental version of S1 that acts as if it were an S2 style,
9928         # getting all of its necessary data from the S2 data structures rather than
9929         # fetching the data itself and duplicating all of that logic.
9930         # It should ideally generate exactly the same output as traditional S1 with
9931         # the same input data, but until this has been tested thoroughly it's
9932         # disabled by default.
9933
9934         # We render S1w2 in addition to traditional S1 so that we can see if there
9935         # is any difference.
9936         my $s1result = $ret;
9937         $ret = "";
9938
9939         require "ljviews-s1-using-s2.pl"; # Load on demand
9940         $LJ::S1w2::viewcreator{$view}->(\$ret, $u, \%vars, $remote, $opts);
9941
9942         if ($s1result ne $ret) {
9943             warn "S1w2 differed from S1 when rendering a $view page for $u->{user} with ".($remote ? $remote->{user} : "an anonymous user")." watching";
9944
9945             # Optionally produce a diff between S1 and S1w2
9946             # NOTE: This _make_diff function hits the filesystem and forks a diff process.
9947             #   It's only useful/sensible on a low-load development server.
9948             if ($LJ::SHOW_S1w2_DIFFS) {
9949                 $ret .= "<plaintext>".LJ::S1w2::_make_diff($s1result, $ret);
9950             }
9951         }
9952
9953     }
9954
9955     unless ($res) {
9956         my $errcode = $opts->{'errcode'};
9957         my $errmsg = {
9958             'nodb' => 'Database temporarily unavailable during maintenance.',
9959             'nosyn' => 'No syndication URL available.',
9960         }->{$errcode};
9961         return "<!-- $errmsg -->" if ($opts->{'vhost'} eq "customview");
9962
9963         # If not customview, set the error response code.
9964         $opts->{'status'} = {
9965             'nodb' => '503 Maintenance',
9966             'nosyn' => '404 Not Found',
9967         }->{$errcode} || '500 Server Error';
9968         return $errmsg;
9969     }
9970
9971     if ($opts->{'redir'}) {
9972         return undef;
9973     }
9974
9975     # clean up attributes which we weren't able to quickly verify
9976     # as safe in the Storable-stored clean copy of the style.
9977     $ret =~ s/\%\%\[attr\[(.+?)\]\]\%\%/LJ::CleanHTML::s1_attribute_clean($1)/eg;
9978
9979     # return it...
9980     return $ret;
9981 }
9982
9983 # <LJFUNC>
9984 # name: LJ::canonical_username
9985 # des: normalizes username.
9986 # info:
9987 # args: user
9988 # returns: the canonical username given, or blank if the username is not well-formed
9989 # </LJFUNC>
9990 sub canonical_username
9991 {
9992     my $user = shift;
9993     if ($user =~ /^\s*([A-Za-z0-9_\-]{1,15})\s*$/) {
9994         # perl 5.8 bug:  $user = lc($1) sometimes causes corruption when $1 points into $user.
9995         $user = $1;
9996         $user = lc($user);
9997         $user =~ s/-/_/g;
9998         return $user;
9999     }
10000     return "";  # not a good username.
10001 }
10002
10003 # <LJFUNC>
10004 # name: LJ::get_userid
10005 # des: Returns a userid given a username.
10006 # info: Results cached in memory.  On miss, does DB call.  Not advised
10007 #       to use this many times in a row... only once or twice perhaps
10008 #       per request.  Tons of serialized db requests, even when small,
10009 #       are slow.  Opposite of [func[LJ::get_username]].
10010 # args: user
10011 # des-user: Username whose userid to look up.
10012 # returns: Userid, or 0 if invalid user.
10013 # </LJFUNC>
10014 sub get_userid {
10015     my $user = shift;
10016
10017     $user = LJ::canonical_username($user);
10018
10019     if (exists $LJ::PRELOADED_USER_IDS{$user} && !$LJ::IS_DEV_SERVER) { return $LJ::PRELOADED_USER_IDS{$user}; }
10020     if ($LJ::CACHE_USERID{$user}) { return $LJ::CACHE_USERID{$user}; }
10021
10022     my $userid = LJ::MemCacheProxy::get("uidof:$user");
10023     return $LJ::CACHE_USERID{$user} = $userid if $userid;
10024
10025     my $dbr = LJ::get_db_reader();
10026     $userid = $dbr->selectrow_array("SELECT userid FROM useridmap WHERE user=?", undef, $user);
10027
10028     # implicitly create an account if we're using an external
10029     # auth mechanism
10030     if (! $userid && ref $LJ::AUTH_EXISTS eq "CODE")
10031     {
10032         $userid = LJ::create_account({ 'user' => $user,
10033                                        'name' => $user,
10034                                        'password' => '', });
10035     }
10036
10037     if ($userid) {
10038         $LJ::CACHE_USERID{$user} = $userid;
10039         LJ::MemCacheProxy::set("uidof:$user", $userid);
10040     }
10041
10042     return ($userid+0);
10043 }
10044
10045 # TODO: Rewrite that function in more optimal way!
10046 sub get_userid_multi {
10047     my($users) = @_;
10048     my @res;
10049
10050     for my $user ( @$users ) {
10051         my $userid = LJ::get_userid( $user );
10052         push @res, $userid if $userid;
10053     }
10054
10055     return @res;
10056 }
10057
10058 # <LJFUNC>
10059 # name: LJ::want_user
10060 # des: Returns user object when passed either userid or user object. Useful to functions that
10061 #      want to accept either.
10062 # args: user
10063 # des-user: Either a userid or a user hash with the userid in its 'userid' key.
10064 # returns: The user object represented by said userid or username.
10065 # </LJFUNC>
10066 sub want_user
10067 {
10068     my $uuid = shift;
10069     return undef unless $uuid;
10070     return $uuid if ref $uuid;
10071     return LJ::load_userid($uuid) if $uuid =~ /^\d+$/;
10072     Carp::croak("Bogus caller of LJ::want_user with non-ref/non-numeric parameter: $uuid");
10073 }
10074
10075 # <LJFUNC>
10076 # name: LJ::get_username
10077 # des: Returns a username given a userid.
10078 # info: Results cached in memory.  On miss, does DB call.  Not advised
10079 #       to use this many times in a row... only once or twice perhaps
10080 #       per request.  Tons of serialized db requests, even when small,
10081 #       are slow.  Opposite of [func[LJ::get_userid]].
10082 # args: user
10083 # des-user: Username whose userid to look up.
10084 # returns: Userid, or 0 if invalid user.
10085 # </LJFUNC>
10086 sub get_username {
10087     my $userid = shift;
10088     $userid += 0;
10089
10090     # Checked the cache first.
10091     if ($LJ::CACHE_USERNAME{$userid}) { return $LJ::CACHE_USERNAME{$userid}; }
10092
10093     # if we're using memcache, it's faster to just query memcache for
10094     # an entire $u object and just return the username.  otherwise, we'll
10095     # go ahead and query useridmap
10096     if (@LJ::MEMCACHE_SERVERS) {
10097         my $u = LJ::load_userid($userid);
10098         return undef unless $u;
10099
10100         $LJ::CACHE_USERNAME{$userid} = $u->{'user'};
10101         return $u->{'user'};
10102     }
10103
10104     my $dbr = LJ::get_db_reader();
10105     my $user = $dbr->selectrow_array("SELECT user FROM useridmap WHERE userid=?", undef, $userid);
10106
10107     # Fall back to master if it doesn't exist.
10108     unless (defined $user) {
10109         my $dbh = LJ::get_db_writer();
10110         $user = $dbh->selectrow_array("SELECT user FROM useridmap WHERE userid=?", undef, $userid);
10111     }
10112
10113     return undef unless defined $user;
10114
10115     $LJ::CACHE_USERNAME{$userid} = $user;
10116     return $user;
10117 }
10118
10119 # <LJFUNC>
10120 # name: LJ::can_manage_other
10121 # des: Given a user and a target user, will determine if the first user is an
10122 #      admin for the target user, but not if the two are the same.
10123 # args: remote, u
10124 # des-remote: user object or userid of user to try and authenticate
10125 # des-u: user object or userid of target user
10126 # returns: bool: true if authorized, otherwise fail
10127 # </LJFUNC>
10128 sub can_manage_other {
10129     my ($remote, $u) = @_;
10130     return 0 if LJ::want_userid($remote) == LJ::want_userid($u);
10131     $remote = LJ::want_user($remote);
10132     return $remote && $remote->can_manage($u);
10133 }
10134
10135 sub can_delete_journal_item {
10136     my ($remote, $u, $itemid) = @_;
10137     $remote = LJ::want_user($remote);
10138
10139     return 0 unless $remote;
10140
10141     return 0 unless $remote->can_manage($u);
10142     # here admin or supermaintainer
10143
10144     return 0 if $LJ::JOURNALS_WITH_PROTECTED_CONTENT{ $u->{user} } and !LJ::is_friend($u, $remote);
10145
10146     return 1;
10147 }
10148
10149
10150 # <LJFUNC>
10151 # name: LJ::get_remote
10152 # des: authenticates the user at the remote end based on their cookies
10153 #      and returns a hashref representing them.
10154 # args: opts?
10155 # des-opts: 'criterr': scalar ref to set critical error flag.  if set, caller
10156 #           should stop processing whatever it's doing and complain
10157 #           about an invalid login with a link to the logout page.
10158 #           'ignore_ip': ignore IP address of remote for IP-bound sessions
10159 # returns: hashref containing 'user' and 'userid' if valid user, else
10160 #          undef.
10161 # </LJFUNC>
10162 sub get_remote {
10163     my $opts = ref $_[0] eq "HASH" ? shift : {};
10164
10165     return $LJ::CACHE_REMOTE if $LJ::CACHED_REMOTE && ! $opts->{'ignore_ip'};
10166
10167     my $no_remote = sub {
10168         LJ::User->set_remote(undef);
10169         return undef;
10170     };
10171
10172     # can't have a remote user outside of web context
10173     return $no_remote->() unless LJ::Request->is_inited;
10174
10175     my $get_as = LJ::Request->get_param('as');
10176     if ( $LJ::IS_DEV_SERVER && $get_as =~ /^\w{1,15}$/ ) {
10177         my $ru = LJ::load_user($get_as);
10178
10179         # might be undef, to allow for "view as logged out":
10180         LJ::set_remote($ru);
10181         return $ru;
10182     }
10183
10184     my $criterr = $opts->{criterr} || do { my $d; \$d; };
10185     $$criterr = 0;
10186
10187     $LJ::CACHE_REMOTE_BOUNCE_URL = "";
10188
10189     # set this flag if any of their ljsession cookies contained the ".FS"
10190     # opt to use the fast server.  if we later find they're not logged
10191     # in and set it, or set it with a free account, then we give them
10192     # the invalid cookies error.
10193     my $tried_fast = 0;
10194     my $sessobj = LJ::Session->session_from_cookies(
10195         tried_fast   => \$tried_fast,
10196         redirect_ref => \$LJ::CACHE_REMOTE_BOUNCE_URL,
10197         ignore_ip    => $opts->{ignore_ip},
10198     );
10199
10200     my $u = $sessobj ? $sessobj->owner : undef;
10201
10202     # inform the caller that this user is faking their fast-server cookie
10203     # attribute.
10204     if ($tried_fast && ! LJ::get_cap($u, "fastserver")) {
10205         $$criterr = 1;
10206     }
10207
10208     return $no_remote->() unless $sessobj;
10209
10210     # renew soon-to-expire sessions
10211     $sessobj->try_renew;
10212
10213     # augment hash with session data;
10214     $u->{'_session'} = $sessobj;
10215
10216     # keep track of activity for the user we just loaded from db/memcache
10217     # - if necessary, this code will actually run in Apache's cleanup handler
10218     #   so latency won't affect the user
10219     if (@LJ::MEMCACHE_SERVERS && ! $LJ::DISABLED{active_user_tracking}) {
10220         push @LJ::CLEANUP_HANDLERS, sub { $u->note_activity('A') };
10221     }
10222
10223     LJ::User->set_remote($u);
10224     LJ::Request->notes("ljuser" => $u->{'user'});
10225     return $u;
10226 }
10227
10228 # returns either $remote or the authenticated user that $remote is working with
10229 sub get_effective_remote {
10230     my $authas_arg = shift || "authas";
10231
10232     return undef unless LJ::is_web_context();
10233
10234     my $remote = LJ::get_remote();
10235     return undef unless $remote;
10236
10237     my $authas = $BMLCodeBlock::GET{authas} || $BMLCodeBlock::POST{authas} || $remote->user;
10238     return $remote if $authas eq $remote->user;
10239
10240     return LJ::get_authas_user($authas);
10241 }
10242
10243 # returns URL we have to bounce the remote user to in order to
10244 # get their domain cookie
10245 sub remote_bounce_url {
10246     return $LJ::CACHE_REMOTE_BOUNCE_URL;
10247 }
10248
10249 sub set_remote {
10250     my $remote = shift;
10251     LJ::User->set_remote($remote);
10252     1;
10253 }
10254
10255 sub unset_remote
10256 {
10257     LJ::User->unset_remote;
10258     1;
10259 }
10260
10261 sub get_active_journal
10262 {
10263     return $LJ::ACTIVE_JOURNAL;
10264 }
10265
10266 sub set_active_journal
10267 {
10268     $LJ::ACTIVE_JOURNAL = shift;
10269 }
10270
10271 # Checks if they are flagged as having a bad password and redirects
10272 # to changepassword.bml.  If returl is on it returns the URL to
10273 # redirect to vs doing the redirect itself.  Useful in non-BML context
10274 # and for QuickReply links
10275 sub bad_password_redirect {
10276     my $opts = shift;
10277
10278     my $remote = LJ::get_remote();
10279     return undef unless $remote;
10280
10281     return undef if $LJ::DISABLED{'force_pass_change'};
10282
10283     return undef unless $remote->prop('badpassword');
10284
10285     my $redir = "$LJ::SITEROOT/changepassword.bml";
10286     unless (defined $opts->{'returl'}) {
10287         return BML::redirect($redir);
10288     } else {
10289         return $redir;
10290     }
10291 }
10292
10293 # Returns HTML to display user search results
10294 # Args: %args
10295 # des-args:
10296 #           users    => hash ref of userid => u object like LJ::load userids
10297 #                       returns or array ref of user objects
10298 #           userids  => array ref of userids to include in results, ignored
10299 #                       if users is defined
10300 #           timesort => set to 1 to sort by last updated instead
10301 #                       of username
10302 #           perpage  => Enable pagination and how many users to display on
10303 #                       each page
10304 #           curpage  => What page of results to display
10305 #           navbar   => Scalar reference for paging bar
10306 #           pickwd   => userpic keyword to display instead of default if it
10307 #                       exists for the user
10308 #           self_link => Sub ref to generate link to use for pagination
10309 sub user_search_display {
10310     my %args = @_;
10311
10312     my $loaded_users;
10313     unless (defined $args{users}) {
10314         $loaded_users = LJ::load_userids(@{$args{userids}});
10315     } else {
10316         if (ref $args{users} eq 'HASH') { # Assume this is direct from LJ::load_userids
10317             $loaded_users = $args{users};
10318         } elsif (ref $args{users} eq 'ARRAY') { # They did a grep on it or something
10319             foreach (@{$args{users}}) {
10320                 $loaded_users->{$_->{userid}} = $_;
10321             }
10322         } else {
10323             return undef;
10324         }
10325     }
10326
10327     # If we're sorting by last updated, we need to load that
10328     # info for all users before the sort.  If sorting by
10329     # username we can load it for a subset of users later,
10330     # if paginating.
10331     my $updated;
10332     my @display;
10333
10334     if ($args{timesort}) {
10335         $updated = LJ::get_timeupdate_multi(keys %$loaded_users);
10336         @display = sort { $updated->{$b->{userid}} <=> $updated->{$a->{userid}} } values %$loaded_users;
10337     } else {
10338         @display = sort { $a->{user} cmp $b->{user} } values %$loaded_users;
10339     }
10340
10341     if (defined $args{perpage}) {
10342         my %items = BML::paging(\@display, $args{curpage}, $args{perpage});
10343
10344         # Fancy paging bar
10345         my $opts;
10346         $opts->{self_link} = $args{self_link} if $args{self_link};
10347         ${$args{navbar}} = LJ::paging_bar($items{'page'}, $items{'pages'}, $opts);
10348
10349         # Now pull out the set of users to display
10350         @display = @{$items{'items'}};
10351     }
10352
10353     # If we aren't sorting by time updated, load last updated time for the
10354     # set of users we are displaying.
10355     $updated = LJ::get_timeupdate_multi(map { $_->{userid} } @display)
10356         unless $args{timesort};
10357
10358     # Allow caller to specify a custom userpic to use instead
10359     # of the user's default all userpics
10360     my $get_picid = sub {
10361         my $u = shift;
10362         return $u->{'defaultpicid'} unless $args{'pickwd'};
10363         return LJ::get_picid_from_keyword($u, $args{'pickwd'});
10364     };
10365
10366     my $ret;
10367     foreach my $u (@display) {
10368         # We should always have loaded user objects, but it seems
10369         # when the site is overloaded we don't always load the users
10370         # we request.
10371         next unless LJ::isu($u);
10372
10373         $ret .= "<div style='width: 300px; height: 105px; overflow: hidden; float: left; ";
10374         $ret .= "border-bottom: 1px solid <?altcolor2?>; margin-bottom: 10px; padding-bottom: 5px; margin-right: 10px'>";
10375         $ret .= "<table style='height: 105px'><tr>";
10376
10377         $ret .= "<td style='width: 100px; text-align: center;'>";
10378         $ret .= "<a href='/allpics.bml?user=$u->{user}'>";
10379         if (my $picid = $get_picid->($u)) {
10380             $ret .= "<img src='$LJ::USERPIC_ROOT/$picid/$u->{userid}' alt='$u->{user} userpic' style='border: 1px solid #000;' />";
10381         } else {
10382             $ret .= "<img src='$LJ::STATPREFIX/horizon/nouserpic.png?v=2621' alt='no default userpic' style='border: 1px solid #000;' width='100' height='100' />";
10383         }
10384         $ret .= "</a>";
10385
10386         $ret .= "</td><td style='padding-left: 5px;' valign='top'><table>";
10387
10388         $ret .= "<tr><td class='searchusername' colspan='2' style='text-align: left;'>";
10389         $ret .= $u->ljuser_display({ head_size => $args{head_size} });
10390         $ret .= "</td></tr><tr>";
10391
10392         if ($u->{name}) {
10393             $ret .= "<td width='1%' style='font-size: smaller' valign='top'>Name:</td><td style='font-size: smaller'><a href='" . $u->profile_url . "'>";
10394             $ret .= LJ::ehtml($u->{name});
10395             $ret .= "</a>";
10396             $ret .= "</td></tr><tr>";
10397         }
10398
10399         if (my $jtitle = $u->prop('journaltitle')) {
10400             $ret .= "<td width='1%' style='font-size: smaller' valign='top'>Journal:</td><td style='font-size: smaller'><a href='" . $u->journal_base . "'>";
10401             $ret .= LJ::ehtml($jtitle) . "</a>";
10402             $ret .= "</td></tr>";
10403         }
10404
10405         $ret .= "<tr><td colspan='2' style='text-align: left; font-size: smaller' class='lastupdated'>";
10406
10407         if ($updated->{$u->{'userid'}} > 0) {
10408             $ret .= "Updated ";
10409             $ret .= LJ::TimeUtil->ago_text(time() - $updated->{$u->{'userid'}});
10410         } else {
10411             $ret .= "Never updated";
10412         }
10413
10414         $ret .= "</td></tr>";
10415
10416         $ret .= "</table>";
10417         $ret .= "</td></tr>";
10418         $ret .= "</table></div>";
10419     }
10420
10421     return $ret;
10422 }
10423
10424 # returns the country that the remote IP address comes from
10425 # undef is returned if the country cannot be determined from the IP
10426 sub country_of_remote_ip {
10427     my $ip = LJ::get_remote_ip();
10428     return undef unless $ip;
10429
10430     if (LJ::GeoLocation->can('get_country_info_by_ip')) {
10431         ## use module LJ::GeoLocation if it's installed
10432         return LJ::GeoLocation->get_country_info_by_ip($ip)
10433     } elsif (eval "use IP::Country::Fast; 1;") {
10434         my $reg = IP::Country::Fast->new();
10435         my $country = $reg->inet_atocc($ip);
10436
10437         # "**" is returned if the IP is private
10438         return undef if $country eq "**";
10439         return $country;
10440     }
10441
10442     return undef;
10443 }
10444
10445 sub get_aggregated_user {
10446     my ($row, $opts) = @_;
10447
10448     my $user = eval { LJ::load_userid($row->{userid}) };
10449
10450     return unless $user;
10451
10452     return unless $opts->{attrs} && ref $opts->{attrs};
10453
10454     my @identity_methods;
10455
10456     foreach my $method (@{$opts->{attrs}}) {
10457         if($method =~ /^identity_(.+)/) {
10458             push @identity_methods, $1;
10459             next;
10460         }
10461
10462         my @result = eval {$user->$method};
10463         ($row->{$method}) = @result > 1 ? \@result : @result;
10464     }
10465
10466     return unless (@identity_methods && $user->is_identity);
10467
10468     my $i = $user->identity;
10469
10470     foreach my $method (@identity_methods) {
10471         my @result = eval {$i->$method};
10472         ($row->{'identity_'.$method}) = @result > 1 ? \@result : @result;
10473     }
10474 }
10475
10476 # Return friends with type
10477 # Types:
10478 #   C -> Community
10479 #   P -> Personal
10480 #   I -> Identity
10481 #   Y -> Syndicated
10482 #   S -> Shared
10483 #   N -> News
10484 sub get_friends_with_type {
10485     my ($u, $options) = @_;
10486
10487     my $types = $options->{types};
10488     my $limit = $options->{limit};
10489
10490     die "no user" unless $u;
10491     die "no type" unless $types;
10492
10493     my %allow_list = map { $_ => 1 } @$types;
10494
10495     #
10496     # Exclude some friends types to type  P.
10497     #
10498     if ($allow_list{'P'}) {
10499         my %types_data = map { $_ => 1 } @$types;
10500
10501         my @types_list = ('I', 'Y', 'N', 'C');
10502         my @types_to_load = ();
10503
10504         #
10505         # May do not need to exclude  all friends
10506         #
10507         foreach my $type (@types_list) {
10508             push @types_to_load, $type
10509                 unless $types_data{$type};
10510         }
10511
10512         my @exclude = get_friends_with_type($u, { types => \@types_to_load,
10513                                                   limit => $limit });
10514
10515         my %exclude_list = map { $_ => 1 } @exclude;
10516         my @friends = $u->friend_uids(limit => $limit);
10517         my @list =  grep { !$exclude_list{$_}  } @friends;
10518
10519         return @list;
10520     }
10521
10522     #mnenonic User:FriendsList:
10523     my @keys = map { "u:fl:" . $u->userid . ":$_"} @$types ;
10524
10525     my $redis = LJ::Redis->get_connection();
10526     if ($redis) {
10527         my @list = ();
10528         foreach my $key (@keys) {
10529             my @result = $redis->smembers($key);
10530             push @list, @result if @result;
10531         }
10532
10533         return @list if @list;
10534     }
10535
10536     # get and set a list
10537
10538     my @friends = $u->friend_uids();
10539     my $friends_data = LJ::get_journal_short_info_multi(@friends);
10540
10541     my @typed_journals = ();
10542     my %put_in_cache = ();
10543     foreach my $friend (@friends) {
10544         my $friend_info = $friends_data->{$friend};
10545         next if $friend_info->{statusvis} eq 'X' ||
10546                 $friend_info->{clusterid} == 0;
10547
10548         my $type = $friend_info->{journaltype};
10549         next unless $allow_list{$type};
10550
10551         push @{$put_in_cache{$type}}, $friend if $redis;
10552         push @typed_journals, $friend;
10553     }
10554
10555     if ($redis) {
10556         foreach my $type (keys %put_in_cache) {
10557             my $key = "u:fl:" . $u->userid . ":$type";
10558             $redis->sadd($key, @{$put_in_cache{$type}});
10559             $redis->expire($key, 60 * 60);
10560         }
10561     }
10562
10563     return @typed_journals;
10564 }
10565
10566 sub remove_from_friend_list {
10567     my ($u, $friend) = @_;
10568
10569     my $type = $friend->journaltype;
10570     my $key  = "u:fl:" . $u->userid . ":$type";
10571     my $redis = LJ::Redis->get_connection();
10572     if ($redis) {
10573         $redis->srem($key, $friend);
10574     }
10575 }
10576
10577 sub add_to_friend_list {
10578     my ($u, $friend) = @_;
10579
10580     my $type = $friend->journaltype;
10581     my $key  = "u:fl:" . $u->userid . ":$type";
10582     my $redis = LJ::Redis->get_connection();
10583
10584     if ($redis && $redis->exists($key)) {
10585         $redis->sadd($key, $friend);
10586     }
10587 }
10588
10589 sub get_journal_short_info_multi {
10590     my @userids = @_;
10591     my @keys = ();
10592
10593     foreach my $userid (@userids) {
10594         push @keys, "u:s:$userid";
10595     }
10596
10597     my %final_result = ();
10598
10599     my $result = LJ::MemCache::get_multi(@keys);
10600
10601     my @users_to_load = ();
10602     foreach my $userid (@userids) {
10603         my $data = delete $result->{"u:s:$userid"};
10604         unless ($data) {
10605             push @users_to_load, $userid;
10606         } else {
10607             my %user_result = ();
10608
10609             my ($status, $cid, $type) = split(/:/, $data);
10610             $user_result{statusvis}    = $status;
10611             $user_result{clusterid}    = $cid;
10612             $user_result{journaltype}  = $type;
10613
10614             $final_result{$userid} = \%user_result;
10615         }
10616     }
10617
10618     my $users = LJ::load_userids(@users_to_load);
10619
10620     foreach my $userid (@users_to_load) {
10621         my $user = $users->{$userid};
10622
10623         if ($user) {
10624             my $status  = $user->{statusvis};
10625             my $cid     = $user->{clusterid};
10626             my $type    = $user->{journaltype};
10627
10628             my %user_result = ();
10629
10630             $user_result{statusvis}    = $status;
10631             $user_result{clusterid}    = $cid;
10632             $user_result{journaltype}  = $type;
10633
10634             $final_result{$userid} = \%user_result;
10635
10636             my $cache = join(':', $status, $cid, $type);
10637             my $expire_time = time + 60*60*24*30;
10638             LJ::MemCache::set("u:s:$userid", $cache, $expire_time);
10639         }
10640     }
10641
10642     return \%final_result;
10643 }
10644
10645 1;