mourningdove/cgi-bin/LJ/Userpic.pm
2026-05-24 01:03:05 +00:00

1552 lines
43 KiB
Perl

# This code was forked from the LiveJournal project owned and operated
# by Live Journal, Inc. The code has been modified and expanded by
# Dreamwidth Studios, LLC. These files were originally licensed under
# the terms of the license supplied by Live Journal, Inc, which can
# currently be found at:
#
# http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt
#
# In accordance with the original license, this code and all its
# modifications are provided under the GNU General Public License.
# A copy of that license can be found in the LICENSE file included as
# part of this distribution.
# echo "# CONTROLLER_TEST_$(date)" >> /home/dw/dw/cgi-bin/DW/Controller/Media.pm
package LJ::Userpic;
use strict;
use v5.10;
use Log::Log4perl;
my $log = Log::Log4perl->get_logger(__PACKAGE__);
use Digest::MD5;
use Storable;
use DW::BlobStore;
use LJ::Event::NewUserpic;
use LJ::Global::Constants;
##
## Potential properties of an LJ::Userpic object
##
# picid : (accessors picid, id) unique identifier for the object, generated
# userid : (accessor userid) the userid associated with the object
# state : state
# comment : user submitted descriptive comment
# description : user submitted description
# keywords : user submitted keywords (all keywords in a single string)
# dim : (accessors width, height, dimensions) array:[width][height]
# pictime : pictime
# flags : flags
# md5base64 : md5sum of of the image bitstream to prevent duplication
# ext : file extension, corresponding to mime types
# location : whether the image is stored in database or mogile
##
## virtual accessors
##
# url : returns a URL directly to the userpic
# fullurl : returns the URL used at upload time, it if exists
# altext : "username: keyword, comment (description)"
# u, owner : return the user object indicated by the userid
# legal image types
my %MimeTypeMap = (
'image/gif' => 'gif',
'G' => 'gif',
'image/jpeg' => 'jpg',
'J' => 'jpg',
'image/png' => 'png',
'P' => 'png',
);
# all LJ::Userpics in memory
# userid -> picid -> LJ::Userpic
my %singletons;
sub reset_singletons {
%singletons = ();
}
=head1 NAME
LJ::Userpic
=head1 Class Methods
=cut
# LJ::Userpic constructor. Returns a LJ::Userpic object.
# Return existing with userid and picid populated, or make new.
sub instance {
my ( $class, $u, $picid ) = @_;
$picid = 0 unless defined $picid;
my $up;
# return existing one, if loaded
if ( my $us = $singletons{ $u->{userid} } ) {
return $up if $up = $us->{$picid};
}
# otherwise construct a new one with the given picid
$up = $class->_skeleton( $u, $picid );
$singletons{ $u->{userid} }->{$picid} = $up;
return $up;
}
*new = \&instance;
# LJ::Userpic accessor. Returns a LJ::Userpic object indicated by $picid, or
# undef if userpic doesn't exist in the db.
# TODO: add in lazy peer loading here?
sub get {
my ( $class, $u, $picid, $opts ) = @_;
return unless LJ::isu($u);
return if $u->is_expunged || $u->is_suspended;
return unless defined $picid;
my $obj = ref $class ? $class : $class->new( $u, $picid );
my @cache = $class->load_user_userpics($u);
foreach my $curr (@cache) {
return $obj->absorb_row($curr) if $curr->{picid} == $picid;
}
# check the database directly (for expunged userpics,
# which aren't included in load_user_userpics)
return undef if $opts && $opts->{no_expunged};
my $row = $u->selectrow_hashref(
"SELECT userid, picid, width, height, state, "
. "fmt, comment, description, location, url, "
. "UNIX_TIMESTAMP(picdate) AS 'pictime', flags, md5base64 "
. "FROM userpic2 WHERE userid=? AND picid=?",
undef, $u->userid, $picid
);
return $obj->absorb_row($row) if $row;
return undef;
}
sub _skeleton {
my ( $class, $u, $picid ) = @_;
$picid = 0 unless defined $picid;
# starts out as a skeleton and gets loaded in over time, as needed:
return bless {
userid => $u->{userid},
picid => int($picid),
};
}
# given a md5sum, load a userpic
# takes $u, $md5sum (base64)
# TODO: croak if md5sum is wrong number of bytes
sub new_from_md5 {
my ( $class, $u, $md5sum ) = @_;
die unless $u && length($md5sum) == 22;
my $sth = $u->prepare( "SELECT * FROM userpic2 WHERE userid=? " . "AND md5base64=?" );
$sth->execute( $u->{'userid'}, $md5sum );
my $row = $sth->fetchrow_hashref
or return undef;
return LJ::Userpic->new_from_row($row);
}
sub preload_default_userpics {
my ( $class, @us ) = @_;
foreach my $u (@us) {
my $up = $u->userpic or next;
$up->load_row;
}
}
sub new_from_row {
my ( $class, $row ) = @_;
die unless $row && $row->{userid} && $row->{picid};
my $self = LJ::Userpic->new( LJ::load_userid( $row->{userid} ), $row->{picid} );
$self->absorb_row($row);
return $self;
}
=head2 C<< $class->new_from_keyword( $u, $kw ) >>
Returns the LJ::Userpic for the given keyword
=cut
sub new_from_keyword {
my ( $class, $u, $kw ) = @_;
return undef unless LJ::isu($u);
my $picid = $u->get_picid_from_keyword($kw);
return $picid ? $class->new( $u, $picid ) : undef;
}
=head2 C<< $class->new_from_mapid( $u, $mapid ) >>
Returns the LJ::Userpic for the given mapid
=cut
sub new_from_mapid {
my ( $class, $u, $mapid ) = @_;
return undef unless LJ::isu($u);
my $picid = $u->get_picid_from_mapid($mapid);
return $picid ? $class->new( $u, $picid ) : undef;
}
=head1 Instance Methods
=cut
sub valid {
return defined $_[0]->state;
}
sub absorb_row {
my ( $self, $row ) = @_;
return $self unless $row && ref $row eq 'HASH';
for my $f (
qw(userid picid width height comment description location state url pictime flags md5base64)
)
{
$self->{$f} = $row->{$f};
}
my $key;
$key ||= $row->{fmt} if exists $row->{fmt};
$key ||= $row->{contenttype} if exists $row->{contenttype};
$self->{_ext} = $MimeTypeMap{$key} if defined $key;
return $self;
}
##
## accessors
##
# returns the picture ID associated with the object
sub picid {
return $_[0]->{picid};
}
*id = \&picid;
# returns the userid associated with the object
sub userid {
return $_[0]->{userid};
}
# given a userpic with a known userid, return the user object
sub u {
return LJ::load_userid( $_[0]->userid );
}
*owner = \&u;
sub inactive {
my $self = $_[0];
my $state = defined $self->state ? $self->state : '';
return $state eq 'I';
}
sub expunged {
my $self = $_[0];
my $state = defined $self->state ? $self->state : '';
return $state eq 'X';
}
sub state {
my $self = $_[0];
return $self->{state} if defined $self->{state};
$self->load_row;
return $self->{state};
}
sub comment {
my $self = $_[0];
return $self->{comment} if exists $self->{comment};
$self->load_row;
return $self->{comment};
}
sub description {
my $self = $_[0];
return $self->{description} if exists $self->{description};
$self->load_row;
return $self->{description};
}
sub width {
my $self = $_[0];
my @dims = $self->dimensions;
return undef unless @dims;
return $dims[0];
}
sub height {
my $self = $_[0];
my @dims = $self->dimensions;
return undef unless @dims;
return $dims[1];
}
sub picdate {
return LJ::mysql_time( $_[0]->pictime );
}
sub pictime {
return $_[0]->{pictime};
}
sub flags {
return $_[0]->{flags};
}
sub md5base64 {
return $_[0]->{md5base64};
}
sub mimetype {
my $self = $_[0];
return {
gif => 'image/gif',
jpg => 'image/jpeg',
png => 'image/png'
}->{ $self->extension };
}
sub extension {
my $self = $_[0];
return $self->{_ext} if $self->{_ext};
$self->load_row;
return $self->{_ext};
}
sub location {
my $self = $_[0];
return $self->{location} if $self->{location};
$self->load_row;
return $self->{location};
}
sub storage_key {
my ( $self, $userid, $picid ) = @_;
# If called on LJ::Userpic...
return 'up:' . $self->userid . ':' . $self->picid
if ref $self;
# Else...
$log->logcroak('Invalid usage of storage_key.')
unless defined $userid && defined $picid;
return 'up:' . ( $userid + 0 ) . ':' . ( $picid + 0 );
}
sub in_mogile {
my $self = $_[0];
return ( $self->location // '' ) eq 'mogile';
}
sub in_blobstore {
my $self = $_[0];
return ( $self->location // '' ) eq 'blobstore';
}
# returns (width, height)
sub dimensions {
my $self = $_[0];
# width and height probably loaded from DB
return ( $self->{width}, $self->{height} ) if ( $self->{width} && $self->{height} );
# if not, load them explicitly
$self->load_row;
return ( $self->{width}, $self->{height} );
}
sub max_allowed_bytes {
my ( $class, $u ) = @_;
return 600000;
}
# Returns the direct link to the uploaded userpic
sub url {
my $self = $_[0];
if ( my $hook_path = LJ::Hooks::run_hook( 'construct_userpic_url', $self ) ) {
return $hook_path;
}
return "$LJ::USERPIC_ROOT/$self->{picid}/$self->{userid}";
}
# Returns original URL used if userpic was originally uploaded
# via a URL.
# FIXME: should be renamed to source_url
sub fullurl {
my $self = $_[0];
return $self->{url} if $self->{url};
$self->load_row;
return $self->{url};
}
# given a userpic and a keyword, return the alt text
sub alttext {
my ( $self, $kw, $mark_default ) = @_;
# load the alttext.
# "username: description (keyword)"
# If any of those are not present leave them (and their
# affiliated punctuation) out.
# always include the username
my $u = $self->owner;
my $alt = $u->username . ":";
if ( $self->description ) {
$alt .= " " . $self->description;
}
# 1. If there is a keyword associated with the icon, use it.
if ( defined $kw ) {
$alt .= " (" . $kw . ")";
}
# 2. If it was chosen via the default icon, show "(Default)".
if ( $mark_default // !defined $kw ) {
$alt .= " (Default)";
}
return LJ::ehtml($alt);
}
# given a userpic and a keyword, return the title text
sub titletext {
my ( $self, $kw, $mark_default ) = @_;
# load the titletext.
# "username: keyword (description)"
# If any of those are not present leave them (and their
# affiliated punctuation) out.
# always include the username
my $u = $self->owner;
my $title = $u->username . ":";
# 1. If there is a keyword associated with the icon, use it.
if ( defined $kw ) {
$title .= " " . $kw;
}
# 2. If it was chosen via the default icon, show "(Default)".
if ( $mark_default // !defined $kw ) {
$title .= " (Default)";
}
if ( $self->description ) {
$title .= " (" . $self->description . ")";
}
return LJ::ehtml($title);
}
# returns an image tag of this userpic
# optional parameters (which must be explicitly passed) include
# width, keyword, and user (object)
sub imgtag {
my ( $self, %opts ) = @_;
# if the width and keyword have been passed in as explicit
# parameters, set them. Otherwise, take what ever is set in
# the userpic
my $width = $opts{width} || $self->width;
my $height = $opts{height} || $self->height;
my $keyword = $opts{keyword} || $self->keywords;
my $alttext = $self->alttext($keyword);
my $title = $self->titletext($keyword);
return
'<img src="'
. $self->url
. '" width="'
. $width
. '" height="'
. $height
. '" alt="'
. $alttext
. '" title="'
. $title
. '" class="userpic-img" />';
}
# FIXME: should have alt text, if it should be kept
sub imgtag_lite {
my $self = $_[0];
return
'<img src="'
. $self->url
. '" width="'
. $self->width
. '" height="'
. $self->height
. '" class="userpic-img" />';
}
# FIXME: should have alt text, if it should be kept
sub imgtag_nosize {
my $self = $_[0];
return '<img src="' . $self->url . '" class="userpic-img" />';
}
# pass the decimal version of a percentage that you want to shrink/increase the userpic by
# default is 50% of original size
sub imgtag_percentagesize {
my ( $self, $percentage ) = @_;
$percentage ||= 0.5;
my $width = int( $self->width * $percentage );
my $height = int( $self->height * $percentage );
return
'<img src="'
. $self->url
. '" width="'
. $width
. '" height="'
. $height
. '" class="userpic-img" />';
}
# pass a fixed height or width that you want to be the size of the userpic
# must include either a height or width, if both are given the smaller of the two is used
# returns the width and height attributes as a string to insert into an img tag
sub img_fixedsize {
my ( $self, %opts ) = @_;
my $width = $opts{width} || 0;
my $height = $opts{height} || 0;
if ( $width > 0
&& $width < $self->width
&& ( !$height || ( $width <= $height && $self->width >= $self->height ) ) )
{
my $ratio = $width / $self->width;
$height = int( $self->height * $ratio );
}
elsif ( $height > 0 && $height < $self->height ) {
my $ratio = $height / $self->height;
$width = int( $self->width * $ratio );
}
else {
$width = $self->width;
$height = $self->height;
}
return 'height="' . $height . '" width="' . $width . '"';
}
# in scalar context returns comma-seperated list of keywords or "pic#12345" if no keywords defined
# in list context returns list of keywords ( (pic#12345) if none defined )
# opts: 'raw' = return '' instead of 'pic#12345'
sub keywords {
my ( $self, %opts ) = @_;
my $raw = delete $opts{raw} || undef;
$log->logcroak("Invalid opts passed to LJ::Userpic::keywords")
if keys %opts;
my $u = $self->owner;
my $keywords = $u->get_userpic_kw_map();
# return keywords for this picid
my @pickeywords = $keywords->{ $self->id } ? @{ $keywords->{ $self->id } } : ();
if (wantarray) {
# if list context return the array
return ( $raw ? ('') : ( "pic#" . $self->id ) ) unless @pickeywords;
return sort { lc $a cmp lc $b } @pickeywords;
}
else {
# if scalar context return comma-seperated list of keywords, or "pic#12345" if no keywords
return ( $raw ? '' : "pic#" . $self->id ) unless @pickeywords;
return join( ', ', sort { lc $a cmp lc $b } @pickeywords );
}
}
sub imagedata {
my $self = $_[0];
$self->load_row or return undef;
return undef if $self->expunged;
my $data = DW::BlobStore->retrieve( userpics => $self->storage_key );
return $data ? $$data : undef;
}
# get : class :: load_row : object
sub load_row {
my $self = $_[0];
# use class method
return $self->get( $self->owner, $self->picid );
}
# checks request cache and memcache,
# returns: undef if nothing in cache
# arrayref of LJ::Userpic instances if found in cache
sub get_cache {
my ( $class, $u ) = @_;
# check request cache first!
# -- this gets populated when a ->load_user_userpics call happens,
# so the actual guts of the LJ::Userpic objects is cached in
# the singletons
if ( $u->{_userpicids} ) {
return [ map { LJ::Userpic->instance( $u, $_ ) } @{ $u->{_userpicids} } ];
}
my $memkey = $class->memkey($u);
my $memval = LJ::MemCache::get($memkey);
# nothing found in cache, return undef
return undef unless $memval;
my @ret = ();
foreach my $row (@$memval) {
my $curr = LJ::MemCache::array_to_hash( 'userpic2', $row );
$curr->{userid} = $u->id;
push @ret, LJ::Userpic->new_from_row($curr);
}
# set cache of picids on $u since we got them from memcache
$u->{_userpicids} = [ map { $_->picid } @ret ];
# return arrayref of LJ::Userpic instances
return \@ret;
}
# $class->memkey( $u )
sub memkey {
return [ $_[1]->id, "userpic2:" . $_[1]->id ];
}
sub set_cache {
my ( $class, $u, $rows ) = @_;
my $memkey = $class->memkey($u);
my @vals = map { LJ::MemCache::hash_to_array( 'userpic2', $_ ) } @$rows;
LJ::MemCache::set( $memkey, \@vals, 60 * 30 );
# set cache of picids on $u
$u->{_userpicids} = [ map { $_->{picid} } @$rows ];
return 1;
}
sub load_user_userpics {
my ( $class, $u ) = @_;
local $LJ::THROW_ERRORS = 1;
my $cache = $class->get_cache($u);
return @$cache if $cache;
# select all of their userpics
my $data = $u->selectall_hashref(
"SELECT userid, picid, width, height, state, fmt, comment,"
. " description, location, url, UNIX_TIMESTAMP(picdate) AS 'pictime',"
. " flags, md5base64 FROM userpic2 WHERE userid=? AND state <> 'X'",
'picid', undef, $u->userid
);
die "Error loading userpics: clusterid=$u->{clusterid}, errstr=" . $u->errstr
if $u->err;
my @ret = sort { $a->{picid} <=> $b->{picid} } values %$data;
# set cache if reasonable
$class->set_cache( $u, \@ret );
return map { $class->new_from_row($_) } @ret;
}
sub create {
my ( $class, $u, %opts ) = @_;
local $LJ::THROW_ERRORS = 1;
my $dataref = delete $opts{data};
my $maxbytesize = delete $opts{maxbytesize};
my $nonotify = delete $opts{nonotify};
$log->logcroak("dataref not a scalarref")
unless ref $dataref eq 'SCALAR';
$log->logcroak( "Unknown extra options: " . join( ", ", scalar keys %opts ) )
if %opts;
my $err = sub {
my $msg = $_[0];
};
# FIXME the filetype is supposed to be returned in the next call
# but according to the docs of Image::Size v3.2 it does not return that value
eval "use Image::Size;";
my ( $w, $h, $filetype ) = Image::Size::imgsize($dataref);
my $MAX_UPLOAD = $maxbytesize || LJ::Userpic->max_allowed_bytes($u);
my $size = length $$dataref;
my $fmterror = 0;
my @errors;
if ( $size > $MAX_UPLOAD ) {
push @errors,
LJ::errobj(
"Userpic::Bytesize",
size => $size,
max => int( $MAX_UPLOAD / 1024 )
);
}
unless ( $filetype eq "GIF" || $filetype eq "JPG" || $filetype eq "PNG" ) {
push @errors, LJ::errobj( "Userpic::FileType", type => $filetype );
$fmterror = 1;
}
# don't throw a dimensions error if it's the wrong file type because its dimensions will always
# be 0x0
unless ( $w && $w >= 1 && $w <= 100 && $h && $h >= 1 && $h <= 100 ) {
push @errors,
LJ::errobj(
"Userpic::Dimensions",
w => $w,
h => $h
) unless $fmterror;
}
LJ::throw(@errors);
# see if it's a duplicate, return it if it is
my $base64 = Digest::MD5::md5_base64($$dataref);
if ( my $dup_up = LJ::Userpic->new_from_md5( $u, $base64 ) ) {
return $dup_up;
}
# start making a new onew
my $picid = LJ::alloc_global_counter('P');
my $contenttype = {
'GIF' => 'G',
'PNG' => 'P',
'JPG' => 'J',
}->{$filetype};
@errors = (); # TEMP: FIXME: remove... using exceptions
$u->do(
q{INSERT INTO userpic2 (
picid, userid, fmt, width, height, picdate, md5base64, location)
VALUES (?, ?, ?, ?, ?, NOW(), ?, ?)},
undef, $picid, $u->userid, $contenttype, $w, $h, $base64, 'blobstore'
);
push @errors, $err->( $u->errstr )
if $u->err;
# All pictures are now stored to blobstore
my $storage_key = LJ::Userpic->storage_key( $u->userid, $picid );
unless ( DW::BlobStore->store( userpics => $storage_key, $dataref ) ) {
$u->do( q{DELETE FROM userpic2 WHERE userid=? AND picid=?}, undef, $u->userid, $picid );
push @errors, 'Failed to store userpic in blobstore.';
}
LJ::throw(@errors);
# now that we've created a new pic, invalidate the user's memcached userpic info
LJ::Userpic->delete_cache($u);
# Fire ESN and return
my $pic = LJ::Userpic->new( $u, $picid )
or $log->logcroak('Error insantiating userpic after creation');
LJ::Event::NewUserpic->new($pic)->fire
if LJ::is_enabled('esn') && !$nonotify;
return $pic;
}
# this will return a user's userpicfactory image stored in mogile scaled down.
# if only $size is passed, will return image scaled so the largest dimension will
# not be greater than $size. If $x1, $y1... are set then it will return the image
# scaled so the largest dimension will not be greater than 100
# all parameters are optional, default size is 640.
#
# if maxfilesize option is passed, get_upf_scaled will decrease the image quality
# until it reaches maxfilesize, in kilobytes. (only applies to the 100x100 userpic)
#
# returns [imageref, mime, width, height] on success, undef on failure.
#
# note: this will always keep the image's original aspect ratio and not distort it.
sub get_upf_scaled {
my ( $class, %opts ) = @_;
my $size = delete $opts{size} || 640;
my $x1 = delete $opts{x1};
my $y1 = delete $opts{y1};
my $x2 = delete $opts{x2};
my $y2 = delete $opts{y2};
my $border = delete $opts{border} || 0;
my $maxfilesize = delete $opts{maxfilesize} || 38;
my $u = LJ::want_user( delete $opts{userid} || delete $opts{u} ) || LJ::get_remote();
my $mogkey = delete $opts{mogkey};
my $downsize_only = delete $opts{downsize_only};
$log->logcroak("No userid or remote")
unless $u || $mogkey;
$maxfilesize *= 1024;
$log->logcroak("Invalid parameters to get_upf_scaled")
if scalar keys %opts;
my $mode = ( $x1 || $y1 || $x2 || $y2 ) ? "crop" : "scale";
eval "use Image::Magick (); 1;"
or return undef;
eval "use Image::Size (); 1;"
or return undef;
$mogkey ||= 'upf:' . $u->{userid};
my $dataref = DW::BlobStore->retrieve( temp => $mogkey )
or return undef;
# original width/height
my ( $ow, $oh ) = Image::Size::imgsize($dataref);
return undef unless $ow && $oh;
# converts an ImageMagick object to the form returned to our callers
my $imageParams = sub {
my $im = $_[0];
my $blob = $im->ImageToBlob;
return [ \$blob, $im->Get('MIME'), $im->Get('width'), $im->Get('height') ];
};
# compute new width and height while keeping aspect ratio
my $getSizedCoords = sub {
my ( $newsize, $img ) = @_;
my $fromw = $img ? $img->Get('width') : $ow;
my $fromh = $img ? $img->Get('height') : $oh;
return ( int( $newsize * $fromw / $fromh ), $newsize ) if $fromh > $fromw;
return ( $newsize, int( $newsize * $fromh / $fromw ) );
};
# get the "medium sized" width/height. this is the size which
# the user selects from
my ( $medw, $medh ) = $getSizedCoords->($size);
return undef unless $medw && $medh;
# simple scaling mode
if ( $mode eq "scale" ) {
my $image = Image::Magick->new( size => "${medw}x${medh}" )
or return undef;
$image->BlobToImage($$dataref);
unless ( $downsize_only && ( $medw > $ow || $medh > $oh ) ) {
$image->Resize( width => $medw, height => $medh );
}
return $imageParams->($image);
}
# else, we're in 100x100 cropping mode
# scale user coordinates up from the medium pixelspace to full pixelspace
$x1 *= ( $ow / $medw );
$x2 *= ( $ow / $medw );
$y1 *= ( $oh / $medh );
$y2 *= ( $oh / $medh );
# cropping dimensions from the full pixelspace
my $tw = $x2 - $x1;
my $th = $y2 - $y1;
# but if their selected region in full pixelspace is 800x800 or something
# ridiculous, no point decoding the JPEG to its full size... we can
# decode to a smaller size so we get 100px when we crop
my $min_dim = $tw < $th ? $tw : $th;
my ( $decodew, $decodeh ) = ( $ow, $oh );
my $wanted_size = 100;
if ( $min_dim > $wanted_size ) {
# then let's not decode the full JPEG down from its huge size
my $de_scale = $wanted_size / $min_dim;
$decodew = int( $de_scale * $decodew );
$decodeh = int( $de_scale * $decodeh );
$_ *= $de_scale foreach ( $x1, $x2, $y1, $y2 );
}
$_ = int($_) foreach ( $x1, $x2, $y1, $y2, $tw, $th );
# make the pristine (uncompressed) 100x100 image
my $timage = Image::Magick->new( size => "${decodew}x${decodeh}" )
or return undef;
$timage->BlobToImage($$dataref);
$timage->Scale( width => $decodew, height => $decodeh );
my $w = ( $x2 - $x1 );
my $h = ( $y2 - $y1 );
my $foo = $timage->Mogrify( crop => "${w}x${h}+$x1+$y1" );
my $targetSize = $border ? 98 : 100;
my ( $nw, $nh ) = $getSizedCoords->( $targetSize, $timage );
$timage->Scale( width => $nw, height => $nh );
# add border if desired
$timage->Border( geometry => "1x1", color => 'black' ) if $border;
foreach my $qual (qw(100 90 85 75)) {
# work off a copy of the image so we aren't recompressing it
my $piccopy = $timage->Clone();
$piccopy->Set( 'quality' => $qual );
my $ret = $imageParams->($piccopy);
return $ret if length( ${ $ret->[0] } ) < $maxfilesize;
}
return undef;
}
# make this picture the default
sub make_default {
my $self = shift;
my $u = $self->owner
or die;
$u->update_self( { defaultpicid => $self->id } );
$u->{'defaultpicid'} = $self->id;
}
# returns true if this picture is the default userpic
sub is_default {
my $self = $_[0];
my $u = $self->owner;
return unless defined $u->{'defaultpicid'};
return $u->{'defaultpicid'} == $self->id;
}
sub delete_cache {
my ( $class, $u ) = @_;
my $memkey = [ $u->{'userid'}, "upicinf:$u->{'userid'}" ];
LJ::MemCache::delete($memkey);
$memkey = [ $u->{'userid'}, "upiccom:$u->{'userid'}" ];
LJ::MemCache::delete($memkey);
$memkey = [ $u->{'userid'}, "upicurl:$u->{'userid'}" ];
LJ::MemCache::delete($memkey);
$memkey = [ $u->{'userid'}, "upicdes:$u->{'userid'}" ];
LJ::MemCache::delete($memkey);
# userpic2 rows for a given $u
$memkey = LJ::Userpic->memkey($u);
LJ::MemCache::delete($memkey);
delete $u->{_userpicids};
# clear process cache
$LJ::CACHE_USERPIC_INFO{ $u->{'userid'} } = undef;
}
# delete this userpic
# TODO: error checking/throw errors on failure
sub delete {
my $self = $_[0];
local $LJ::THROW_ERRORS = 1;
my $fail = sub {
LJ::errobj(
"WithSubError",
main => LJ::errobj("DeleteFailed"),
suberr => $@
)->throw;
};
my $u = $self->owner;
my $picid = $self->id;
# userpic keywords
eval {
if ( $u->userpic_have_mapid ) {
$u->do( "DELETE FROM userpicmap3 WHERE userid = ? AND picid = ? AND kwid=NULL",
undef, $u->userid, $picid )
or die;
$u->do( "UPDATE userpicmap3 SET picid=NULL WHERE userid=? AND picid=?",
undef, $u->userid, $picid )
or die;
}
else {
$u->do( "DELETE FROM userpicmap2 WHERE userid=? AND picid=?",
undef, $u->userid, $picid )
or die;
}
$u->do( "DELETE FROM userpic2 WHERE picid=? AND userid=?", undef, $picid, $u->userid )
or die;
};
$fail->() if $@;
$u->log_event( 'delete_userpic', { picid => $picid } );
DW::BlobStore->delete( userpics => $self->storage_key );
LJ::Userpic->delete_cache($u);
return 1;
}
sub set_comment {
my ( $self, $comment ) = @_;
local $LJ::THROW_ERRORS = 1;
my $u = $self->owner;
$comment = LJ::text_trim( $comment, LJ::BMAX_UPIC_COMMENT(), LJ::CMAX_UPIC_COMMENT() );
$u->do( "UPDATE userpic2 SET comment=? WHERE userid=? AND picid=?",
undef, $comment, $u->{'userid'}, $self->id )
or die;
$self->{comment} = $comment;
LJ::Userpic->delete_cache($u);
return 1;
}
sub set_description {
my ( $self, $description ) = @_;
local $LJ::THROW_ERRORS = 1;
my $u = $self->owner;
#return 0 unless LJ::Userpic->user_supports_descriptions($u);
$description =
LJ::text_trim( $description, LJ::BMAX_UPIC_DESCRIPTION, LJ::CMAX_UPIC_DESCRIPTION );
$u->do( "UPDATE userpic2 SET description=? WHERE userid=? AND picid=?",
undef, $description, $u->{'userid'}, $self->id )
or die;
$self->{description} = $description;
LJ::Userpic->delete_cache($u);
return 1;
}
# instance method: takes a string of comma-separate keywords, or an array of keywords
sub set_keywords {
my $self = shift;
my @keywords;
if ( @_ > 1 ) {
@keywords = @_;
}
else {
@keywords = split( ',', $_[0] );
}
@keywords = grep { !/^pic\#\d+$/ } map { s/^\s+//; s/\s+$//; $_ } @keywords;
my $u = $self->owner;
my $have_mapid = $u->userpic_have_mapid;
my $sth;
my $dbh;
if ($have_mapid) {
$sth = $u->prepare("SELECT kwid FROM userpicmap3 WHERE userid=? AND picid=?");
}
else {
$sth = $u->prepare("SELECT kwid FROM userpicmap2 WHERE userid=? AND picid=?");
}
$sth->execute( $u->userid, $self->id );
my %exist_kwids;
while ( my ($kwid) = $sth->fetchrow_array ) {
# This is an edge case to catch keyword changes where the existing keyword
# is in the pic# format. In this case kwid is NULL and we want to
# delete any records from userpicmap3 that involve it.
unless ($kwid) {
$u->do( "DELETE FROM userpicmap3 WHERE userid=? AND picid=? AND kwid IS NULL",
undef, $u->id, $self->id );
}
$exist_kwids{$kwid} = 1;
}
my %kwid_to_mapid;
if ($have_mapid) {
$sth =
$u->prepare("SELECT mapid, kwid FROM userpicmap3 WHERE userid=? AND kwid IS NOT NULL");
$sth->execute( $u->userid );
while ( my ( $mapid, $kwid ) = $sth->fetchrow_array ) {
$kwid_to_mapid{$kwid} = $mapid;
}
}
my ( @bind, @data, @kw_errors );
my $c = 0;
my $picid = $self->{picid};
foreach my $kw (@keywords) {
my $kwid = $u->get_keyword_id($kw);
next unless $kwid; # TODO: fire some warning that keyword was bogus
if ( ++$c > $LJ::MAX_USERPIC_KEYWORDS ) {
push @kw_errors, $kw;
next;
}
if ( exists $exist_kwids{$kwid} ) {
delete $exist_kwids{$kwid};
}
else {
if ($have_mapid) {
$kwid_to_mapid{$kwid} ||= LJ::alloc_user_counter( $u, 'Y' );
push @bind, '(?, ?, ?, ?)';
push @data, $u->userid, $kwid_to_mapid{$kwid}, $kwid, $picid;
}
else {
push @bind, '(?, ?, ?)';
push @data, $u->userid, $kwid, $picid;
}
}
}
LJ::Userpic->delete_cache($u);
foreach my $kwid ( keys %exist_kwids ) {
if ($have_mapid) {
$u->do( "UPDATE userpicmap3 SET picid=NULL WHERE userid=? AND picid=? AND kwid=?",
undef, $u->id, $self->id, $kwid );
}
else {
$u->do( "DELETE FROM userpicmap2 WHERE userid=? AND picid=? AND kwid=?",
undef, $u->id, $self->id, $kwid );
}
}
# save data if any
if ( scalar @data ) {
my $bind = join( ',', @bind );
if ($have_mapid) {
$u->do( "REPLACE INTO userpicmap3 (userid, mapid, kwid, picid) VALUES $bind",
undef, @data );
}
else {
$u->do( "REPLACE INTO userpicmap2 (userid, kwid, picid) VALUES $bind", undef, @data );
}
}
# clear the userpic-keyword map.
$u->clear_userpic_kw_map;
# Let the user know about any we didn't save
# don't throw until the end or nothing will be saved!
if (@kw_errors) {
my $num_words = scalar(@kw_errors);
LJ::errobj(
"Userpic::TooManyKeywords",
userpic => $self,
lost => \@kw_errors
)->throw;
}
return 1;
}
# instance method: takes two strings of comma-separated keywords, the first
# being the new set of keywords, the second being the old set of keywords.
#
# the new keywords must be the same number as the old keywords; that is,
# if the userpic has three keywords and you want to rename them, you must
# rename them to three keywords (some can match). otherwise there would be
# some ambiguity about which old keywords should match up with the new
# keywords. if the number of keywords don't match, then an error is thrown
# and no changes are made to the keywords for this userpic.
#
# all new keywords must not currently be in use; you can't rename a keyword
# to a keyword currently mapped to another (or the same) userpic. this will
# result in an error and no changes made to these keywords.
sub set_and_rename_keywords {
my ( $self, $new_keyword_string, $orig_keyword_string ) = @_;
my $u = $self->owner;
LJ::errobj(
"Userpic::RenameKeywords",
origkw => $orig_keyword_string,
newkw => $new_keyword_string
)->throw
unless LJ::is_enabled("icon_renames") || $u->userpic_have_mapid;
my @keywords = split( ',', $new_keyword_string );
my @orig_keywords = split( ',', $orig_keyword_string );
if ( grep ( /^\s*pic\#\d+\s*$/, @keywords ) ) {
LJ::errobj(
"Userpic::RenameBlankKeywords",
origkw => $orig_keyword_string,
newkw => $new_keyword_string
)->throw;
}
# compare sizes
if ( scalar @keywords ne scalar @orig_keywords ) {
LJ::errobj(
"Userpic::MismatchRenameKeywords",
origkw => $orig_keyword_string,
newkw => $new_keyword_string
)->throw;
}
#interleave these into a map, excluding duplicates
my %keywordmap;
foreach my $newkw (@keywords) {
my $origkw = shift(@orig_keywords);
# clear whitespace
$newkw =~ s/^\s+//;
$newkw =~ s/\s+$//;
$origkw =~ s/^\s+//;
$origkw =~ s/\s+$//;
$keywordmap{$origkw} = $newkw if $origkw ne $newkw;
}
# make sure there is at least one change.
if ( keys(%keywordmap) ) {
#make sure that none of the target keywords already exist.
foreach my $kw ( values %keywordmap ) {
if ( $u && $u->get_picid_from_keyword( $kw, -1 ) != -1 ) {
LJ::errobj( "Userpic::RenameKeywordExisting", keyword => $kw )->throw;
}
}
while ( my ( $origkw, $newkw ) = each(%keywordmap) ) {
# need to check if the kwid already has a mapid
my $mapid = $u->get_mapid_from_keyword($newkw);
# if it does, we have to remap it
if ($mapid) {
my $oldid = $u->get_mapid_from_keyword($origkw);
# redirect the old mapid to the new mapid
$u->do(
"UPDATE userpicmap3 SET kwid = NULL, picid = NULL, redirect_mapid = ? WHERE mapid = ? AND userid = ?",
undef, $mapid, $oldid, $u->id
);
if ( $u->err ) {
warn $u->errstr;
LJ::errobj(
"Userpic::RenameKeywords",
origkw => $origkw,
newkw => $newkw
)->throw;
}
# change any redirects pointing to the old mapid to the new mapid
$u->do(
"UPDATE userpicmap3 SET redirect_mapid = ? WHERE redirect_mapid = ? AND userid = ?",
undef, $mapid, $oldid, $u->id
);
if ( $u->err ) {
warn $u->errstr;
LJ::errobj(
"Userpic::RenameKeywords",
origkw => $origkw,
newkw => $newkw
)->throw;
}
# and set the new mapid to point to the picture
$u->do( "UPDATE userpicmap3 SET picid = ? WHERE mapid = ? AND userid = ?",
undef, $self->picid, $mapid, $u->id );
if ( $u->err ) {
warn $u->errstr;
LJ::errobj(
"Userpic::RenameKeywords",
origkw => $origkw,
newkw => $newkw
)->throw;
}
}
else {
if ( $origkw !~ /^\s*pic\#(\d+)\s*$/ ) {
$u->do(
"UPDATE userpicmap3 SET kwid = ? WHERE kwid = ? AND userid = ?",
undef,
$u->get_keyword_id($newkw),
$u->get_keyword_id($origkw), $u->id
);
if ( $u->err ) {
warn $u->errstr;
LJ::errobj(
"Userpic::RenameKeywords",
origkw => $origkw,
newkw => $newkw
)->throw;
}
}
else { # pic#xx
my $picid = $1;
# get (or create) the mapid for picxx
my $mapid_for_picxx = $u->get_mapid_from_keyword($origkw);
$u->do(
"UPDATE userpicmap3 SET kwid = ? WHERE kwid is NULL AND userid = ? AND picid = ?",
undef, $u->get_keyword_id($newkw), $u->id, $picid
);
if ( $u->err ) {
warn $u->errstr;
LJ::errobj(
"Userpic::RenameKeywords",
origkw => $origkw,
newkw => $newkw
)->throw;
}
}
}
}
LJ::Userpic->delete_cache($u);
$u->clear_userpic_kw_map;
}
return 1;
}
sub set_fullurl {
my ( $self, $url ) = @_;
my $u = $self->owner;
$u->do( "UPDATE userpic2 SET url=? WHERE userid=? AND picid=?",
undef, $url, $u->{'userid'}, $self->id );
$self->{url} = $url;
LJ::Userpic->delete_cache($u);
return 1;
}
# Sorts the given list of Userpics.
sub sort {
my ( $class, $userpics ) = @_;
return () unless ( $userpics && ref $userpics );
my %kwhash;
my %nokwhash;
for my $pic (@$userpics) {
my $pickw = $pic->keywords( raw => 1 );
if ( defined $pickw ) {
$kwhash{$pickw} = $pic;
}
else {
$pickw = $pic->keywords;
$nokwhash{$pickw} = $pic;
}
}
my @sortedkw = sort { lc $a cmp lc $b } keys %kwhash;
my @sortednokw = sort { lc $a cmp lc $b } keys %nokwhash;
my @sortedpics;
foreach my $kw (@sortedkw) {
push @sortedpics, $kwhash{$kw};
}
foreach my $kw (@sortednokw) {
push @sortedpics, $nokwhash{$kw};
}
return @sortedpics;
}
# Organizes the given userpics by keyword. Returns an array of hashes,
# with values of keyword and userpic.
sub separate_keywords {
my ( $class, $userpics ) = @_;
return () unless ( $userpics && ref $userpics );
my @userpic_array;
my @nokw_array;
foreach my $userpic (@$userpics) {
my @keywords = $userpic->keywords( raw => 0 );
foreach my $keyword (@keywords) {
if ( defined $keyword ) {
push @userpic_array, { keyword => $keyword, userpic => $userpic };
}
else {
$keyword = $userpic->keywords;
push @nokw_array, { keyword => $keyword, userpic => $userpic };
}
}
}
@userpic_array = sort { lc( $a->{keyword} ) cmp lc( $b->{keyword} ) } @userpic_array;
push @userpic_array, sort { $a->{keyword} cmp $b->{keyword} } @nokw_array;
return @userpic_array;
}
# convert to json
sub TO_JSON {
my $self = shift;
my $remote = LJ::get_remote();
my @keywords = $self->keywords;
my $returnval = {
username => $self->u->user,
picid => int( $self->picid ),
url => $self->url,
comment => $self->comment,
keywords => \@keywords,
};
if ( $remote && $remote eq $self->u ) {
$returnval->{inactive} = $self->inactive;
}
return $returnval;
}
####
# error classes:
package LJ::Error::Userpic::TooManyKeywords;
sub user_caused { 1 }
sub fields { qw(userpic lost); }
sub number_lost {
my $self = $_[0];
return scalar @{ $self->field("lost") };
}
sub lost_keywords_as_html {
my $self = $_[0];
return join( ", ", map { LJ::ehtml($_) } @{ $self->field("lost") } );
}
sub as_html {
my $self = $_[0];
return LJ::Lang::ml(
"error.editicons.toomanykeywords",
{
numwords => $self->number_lost,
words => $self->lost_keywords_as_html,
max => $LJ::MAX_USERPIC_KEYWORDS,
}
);
}
package LJ::Error::Userpic::Bytesize;
sub user_caused { 1 }
sub fields { qw(size max); }
sub as_html {
my $self = $_[0];
return LJ::Lang::ml(
'error.editicons.filetoolarge',
{
maxsize => $self->{'max'},
}
);
}
package LJ::Error::Userpic::Dimensions;
sub user_caused { 1 }
sub fields { qw(w h); }
sub as_html {
my $self = $_[0];
return LJ::Lang::ml(
'error.editicons.imagetoolarge',
{
imagesize => $self->{'w'} . 'x' . $self->{'h'},
}
);
}
package LJ::Error::Userpic::FileType;
sub user_caused { 1 }
sub fields { qw(type); }
sub as_html {
my $self = $_[0];
return LJ::Lang::ml(
"error.editicons.unsupportedtype",
{
filetype => $self->{'type'},
}
);
}
package LJ::Error::Userpic::MismatchRenameKeywords;
sub user_caused { 1 }
sub fields { qw(origkw newkw); }
sub as_html {
my $self = $_[0];
return LJ::Lang::ml(
"error.iconkw.rename.mismatchedlength",
{
origkw => $self->{'origkw'},
newkw => $self->{'newkw'},
}
);
}
package LJ::Error::Userpic::RenameBlankKeywords;
sub user_caused { 1 }
sub fields { qw(origkw newkw); }
sub as_html {
my $self = $_[0];
return LJ::Lang::ml(
"error.iconkw.rename.blankkw",
{
origkw => $self->{'origkw'},
newkw => $self->{'newkw'},
}
);
}
package LJ::Error::Userpic::RenameKeywordExisting;
sub user_caused { 1 }
sub fields { qw(keyword); }
sub as_html {
my $self = $_[0];
return LJ::Lang::ml(
"error.iconkw.rename.keywordexists",
{
keyword => $self->{'keyword'},
}
);
}
package LJ::Error::Userpic::RenameKeywords;
sub user_caused { 0 }
sub fields { qw(origkw newkw); }
sub as_html {
my $self = $_[0];
return LJ::Lang::ml(
"error.iconkw.rename.keywords",
{
origkw => $self->{'origkw'},
newkw => $self->{'newkw'},
}
);
}
package LJ::Error::Userpic::DeleteFailed;
sub user_caused { 0 }
1;