mark: A photo of Mark kneeling on top of the Taal Volcano in the Philippines. It was a long hike. (Default)
Mark Smith ([staff profile] mark) wrote in [site community profile] changelog2009-11-25 05:15 am
  • Add Memory
  • Share This Entry

[dw-free] Business statistics

[commit: http://hg.dwscoalition.org/dw-free/rev/c557c814bf14]

http://bugs.dwscoalition.org/show_bug.cgi?id=124

Add statistics gathering to break down activity by paid account type.

Patch by [personal profile] pauamma.

Files modified:
  • cgi-bin/DW/Pay.pm
  • cgi-bin/DW/StatData/ActiveAccounts.pm
  • cgi-bin/DW/StatData/PaidAccounts.pm
--------------------------------------------------------------------------------
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 <pauamma@cpan.org>
@@ -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
 
--------------------------------------------------------------------------------
  • Add Memory
  • Share This Entry
(0 comments)

Post a comment in response:

This account has disabled anonymous posting.
If you don't have an account you can create one now.
HTML doesn't work in the subject.
More info about formatting

If you are unable to use this captcha for any reason, please contact us by email at support@dreamwidth.org

 
Notice: This account is set to log the IP addresses of everyone who comments.
Links will be displayed as unclickable URLs to help prevent spam.