lib/DBIx/Class/Storage/Statistics.pm

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