lib/DBIx/Class/Storage/Statistics.pm

   1 package DBIx::Class::Storage::Statistics;
   2 use strict;
   3 use warnings;
   4
   5 use base qw/Class::Accessor::Grouped/;
   6
   7 __PACKAGE__->mk_group_accessors(simple => qw/callback debugfh/);
   8
   9 =head1 NAME
  10
  11 DBIx::Class::Storage::Statistics - SQL Statistics
  12
  13 =head1 SYNOPSIS
  14
  15 =head1 DESCRIPTION
  16
  17 This class is called by DBIx::Class::Storage::DBI as a means of collecting
  18 statistics on it's actions.  Using this class alone merely prints the SQL
  19 executed, the fact that it completes and begin/end notification for
  20 transactions.
  21
  22 To really use this class you should subclass it and create your own method
  23 for collecting the statistics as discussed in L<DBIx::Class::Manual::Cookbook>.
  24
  25 =head1 METHODS
  26
  27 =cut
  28
  29 =head2 new
  30
  31 Returns a new L<DBIx::Class::Storage::Statistics> object.
  32
  33 =cut
  34 sub new {
  35   my $self = {};
  36   bless $self, (ref($_[0]) || $_[0]);
  37
  38   return $self;
  39 }
  40
  41 =head2 debugfh
  42
  43 Sets or retrieves the filehandle used for trace/debug output.  This should
  44 be an IO::Handle compatible object (only the C<print> method is used). Initially
  45 should be set to STDERR - although see information on the
  46 L<DBIC_TRACE> environment variable.
  47
  48 =head2 txn_begin
  49
  50 Called when a transaction begins.
  51
  52 =cut
  53 sub txn_begin {
  54   my $self = shift;
  55
  56   $self->debugfh->print("BEGIN WORK\n");
  57 }
  58
  59 =head2 txn_rollback
  60
  61 Called when a transaction is rolled back.
  62
  63 =cut
  64 sub txn_rollback {
  65   my $self = shift;
  66
  67   $self->debugfh->print("ROLLBACK\n");
  68 }
  69
  70 =head2 txn_commit
  71
  72 Called when a transaction is committed.
  73
  74 =cut
  75 sub txn_commit {
  76   my $self = shift;
  77
  78   $self->debugfh->print("COMMIT\n");
  79 }
  80
  81 =head2 query_start
  82
  83 Called before a query is executed.  The first argument is the SQL string being
  84 executed and subsequent arguments are the parameters used for the query.
  85
  86 =cut
  87 sub query_start {
  88   my ($self, $string, @bind) = @_;
  89
  90   my $message = "$string: ".join(', ', @bind)."\n";
  91
  92   if(defined($self->callback)) {
  93     $string =~ m/^(\w+)/;
  94     $self->callback->($1, $message);
  95     return;
  96   }
  97
  98   $self->debugfh->print($message);
  99 }
 100
 101 =head2 query_end
 102
 103 Called when a query finishes executing.  Has the same arguments as query_start.
 104
 105 =cut
 106 sub query_end {
 107   my ($self, $string) = @_;
 108 }
 109
 110 1;
 111
 112 =head1 AUTHORS
 113
 114 Cory G. Watson <gphat@cpan.org>
 115
 116 =head1 LICENSE
 117
 118 You may distribute this code under the same license as Perl itself.
 119
 120 =cut