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
1=== modified file 'lib/Joule/History.pm'
2--- lib/Joule/History.pm 2009-04-21 01:52:56 +0000
3+++ lib/Joule/History.pm 2009-04-27 04:10:26 +0000
4@@ -1,5 +1,5 @@
5 # Joule - track changes in an online list over time
6-# Copyright (C) 2002-2008 Thomas Thurman
7+# Copyright (C) 2002-2009 Thomas Thurman
8 #
9 # This program is free software: you can redistribute it and/or modify
10 # it under the terms of the GNU Affero General Public License as
11@@ -49,6 +49,14 @@
12 return map { $_->[0] } @{ $sth->fetchall_arrayref() };
13 }
14
15+sub _add_snapshot_row {
16+ my ($self, $snap, $name) = @_;
17+ my $sth = $self->{dbh}->prepare('INSERT INTO snapshot (snap, name) VALUES (?,?)');
18+ $sth->execute($snap, $name);
19+ open TEST, ">/tmp/j-$snap-$name";
20+ close TEST;
21+}
22+
23 sub content {
24 my ($self, $opts) = @_;
25
26@@ -61,67 +69,87 @@
27 my $done_today = $self->{dbh}->prepare("SELECT COUNT(datestamp) FROM checking WHERE userid=? AND datestamp=CURRENT_DATE LIMIT 1");
28 $done_today->execute($self->{userid});
29
30- if ($done_today->fetchrow()) {
31-
32- if ($opts->{virgin}) {
33- $opts->{current_names} = [ $self->{'status'}->names() ];
34- return ();
35- }
36-
37- } else {
38+ my $sth;
39+
40+ unless ($done_today->fetchrow()) {
41+
42 # it hasn't been done today
43
44 $self->{dbh}->begin_work();
45
46- my @newfetch = $self->{'status'}->names();
47-
48- $opts->{lonely} = 1 unless @newfetch;
49+ $sth = $self->{dbh}->prepare("SELECT nextval('snapid'), current_date");
50+ $sth->execute();
51+ my ($snap, $today) = $sth->fetchrow_array();
52+ my $name_count = 0;
53+
54+ $self->{'status'}->names(sub {
55+ $name_count++;
56+ $self->_add_snapshot_row($snap, shift);
57+ });
58+
59+ $opts->{lonely} = 1 unless $name_count;
60 return () if $opts->{lonely} and $opts->{virgin}; # because we don't know for sure it exists at all
61
62- my $sth = $self->{dbh}->prepare("SELECT COUNT(*) FROM account WHERE userid=?");
63+ $sth = $self->{dbh}->prepare("SELECT COUNT(*) FROM account WHERE userid=? LIMIT 1");
64 $sth->execute($self->{userid});
65 unless ($sth->fetchrow()) {
66- $sth = $self->{dbh}->prepare("INSERT INTO account VALUES (?)");
67- $sth->execute($self->{userid});
68+ $sth = $self->{dbh}->prepare("INSERT INTO account VALUES (?)");
69+ $sth->execute($self->{userid});
70 }
71
72 my $adder = $self->{dbh}->prepare("INSERT INTO checking(userid, datestamp) VALUES (?, CURRENT_DATE)");
73 $adder->execute($self->{userid});
74
75- my $current_add = $self->{dbh}->prepare("INSERT INTO current(userid, fan) VALUES (?,?)");
76 if ($opts->{virgin}) {
77- $opts->{virgin} = 1;
78- $opts->{current_names} = \@newfetch;
79-
80- for (@newfetch) {
81- $current_add->execute($self->{userid}, $_);
82- }
83+
84+ $opts->{virgin} = 1;
85+
86+ $sth = $self->{dbh}->prepare(
87+ "insert into current (userid, fan) ".
88+ "select ?, name from snapshot where snap=?");
89+ $sth->execute($self->{userid}, $snap);
90
91 } else {
92- my @latest = $self->current();
93-
94- my $adder = $self->{dbh}->prepare("INSERT INTO change(userid, datestamp, fan, added) VALUES (?,CURRENT_DATE,?,?)");
95- my $current_del = $self->{dbh}->prepare("DELETE FROM current WHERE userid=? AND fan=?");
96-
97- # Deltas are not stored for virgin accounts (otherwise it shows a mass friending first)
98- for (_subtract( \@newfetch, \@latest )) {
99- $adder->execute($self->{userid}, $_, 1);
100- $current_add->execute($self->{userid}, $_);
101- }
102-
103- for (_subtract( \@latest, \@newfetch )) {
104- $adder->execute($self->{userid}, $_, 0);
105- $current_del->execute($self->{userid}, $_);
106- }
107+
108+ # Deltas are not stored for virgin accounts
109+ # (otherwise it shows a mass friending first)
110+
111+ $sth = $self->{dbh}->prepare(
112+ "insert into change(userid,datestamp,fan,added) ".
113+ "select ?, ?, name, true ".
114+ "from snapshot where snap=? and name not in ".
115+ "(select fan from current where userid=?)");
116+ $sth->execute($self->{userid}, $today, $snap, $self->{userid});
117+
118+ $sth = $self->{dbh}->prepare(
119+ "insert into change(userid,datestamp,fan,added) ".
120+ "select ?, ?, fan, false ".
121+ "from current where userid=? and fan not in ".
122+ "(select name from snapshot where snap=?) and userid=?");
123+ $sth->execute($self->{userid}, $today, $self->{userid}, $snap, $self->{userid});
124+
125+ $sth = $self->{dbh}->prepare(
126+ "insert into current select userid, fan from change ".
127+ "where userid=? and datestamp=? and added");
128+ $sth->execute($self->{userid}, $today);
129+
130+ $sth = $self->{dbh}->prepare(
131+ "delete from current where userid=? ".
132+ "and fan in (select fan from change where ".
133+ "userid=? and datestamp=? and not added)");
134+ $sth->execute($self->{userid}, $self->{userid}, $today);
135 }
136
137+ $sth = $self->{dbh}->prepare('delete from snapshot where snap=?');
138+ $sth->execute($snap);
139+
140 # Aaaaand... commit.
141 $self->{dbh}->commit();
142-
143- # There's no more useful information to return on virgin accounts.
144- return () if $opts->{virgin};
145 }
146
147+ # There's no more useful information to return on virgin accounts.
148+ return () if $opts->{virgin};
149+
150 my $query;
151 if ($opts->{'noblanks'}) { # noblanks version is much simpler
152 my $where_limit = '';
153@@ -144,8 +172,7 @@
154 ' ORDER BY checking.datestamp DESC';
155 }
156
157- my $sth = $self->{dbh}->prepare($query);
158-
159+ $sth = $self->{dbh}->prepare($query);
160 $sth->execute($self->{userid});
161
162 my %results;
163@@ -180,17 +207,6 @@
164 return @result;
165 }
166
167-sub _subtract {
168- my ($left, $right) = @_;
169-
170- my @left = @$left;
171- my @right = @$right;
172-
173- my %right_index = map { $_ => 1 } @right;
174-
175- return grep { !$right_index{$_} } @$left;
176-}
177-
178 sub DESTROY {
179 my ($self) = @_;
180 $self->{dbh}->disconnect();
181
182=== modified file 'lib/Joule/Status/From_DE.pm'
183--- lib/Joule/Status/From_DE.pm 2008-10-28 14:23:22 +0000
184+++ lib/Joule/Status/From_DE.pm 2009-04-25 01:38:44 +0000
185@@ -30,7 +30,8 @@
186 sub site { "del.icio.us"; }
187
188 sub names {
189- my ($self) = @_;
190+ my ($self, $callback) = @_;
191+
192 my $ua = LWP::UserAgent->new();
193 $ua->agent("Joule/3.0 (http://marnanel.org/joule; thomas\@thurman.org.uk)");
194
195@@ -40,7 +41,9 @@
196
197 die __PACKAGE__ . ' error: ' . $res->status_line() unless $res->is_success();
198
199- return @{ jsonToObj($res->content()) };
200+ for (@{ jsonToObj($res->content()) }) {
201+ $callback->($_);
202+ }
203 }
204
205 1;
206
207=== modified file 'lib/Joule/Status/From_LJ.pm'
208--- lib/Joule/Status/From_LJ.pm 2008-10-28 14:23:22 +0000
209+++ lib/Joule/Status/From_LJ.pm 2009-04-25 01:38:44 +0000
210@@ -30,7 +30,8 @@
211 sub site { "LiveJournal"; }
212
213 sub names {
214- my ($self) = @_;
215+ my ($self, $callback) = @_;
216+
217 my $ua = LWP::UserAgent->new();
218 $ua->agent("Joule/3.0 (http://marnanel.org/joule; thomas\@thurman.org.uk)");
219
220@@ -40,13 +41,9 @@
221
222 die __PACKAGE__ . ' error: ' . $res->status_line() unless $res->is_success();
223
224- my @result;
225-
226 for (split('\n', $res->content())) {
227- push @result, $1 if $_ =~ /^< (.*)$/;
228+ $callback->($1) if $_ =~ /^< (.*)$/;
229 }
230-
231- return @result;
232 }
233
234 1;
235
236=== added file 'lib/Joule/Status/From_QD.pm'
237--- lib/Joule/Status/From_QD.pm 1970-01-01 00:00:00 +0000
238+++ lib/Joule/Status/From_QD.pm 2009-04-27 04:10:26 +0000
239@@ -0,0 +1,46 @@
240+# Joule - track changes in an online list over time
241+# Copyright (C) 2002-2008 Thomas Thurman
242+#
243+# This program is free software: you can redistribute it and/or modify
244+# it under the terms of the GNU Affero General Public License as
245+# published by the Free Software Foundation, either version 3 of the
246+# License, or (at your option) any later version.
247+#
248+# This program is distributed in the hope that it will be useful,
249+# but WITHOUT ANY WARRANTY; without even the implied warranty of
250+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
251+# GNU Affero General Public License for more details.
252+#
253+# You should have received a copy of the GNU Affero General Public License
254+# along with this program. If not, see <http://www.gnu.org/licenses/>.
255+
256+package Joule::Status::From_QD;
257+
258+use strict;
259+use warnings;
260+use JSON;
261+
262+sub new {
263+ my ($class, $vars) = @_;
264+
265+ die "unknown user" unless $vars->{user} eq 'dummy';
266+
267+ bless {}, $class;
268+}
269+
270+sub site { "Dummy testing site"; }
271+
272+sub names {
273+ my ($self, $callback) = @_;
274+
275+ open JSON, '</tmp/joule.qd.json' or return;
276+ my @result = @{from_json(<JSON>)};
277+ close JSON or return;
278+
279+ for (@result) {
280+ $callback->($_);
281+ }
282+}
283+
284+1;
285+
286
287=== modified file 'share/tmpl/html_virgin_page.tmpl'
288--- share/tmpl/html_virgin_page.tmpl 2008-10-28 14:06:24 +0000
289+++ share/tmpl/html_virgin_page.tmpl 2009-04-27 04:14:27 +0000
290@@ -2,9 +2,5 @@
291 You haven't used Joule before today. Welcome!<br /><br />
292
293 Come back tomorrow and you'll see a list of who has friended
294-or unfriended you between now and then. Until then, here's the
295-list of people who currently have you friended:<br /><br />
296-
297-[% SET nohiccup=1 %]
298-[% INCLUDE user_list.tmpl list=current_names %]
299+or unfriended you between now and then.
300 </p>
301
302=== added directory 'test'
303=== added file 'test/qd-test.pl'
304--- test/qd-test.pl 1970-01-01 00:00:00 +0000
305+++ test/qd-test.pl 2009-04-27 04:10:26 +0000
306@@ -0,0 +1,89 @@
307+use strict;
308+use warnings;
309+use Test::More tests=>7;
310+use Data::Dumper;
311+use DBI;
312+use LWP::UserAgent;
313+use JSON;
314+
315+my $settings = do '/etc/joule.conf';
316+die "Must be run on the staging server" if $settings->{'user'} ne 'stagingjoule';
317+
318+my $dbh = DBI->connect($settings->{'database'},
319+ $settings->{'user'},
320+ $settings->{'password'});
321+ok($dbh, 'connected to the database');
322+die "no point continuing" unless $dbh;
323+
324+my $sth;
325+
326+$sth = $dbh->prepare("DELETE FROM current WHERE userid=?");
327+$sth->execute('qd/dummy');
328+$sth = $dbh->prepare("DELETE FROM change WHERE userid=?");
329+$sth->execute('qd/dummy');
330+$sth = $dbh->prepare("DELETE FROM checking WHERE userid=?");
331+$sth->execute('qd/dummy');
332+
333+ok(1, "cleaned database");
334+
335+sub db_state {
336+ my @result;
337+
338+ my $sth = $dbh->prepare("select fan from current where userid='qd/dummy'");
339+ $sth->execute();
340+ @result = (@result, map { $_->[0] } @{ $sth->fetchall_arrayref() } );
341+
342+ $sth = $dbh->prepare("select fan from change where userid='qd/dummy' and added");
343+ $sth->execute();
344+ @result = (@result, map { '+'.$_->[0] } @{ $sth->fetchall_arrayref() } );
345+
346+ $sth = $dbh->prepare("select fan from change where userid='qd/dummy' and not added");
347+ $sth->execute();
348+ @result = (@result, map { '-'.$_->[0] } @{ $sth->fetchall_arrayref() } );
349+
350+ return join(' ', sort @result);
351+}
352+
353+sub set_qd {
354+ open JSON, '>/tmp/joule.qd.json' or die "Can't open: $!";
355+ print JSON to_json(\@_);
356+ close JSON or die "Can't close!";
357+}
358+
359+sub do_fetch {
360+
361+ my $ua = LWP::UserAgent->new;
362+
363+ my $req = HTTP::Request->new(GET => 'http://staging.joule.marnanel.org/chart/qd/dummy');
364+ my $res = $ua->request($req);
365+
366+ ok($res->is_success, 'Touched the webserver to make it fetch');
367+ die $res->status_line unless $res->is_success;
368+}
369+
370+sub age_records {
371+ my $sth = $dbh->prepare('INSERT INTO checking (userid, datestamp) VALUES (?,?)');
372+ $sth->execute('qd/dummy', '1975-01-30');
373+ $sth = $dbh->prepare('UPDATE change SET datestamp=? WHERE userid=?');
374+ $sth->execute('1975-01-30', 'qd/dummy');
375+ $sth = $dbh->prepare('DELETE FROM checking WHERE userid=? AND datestamp!=?');
376+ $sth->execute('qd/dummy', '1975-01-30');
377+}
378+
379+is(db_state(), '', 'initially empty');
380+
381+set_qd(qw(alpha beta gamma delta));
382+
383+do_fetch();
384+
385+is(db_state(), 'alpha beta delta gamma', 'first check has no changes');
386+
387+set_qd(qw(delta beta epsilon zeta));
388+
389+age_records();
390+
391+do_fetch();
392+
393+is(db_state(), '+epsilon +zeta -alpha -gamma beta delta epsilon zeta', 'second check has changes');
394+
395+$dbh->disconnect();

Subscribers

People subscribed via source and target branches

to all changes: