Permalink
Browse files

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
  • Loading branch information...
0 parents commit 29c4b0379b3e5c27dc68b032874a12eeb4bf6eaa Marcel Gruenauer committed Apr 18, 2008
Showing with 656 additions and 0 deletions.
  1. +9 −0 .shipit
  2. +24 −0 Changes
  3. +28 −0 MANIFEST
  4. +36 −0 MANIFEST.SKIP
  5. +24 −0 Makefile.PL
  6. +27 −0 README
  7. +30 −0 etc/perldb
  8. +196 −0 lib/DB/Pluggable.pm
  9. +167 −0 lib/DB/Pluggable/BreakOnTestNumber.pm
  10. +80 −0 lib/DB/Pluggable/Constants.pm
  11. +23 −0 t/01_misc.t
  12. +12 −0 t/perlcriticrc
@@ -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
+
+
24 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
@@ -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
@@ -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/
@@ -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;
27 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
@@ -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
+
@@ -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
+
Oops, something went wrong.

0 comments on commit 29c4b03

Please sign in to comment.