r6069@nbgr: marcel | 2008-04-18 16:27:14 +0200

 lang/perl/DB-Pluggable: initial commit


git-svn-id: http://svn.coderepos.org/share/lang/perl/DB-Pluggable/trunk@9751 d0d07461-0603-4401-acd4-de1884942a52

.shipit

@@ -0,0 +1,9 @@
+steps = ApplyYAMLChangeLogVersion, Manifest, DistTest, Commit, Tag, MakeDist, MyUploadCPAN, DistClean, Twitter
+
+svk.tagpattern = //local/cpan/tags/DB-Pluggable-%v
+
+twitter.config = ~/.twitterrc
+twitter.distname = DB-Pluggable
+twitter.message = shipped %d %v - soon at %u
+
+

Changes

@@ -0,0 +1,24 @@
+---
+global:
+  name: DB-Pluggable
+releases:
+  - author: 'Marcel Gruenauer <marcel@cpan.org>'
+    changes:
+      - set the version to 0.03
+      - 'fixed first year, is 2008'
+    date: 2008-04-18T13:55:59Z
+    tags: []
+    version: 0.03
+  - author: 'Marcel Gruenauer <marcel@cpan.org>'
+    changes:
+      - hiding the DB package from the PAUSE indexer
+      - set version to 0.02
+    date: 2008-04-17T21:49:33Z
+    tags: []
+    version: 0.02
+  - author: 'Marcel Gruenauer <marcel@cpan.org>'
+    changes:
+      - original version
+    date: 2008-04-17T19:45:15Z
+    tags: []
+    version: 0.01

MANIFEST

@@ -0,0 +1,28 @@
+Changes
+etc/perldb
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/StandardTests.pm
+inc/Module/Install/Template.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+inc/Test/Compile.pm
+inc/Test/Differences.pm
+inc/Test/More.pm
+inc/UNIVERSAL/require.pm
+lib/DB/Pluggable.pm
+lib/DB/Pluggable/BreakOnTestNumber.pm
+lib/DB/Pluggable/Constants.pm
+Makefile.PL
+MANIFEST			This list of files
+META.yml
+README
+t/01_misc.t
+t/perlcriticrc

MANIFEST.SKIP

@@ -0,0 +1,36 @@
+# Version control files and dirs.
+\bRCS\b
+\bCVS\b
+.svn
+,v$
+
+# Makemaker/Build.PL generated files and dirs.
+^MANIFEST\.
+^Makefile$
+^Build$
+^blib/
+^_build/
+^MakeMaker-\d
+embedded/
+cover_db/
+smoke.html
+smoke.yaml
+smoketee.txt
+sqlnet.log
+BUILD.SKIP
+COVER.SKIP
+CPAN.SKIP
+t/000_standard__*
+
+# Temp, old, emacs, vim, backup files.
+~$
+\.old$
+\.swp$
+^#.*#$
+^\.#
+.shipit
+
+# Local files, not to be included
+^scratch/
+core
+^var/

Makefile.PL

@@ -0,0 +1,24 @@
+use inc::Module::Install;
+include 'Module::AutoInstall';
+
+name 'DB-Pluggable';
+all_from 'lib/DB/Pluggable.pm';
+perl_version '5.006';
+
+requires 'Hook::LexWrap';
+requires 'Hook::Modular';
+
+build_requires 'Test::Differences';
+build_requires 'Test::More' => '0.70';
+
+process_templates(
+    first_year => 2008,
+    rest_from  => "$ENV{HOME}/.mitlib/standard_pod",
+    start_tag  => '{%',
+    end_tag    => '%}',
+);
+
+use_standard_tests(without => 'pod_coverage');
+auto_install;
+auto_include;
+WriteAll;

README

@@ -0,0 +1,27 @@
+This is the Perl distribution DB-Pluggable.
+
+INSTALLATION
+
+DB-Pluggable installation is straightforward. If your CPAN shell is
+set up, you should just be able to do
+
+    % cpan DB::Pluggable
+
+Download it, unpack it, then build it as per the usual:
+
+    % perl Makefile.PL
+    % make && make test
+
+Then install it:
+
+    % make install
+
+DOCUMENTATION
+
+DB-Pluggable documentation is available as in POD. So you can do:
+
+    % perldoc DB::Pluggable
+
+to read the documentation online with your favorite pager.
+
+Marcel Gruenauer

etc/perldb

@@ -0,0 +1,30 @@
+# "perl -d" means ~/.perldb runs before $PERL5OPT is evaluated. So we need to
+# tell ~/.perldb where to find modules, if they're not globally installed. This
+# is probably not a problem for you, but I have Hook::Modular in my working
+# directory only.
+
+use Devel::SearchINC::FindLib '/Users/marcel/svk/cpan';
+
+use DB::Pluggable;
+use YAML;
+
+# need to set the $DB::PluginHandler variable. Because DB::Pluggable derives
+# from Hook::Modular, the 'config' value could also be a string that would be
+# interpreted as a path to a YAML config file.
+
+$DB::PluginHandler = DB::Pluggable->new(config => Load <<EOYAML);
+global:
+  log:
+    level: error
+
+plugins:
+  - module: BreakOnTestNumber
+EOYAML
+
+# don't call Hook::Modular's run_main() method because that does too much for
+# our needs.
+
+$DB::PluginHandler->run;
+
+# you can add more custom debugger code below
+

lib/DB/Pluggable.pm

@@ -0,0 +1,196 @@
+package DB::Pluggable;
+
+use strict;
+use warnings;
+use DB::Pluggable::Constants ':all';
+use Hook::LexWrap;
+
+
+use base 'Hook::Modular';
+
+
+our $VERSION = '0.03';
+
+
+use constant PLUGIN_NAMESPACE => 'DB::Pluggable';
+
+
+sub enable_watchfunction {
+    my $self = shift;
+    no warnings 'once';
+    $DB::trace |= 4;    # Enable watchfunction
+}
+
+
+package # hide from PAUSE indexer
+    DB;
+
+# switch package so as to get the desired stack trace
+
+sub watchfunction {
+    return unless defined $DB::PluginHandler;
+
+    my $depth = 1;
+    while (1) {
+        my ($package, $file, $line, $sub) = caller $depth;
+        last unless defined $package;
+        return if $sub =~ /::DESTROY$/;
+
+        $depth++;
+    }
+
+    $DB::PluginHandler->run_hook('db.watchfunction');
+}
+
+
+package DB::Pluggable;
+
+
+sub run {
+    my $self = shift;
+
+    $self->run_hook('plugin.init');
+
+    our $cmd_b_wrapper = wrap 'DB::cmd_b', pre => sub {
+        my ($cmd, $line, $dbline) = @_;
+
+        my @result = $self->run_hook('db.cmd.b', {
+            cmd    => $cmd,
+            line   => $line,
+            dbline => $dbline,
+        });
+
+        # short-circuit (i.e., don't call the original debugger function) if
+        # a plugin has handled it
+
+        $_[-1] = 1 if grep { $_ eq HANDLED } @result;
+    };
+}
+
+
+1;
+
+
+__END__
+
+{% USE p = PodGenerated %}
+
+=head1 NAME
+
+{% p.package %} - add plugin support for the Perl debugger
+
+=head1 SYNOPSIS
+
+    $ cat ~/.perldb
+
+    use DB::Pluggable;
+    use YAML;
+
+    $DB::PluginHandler = DB::Pluggable->new(config => Load <<EOYAML);
+    global:
+      log:
+        level: error
+
+    plugins:
+      - module: BreakOnTestNumber
+    EOYAML
+
+    $DB::PluginHandler->run;
+
+    $ perl -d foo.pl
+
+=head1 DESCRIPTION
+
+This class adds plugin support to the Perl debugger. It is based on
+L<Hook::Modular>, so see its documentation for details.
+
+You need to have a C<~/.perldb> file (see L<perldebug> for details) that
+invokes the plugin mechanism. The one in the synopsis will do, and there is a
+more commented one in this distribution's C<etc/perldb> file.
+
+Plugins should live in the C<DB::Pluggable::> namespace, like
+L<DB::Pluggable::BreakOnTestNumber> does.
+
+=head1 HOOKS
+
+This class is very much in beta, so it's more like a proof of concept.
+Therefore, not all hooks imaginable have been added, only the ones to make
+this demo work. If you want more hooks or if the current hooks don't work for
+you, let me know.
+
+The following hooks exist:
+
+=over 4
+
+=item plugin.init
+
+Called at the beginning of the C<run()> method. The hook doesn't get any
+arguments.
+
+=item db.watchfunction
+
+Called from within C<DB::watchfunction()>. If you want the debugger to call
+the function, you need to enable it by calling C<enable_watchfunction()>
+somewhere within your plugin. It's a good idea to enable it as late as
+possible because it is being called very often. See the
+L<DB::Pluggable::BreakOnTestNumber> source code for an example. The hook
+doesn't get any arguments.
+
+=item db.cmd.b
+
+Called when the C<b> debugger command (used to set breakpoints) is invoked.
+See C<run()> below for what the hook should return.
+
+The hook passes these named arguments:
+
+=over 4
+
+=item cmd
+
+This is the first argument passed to C<DB::cmd_b()>.
+
+=item line
+
+This is the second argument passed to C<DB::cmd_b()>. This is the most
+important argument as it contains the command line. See the
+L<DB::Pluggable::BreakOnTestNumber> source code for an example.
+
+=item dbline
+
+This is the third argument passed to C<DB::cmd_b()>.
+
+=back
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item enable_watchfunction
+
+Tells the debugger to call C<DB::watchfunction()>, which in turn calls the
+C<db.watchfunction> hook on all plugins that have registered it.
+
+=item run
+
+First it calls the C<plugin.init> hook, then it enables hooks for the relevant
+debugger commands (see above for which hooks are available).
+
+Each command-related hook should return the appropriate constant from
+L<DB::Pluggable::Constants> - either C<HANDLED> if the hook has handled the
+command, or C<DECLINED> if it didn't. If no hook has C<HANDLED> the command,
+the default command subroutine (e.g., C<DB::cmd_b()>) from C<perl5db.pl>
+will be called.
+
+
+{% p.write_methods %}
+
+=back
+
+{% p.write_inheritance %}
+
+{% PROCESS standard_pod %}
+
+=cut
+