File Manager
body<=
{'user'};
my $u = LJ::get_authas_user($authas);
return LJ::bad_input($ML{'error.invalidauth'})
unless $u;
# KiB vs MiB byte conversions / printing
my %shift = ( MiB => 1 << 20, KiB => 1 << 10 );
my $size = sub {
my $bytes = shift;
# Display in Mb or Kb?
return sprintf("%.2f MiB", $bytes / $shift{MiB}) if $bytes >= $shift{MiB};
return sprintf("%.2f KiB", $bytes / $shift{KiB});
};
# for reporting error
my $err = sub { return "" };
# what type of blob to show
my $showtype = $GET{'showtype'};
# extra arguments for get requests
# how to make links back to this page
my $self_link = sub {
my $page = shift || $GET{'page'};
my $sort = shift || $GET{'sort'};
my $uri = "files.bml?";
$uri .= "authas=$authas&" if $authas ne $remote->{'user'};
$uri .= "showtype=$showtype&" if $showtype;
$uri .= "page=$page&" if $page > 1;
$uri .= "sort=$sort&" if $sort;
chop $uri;
return $uri;
};
# how to make a sort link back to this page,
# given a sort type and name
my $sort_link = sub {
my ($sort, $name) = @_;
return $name unless $sort;
my $type = $GET{'sort'} eq "${sort}_asc"
? "${sort}_desc" : "${sort}_asc";
return "$name";
};
# declare these up here so closures below can use them
my %blobs = (); # { 'blobid' => blob object }, references into @blobs
my @blobs = (); # [ { blob object }, { ... }, ... ]
my ($domain, $domainid); # blob domain/id
my ($dbh, $dbcm);
my %btype = ();
###
### Userpic handler functions
###
$btype{'userpic'} = {
'name' => "Userpics",
# how to sort various columns
'sort' => sub {
my $sort = $GET{'sort'};
my $cmp = sub { $b->{'length'} <=> $a->{'length'} };
# numeric <=> comparison
if ($sort =~ /^(kw_ct|width|height|length)_(asc|desc)$/) {
my ($meth, $dir) = ($1, $2);
if ($dir eq 'desc') {
$cmp = sub { $b->{$meth} <=> $a->{$meth} };
} elsif ($dir eq 'asc') {
$cmp = sub { $a->{$meth} <=> $b->{$meth} };
}
# string 'cmp' comparison
} elsif ($sort =~ /^(picdate|ext)_(asc|desc)$/) {
my ($meth, $dir) = ($1, $2);
if ($dir eq 'desc') {
$cmp = sub { $b->{$meth} cmp $a->{$meth} };
} elsif ($dir eq 'asc') {
$cmp = sub { $a->{$meth} cmp $b->{$meth} };
}
}
return sort $cmp @blobs;
},
# how to fetch userpic objects from the database
'fetch' => sub {
my @ids = map { $_->{'blobid'} } @blobs;
my $bind = join(",", map { "?" } @ids);
my $sth;
if ($u->{'dversion'} > 6) {
my $dbcr = LJ::get_cluster_def_reader($u);
$sth = $dbcr->prepare("SELECT picid, fmt, width, height, " .
"state, picdate FROM userpic2 " .
"WHERE userid=$u->{'userid'} AND picid IN ($bind)");
} else {
$sth = $dbh->prepare("SELECT picid, contenttype, width, height, " .
"state, picdate FROM userpic " .
"WHERE picid IN ($bind)");
}
$sth->execute(@ids);
while (my $row = $sth->fetchrow_hashref) {
my $picid = $row->{'picid'};
$row->{'length'} = $blobs{$picid}->{'length'};
$blobs{$picid} = $row;
}
@blobs = values %blobs;
# add in keywords
my $upicinf = LJ::get_userpic_info($u);
while (my ($k, $v) = each %{$upicinf->{'kw'}}) {
push @{$blobs{$v->{'picid'}}->{'kw'}}, $k;
}
# don't need keyword array though,
# 'kw_str' => comma separated keywords
# 'kw_ct' => count of keywords, for sorting
foreach my $bl (@blobs) {
$bl->{'kw_str'} = join(", ", @{$bl->{'kw'}||[]});
$bl->{'kw_ct'} = scalar(@{$bl->{'kw'}||[]});
delete $bl->{'kw'};
# convert mime type to filetype (ext)
if ($u->{'dversion'} > 6) {
$bl->{'ext'} = {
'G' => 'gif',
'J' => 'jpg',
'P' => 'png',
}->{$bl->{'contenttype'}};
} else {
$bl->{'ext'} = {
'image/gif' => 'gif',
'image/jpeg' => 'jpg',
'image/png' => 'png',
}->{$bl->{'contenttype'}};
}
delete $bl->{'contenttype'};
}
},
# deletes blobs which need to be deleted based on %POST
'delete' => sub {
# find picids to delete
my @del = ();
foreach my $id (map { $_->{'picid'} } @blobs) {
push @del, $id if $POST{"del_${id}"};
}
return 0 unless @del;
# try and delete from either the blob server or database,
my $deleted = 0;
my $bind = join(",", map { "?" } @del);
if ($LJ::USERPIC_BLOBSERVER) {
# delete blobs from blobserver
foreach my $picid (@del) {
LJ::Blob::delete($u, $domain, $blobs{$picid}->{'ext'}, $picid);
}
$deleted = 1;
} elsif ($u->do("DELETE FROM userpicblob2 WHERE ".
"userid=? AND picid IN ($bind)", undef,
$u->{userid}, @del) > 0) {
$deleted = 1;
}
if ($deleted) {
if ($u->{'dversion'} > 6) {
$u->do("DELETE FROM userpic2 WHERE userid=? IN ($bind)",
undef, $u->{'userid'}, @del);
} else {
$dbh->do("DELETE FROM userpic WHERE picid IN ($bind)",
undef, @del);
}
$u->do("DELETE FROM userblob WHERE journalid=? AND domain=? " .
"AND blobid IN ($bind)", undef, $u->{'userid'},
$domain, @del);
# userpics changed, need to reactivate
LJ::activate_userpics($u);
}
return scalar(@del);
},
# renders userpic rows in the table (including column headings)
'render' => sub {
my $ret;
$ret .= "
";
if ($bl->{'security'} && $bl->{'security'} ne 'public') {
$ret .= "";
return $ret;
}
};
# All of this is managed on the FotoBilder side of things, so just give total
# usage info, and a link to where they can manage it.
if (LJ::get_cap($u, 'fb_account')) {
$btype{'fotobilder'} = {
'name' => "Photo Hosting",
'sort' => sub {},
'delete' => sub {},
'fetch' => sub {},
'render' => sub
{
my $ret;
my $pp_bytes = LJ::Blob::get_disk_usage($u, 'fotobilder');
my $pp_display = $size->($pp_bytes);
my $max_size = LJ::get_cap($u, "disk_quota") * $shift{MiB};
my $ret;
$ret .= '
";
$ret .= " $showtype) if $showtype;
$ret .= LJ::make_authas_select($remote, { 'authas' => $GET{'authas'} }) . "\n";
$ret .= "\n\n";
# domain type selector
$ret .= "";
# show quota info
my $used_size = LJ::Blob::get_disk_usage($u);
my $max_size = LJ::get_cap($u, "disk_quota") * $shift{MiB};
if ($max_size) {
$ret .= "";
$ret .= "
You are currently using " . $size->($used_size) . " (";
$ret .= sprintf("%.2f%%", ($used_size / $max_size) * 100);
$ret .= ") of your " . $size->($max_size) . " quota.
";
}
return $ret unless defined $btype{$showtype};
###
### LOAD DATA
###
# now we have a showtype
$domain = $showtype;
$domainid = LJ::get_blob_domainid($domain);
my $bobj = $btype{$showtype};
# get db handle now
$dbh = LJ::get_db_writer();
$dbcm = LJ::get_cluster_master($u);
return $err->($ML{'error.nodb'}) unless $dbh && $dbcm;
# fetch data from userblob
my $sth = $dbcm->prepare("SELECT blobid, length FROM userblob " .
"WHERE journalid=? AND domain=?");
$sth->execute($u->{'userid'}, $domainid);
while (my $row = $sth->fetchrow_hashref) {
push @blobs, $row;
}
# no blobs?
unless (@blobs) {
$ret .= "";
$ret .= "";
return $ret;
}
# generate paging object and make a navbar
my $page_size = 25;
my %items = BML::paging(\@blobs, $GET{'page'}, $page_size);
my $navbar = LJ::paging_bar($items{'page'}, $items{'pages'},
{ 'self_link' => $self_link });
@blobs = @{$items{'items'}};
# get only this page of blobids
$blobs{$_->{'blobid'}} = $_ foreach @blobs;
# call data-getter to fill in the rest of blob data
$bobj->{'fetch'}->();
# sort blobs into specified order
@blobs = $bobj->{'sort'}->();
# if a blob's id is in the blobid list, but we got nothing from the
# database, then we'll remove its entry from userblob because we
# forgot to remove the row in editpics.bml
if ($showtype eq 'userpic') {
my @del;
foreach my $bl (@blobs) {
# see if required 'picdate' column was added in
push @del, $bl->{'blobid'} unless
$bl->{'picdate'};
}
if (@del) {
return $err->($ML{'error.nodb'}) unless $u->writer;
my $bind = join(",", map { "?" } @del);
$u->do("DELETE FROM userblob WHERE journalid=? AND domain=? " .
"AND blobid IN ($bind)", undef, $u->{'userid'}, $domainid, @del);
return BML::redirect($self_link->());
}
}
###
### Perform actions
###
if (LJ::did_post() && $POST{'action:delete'}) {
my $res = $bobj->{'delete'}->();
if ($res) {
# now the database has been modified and deleted, but our current
# memory state isn't accurate, so we'll have to redirect and start
# over before displaying anything below
return BML::redirect($self_link->());
}
}
###
### Generate page
###
# output table
$ret .= $navbar;
$ret .= "";
$ret .= $navbar;
return $ret;
}
_code?>
<=body
head<=
<=head
page?>
{'picid'};
# delete checkbox
$ret .= "
";
return $ret;
}
};
# All of this is managed on the FotoBilder side of things, so just give total
# usage info, and a link to where they can manage it.
if (LJ::get_cap($u, 'fb_account')) {
$btype{'fotobilder'} = {
'name' => "Photo Hosting",
'sort' => sub {},
'delete' => sub {},
'fetch' => sub {},
'render' => sub
{
my $ret;
my $pp_bytes = LJ::Blob::get_disk_usage($u, 'fotobilder');
my $pp_display = $size->($pp_bytes);
my $max_size = LJ::get_cap($u, "disk_quota") * $shift{MiB};
my $ret;
$ret .= '
$showtype) if $showtype;
$ret .= LJ::make_authas_select($remote, { 'authas' => $GET{'authas'} }) . "\n";
$ret .= "\n\n";
# domain type selector
$ret .= "";
# show quota info
my $used_size = LJ::Blob::get_disk_usage($u);
my $max_size = LJ::get_cap($u, "disk_quota") * $shift{MiB};
if ($max_size) {
$ret .= "";
$ret .= "