Joule

Merge lp://qastaging/~marnanel/joule/statussnap into lp://qastaging/joule

  1. statussnap
  2. Merge into joule-3-0-1
Proposed by Marnanel Thurman
Status: Merged
Merged at revision: not available
Proposed branch: lp://qastaging/~marnanel/joule/statussnap
Merge into: lp://qastaging/joule
Diff against target: None lines
To merge this branch: bzr merge lp://qastaging/~marnanel/joule/statussnap
Reviewer Review Type Date Requested Status
Marnanel Thurman Approve
Review via email: mp+5915@code.qastaging.launchpad.net
To post a comment you must log in.
Revision history for this message
Marnanel Thurman (marnanel) wrote :

Completed.

Revision history for this message
Marnanel Thurman (marnanel) wrote :

approving my own review :)

review: Approve

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
=== modified file 'lib/Joule/History.pm'
--- lib/Joule/History.pm 2009-04-21 01:52:56 +0000
+++ lib/Joule/History.pm 2009-04-27 04:10:26 +0000
@@ -1,5 +1,5 @@
1# Joule - track changes in an online list over time1# Joule - track changes in an online list over time
2# Copyright (C) 2002-2008 Thomas Thurman2# Copyright (C) 2002-2009 Thomas Thurman
3#3#
4# This program is free software: you can redistribute it and/or modify4# This program is free software: you can redistribute it and/or modify
5# it under the terms of the GNU Affero General Public License as5# it under the terms of the GNU Affero General Public License as
@@ -49,6 +49,14 @@
49 return map { $_->[0] } @{ $sth->fetchall_arrayref() };49 return map { $_->[0] } @{ $sth->fetchall_arrayref() };
50}50}
5151
52sub _add_snapshot_row {
53 my ($self, $snap, $name) = @_;
54 my $sth = $self->{dbh}->prepare('INSERT INTO snapshot (snap, name) VALUES (?,?)');
55 $sth->execute($snap, $name);
56 open TEST, ">/tmp/j-$snap-$name";
57 close TEST;
58}
59
52sub content {60sub content {
53 my ($self, $opts) = @_;61 my ($self, $opts) = @_;
5462
@@ -61,67 +69,87 @@
61 my $done_today = $self->{dbh}->prepare("SELECT COUNT(datestamp) FROM checking WHERE userid=? AND datestamp=CURRENT_DATE LIMIT 1");69 my $done_today = $self->{dbh}->prepare("SELECT COUNT(datestamp) FROM checking WHERE userid=? AND datestamp=CURRENT_DATE LIMIT 1");
62 $done_today->execute($self->{userid});70 $done_today->execute($self->{userid});
6371
64 if ($done_today->fetchrow()) {72 my $sth;
6573
66 if ($opts->{virgin}) {74 unless ($done_today->fetchrow()) {
67 $opts->{current_names} = [ $self->{'status'}->names() ];75
68 return ();
69 }
70
71 } else {
72 # it hasn't been done today76 # it hasn't been done today
7377
74 $self->{dbh}->begin_work();78 $self->{dbh}->begin_work();
7579
76 my @newfetch = $self->{'status'}->names();80 $sth = $self->{dbh}->prepare("SELECT nextval('snapid'), current_date");
7781 $sth->execute();
78 $opts->{lonely} = 1 unless @newfetch;82 my ($snap, $today) = $sth->fetchrow_array();
83 my $name_count = 0;
84
85 $self->{'status'}->names(sub {
86 $name_count++;
87 $self->_add_snapshot_row($snap, shift);
88 });
89
90 $opts->{lonely} = 1 unless $name_count;
79 return () if $opts->{lonely} and $opts->{virgin}; # because we don't know for sure it exists at all91 return () if $opts->{lonely} and $opts->{virgin}; # because we don't know for sure it exists at all
8092
81 my $sth = $self->{dbh}->prepare("SELECT COUNT(*) FROM account WHERE userid=?");93 $sth = $self->{dbh}->prepare("SELECT COUNT(*) FROM account WHERE userid=? LIMIT 1");
82 $sth->execute($self->{userid});94 $sth->execute($self->{userid});
83 unless ($sth->fetchrow()) {95 unless ($sth->fetchrow()) {
84 $sth = $self->{dbh}->prepare("INSERT INTO account VALUES (?)");96 $sth = $self->{dbh}->prepare("INSERT INTO account VALUES (?)");
85 $sth->execute($self->{userid});97 $sth->execute($self->{userid});
86 }98 }
8799
88 my $adder = $self->{dbh}->prepare("INSERT INTO checking(userid, datestamp) VALUES (?, CURRENT_DATE)");100 my $adder = $self->{dbh}->prepare("INSERT INTO checking(userid, datestamp) VALUES (?, CURRENT_DATE)");
89 $adder->execute($self->{userid});101 $adder->execute($self->{userid});
90102
91 my $current_add = $self->{dbh}->prepare("INSERT INTO current(userid, fan) VALUES (?,?)");
92 if ($opts->{virgin}) {103 if ($opts->{virgin}) {
93 $opts->{virgin} = 1;104
94 $opts->{current_names} = \@newfetch;105 $opts->{virgin} = 1;
95106
96 for (@newfetch) {107 $sth = $self->{dbh}->prepare(
97 $current_add->execute($self->{userid}, $_);108 "insert into current (userid, fan) ".
98 }109 "select ?, name from snapshot where snap=?");
110 $sth->execute($self->{userid}, $snap);
99111
100 } else {112 } else {
101 my @latest = $self->current();113
102114 # Deltas are not stored for virgin accounts
103 my $adder = $self->{dbh}->prepare("INSERT INTO change(userid, datestamp, fan, added) VALUES (?,CURRENT_DATE,?,?)");115 # (otherwise it shows a mass friending first)
104 my $current_del = $self->{dbh}->prepare("DELETE FROM current WHERE userid=? AND fan=?");116
105117 $sth = $self->{dbh}->prepare(
106 # Deltas are not stored for virgin accounts (otherwise it shows a mass friending first)118 "insert into change(userid,datestamp,fan,added) ".
107 for (_subtract( \@newfetch, \@latest )) {119 "select ?, ?, name, true ".
108 $adder->execute($self->{userid}, $_, 1);120 "from snapshot where snap=? and name not in ".
109 $current_add->execute($self->{userid}, $_);121 "(select fan from current where userid=?)");
110 }122 $sth->execute($self->{userid}, $today, $snap, $self->{userid});
111123
112 for (_subtract( \@latest, \@newfetch )) {124 $sth = $self->{dbh}->prepare(
113 $adder->execute($self->{userid}, $_, 0);125 "insert into change(userid,datestamp,fan,added) ".
114 $current_del->execute($self->{userid}, $_);126 "select ?, ?, fan, false ".
115 }127 "from current where userid=? and fan not in ".
128 "(select name from snapshot where snap=?) and userid=?");
129 $sth->execute($self->{userid}, $today, $self->{userid}, $snap, $self->{userid});
130
131 $sth = $self->{dbh}->prepare(
132 "insert into current select userid, fan from change ".
133 "where userid=? and datestamp=? and added");
134 $sth->execute($self->{userid}, $today);
135
136 $sth = $self->{dbh}->prepare(
137 "delete from current where userid=? ".
138 "and fan in (select fan from change where ".
139 "userid=? and datestamp=? and not added)");
140 $sth->execute($self->{userid}, $self->{userid}, $today);
116 }141 }
117142
143 $sth = $self->{dbh}->prepare('delete from snapshot where snap=?');
144 $sth->execute($snap);
145
118 # Aaaaand... commit.146 # Aaaaand... commit.
119 $self->{dbh}->commit();147 $self->{dbh}->commit();
120
121 # There's no more useful information to return on virgin accounts.
122 return () if $opts->{virgin};
123 }148 }
124149
150 # There's no more useful information to return on virgin accounts.
151 return () if $opts->{virgin};
152
125 my $query;153 my $query;
126 if ($opts->{'noblanks'}) { # noblanks version is much simpler154 if ($opts->{'noblanks'}) { # noblanks version is much simpler
127 my $where_limit = '';155 my $where_limit = '';
@@ -144,8 +172,7 @@
144 ' ORDER BY checking.datestamp DESC';172 ' ORDER BY checking.datestamp DESC';
145 }173 }
146174
147 my $sth = $self->{dbh}->prepare($query);175 $sth = $self->{dbh}->prepare($query);
148
149 $sth->execute($self->{userid});176 $sth->execute($self->{userid});
150177
151 my %results;178 my %results;
@@ -180,17 +207,6 @@
180 return @result;207 return @result;
181}208}
182209
183sub _subtract {
184 my ($left, $right) = @_;
185
186 my @left = @$left;
187 my @right = @$right;
188
189 my %right_index = map { $_ => 1 } @right;
190
191 return grep { !$right_index{$_} } @$left;
192}
193
194sub DESTROY {210sub DESTROY {
195 my ($self) = @_;211 my ($self) = @_;
196 $self->{dbh}->disconnect();212 $self->{dbh}->disconnect();
197213
=== modified file 'lib/Joule/Status/From_DE.pm'
--- lib/Joule/Status/From_DE.pm 2008-10-28 14:23:22 +0000
+++ lib/Joule/Status/From_DE.pm 2009-04-25 01:38:44 +0000
@@ -30,7 +30,8 @@
30sub site { "del.icio.us"; }30sub site { "del.icio.us"; }
3131
32sub names {32sub names {
33 my ($self) = @_;33 my ($self, $callback) = @_;
34
34 my $ua = LWP::UserAgent->new();35 my $ua = LWP::UserAgent->new();
35 $ua->agent("Joule/3.0 (http://marnanel.org/joule; thomas\@thurman.org.uk)");36 $ua->agent("Joule/3.0 (http://marnanel.org/joule; thomas\@thurman.org.uk)");
3637
@@ -40,7 +41,9 @@
4041
41 die __PACKAGE__ . ' error: ' . $res->status_line() unless $res->is_success();42 die __PACKAGE__ . ' error: ' . $res->status_line() unless $res->is_success();
4243
43 return @{ jsonToObj($res->content()) };44 for (@{ jsonToObj($res->content()) }) {
45 $callback->($_);
46 }
44}47}
4548
461;491;
4750
=== modified file 'lib/Joule/Status/From_LJ.pm'
--- lib/Joule/Status/From_LJ.pm 2008-10-28 14:23:22 +0000
+++ lib/Joule/Status/From_LJ.pm 2009-04-25 01:38:44 +0000
@@ -30,7 +30,8 @@
30sub site { "LiveJournal"; }30sub site { "LiveJournal"; }
3131
32sub names {32sub names {
33 my ($self) = @_;33 my ($self, $callback) = @_;
34
34 my $ua = LWP::UserAgent->new();35 my $ua = LWP::UserAgent->new();
35 $ua->agent("Joule/3.0 (http://marnanel.org/joule; thomas\@thurman.org.uk)");36 $ua->agent("Joule/3.0 (http://marnanel.org/joule; thomas\@thurman.org.uk)");
3637
@@ -40,13 +41,9 @@
4041
41 die __PACKAGE__ . ' error: ' . $res->status_line() unless $res->is_success();42 die __PACKAGE__ . ' error: ' . $res->status_line() unless $res->is_success();
42 43
43 my @result;
44
45 for (split('\n', $res->content())) {44 for (split('\n', $res->content())) {
46 push @result, $1 if $_ =~ /^< (.*)$/;45 $callback->($1) if $_ =~ /^< (.*)$/;
47 }46 }
48
49 return @result;
50}47}
5148
521;491;
5350
=== added file 'lib/Joule/Status/From_QD.pm'
--- lib/Joule/Status/From_QD.pm 1970-01-01 00:00:00 +0000
+++ lib/Joule/Status/From_QD.pm 2009-04-27 04:10:26 +0000
@@ -0,0 +1,46 @@
1# Joule - track changes in an online list over time
2# Copyright (C) 2002-2008 Thomas Thurman
3#
4# This program is free software: you can redistribute it and/or modify
5# it under the terms of the GNU Affero General Public License as
6# published by the Free Software Foundation, either version 3 of the
7# License, or (at your option) any later version.
8#
9# This program is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12# GNU Affero General Public License for more details.
13#
14# You should have received a copy of the GNU Affero General Public License
15# along with this program. If not, see <http://www.gnu.org/licenses/>.
16
17package Joule::Status::From_QD;
18
19use strict;
20use warnings;
21use JSON;
22
23sub new {
24 my ($class, $vars) = @_;
25
26 die "unknown user" unless $vars->{user} eq 'dummy';
27
28 bless {}, $class;
29}
30
31sub site { "Dummy testing site"; }
32
33sub names {
34 my ($self, $callback) = @_;
35
36 open JSON, '</tmp/joule.qd.json' or return;
37 my @result = @{from_json(<JSON>)};
38 close JSON or return;
39
40 for (@result) {
41 $callback->($_);
42 }
43}
44
451;
46
047
=== modified file 'share/tmpl/html_virgin_page.tmpl'
--- share/tmpl/html_virgin_page.tmpl 2008-10-28 14:06:24 +0000
+++ share/tmpl/html_virgin_page.tmpl 2009-04-27 04:14:27 +0000
@@ -2,9 +2,5 @@
2You haven't used Joule before today. Welcome!<br /><br />2You haven't used Joule before today. Welcome!<br /><br />
33
4Come back tomorrow and you'll see a list of who has friended4Come back tomorrow and you'll see a list of who has friended
5or unfriended you between now and then. Until then, here's the5or unfriended you between now and then.
6list of people who currently have you friended:<br /><br />
7
8[% SET nohiccup=1 %]
9[% INCLUDE user_list.tmpl list=current_names %]
10</p>6</p>
117
=== added directory 'test'
=== added file 'test/qd-test.pl'
--- test/qd-test.pl 1970-01-01 00:00:00 +0000
+++ test/qd-test.pl 2009-04-27 04:10:26 +0000
@@ -0,0 +1,89 @@
1use strict;
2use warnings;
3use Test::More tests=>7;
4use Data::Dumper;
5use DBI;
6use LWP::UserAgent;
7use JSON;
8
9my $settings = do '/etc/joule.conf';
10die "Must be run on the staging server" if $settings->{'user'} ne 'stagingjoule';
11
12my $dbh = DBI->connect($settings->{'database'},
13 $settings->{'user'},
14 $settings->{'password'});
15ok($dbh, 'connected to the database');
16die "no point continuing" unless $dbh;
17
18my $sth;
19
20$sth = $dbh->prepare("DELETE FROM current WHERE userid=?");
21$sth->execute('qd/dummy');
22$sth = $dbh->prepare("DELETE FROM change WHERE userid=?");
23$sth->execute('qd/dummy');
24$sth = $dbh->prepare("DELETE FROM checking WHERE userid=?");
25$sth->execute('qd/dummy');
26
27ok(1, "cleaned database");
28
29sub db_state {
30 my @result;
31
32 my $sth = $dbh->prepare("select fan from current where userid='qd/dummy'");
33 $sth->execute();
34 @result = (@result, map { $_->[0] } @{ $sth->fetchall_arrayref() } );
35
36 $sth = $dbh->prepare("select fan from change where userid='qd/dummy' and added");
37 $sth->execute();
38 @result = (@result, map { '+'.$_->[0] } @{ $sth->fetchall_arrayref() } );
39
40 $sth = $dbh->prepare("select fan from change where userid='qd/dummy' and not added");
41 $sth->execute();
42 @result = (@result, map { '-'.$_->[0] } @{ $sth->fetchall_arrayref() } );
43
44 return join(' ', sort @result);
45}
46
47sub set_qd {
48 open JSON, '>/tmp/joule.qd.json' or die "Can't open: $!";
49 print JSON to_json(\@_);
50 close JSON or die "Can't close!";
51}
52
53sub do_fetch {
54
55 my $ua = LWP::UserAgent->new;
56
57 my $req = HTTP::Request->new(GET => 'http://staging.joule.marnanel.org/chart/qd/dummy');
58 my $res = $ua->request($req);
59
60 ok($res->is_success, 'Touched the webserver to make it fetch');
61 die $res->status_line unless $res->is_success;
62}
63
64sub age_records {
65 my $sth = $dbh->prepare('INSERT INTO checking (userid, datestamp) VALUES (?,?)');
66 $sth->execute('qd/dummy', '1975-01-30');
67 $sth = $dbh->prepare('UPDATE change SET datestamp=? WHERE userid=?');
68 $sth->execute('1975-01-30', 'qd/dummy');
69 $sth = $dbh->prepare('DELETE FROM checking WHERE userid=? AND datestamp!=?');
70 $sth->execute('qd/dummy', '1975-01-30');
71}
72
73is(db_state(), '', 'initially empty');
74
75set_qd(qw(alpha beta gamma delta));
76
77do_fetch();
78
79is(db_state(), 'alpha beta delta gamma', 'first check has no changes');
80
81set_qd(qw(delta beta epsilon zeta));
82
83age_records();
84
85do_fetch();
86
87is(db_state(), '+epsilon +zeta -alpha -gamma beta delta epsilon zeta', 'second check has changes');
88
89$dbh->disconnect();

Subscribers

People subscribed via source and target branches

to all changes: