File Coverage

blib/lib/SlapbirdAPM/DBIx/Tracer.pm

Criterion	Covered	Total	%
statement	26	122	21.3
branch	0	42	0.0
condition	0	8	0.0
subroutine	9	20	45.0
pod	1	1	100.0
total	36	193	18.6

# This software is copyright (c) 2012 by Tokuhiro Matsuno Etokuhirom AAJKLFJEF@ GMAIL COME.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
# Terms of the Perl programming language system itself
#
# a) the GNU General Public License as published by the Free
#    Software Foundation; either version 1, or (at your option) any
#    later version, or
# b) the "Artistic License"
#
# --- The GNU General Public License, Version 1, February 1989 ---
#
# This software is Copyright (c) 2012 by Tokuhiro Matsuno Etokuhirom AAJKLFJEF@ GMAIL COME.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 1, February 1989
#
#                     GNU GENERAL PUBLIC LICENSE
#                      Version 1, February 1989
#
#  Copyright (C) 1989 Free Software Foundation, Inc.
#  51 Franklin St, Suite 500, Boston, MA  02110-1335  USA
#
#  Everyone is permitted to copy and distribute verbatim copies
#  of this license document, but changing it is not allowed.
#
#                             Preamble
#
#   The license agreements of most software companies try to keep users
# at the mercy of those companies.  By contrast, our General Public
# License is intended to guarantee your freedom to share and change free
# software--to make sure the software is free for all its users.  The
# General Public License applies to the Free Software Foundation's
# software and to any other program whose authors commit to using it.
# You can use it for your programs, too.
#
#   When we speak of free software, we are referring to freedom, not
# price.  Specifically, the General Public License is designed to make
# sure that you have the freedom to give away or sell copies of free
# software, that you receive source code or can get it if you want it,
# that you can change the software or use pieces of it in new free
# programs; and that you know you can do these things.
#
#   To protect your rights, we need to make restrictions that forbid
# anyone to deny you these rights or to ask you to surrender the rights.
# These restrictions translate to certain responsibilities for you if you
# distribute copies of the software, or if you modify it.
#
#   For example, if you distribute copies of a such a program, whether
# gratis or for a fee, you must give the recipients all the rights that
# you have.  You must make sure that they, too, receive or can get the
# source code.  And you must tell them their rights.
#
#   We protect your rights with two steps: (1) copyright the software, and
# (2) offer you this license which gives you legal permission to copy,
# distribute and/or modify the software.
#
#   Also, for each author's protection and ours, we want to make certain
# that everyone understands that there is no warranty for this free
# software.  If the software is modified by someone else and passed on, we
# want its recipients to know that what they have is not the original, so
# that any problems introduced by others will not reflect on the original
# authors' reputations.
#
#   The precise terms and conditions for copying, distribution and
# modification follow.
#
#                     GNU GENERAL PUBLIC LICENSE
#    TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
#
#   0. This License Agreement applies to any program or other work which
# contains a notice placed by the copyright holder saying it may be
# distributed under the terms of this General Public License.  The
# "Program", below, refers to any such program or work, and a "work based
# on the Program" means either the Program or any work containing the
# Program or a portion of it, either verbatim or with modifications.  Each
# licensee is addressed as "you".
#
#   1. You may copy and distribute verbatim copies of the Program's source
# code as you receive it, in any medium, provided that you conspicuously and
# appropriately publish on each copy an appropriate copyright notice and
# disclaimer of warranty; keep intact all the notices that refer to this
# General Public License and to the absence of any warranty; and give any
# other recipients of the Program a copy of this General Public License
# along with the Program.  You may charge a fee for the physical act of
# transferring a copy.
#
#   2. You may modify your copy or copies of the Program or any portion of
# it, and copy and distribute such modifications under the terms of Paragraph
# 1 above, provided that you also do the following:
#
#     a) cause the modified files to carry prominent notices stating that
#     you changed the files and the date of any change; and
#
#     b) cause the whole of any work that you distribute or publish, that
#     in whole or in part contains the Program or any part thereof, either
#     with or without modifications, to be licensed at no charge to all
#     third parties under the terms of this General Public License (except
#     that you may choose to grant warranty protection to some or all
#     third parties, at your option).
#
#     c) If the modified program normally reads commands interactively when
#     run, you must cause it, when started running for such interactive use
#     in the simplest and most usual way, to print or display an
#     announcement including an appropriate copyright notice and a notice
#     that there is no warranty (or else, saying that you provide a
#     warranty) and that users may redistribute the program under these
#     conditions, and telling the user how to view a copy of this General
#     Public License.
#
#     d) You may charge a fee for the physical act of transferring a
#     copy, and you may at your option offer warranty protection in
#     exchange for a fee.
#
# Mere aggregation of another independent work with the Program (or its
# derivative) on a volume of a storage or distribution medium does not bring
# the other work under the scope of these terms.
#
#   3. You may copy and distribute the Program (or a portion or derivative of
# it, under Paragraph 2) in object code or executable form under the terms of
# Paragraphs 1 and 2 above provided that you also do one of the following:
#
#     a) accompany it with the complete corresponding machine-readable
#     source code, which must be distributed under the terms of
#     Paragraphs 1 and 2 above; or,
#
#     b) accompany it with a written offer, valid for at least three
#     years, to give any third party free (except for a nominal charge
#     for the cost of distribution) a complete machine-readable copy of the
#     corresponding source code, to be distributed under the terms of
#     Paragraphs 1 and 2 above; or,
#
#     c) accompany it with the information you received as to where the
#     corresponding source code may be obtained.  (This alternative is
#     allowed only for noncommercial distribution and only if you
#     received the program in object code or executable form alone.)
#
# Source code for a work means the preferred form of the work for making
# modifications to it.  For an executable file, complete source code means
# all the source code for all modules it contains; but, as a special
# exception, it need not include source code for modules which are standard
# libraries that accompany the operating system on which the executable
# file runs, or for standard header files or definitions files that
# accompany that operating system.
#
#   4. You may not copy, modify, sublicense, distribute or transfer the
# Program except as expressly provided under this General Public License.
# Any attempt otherwise to copy, modify, sublicense, distribute or transfer
# the Program is void, and will automatically terminate your rights to use
# the Program under this License.  However, parties who have received
# copies, or rights to use copies, from you under this General Public
# License will not have their licenses terminated so long as such parties
# remain in full compliance.
#
#   5. By copying, distributing or modifying the Program (or any work based
# on the Program) you indicate your acceptance of this license to do so,
# and all its terms and conditions.
#
#   6. Each time you redistribute the Program (or any work based on the
# Program), the recipient automatically receives a license from the original
# licensor to copy, distribute or modify the Program subject to these
# terms and conditions.  You may not impose any further restrictions on the
# recipients' exercise of the rights granted herein.
#
#   7. The Free Software Foundation may publish revised and/or new versions
# of the General Public License from time to time.  Such new versions will
# be similar in spirit to the present version, but may differ in detail to
# address new problems or concerns.
#
# Each version is given a distinguishing version number.  If the Program
# specifies a version number of the license which applies to it and "any
# later version", you have the option of following the terms and conditions
# either of that version or of any later version published by the Free
# Software Foundation.  If the Program does not specify a version number of
# the license, you may choose any version ever published by the Free Software
# Foundation.
#
#   8. If you wish to incorporate parts of the Program into other free
# programs whose distribution conditions are different, write to the author
# to ask for permission.  For software which is copyrighted by the Free
# Software Foundation, write to the Free Software Foundation; we sometimes
# make exceptions for this.  Our decision will be guided by the two goals
# of preserving the free status of all derivatives of our free software and
# of promoting the sharing and reuse of software generally.
#
#                             NO WARRANTY
#
#   9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
# FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
# OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
# PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
# OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
# TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
# PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
# REPAIR OR CORRECTION.
#
#   10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
# WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
# REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
# INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
# TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
# YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
# PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGES.
#
#                      END OF TERMS AND CONDITIONS
#
#         Appendix: How to Apply These Terms to Your New Programs
#
#   If you develop a new program, and you want it to be of the greatest
# possible use to humanity, the best way to achieve this is to make it
# free software which everyone can redistribute and change under these
# terms.
#
#   To do so, attach the following notices to the program.  It is safest to
# attach them to the start of each source file to most effectively convey
# the exclusion of warranty; and each file should have at least the
# "copyright" line and a pointer to where the full notice is found.
#
#
#     Copyright (C) 19yy
#
#     This program is free software; you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation; either version 1, or (at your option)
#     any later version.
#
#     This program is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
#
#     You should have received a copy of the GNU General Public License
#     along with this program; if not, write to the Free Software
#     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA  02110-1301 USA
#
#
# Also add information on how to contact you by electronic and paper mail.
#
# If the program is interactive, make it output a short notice like this
# when it starts in an interactive mode:
#
#     Gnomovision version 69, Copyright (C) 19xx name of author
#     Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
#     This is free software, and you are welcome to redistribute it
#     under certain conditions; type `show c' for details.
#
# The hypothetical commands `show w' and `show c' should show the
# appropriate parts of the General Public License.  Of course, the
# commands you use may be called something other than `show w' and `show
# c'; they could even be mouse-clicks or menu items--whatever suits your
# program.
#
# You should also get your employer (if you work as a programmer) or your
# school, if any, to sign a "copyright disclaimer" for the program, if
# necessary.  Here a sample; alter the names:
#
#   Yoyodyne, Inc., hereby disclaims all copyright interest in the
#   program `Gnomovision' (a program to direct compilers to make passes
#   at assemblers) written by James Hacker.
#
#   , 1 April 1989
#   Ty Coon, President of Vice
#
# That's all there is to it!
#
#
# --- The Artistic License 1.0 ---
#
# This software is Copyright (c) 2012 by Tokuhiro Matsuno Etokuhirom AAJKLFJEF@ GMAIL COME.
#
# This is free software, licensed under:
#
#   The Artistic License 1.0
#
# The Artistic License
#
# Preamble
#
# The intent of this document is to state the conditions under which a Package
# may be copied, such that the Copyright Holder maintains some semblance of
# artistic control over the development of the package, while giving the users of
# the package the right to use and distribute the Package in a more-or-less
# customary fashion, plus the right to make reasonable modifications.
#
# Definitions:
#
#   - "Package" refers to the collection of files distributed by the Copyright
#     Holder, and derivatives of that collection of files created through
#     textual modification.
#   - "Standard Version" refers to such a Package if it has not been modified,
#     or has been modified in accordance with the wishes of the Copyright
#     Holder.
#   - "Copyright Holder" is whoever is named in the copyright or copyrights for
#     the package.
#   - "You" is you, if you're thinking about copying or distributing this Package.
#   - "Reasonable copying fee" is whatever you can justify on the basis of media
#     cost, duplication charges, time of people involved, and so on. (You will
#     not be required to justify it to the Copyright Holder, but only to the
#     computing community at large as a market that must bear the fee.)
#   - "Freely Available" means that no fee is charged for the item itself, though
#     there may be fees involved in handling the item. It also means that
#     recipients of the item may redistribute it under the same conditions they
#     received it.
#
# 1. You may make and give away verbatim copies of the source form of the
# Standard Version of this Package without restriction, provided that you
# duplicate all of the original copyright notices and associated disclaimers.
#
# 2. You may apply bug fixes, portability fixes and other modifications derived
# from the Public Domain or from the Copyright Holder. A Package modified in such
# a way shall still be considered the Standard Version.
#
# 3. You may otherwise modify your copy of this Package in any way, provided that
# you insert a prominent notice in each changed file stating how and when you
# changed that file, and provided that you do at least ONE of the following:
#
#   a) place your modifications in the Public Domain or otherwise make them
#      Freely Available, such as by posting said modifications to Usenet or an
#      equivalent medium, or placing the modifications on a major archive site
#      such as ftp.uu.net, or by allowing the Copyright Holder to include your
#      modifications in the Standard Version of the Package.
#
#   b) use the modified Package only within your corporation or organization.
#
#   c) rename any non-standard executables so the names do not conflict with
#      standard executables, which must also be provided, and provide a separate
#      manual page for each non-standard executable that clearly documents how it
#      differs from the Standard Version.
#
#   d) make other distribution arrangements with the Copyright Holder.
#
# 4. You may distribute the programs of this Package in object code or executable
# form, provided that you do at least ONE of the following:
#
#   a) distribute a Standard Version of the executables and library files,
#      together with instructions (in the manual page or equivalent) on where to
#      get the Standard Version.
#
#   b) accompany the distribution with the machine-readable source of the Package
#      with your modifications.
#
#   c) accompany any non-standard executables with their corresponding Standard
#      Version executables, giving the non-standard executables non-standard
#      names, and clearly documenting the differences in manual pages (or
#      equivalent), together with instructions on where to get the Standard
#      Version.
#
#   d) make other distribution arrangements with the Copyright Holder.
#
# 5. You may charge a reasonable copying fee for any distribution of this
# Package.  You may charge any fee you choose for support of this Package. You
# may not charge a fee for this Package itself. However, you may distribute this
# Package in aggregate with other (possibly commercial) programs as part of a
# larger (possibly commercial) software distribution provided that you do not
# advertise this Package as a product of your own.
#
# 6. The scripts and library files supplied as input to or produced as output
# from the programs of this Package do not automatically fall under the copyright
# of this Package, but belong to whomever generated them, and may be sold
# commercially, and may be aggregated with this Package.
#
# 7. C or perl subroutines supplied by you and linked into this Package shall not
# be considered part of this Package.
#
# 8. The name of the Copyright Holder may not be used to endorse or promote
# products derived from this software without specific prior written permission.
#
# 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# The End

package SlapbirdAPM::DBIx::Tracer;
use strict;
use warnings;
use 5.008008;
our $VERSION = '0.03';

use DBI;
use Time::HiRes qw(time gettimeofday tv_interval);
use Carp;

our $IN_DO;

my $org_execute               = \&DBI::st::execute;
my $org_bind_param            = \&DBI::st::bind_param;
my $org_db_do                 = \&DBI::db::do;
my $org_db_selectall_arrayref = \&DBI::db::selectall_arrayref;
my $org_db_selectrow_arrayref = \&DBI::db::selectrow_arrayref;
my $org_db_selectrow_array    = \&DBI::db::selectrow_array;

my $pp_mode = $INC{'DBI/PurePerl.pm'} ? 1 : 0;

my $st_execute;
my $st_bind_param;
my $db_do;
my $selectall_arrayref;
my $selectrow_arrayref;
my $selectrow_array;

our $OUTPUT;

sub new {
    my $class = shift;

    # argument processing
    my %args;
    if ( @_ == 1 ) {
        if ( ref $_[0] eq 'CODE' ) {
            $args{code} = $_[0];
        }
        else {
            %args = %{ $_[0] };
        }
    }
    else {
        %args = @_;
    }
    for (qw(code)) {
        unless ( $args{$_} ) {
            croak "Missing mandatory parameter $_ for DBIx::Tracer->new";
        }
    }

    my $logger = $args{code};

    # create object
    my $self = bless \%args, $class;

    # wrap methods
    my $st_execute = $class->_st_execute( $org_execute, $logger );
    $st_bind_param = $class->_st_bind_param( $org_bind_param, $logger );
    $db_do         = $class->_db_do( $org_db_do, $logger );
    unless ($pp_mode) {
        $selectall_arrayref =
          $class->_select_array( $org_db_selectall_arrayref, 0, $logger );
        $selectrow_arrayref =
          $class->_select_array( $org_db_selectrow_arrayref, 0, $logger );
        $selectrow_array =
          $class->_select_array( $org_db_selectrow_array, 1, $logger );
    }

    no warnings qw(redefine prototype);
    *DBI::st::execute    = $st_execute;
    *DBI::st::bind_param = $st_bind_param;
    *DBI::db::do         = $db_do;
    unless ($pp_mode) {
        *DBI::db::selectall_arrayref = $selectall_arrayref;
        *DBI::db::selectrow_arrayref = $selectrow_arrayref;
        *DBI::db::selectrow_array    = $selectrow_array;
    }

    return $self;
}

