http://bugs.dwscoalition.org/show_bug.cgi?id=1710
This has syntax errors, wtf.
X-Hg-Repo: dw-free
Subject: dw-free: http://bugs.dwscoalition.org/show_bug.cgi?id=1710
From: mark
changeset e592e3f488fb in /home/hg/repos/dw-free
details: http://hg.dwscoalition.org/dw-free?cmd=changeset;node=e592e3f488fb
description:
http://bugs.dwscoalition.org/show_bug.cgi?id=1710
Revert changeset 4d8bd333d94e for gratuitous syntax errors, it won't
even compile.
Patch by mark.
diffs (807 lines):
diff -r 4d8bd333d94e -r e592e3f488fb bin/upgrading/s2style-wizard-update.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/upgrading/s2style-wizard-update.pl Sun Sep 20 18:51:52 2009 +0000
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+use strict;
+$| = 1;
+
+require "$ENV{'LJHOME'}/cgi-bin/ljlib.pl";
+
+my $sysid = LJ::get_userid("system");
+die "Couldn't find system userid"
+ unless $sysid;
+
+my $dbh = LJ::get_db_writer();
+die "Could not connect to global master"
+ unless $dbh;
+
+
+# find info on styles based on public layouts
+
+# need to select from:
+# s2styles - get style name
+# s2stylelayers - get layout s2lid
+# s2layers - get userid of layer
+# s2info - get redist_uniq
+
+{
+ print "Converting styles based on public layouts...";
+
+ my $sth = $dbh->prepare("SELECT s.styleid, i.value " .
+ "FROM s2styles s, s2stylelayers sl, s2layers l,
s2info i " .
+ "WHERE s.styleid=sl.styleid AND l.s2lid=sl.s2lid
AND i.s2lid=l.s2lid " .
+ "AND l.userid=? AND l.type='layout' AND
s.name='wizard' " .
+ "AND i.infokey='redist_uniq'");
+ $sth->execute($sysid);
+ my $ct = 0;
+ while (my ($styleid, $redist_uniq) = $sth->fetchrow_array) {
+
+ my $layout = (split("/", $redist_uniq))[0];
+ $dbh->do("UPDATE s2styles SET name=? WHERE styleid=?",
+ undef, "wizard-$layout", $styleid);
+ $ct++;
+ print "." if $ct % 1000 == 0;
+ }
+
+ print " $ct done.\n";
+}
+
+
+# find info on styles based on user layouts
+
+# need to select from:
+# s2styles - get style name
+# s2stylelayers - get layout s2lid
+# s2layers - get userid of layer
+
+{
+ print "Converting styles based on user layouts...";
+
+ my $sth = $dbh->prepare("SELECT s.styleid, l.s2lid " .
+ "FROM s2styles s, s2stylelayers sl, s2layers l " .
+ "WHERE s.styleid=sl.styleid AND l.s2lid=sl.s2lid "
.
+ "AND l.userid<>? AND l.type='layout' AND
s.name='wizard'");
+ $sth->execute($sysid);
+ my $ct = 0;
+ while (my ($styleid, $s2lid) = $sth->fetchrow_array) {
+
+ $dbh->do("UPDATE s2styles SET name=? WHERE styleid=?",
+ undef, "wizard-$s2lid", $styleid);
+ $ct++;
+ print "." if $ct % 1000 == 0;
+ }
+
+ print " $ct done.\n";
+}
diff -r 4d8bd333d94e -r e592e3f488fb bin/upgrading/update-db-general.pl
--- a/bin/upgrading/update-db-general.pl Sun Sep 20 09:15:19 2009 +0000
+++ b/bin/upgrading/update-db-general.pl Sun Sep 20 18:51:52 2009 +0000
@@ -890,8 +890,6 @@ register_tabledrop("portal_typemap");
register_tabledrop("portal_typemap");
register_tabledrop("memkeyword");
register_tabledrop("memorable");
-register_tabledrop("s2source");
-register_tabledrop("s2stylelayers");
register_tablecreate("infohistory", <<'EOC');
CREATE TABLE infohistory (
@@ -1047,6 +1045,16 @@ CREATE TABLE s2info (
)
EOC
+# TODO: Move anything left here to s2source_inno for sites migrating from LJ
+# to DW, then nuke table. New sites should have nothing here.
+register_tablecreate("s2source", <<'EOC'); # global
+CREATE TABLE s2source (
+ s2lid INT UNSIGNED NOT NULL,
+ PRIMARY KEY (s2lid),
+ s2code MEDIUMBLOB
+)
+EOC
+
register_tablecreate("s2source_inno", <<'EOC'); # global
CREATE TABLE s2source_inno (
s2lid INT UNSIGNED NOT NULL,
@@ -1096,6 +1104,15 @@ CREATE TABLE s2styles (
modtime INT UNSIGNED NOT NULL,
INDEX (userid)
+)
+EOC
+
+register_tablecreate("s2stylelayers", <<'EOC'); # global
+CREATE TABLE s2stylelayers (
+ styleid INT UNSIGNED NOT NULL,
+ type ENUM('core','i18nc','layout','theme','i18n','user') NOT NULL,
+ UNIQUE (styleid, type),
+ s2lid INT UNSIGNED NOT NULL
)
EOC
@@ -3222,6 +3239,15 @@ register_alter(sub {
set_dbnote("privcode_all_to_*", 1);
}
+ # convert 'wizard' s2 styles to 'wizard-uniq'
+ if (table_relevant("s2styles") && !check_dbnote("s2style-wizard-update")) {
+
+ # set_dbnote will return true if $opt_sql is set and it sets
+ # the note successfully. only then do we run the wizard updater
+ set_dbnote("s2style-wizard-update", 1) &&
+ system("$ENV{'LJHOME'}/bin/upgrading/s2style-wizard-update.pl");
+ }
+
# this never ended up being useful, and just freaked people out
unnecessarily.
if (column_type("user", "track")) {
do_alter("user", "ALTER TABLE user DROP track");
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/DW/BusinessRules.pm
--- a/cgi-bin/DW/BusinessRules.pm Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/DW/BusinessRules.pm Sun Sep 20 18:51:52 2009 +0000
@@ -19,7 +19,8 @@ use strict;
use strict;
use warnings;
use Carp ();
-use lib "$LJ::HOME/cgi-bin";
+use DW;
+use LJ::ModuleLoader;
=head1 NAME
@@ -91,7 +92,7 @@ sub install_overrides {
my $pkgpath = $callpkg;
$pkgpath =~ s!::!/!g;
- return unless -d "$LJ::HOME/cgi-bin/$pkgpath";
+ return unless -d DW->home . "/cgi-bin/$pkgpath";
my %seen;
foreach my $dpkg ( LJ::ModuleLoader->module_subclasses( $callpkg ) ) {
diff -r 4d8bd333d94e -r e592e3f488fb
cgi-bin/DW/BusinessRules/InviteCodeRequests.pm
--- a/cgi-bin/DW/BusinessRules/InviteCodeRequests.pm Sun Sep 20 09:15:19
2009 +0000
+++ b/cgi-bin/DW/BusinessRules/InviteCodeRequests.pm Sun Sep 20 18:51:52
2009 +0000
@@ -18,7 +18,6 @@ package DW::BusinessRules::InviteCodeReq
package DW::BusinessRules::InviteCodeRequests;
use strict;
use warnings;
-use lib "$LJ::HOME/cgi-bin";
use base 'DW::BusinessRules';
=head1 NAME
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/DW/BusinessRules/InviteCodes.pm
--- a/cgi-bin/DW/BusinessRules/InviteCodes.pm Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/DW/BusinessRules/InviteCodes.pm Sun Sep 20 18:51:52 2009 +0000
@@ -20,7 +20,6 @@ use warnings;
use warnings;
use Carp ();
use List::Util ();
-use lib "$LJ::HOME/cgi-bin";
use base 'DW::BusinessRules';
use LJ::Lang;
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/DW/Worker/DistributeInvites.pm
--- a/cgi-bin/DW/Worker/DistributeInvites.pm Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/DW/Worker/DistributeInvites.pm Sun Sep 20 18:51:52 2009 +0000
@@ -18,7 +18,6 @@
use strict;
use warnings;
-use lib "$LJ::HOME/cgi-bin";
package DW::Worker::DistributeInvites;
use base 'TheSchwartz::Worker';
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/DW/Worker/XPostWorker.pm
--- a/cgi-bin/DW/Worker/XPostWorker.pm Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/DW/Worker/XPostWorker.pm Sun Sep 20 18:51:52 2009 +0000
@@ -20,7 +20,6 @@
use strict;
use warnings;
-use lib "$LJ::HOME/cgi-bin";
package DW::Worker::XPostWorker;
use base 'TheSchwartz::Worker';
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/LJ/Blob.pm
--- a/cgi-bin/LJ/Blob.pm Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/LJ/Blob.pm Sun Sep 20 18:51:52 2009 +0000
@@ -2,7 +2,6 @@
package LJ::Blob;
use strict;
-use lib "$LJ::HOME/cgi-bin";
use BlobClient;
use BlobClient::Local;
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/LJ/NotificationMethod/DebugLog.pm
--- a/cgi-bin/LJ/NotificationMethod/DebugLog.pm Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/LJ/NotificationMethod/DebugLog.pm Sun Sep 20 18:51:52 2009 +0000
@@ -3,7 +3,6 @@ use strict;
use strict;
use Carp qw/ croak /;
use base 'LJ::NotificationMethod';
-use lib "$LJ::HOME/cgi-bin";
require "weblib.pl";
sub can_digest { 1 };
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/LJ/NotificationMethod/Email.pm
--- a/cgi-bin/LJ/NotificationMethod/Email.pm Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/LJ/NotificationMethod/Email.pm Sun Sep 20 18:51:52 2009 +0000
@@ -4,7 +4,6 @@ use Carp qw/ croak /;
use Carp qw/ croak /;
use base 'LJ::NotificationMethod';
-use lib "$LJ::HOME/cgi-bin";
require "weblib.pl";
sub can_digest { 1 };
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/LJ/S2.pm
--- a/cgi-bin/LJ/S2.pm Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/LJ/S2.pm Sun Sep 20 18:51:52 2009 +0000
@@ -4,7 +4,8 @@ package LJ::S2;
package LJ::S2;
use strict;
-use lib "$LJ::HOME/src/s2";
+use DW;
+use lib DW->home . "/src/s2";
use S2;
use S2::Color;
use S2::Checker;
@@ -867,15 +868,59 @@ sub cleanup_layers {
S2::unregister_layer($_) foreach grep { ! $pub->{$_} } @unload;
}
+sub clone_layer
+{
+ die "LJ::S2::clone_layer() has not been ported to use s2compiled2, but
this function is not currently in use anywhere; if you use this function,
please update it to use s2compiled2.\n";
+
+ my $id = shift;
+ return 0 unless $id;
+
+ my $dbh = LJ::get_db_writer();
+ my $r;
+
+ $r = $dbh->selectrow_hashref("SELECT * FROM s2layers WHERE s2lid=?",
undef, $id);
+ return 0 unless $r;
+ $dbh->do("INSERT INTO s2layers (b2lid, userid, type) VALUES (?,?,?)",
+ undef, $r->{'b2lid'}, $r->{'userid'}, $r->{'type'});
+ my $newid = $dbh->{'mysql_insertid'};
+ return 0 unless $newid;
+
+ foreach my $t (qw(s2compiled s2info s2source)) {
+ if ($t eq "s2source") {
+ $r = LJ::S2::load_layer_source_row($id);
+ } else {
+ $r = $dbh->selectrow_hashref("SELECT * FROM $t WHERE s2lid=?",
undef, $id);
+ }
+ next unless $r;
+ $r->{'s2lid'} = $newid;
+
+ # kinda hacky: we have to update the layer id
+ if ($t eq "s2compiled") {
+ $r->{'compdata'} =~ s/\$_LID = (\d+)/\$_LID = $newid/;
+ }
+
+ $dbh->do("INSERT INTO $t (" . join(',', keys %$r) . ") VALUES (".
+ join(',', map { $dbh->quote($_) } values %$r) . ")");
+ }
+
+ return $newid;
+}
+
sub create_style
{
- my ( $u, $name ) = @_;
+ my ($u, $name, $cloneid) = @_;
my $dbh = LJ::get_db_writer();
return 0 unless $dbh && $u->writer;
my $uid = $u->{userid} + 0
or return 0;
+
+ my $clone;
+ $clone = load_style($cloneid) if $cloneid;
+
+ # can't clone somebody else's style
+ return 0 if $clone && $clone->{'userid'} != $uid;
# can't create name-less style
return 0 unless $name =~ /\S/;
@@ -884,6 +929,20 @@ sub create_style
undef, $u->{'userid'}, $name);
my $styleid = $dbh->{'mysql_insertid'};
return 0 unless $styleid;
+
+ if ($clone) {
+ $clone->{'layer'}->{'user'} =
+ LJ::clone_layer($clone->{'layer'}->{'user'});
+
+ my $values;
+ foreach my $ly ('core','i18nc','layout','theme','i18n','user') {
+ next unless $clone->{'layer'}->{$ly};
+ $values .= "," if $values;
+ $values .= "($uid, $styleid, '$ly', $clone->{'layer'}->{$ly})";
+ }
+ $u->do("REPLACE INTO s2stylelayers2 (userid, styleid, type, s2lid) ".
+ "VALUES $values") if $values;
+ }
return $styleid;
}
@@ -927,7 +986,9 @@ sub delete_user_style
my $dbh = LJ::get_db_writer();
return 0 unless $dbh && $u->writer;
- $dbh->do("DELETE FROM s2styles WHERE styleid=?", undef, $styleid)
+ foreach my $t (qw(s2styles s2stylelayers)) {
+ $dbh->do("DELETE FROM $t WHERE styleid=?", undef, $styleid)
+ }
$u->do("DELETE FROM s2stylelayers2 WHERE userid=? AND styleid=?", undef,
$u->{userid}, $styleid);
@@ -999,7 +1060,7 @@ sub create_layer
}
# takes optional $u as first argument... if user argument is specified, will
-# look through s2stylelayers2 and delete all mappings that this user has to
+# look through s2stylelayers and delete all mappings that this user has to
# this particular layer.
sub delete_layer
{
@@ -1034,6 +1095,9 @@ sub delete_layer
# map in the ids we got from the user's styles and clear layers
referencing
# this particular layer id
my $in = join(',', map { $_ + 0 } @ids);
+ $dbh->do("DELETE FROM s2stylelayers WHERE styleid IN ($in) AND
s2lid = ?",
+ undef, $lid);
+
$u->do("DELETE FROM s2stylelayers2 WHERE userid=? AND styleid IN
($in) AND s2lid = ?",
undef, $u->{userid}, $lid);
@@ -1086,8 +1150,14 @@ sub get_style_layers
return 1;
};
- $fetch->( $u, "SELECT type, s2lid FROM s2stylelayers2 " .
- "WHERE userid=? AND styleid=?", $u->userid, $styleid );
+ unless ($fetch->($u, "SELECT type, s2lid FROM s2stylelayers2 " .
+ "WHERE userid=? AND styleid=?", $u->{userid}, $styleid)) {
+ my $dbh = LJ::get_db_writer();
+ if ($fetch->($dbh, "SELECT type, s2lid FROM s2stylelayers WHERE
styleid=?",
+ $styleid)) {
+ LJ::S2::set_style_layers_raw($u, $styleid, %stylay);
+ }
+ }
# set in memcache
LJ::MemCache::set($memkey, \%stylay);
@@ -1095,7 +1165,43 @@ sub get_style_layers
return \%stylay;
}
+# the old interfaces. handles merging with global database data if necessary.
sub set_style_layers
+{
+ my ($u, $styleid, %newlay) = @_;
+ my $dbh = LJ::get_db_writer();
+ return 0 unless $dbh && $u->writer;
+
+ my @lay = ('core','i18nc','layout','theme','i18n','user');
+ my %need = map { $_, 1 } @lay;
+ delete $need{$_} foreach keys %newlay;
+ if (%need) {
+ # see if the needed layers are already on the user cluster
+ my ($sth, $t, $lid);
+
+ $sth = $u->prepare("SELECT type FROM s2stylelayers2 WHERE userid=? AND
styleid=?");
+ $sth->execute($u->{'userid'}, $styleid);
+ while (($t) = $sth->fetchrow_array) {
+ delete $need{$t};
+ }
+
+ # if we still don't have everything, see if they exist on the
+ # global cluster, and we'll merge them into the %newlay being
+ # posted, so they end up on the user cluster
+ if (%need) {
+ $sth = $dbh->prepare("SELECT type, s2lid FROM s2stylelayers WHERE
styleid=?");
+ $sth->execute($styleid);
+ while (($t, $lid) = $sth->fetchrow_array) {
+ $newlay{$t} = $lid;
+ }
+ }
+ }
+
+ set_style_layers_raw($u, $styleid, %newlay);
+}
+
+# just set in user cluster, not merging with global
+sub set_style_layers_raw {
my ($u, $styleid, %newlay) = @_;
my $dbh = LJ::get_db_writer();
return 0 unless $dbh && $u->writer;
@@ -1404,17 +1510,37 @@ sub load_layer_source
sub load_layer_source
{
my $s2lid = shift;
- my $dbh = LJ::get_db_writer();
-
- return $dbh->selectrow_array( "SELECT s2code FROM s2source_inno WHERE
s2lid=?", undef, $s2lid );
+
+ # s2source is the old global MyISAM table that contains s2 layer sources
+ # s2source_inno is new global InnoDB table that contains new layer sources
+ # -- lazy migration is done whenever an insert/delete happens
+
+ my $dbh = LJ::get_db_writer();
+
+ # first try InnoDB table
+ my $s2source = $dbh->selectrow_array("SELECT s2code FROM s2source_inno
WHERE s2lid=?", undef, $s2lid);
+ return $s2source if $s2source;
+
+ # fall back to MyISAM
+ return $dbh->selectrow_array("SELECT s2code FROM s2source WHERE s2lid=?",
undef, $s2lid);
}
sub load_layer_source_row
{
my $s2lid = shift;
- my $dbh = LJ::get_db_writer();
-
- return $dbh->selectrow_hashref( "SELECT * FROM s2source_inno WHERE
s2lid=?", undef, $s2lid );
+
+ # s2source is the old global MyISAM table that contains s2 layer sources
+ # s2source_inno is new global InnoDB table that contains new layer sources
+ # -- lazy migration is done whenever an insert/delete happens
+
+ my $dbh = LJ::get_db_writer();
+
+ # first try InnoDB table
+ my $s2source = $dbh->selectrow_hashref("SELECT * FROM s2source_inno WHERE
s2lid=?", undef, $s2lid);
+ return $s2source if $s2source;
+
+ # fall back to MyISAM
+ return $dbh->selectrow_hashref("SELECT * FROM s2source WHERE s2lid=?",
undef, $s2lid);
}
sub get_layout_langs
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/LJ/User.pm
--- a/cgi-bin/LJ/User.pm Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/LJ/User.pm Sun Sep 20 18:51:52 2009 +0000
@@ -4624,6 +4624,57 @@ sub can_add_tags_to {
}
+# <LJFUNC>
+# name: LJ::User::get_keyword_id
+# class:
+# des: Get the id for a keyword.
+# args: uuid, keyword, autovivify?
+# des-uuid: User object or userid to use.
+# des-keyword: A string keyword to get the id of.
+# returns: Returns a kwid into [dbtable[userkeywords]].
+# If the keyword doesn't exist, it is automatically created for you.
+# des-autovivify: If present and 1, automatically create keyword.
+# If present and 0, do not automatically create the keyword.
+# If not present, default behavior is the old
+# style -- yes, do automatically create the keyword.
+# </LJFUNC>
+sub get_keyword_id
+{
+ my ( $u, $kw, $autovivify ) = @_;
+ $u = LJ::want_user( $u );
+ return undef unless $u;
+ $autovivify = 1 unless defined $autovivify;
+
+ # setup the keyword for use
+ return 0 unless $kw =~ /\S/;
+ $kw = LJ::text_trim( $kw, LJ::BMAX_KEYWORD, LJ::CMAX_KEYWORD );
+
+ # get the keyword and insert it if necessary
+ my $kwid = $u->selectrow_array( 'SELECT kwid FROM userkeywords WHERE
userid = ? AND keyword = ?',
+ undef, $u->userid, $kw ) + 0;
+ if ( $autovivify && ! $kwid ) {
+ # create a new keyword
+ $kwid = LJ::alloc_user_counter( $u, 'K' );
+ return undef unless $kwid;
+
+ # attempt to insert the keyword
+ my $rv = $u->do( "INSERT IGNORE INTO userkeywords (userid, kwid,
keyword) VALUES (?, ?, ?)",
+ undef, $u->userid, $kwid, $kw ) + 0;
+ return undef if $u->err;
+
+ # at this point, if $rv is 0, the keyword is already there so try again
+ unless ( $rv ) {
+ $kwid = $u->selectrow_array( 'SELECT kwid FROM userkeywords WHERE
userid = ? AND keyword = ?',
+ undef, $u->userid, $kw ) + 0;
+ }
+
+ # nuke cache
+ $u->memc_delete( 'kws' );
+ }
+ return $kwid;
+}
+
+
sub tags {
my $u = shift;
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/LJ/Userpic.pm
--- a/cgi-bin/LJ/Userpic.pm Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/LJ/Userpic.pm Sun Sep 20 18:51:52 2009 +0000
@@ -879,7 +879,7 @@ sub set_keywords {
my $picid = $self->{picid};
foreach my $kw (@keywords) {
- my $kwid = LJ::get_keyword_id( $u, $kw );
+ my $kwid = $u->get_keyword_id( $kw );
next unless $kwid; # TODO: fire some warning that keyword was bogus
if (++$c > $LJ::MAX_USERPIC_KEYWORDS) {
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/ljlib.pl
--- a/cgi-bin/ljlib.pl Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/ljlib.pl Sun Sep 20 18:51:52 2009 +0000
@@ -1501,66 +1501,6 @@ sub cmd_buffer_add
}
-# <LJFUNC>
-# name: LJ::get_keyword_id
-# class:
-# des: Get the id for a keyword.
-# args: uuid?, keyword, autovivify?
-# des-uuid: User object or userid to use.
-# des-keyword: A string keyword to get the id of.
-# returns: Returns a kwid into [dbtable[userkeywords]].
-# If the keyword doesn't exist, it is automatically created for you.
-# des-autovivify: If present and 1, automatically create keyword.
-# If present and 0, do not automatically create the keyword.
-# If not present, default behavior is the old
-# style -- yes, do automatically create the keyword.
-# </LJFUNC>
-sub get_keyword_id
-{
- &nodb;
-
- # see if we got a user? if so we use userkeywords on a cluster
- my $u;
- if (@_ >= 2) {
- $u = LJ::want_user(shift);
- return undef unless $u;
- }
-
- my ($kw, $autovivify) = @_;
- $autovivify = 1 unless defined $autovivify;
-
- # setup the keyword for use
- unless ($kw =~ /\S/) { return 0; }
- $kw = LJ::text_trim($kw, LJ::BMAX_KEYWORD, LJ::CMAX_KEYWORD);
-
- # get the keyword and insert it if necessary
- my $kwid;
- if ( $u ) {
- $kwid = $u->selectrow_array('SELECT kwid FROM userkeywords WHERE
userid = ? AND keyword = ?',
- undef, $u->{userid}, $kw) + 0;
- if ($autovivify && ! $kwid) {
- # create a new keyword
- $kwid = LJ::alloc_user_counter($u, 'K');
- return undef unless $kwid;
-
- # attempt to insert the keyword
- my $rv = $u->do("INSERT IGNORE INTO userkeywords (userid, kwid,
keyword) VALUES (?, ?, ?)",
- undef, $u->{userid}, $kwid, $kw) + 0;
- return undef if $u->err;
-
- # at this point, if $rv is 0, the keyword is already there so try
again
- unless ($rv) {
- $kwid = $u->selectrow_array('SELECT kwid FROM userkeywords
WHERE userid = ? AND keyword = ?',
- undef, $u->{userid}, $kw) + 0;
- }
-
- # nuke cache
- LJ::MemCache::delete([ $u->{userid}, "kws:$u->{userid}" ]);
- }
- }
- return $kwid;
-}
-
sub get_interest {
my $intid = shift
or return undef;
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/ljmemories.pl
--- a/cgi-bin/ljmemories.pl Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/ljmemories.pl Sun Sep 20 18:51:52 2009 +0000
@@ -56,7 +56,7 @@ sub create {
$journalid += 0;
$ditemid += 0;
$security ||= 'public';
- $kwids ||= [ LJ::get_keyword_id($u, '*') ]; # * means no category
+ $kwids ||= [ $u->get_keyword_id( '*' ) ]; # * means no category
$des = LJ::trim($des);
return undef unless $userid && $journalid && $ditemid && $des && $security
&& @$kwids;
return undef unless $security =~ /^(?:public|friends|private)$/;
diff -r 4d8bd333d94e -r e592e3f488fb cgi-bin/taglib.pl
--- a/cgi-bin/taglib.pl Sun Sep 20 09:15:19 2009 +0000
+++ b/cgi-bin/taglib.pl Sun Sep 20 18:51:52 2009 +0000
@@ -730,7 +730,7 @@ sub update_logtags {
# and turn everything into ids
$opts->{"${verb}_ids"} ||= [];
foreach my $kw (@{$opts->{$verb} || []}) {
- my $kwid = LJ::get_keyword_id($u, $kw, $can_control);
+ my $kwid = $u->get_keyword_id( $kw, $can_control );
if ($can_control) {
# error if we failed to create
return undef unless $kwid;
@@ -1065,7 +1065,7 @@ sub create_usertag {
my %res;
foreach my $tag (@$tags) {
- my $kwid = LJ::get_keyword_id($u, $tag);
+ my $kwid = $u->get_keyword_id( $tag );
return undef unless $kwid;
$res{$tag} = $kwid;
@@ -1125,7 +1125,7 @@ sub delete_usertag {
my $tag = LJ::Tags::validate_tag($val);
return undef unless $tag;
- $kwid = LJ::get_keyword_id($u, $tag, 0);
+ $kwid = $u->get_keyword_id( $tag, 0 );
} elsif ($type eq 'id') {
$kwid = $val + 0;
}
@@ -1213,14 +1213,14 @@ sub rename_usertag {
my $val = LJ::Tags::validate_tag($oldkw);
return $err->( LJ::Lang::ml( 'taglib.error.invalid', { tagname =>
LJ::ehtml( $oldkw ) } ) )
unless $val;
- $kwid = LJ::get_keyword_id($u, $val, 0);
+ $kwid = $u->get_keyword_id( $val, 0 );
} elsif ($type eq 'id') {
$kwid = $oldkw + 0;
}
return $err->() unless $kwid;
# see if this is already a keyword
- my $newkwid = LJ::get_keyword_id($u, $newname);
+ my $newkwid = $u->get_keyword_id( $newname );
return undef unless $newkwid;
# see if the tag we're renaming TO already exists as a keyword,
@@ -1293,7 +1293,7 @@ sub set_usertag_display {
return undef unless $var;
# do not auto-vivify but get the keyword id
- $kwid = LJ::get_keyword_id($u, $var, 0);
+ $kwid = $u->get_keyword_id( $var, 0 );
}
return undef unless $kwid;
diff -r 4d8bd333d94e -r e592e3f488fb htdocs/tools/memadd.bml
--- a/htdocs/tools/memadd.bml Sun Sep 20 09:15:19 2009 +0000
+++ b/htdocs/tools/memadd.bml Sun Sep 20 18:51:52 2009 +0000
@@ -313,7 +313,7 @@
return;
}
- my $kwid = LJ::get_keyword_id($memoryu, $kw);
+ my $kwid = $memoryu->get_keyword_id( $kw );
$needflush = 1 unless defined $exist_kw->{$kwid};
push @kwid, $kwid;
}
diff -r 4d8bd333d94e -r e592e3f488fb t/00-compile.t
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/t/00-compile.t Sun Sep 20 18:51:52 2009 +0000
@@ -0,0 +1,113 @@
+#!/usrb/bin/perl -w
+use strict;
+use Test::Most;
+use File::Temp;
+use File::Find::Rule;
+use File::Basename qw(dirname);
+use File::Spec;
+
+my $dir = File::Temp::tempdir( CLEANUP => 1 );
+
+# FIXME: fix the modules that are now skipped
+# some of the modules and scripts cannot yet cleanly loaded
+# instead of waiting them to be fixed we are skipping them for now
+# They should be fixed or makred why they cannot run.
+my %SKIP = (
+ 'LJ/PersistentQueue.pm' => 'bug 1787 needs Data::Queue::Persistent',
+ 'LJ/LDAP.pm' => 'bug 1788 needs Net::LDAP',
+ 'LJ/ConfCheck/General.pm' => 'needs to be integrated into LJ::ConfCheck',
+ 'LJ/S2/EntryPage.pm' => 'definition of S2::PROPS is missing (found in
src/s2/S2.pm)',
+ 'LJ/Widget/CreateAccountProfile.pm' => 'Bareword "LJ::BMAX_NAME"',
+ 'LJ/Widget/IPPU/SettingProd.pm' => 'Bareword "LJ::get_remote"',
+ 'DW/User/Edges/CommMembership.pm' => 'Undefined subroutine
&DW::User::Edges::define_edge',
+ 'DW/User/Edges/WatchTrust.pm' => 'Bareword "LJ::BMAX_GRPNAME2"',
+ 'DW/User/Edges.pm' => 'Bareword "LJ::BMAX_GRPNAME2"',
+ 'DW/External/XPostProtocol/LJXMLRPC.pm' => 'Cant locate object method
"new" via package "DW::External::XPostProtocol::LJXMLRPC"',
+
+ 'DW/Hooks/NavStrip.pm' => 'Undefined subroutine &LJ::register_hook',
+ 'DW/Hooks/SiteScheme.pm' => 'Undefined subroutine &LJ::register_hook',
+ 'LJ/Hooks/PingBack.pm' => 'Undefined subroutine &LJ::register_hook',
+ 'DW/Hooks/SSL.pm' => 'Undefined subroutine &LJ::register_hook',
+ 'DW/Hooks/Display.pm' => 'Undefined subroutine &LJ::register_hook',
+ 'DW/Hooks/Changelog.pm' => 'Undefined subroutine &LJ::register_hook',
+ 'DW/Hooks/EntryForm.pm' => 'Undefined subroutine &LJ::register_hook',
+
+ 'LJ/Test/AtomAPI.pm' => 'needs Apache/Constants',
+ 'Test/FakeApache.pm' => 'needs Apache/Constants.pm',
+ 'Apache/CompressClientFixup.pm' => 'needs Apache/Constants.pm',
+
+ 'Data/ObjectDriver/Driver/DBD/SQLite.pm' => 'Bareword "DBI::SQL_BLOB"',
+ 'Data/ObjectDriver/Driver/DBD/Oracle.pm' => 'no Oracle',
+
+ 'cgi-bin/dw-nonfree.pl' => 'Undefined subroutine &LJ::register_hook',
+ 'cgi-bin/ljdefaults.pl' => 'Cant return outside a subroutine at
cgi-bin/ljdefaults.pl',
+ 'cgi-bin/modperl.pl' => 'Cant locate object method "server" via package
"Apache2::ServerUtil"',
+ 'cgi-bin/lj-bml-init.pl' => 'Undefined subroutine &BML::register_isocode',
+ 'cgi-bin/ljlib-local.pl' => 'Undefined subroutine &LJ::register_hook',
+ 'cgi-bin/lj-bml-blocks.pl' => 'Undefined subroutine &BML::register_block',
+ 'cgi-bin/ljuserpics.pl' => 'croak is not imported',
+);
+
+my @scripts = File::Find::Rule->file->name('*.pl')->in('cgi-bin');
+my @modules = File::Find::Rule->relative->file->name('*.pm')->in('cgi-bin');
+
+
+plan tests => 2 * @scripts + 2 * @modules;
+bail_on_fail;
+
+#diag explain \...@scripts;
+#diag explain \...@modules;
+
+my $out = "$dir/out";
+my $err = "$dir/err";
+my $lib = File::Spec->catdir(dirname(dirname($0)), 'cgi-bin');
+
+foreach my $file (@modules) {
+ my $module = substr $file, 0, -3;
+ $module =~ s{/}{::}g;
+
+ if ($SKIP{$file}) {
+ Test::More->builder->skip($SKIP{$file}) for 1..2;
+ next;
+ }
+
+ system qq($^X -I$lib -e "require $module; print 'ok';" > $out 2>$err);
+ my $err_data = slurp($err);
+ is($err_data, '', "STDERR of $file");
+
+ my $out_data = slurp($out);
+ is($out_data, 'ok', "STDOUT of $file");
+}
+
+foreach my $file (@scripts) {
+ if ($SKIP{$file}) {
+ Test::More->builder->skip($SKIP{$file}) for 1..2;
+ next;
+ }
+
+ system qq($^X -I$lib $file > $out 2>$err);
+ my $err_data = slurp($err);
+ is($err_data, '', "STDERR of $file");
+
+ my $out_data = slurp($out);
+ is($out_data, '', "STDOUT of $file");
+}
+
+# Bail out if any of the tests failed
+BAIL_OUT("Aborting test suite") if scalar
+ grep { not $_->{ok} } Test::More->builder->details;
+
+
+
+
+
+######################################################################
+# Support Functions
+
+sub slurp {
+ my $file = shift;
+ open my $fh, '<', $file or die $!;
+ local $/ = undef;
+ return <$fh>;
+}
+
_______________________________________________
dw-changelog mailing list
[email protected]
http://lists.dwscoalition.org/mailman/listinfo/dw-changelog
