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-04-25 08:50 pm
  • Add Memory
  • Share This Entry

[dw-free] Business statistics

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

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

More business statistics.

Patch by [personal profile] afuna.

Files modified:
  • cgi-bin/DW/StatData.pm
  • cgi-bin/DW/StatData/AccountsByType.pm
  • cgi-bin/DW/StatStore.pm
  • htdocs/admin/index.bml
  • htdocs/admin/index.bml.text
--------------------------------------------------------------------------------
diff -r 7d8ff1c41e7c -r a9f42c02a0b5 cgi-bin/DW/StatData.pm
--- a/cgi-bin/DW/StatData.pm	Sat Apr 25 20:45:19 2009 +0000
+++ b/cgi-bin/DW/StatData.pm	Sat Apr 25 20:50:34 2009 +0000
@@ -19,13 +19,29 @@ DW::StatData - Abstract superclass for s
 
 =head1 SYNOPSIS
 
-  # examples of function usage
+    use DW::StatStore;  # to retrieve stored statistics from the database
+    use DW::StatData;   # to serve as an API for gathering the data
+    # load all the available DW::StatData::* submodules
+    LJ::ModuleLoader::autouse_subclasses( 'DW::StatData' );
+
+    # get the latest set of pony statistics
+    my $ponies = DW::StatData::Ponies->load_latest( DW::StatStore->get( "ponies" ) );
+
+    # how many ponies are currently sparkly?
+    $ret .= $ponies->value( "sparkly" );
+
+    # load statistics for ponies over the past 30 days
+    my $ponies_history = DW::StatData::Ponies->load( DW::StatStore->get( "ponies", 30 ) );
+    
+    # get the number of sparkly ponies 15 days ago
+    $ret .= $ponies_history->{15}->value( "sparkly" );
 
 =cut
 
 use strict;
 use warnings;
 use Carp qw( confess );
+use POSIX qw( floor );
 
 use fields qw( data );
 
@@ -99,17 +115,66 @@ sub collect {
     confess "'collect' should be implemented by subclass"; 
 }
 
-=head2 C<< $class->new( $category, $name, $key1 => $value, ... ) >>
+=head2 C<< $class->new( $key1 => $value, ... ) >>
 
-Initialize
+Initialize this row of stat data, given a hash of statkey-value pairs
 
 =cut
 
 sub new {
-    return fields::new( $_[0] );
+    my ( $self, %data ) = @_;
+    
+    unless ( ref $self ) {
+        $self = fields::new( $self );
+    }
+    while ( my ( $k, $v ) = each %data ) {
+        $self->{$k} = $v;
+    }
+
+    return $self;
+}
+
+=head2 C<< $class->load( { $timestampA => { $key1 => $value1, ... }, $timestampB => ... } ) >>
+
+Given a hashref of timestamps mapped to data rows, returns a hashref of DW::StatData::* objects. Input timestamps are time that row of statistics was collected; returned hash keys are how many days ago this data was collected.
+
+=cut
+
+sub load {
+    my ( $class, $rows ) = @_;
+    my $days_ago = sub {
+        my $timestamp = $_[0];
+        return floor( ( time() - $timestamp ) / ( 24 * 60 * 60 ) );
+    };
+
+    my $ret;
+    while ( my ( $timestamp, $data )  = each %$rows ) {
+        # does not protect against multiple versions of the data collected on the same day?
+        $ret->{$days_ago->( $timestamp )} = $class->new( data => $data );
+    }
+    return $ret;
+}
+
+=head2 C<< $class->load_latest( ... ) >>
+
+Accepts the same arguments as $class->load, but returns only the latest row
+
+=cut
+sub load_latest {
+    my $self = shift;
+    my $rows = $self->load( @_ );
+    my @sorted;
+    if ( %$rows ) {
+        @sorted = sort { $a <=> $b } keys %$rows;
+        return $rows->{$sorted[0]};
+    }
+
+    return undef;
 }
 
 =head1 BUGS
+
+Multiple versions of the data collected on the same day will be collapsed into one day.
 
 =head1 AUTHORS
 
diff -r 7d8ff1c41e7c -r a9f42c02a0b5 cgi-bin/DW/StatData/AccountsByType.pm
--- a/cgi-bin/DW/StatData/AccountsByType.pm	Sat Apr 25 20:45:19 2009 +0000
+++ b/cgi-bin/DW/StatData/AccountsByType.pm	Sat Apr 25 20:50:34 2009 +0000
@@ -61,14 +61,15 @@ sub collect {
     return \%data;
 }
 
-=head2 C<< $class->data >>
+=head2 C<< $self->data >>
  
 =cut
 
 sub data {
     my $self = shift;
-    my $data = $self->data;
-    $data{total} += $data{$_} foreach keys $data;
+    my $data = $self->{data};
+    $data->{total} = 0;
+    $data->{total} += $data->{$_} foreach keys %$data;
     return $data;
 }
 