# -------------------------------------------------------------------------
# wrapper methods.

sub _st_execute {
    my ( $class, $org, $logger ) = @_;

    return sub {
        my $sth    = shift;
        my @params = @_;
        my @types;

        my $dbh = $sth->{Database};
        my $ret = $sth->{Statement};
        if ( my $attrs = $sth->{private_DBIx_Tracer_attrs} ) {
            my $bind_params = $sth->{private_DBIx_Tracer_params};
            for my $i ( 1 .. @$attrs ) {
                push @types,  $attrs->[ $i - 1 ]{TYPE};
                push @params, $bind_params->[ $i - 1 ] if $bind_params;
            }
        }
        $sth->{private_DBIx_Tracer_params} = undef;

        my $begin     = time * 1_000;
        my $wantarray = wantarray ? 1 : 0;
        my $res =
          $wantarray ? [ $org->( $sth, @_ ) ] : scalar $org->( $sth, @_ );
        my $time = sprintf( '%.2f', ( time * 1_000 ) - $begin );

        # DBD::SQLite calls ::st::execute from ::do.
        # It makes duplicated logging output.
        unless ($IN_DO) {
            $class->_logging( $logger, $dbh, $ret, $time, \@params );
        }

        return $wantarray ? @$res : $res;
    };
}

