Add statistics gathering to break down activity by paid account type.
Patch by pauamma.
diffs (247 lines):
diff -r f1b881e72e8d -r c557c814bf14 cgi-bin/DW/Pay.pm
--- a/cgi-bin/DW/Pay.pm Wed Nov 25 04:18:51 2009 +0000
+++ b/cgi-bin/DW/Pay.pm Wed Nov 25 05:14:57 2009 +0000
@@ -38,7 +38,8 @@ use constant ERR_TEMP => 2;
# RETURN: 1/0 if the type is a valid type
#
sub type_is_valid {
- return 1 if $LJ::CAP{$_[0]} && $LJ::CAP{$_[0]}->{_account_type};
+ return 1 if $LJ::CAP{$_[0]} && $LJ::CAP{$_[0]}->{_account_type}
+ && $LJ::CAP{$_[0]}->{_visible_name};
return 0;
}
@@ -52,9 +53,41 @@ sub type_is_valid {
# RETURN: string name of type, else undef
#
sub type_name {
- confess 'invalid typeid'
+ confess "invalid typeid $_[0]"
unless DW::Pay::type_is_valid( $_[0] );
return $LJ::CAP{$_[0]}->{_visible_name};
+}
+
+################################################################################
+# DW::Pay::type_shortname
+#
+# ARGUMENTS: typeid
+#
+# typeid required the id of the type we're checking
+#
+# RETURN: string short name of type, else undef
+#
+sub type_shortname {
+ confess "invalid typeid $_[0]"
+ unless DW::Pay::type_is_valid( $_[0] );
+ return $LJ::CAP{$_[0]}->{_account_type};
+}
+
+################################################################################
+# DW::Pay::all_shortnames
+#
+# ARGUMENTS: (none)
+#
+# RETURN: { typeid => shortname } hashref
+#
+sub all_shortnames {
+ my %names;
+ while ( my ( $typeid, $data ) = each %LJ::CAP ) {
+ # Avoid calling DW::Pay::type_is_valid a zillion times for the same
typeid
+ $names{$typeid} = $data->{_account_type}
+ if DW::Pay::type_is_valid( $typeid );
+ }
+ return \%names;
}
################################################################################
@@ -173,7 +206,7 @@ sub get_account_type {
confess 'account has no valid typeid'
unless $typeid && $typeid > 0;
confess "typeid $typeid not a valid account level"
- unless $LJ::CAP{$typeid} && $LJ::CAP{$typeid}->{_account_type};
+ unless DW::Pay::type_is_valid( $typeid );
return $LJ::CAP{$typeid}->{_account_type};
}
@@ -191,7 +224,7 @@ sub get_account_type_name {
confess 'account has no valid typeid'
unless $typeid && $typeid > 0;
confess "typeid $typeid not a valid account level"
- unless $LJ::CAP{$typeid} && $LJ::CAP{$typeid}->{_visible_name};
+ unless DW::Pay::type_is_valid( $typeid );
return $LJ::CAP{$typeid}->{_visible_name};
}
@@ -679,3 +712,4 @@ sub get_db_writer {
}
1;
+
diff -r f1b881e72e8d -r c557c814bf14 cgi-bin/DW/StatData/ActiveAccounts.pm
--- a/cgi-bin/DW/StatData/ActiveAccounts.pm Wed Nov 25 04:18:51 2009 +0000
+++ b/cgi-bin/DW/StatData/ActiveAccounts.pm Wed Nov 25 05:14:57 2009 +0000
@@ -1,6 +1,7 @@
#!/usr/bin/perl
#
# DW::StatData::ActiveAccounts - Active accounts, by #days since last active
+# and account level
#
# Authors:
# Pau Amma <[email protected]>
@@ -38,7 +39,16 @@ use base 'DW::StatData';
sub category { "active" }
sub name { "Active Accounts" }
-sub keylist { [ qw( active_1d active_7d active_30d ) ] }
+
+my %key_to_days = ( active_1d => 1, active_7d => 7, active_30d => 30 );
+sub keylist {
+ my @levels = ( 'unknown', values %{DW::Pay::all_shortnames()} );
+ my @keys = ();
+ foreach my $k ( keys %key_to_days ) {
+ push @keys, $k, map "$k-$_", @levels;
+ }
+ return \...@keys;
+}
=head1 API
@@ -48,33 +58,45 @@ Collects data for the following keys:
=over
-=item active_1d
+=item active_1d, active_1d-I<< level name >>
-Number of accounts active in the last 24 hours
+Number of accounts active in the last 24 hours (total and for each account
+level)
-=item active_7d
+=item active_7d, active_7d-I<< level name >>
-Number of accounts active in the last 168 (7*24) hours
+Number of accounts active in the last 168 (7*24) hours (total and for each
+account level)
-=item active_30d
+=item active_30d, active_30d-I<< level name >>
-Number of accounts active in the last 720 (30*24) hours
+Number of accounts active in the last 720 (30*24) hours (total and for each
+account level)
=back
+In the above, I<< level name >> is any of the account level names returned by
+C<< DW::Pay::all_shortnames >> or "unknown".
+
=cut
-my %key_to_days = ( active_1d => 1, active_7d => 7, active_30d => 30 );
sub collect {
my ( $class, @keys ) = @_;
my $max_days = 0;
my %data;
+ my $shortnames = DW::Pay::all_shortnames();
+ my @levels = ( '', 'unknown', values %$shortnames );
foreach my $k ( @keys ) {
+ my ( $keyprefix, $keylevel ) = split( '-', $k );
+ $keylevel ||= '';
+
die "Unknown statkey $k for $class"
- unless exists $key_to_days{$k};
- $max_days = $key_to_days{$k}
- if $max_days < $key_to_days{$k};
+ unless exists $key_to_days{$keyprefix}
+ and grep { $_ eq $keylevel } @levels;
+
+ $max_days = $key_to_days{$keyprefix}
+ if $max_days < $key_to_days{$keyprefix};
$data{$k} = 0;
}
@@ -82,17 +104,25 @@ sub collect {
my ( $cid, $dbr ) = @_; # $cid isn't used
my $sth = $dbr->prepare( qq{
- SELECT FLOOR((UNIX_TIMESTAMP()-timeactive)/86400) as days, COUNT(*)
+ SELECT FLOOR((UNIX_TIMESTAMP()-timeactive)/86400) as days,
+ accountlevel, COUNT(*)
FROM clustertrack2
- WHERE timeactive > UNIX_TIMESTAMP()-? GROUP BY days } );
+ WHERE timeactive > UNIX_TIMESTAMP()-?
+ GROUP BY days, accountlevel } );
$sth->execute( $max_days*86400 );
- while ( my ( $days, $active ) = $sth->fetchrow_array ) {
+ while ( my ( $days, $level, $active ) = $sth->fetchrow_array ) {
+ $level = ( defined $level ) ? $shortnames->{$level} : 'unknown';
# which day interval(s) does this fall in?
# -- in last day, in last 7, in last 30?
foreach my $k ( @keys ) {
- $data{$k} += $active if $days < $key_to_days{$k};
+ my ( $keyprefix, $keylevel ) = split( '-', $k );
+ $keylevel ||= '';
+ if ( $days < $key_to_days{$keyprefix}
+ && ( $keylevel eq $level || $keylevel eq '' ) ) {
+ $data{$k} += $active;
+ }
}
}
} );
diff -r f1b881e72e8d -r c557c814bf14 cgi-bin/DW/StatData/PaidAccounts.pm
--- a/cgi-bin/DW/StatData/PaidAccounts.pm Wed Nov 25 04:18:51 2009 +0000
+++ b/cgi-bin/DW/StatData/PaidAccounts.pm Wed Nov 25 05:14:57 2009 +0000
@@ -35,11 +35,12 @@ sub keylist {
sub keylist {
my @account_type_keys;
my $default_typeid = DW::Pay::default_typeid();
+ my $shortnames = DW::Pay::all_shortnames();
- foreach my $typeid ( keys %LJ::CAP ) {
+ while ( my ( $typeid, $name ) = each %$shortnames ) {
next if $typeid == $default_typeid;
- push @account_type_keys, $LJ::CAP{$typeid}->{_account_type} if
$LJ::CAP{$typeid}->{_account_type};
+ push @account_type_keys, $name;
}
return \...@account_type_keys;
@@ -71,19 +72,16 @@ sub collect {
my $dbslow = LJ::get_dbh( 'slow' ) or die "Can't get slow role";
+ my $default_typeid = DW::Pay::default_typeid();
my $sth = $dbslow->prepare( qq{
- SELECT typeid, count(*) FROM dw_paidstatus GROUP BY typeid
+ SELECT typeid, count(*) FROM dw_paidstatus WHERE typeid != ? GROUP BY
typeid
} );
- $sth->execute;
+ $sth->execute( $default_typeid );
- my $default_typeid = DW::Pay::default_typeid();
while ( my ( $typeid, $active ) = $sth->fetchrow_array ) {
- next if $typeid == $default_typeid;
-
- my $account_type = $LJ::CAP{$typeid}->{_account_type};
- next unless defined $account_type and exists $data{$account_type};
-
- $data{$account_type} = $active;
+ next unless DW::Pay::type_is_valid( $typeid );
+ my $account_type = DW::Pay::type_shortname( $typeid );
+ $data{$account_type} = $active if exists $data{$account_type};
}
return \%data;
@@ -92,8 +90,6 @@ sub collect {
=head1 BUGS
Trying to get the number of free accounts from dw_paidstatus will return an
inaccurate number, because that only counts accounts which were paid at some
point. So we do not collect stats for the default_typeid, which are free
accounts for Dreamwidth. This makes assumptions, but I think not too out of
line.
-
-Needs to refactor more of the logic into DW::Pay (or some kind of BusinessRule
or hook, to take care of site-specific logic)
=head1 AUTHORS
_______________________________________________
dw-changelog mailing list
[email protected]
http://lists.dwscoalition.org/mailman/listinfo/dw-changelog
