![[staff profile]](https://www.dreamwidth.org/img/silk/identity/user_staff.png){kind=small}
![[site community profile]](https://www.dreamwidth.org/img/comm_staff.png){kind=small}
[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]](https://www.dreamwidth.org/img/silk/identity/user.png)
afuna.
Files modified:
http://bugs.dwscoalition.org/show_bug.cgi?id=124
More business statistics.
Patch by
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.
--------------------------------------------------------------------------------