sub _st_bind_param {
    my ( $class, $org ) = @_;

    return sub {
        my ( $sth, $p_num, $value, $attr ) = @_;
        $sth->{private_DBIx_Tracer_params} ||= [];
        $sth->{private_DBIx_Tracer_attrs}  ||= [];
        $attr = +{ TYPE => $attr || 0 } unless ref $attr eq 'HASH';
        $sth->{private_DBIx_Tracer_params}[ $p_num - 1 ] = $value;
        $sth->{private_DBIx_Tracer_attrs}[ $p_num - 1 ]  = $attr;
        $org->(@_);
    };
}

sub _select_array {
    my ( $class, $org, $is_selectrow_array, $logger ) = @_;

    return sub {
        my $wantarray = wantarray;
        my ( $dbh, $stmt, $attr, @bind ) = @_;

        no warnings qw(redefine prototype);
        local *DBI::st::execute = $org_execute;    # suppress duplicate logging

        my $ret = ref $stmt ? $stmt->{Statement} : $stmt;

        my $begin = time;
        my $res;
        if ($is_selectrow_array) {
            $res =
              $wantarray
              ? [ $org->( $dbh, $stmt, $attr, @bind ) ]
              : $org->( $dbh, $stmt, $attr, @bind );
        }
        else {
            $res = $org->( $dbh, $stmt, $attr, @bind );
        }
        my $time = sprintf( '%.2f', ( time * 1_000 ) - $begin );

        $class->_logging( $logger, $dbh, $ret, $time, \@bind );

        if ($is_selectrow_array) {
            return $wantarray ? @$res : $res;
        }
        return $res;
    };
}