diff -r 7d8ff1c41e7c -r a9f42c02a0b5 cgi-bin/DW/StatStore.pm
--- a/cgi-bin/DW/StatStore.pm	Sat Apr 25 20:45:19 2009 +0000
+++ b/cgi-bin/DW/StatStore.pm	Sat Apr 25 20:50:34 2009 +0000
@@ -7,6 +7,7 @@
 # Authors:
 #      Mark Smith <mark@dreamwidth.org>
 #      Pau Amma <pauamma@cpan.org>
+#      Afuna <coder.dw@afunamatata.com>
 #
 # Copyright (c) 2009 by Dreamwidth Studios, LLC.
 #
@@ -23,7 +24,12 @@ DW::StatStore -- Statistics store update
   # Add timestamped line to pony stats
   DW::StatStore->add( 'ponies', total => 34738, sparkly => 45 )
       or die "Some error happened";
-  # FIXME: define retrieval method(s)
+
+  # get pony stats from one day ago
+  DW::StatStore->get( 'ponies' );
+  
+  # get pony stats over the last 30 days
+  DW::StatStore->get( 'ponies', 30 );
 
 =cut
 
@@ -67,6 +73,39 @@ sub add {
     return 1;
 }
 
+=head2 C<< $class->get( $catkey, $statkeys, $howmany ) >>
+
+Get statistics data over the past $numdays for all keys under this category. Catkey is a string. $numdays defaults to 1.
+
+=cut
+
+sub get {
+    my ( $class, $catkey, $numdays ) = @_;
+
+    my $catkey_id = $class->to_id( $catkey );
+    return undef unless $catkey_id;
+
+    $numdays ||= 1;
+    my $timestamp = time() - $numdays * 24 * 60 * 60;
+
+    my $dbr = LJ::get_db_reader()
+        or return undef;
+
+    my $sth = $dbr->prepare( "SELECT category_id, key_id, insert_time, value " .
+                    "FROM site_stats " .
+                    "WHERE category_id = ? AND insert_time >= ? ");
+    $sth->execute( $catkey_id, $timestamp );
+
+    my %ret;
+    while ( my $data = $sth->fetchrow_hashref ) {
+        my $key = $class->to_key( $data->{key_id} )
+            or next;
+
+        $ret{$data->{insert_time}}->{$key} = $data->{value};
+    }
+    return \%ret;
+}
+
 =head2 C<< $class->to_id( $key ) >>
 
 Internal: converts key to an id. Key can be either a cat key or a stat key.
@@ -76,6 +115,16 @@ Autocreated on first reference.
 
 sub to_id {
     return $_[0]->typemap->class_to_typeid( $_[1] );
+}
+
+=head2 C<< $class->to_key( $id ) >>
+
+Internal: converts id to a key. Errors hard if you give an invalid id.
+
+=cut
+
+sub to_key {
+    return $_[0]->typemap->typeid_to_class( $_[1] );
 }
 
 =head2 C<< $class->typemap >>
@@ -96,13 +145,13 @@ 1;
 
 =head1 BUGS
 
-There's no API for retrieving stat data.
-
 =head1 AUTHORS
 
 Mark Smith <mark@dreamwidth.org>
 
 Pau Amma <pauamma@cpan.org>
+
+Afuna <coder.dw@afunamatata.com>
 
 =head1 COPYRIGHT AND LICENSE
 
diff -r 7d8ff1c41e7c -r a9f42c02a0b5 htdocs/admin/index.bml
--- a/htdocs/admin/index.bml	Sat Apr 25 20:45:19 2009 +0000
+++ b/htdocs/admin/index.bml	Sat Apr 25 20:50:34 2009 +0000
@@ -91,6 +91,8 @@ body<=
             } ] ],
         [ 'spamreports.bml',
             '<?_ml .admin.spamreports.link _ml?>', '<?_ml .admin.spamreports.text _ml?>', [ 'siteadmin:spamreports', 'siteadmin:*' ] ],
+        [ 'stats.bml',
+            '<?_ml .admin.stats.link _ml?>', '<?_ml .admin.stats.text _ml?>', [ 'payments' ] ],
         [ 'statushistory.bml',
             '<?_ml .admin.statushistory.link _ml?>', '<?_ml .admin.statushistory.text _ml?>', [ 'historyview', sub {
                 return ( $LJ::IS_DEV_SERVER, "<?_ml .devserver _ml?>" );
diff -r 7d8ff1c41e7c -r a9f42c02a0b5 htdocs/admin/index.bml.text
--- a/htdocs/admin/index.bml.text	Sat Apr 25 20:45:19 2009 +0000
+++ b/htdocs/admin/index.bml.text	Sat Apr 25 20:50:34 2009 +0000
@@ -74,6 +74,9 @@
 .admin.spamreports.link=Spam Reports
 .admin.spamreports.text=View and handle reports of spam.
 
+.admin.stats.link=Business Statistics
+.admin.stats.text=Detailed breakdown of business statistics
+
 .admin.statushistory.link=Statushistory
 .admin.statushistory.text=Shows you a user's statushistory.
 
--------------------------------------------------------------------------------