sub _db_do {
    my ( $class, $org, $logger ) = @_;

    return sub {
        my $wantarray = wantarray ? 1 : 0;
        my ( $dbh, $stmt, $attr, @bind ) = @_;

        local $IN_DO = 1;

        my $ret = $stmt;

        my $begin = time;
        my $res =
          $wantarray
          ? [ $org->( $dbh, $stmt, $attr, @bind ) ]
          : scalar $org->( $dbh, $stmt, $attr, @bind );
        my $time = sprintf( '%.2f', ( time * 1_000 ) - $begin );

        $class->_logging( $logger, $dbh, $ret, $time, \@bind );

        return $wantarray ? @$res : $res;
    };
}

sub _logging {
    my ( $class, $logger, $dbh, $sql, $time, $bind_params ) = @_;
    $bind_params ||= [];

    $logger->(
        dbh         => $dbh,
        time        => $time,
        sql         => $sql,
        bind_params => $bind_params,
    );
}

sub DESTROY {
    my $self = shift;

    no warnings qw(redefine prototype);
    *DBI::st::execute    = $org_execute;
    *DBI::st::bind_param = $org_bind_param;
    *DBI::db::do         = $org_db_do;
    unless ($pp_mode) {
        *DBI::db::selectall_arrayref = $org_db_selectall_arrayref;
        *DBI::db::selectrow_arrayref = $org_db_selectrow_arrayref;
        *DBI::db::selectrow_array    = $org_db_selectrow_array;
    }

    return;
}

1;
__END__