r17853 - in /branches/upstream/libdevel-backtrace-perl: ./ current/ current/examples/ current/lib/ current/lib/Devel/ current/lib/Devel/Backtrace/ current/t/
roberto at users.alioth.debian.org
roberto at users.alioth.debian.org
Wed Mar 19 03:46:28 UTC 2008
Author: roberto
Date: Wed Mar 19 03:46:27 2008
New Revision: 17853
URL: http://svn.debian.org/wsvn/?sc=1&rev=17853
Log:
[svn-inject] Installing original source of libdevel-backtrace-perl
Added:
branches/upstream/libdevel-backtrace-perl/
branches/upstream/libdevel-backtrace-perl/current/
branches/upstream/libdevel-backtrace-perl/current/Build.PL
branches/upstream/libdevel-backtrace-perl/current/Changes
branches/upstream/libdevel-backtrace-perl/current/INSTALL
branches/upstream/libdevel-backtrace-perl/current/LICENSE
branches/upstream/libdevel-backtrace-perl/current/MANIFEST
branches/upstream/libdevel-backtrace-perl/current/META.yml
branches/upstream/libdevel-backtrace-perl/current/Makefile.PL
branches/upstream/libdevel-backtrace-perl/current/README
branches/upstream/libdevel-backtrace-perl/current/examples/
branches/upstream/libdevel-backtrace-perl/current/examples/basic.pl
branches/upstream/libdevel-backtrace-perl/current/examples/skipme.pl
branches/upstream/libdevel-backtrace-perl/current/lib/
branches/upstream/libdevel-backtrace-perl/current/lib/Devel/
branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace/
branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace.pm
branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace/Point.pm
branches/upstream/libdevel-backtrace-perl/current/t/
branches/upstream/libdevel-backtrace-perl/current/t/00-load.t
branches/upstream/libdevel-backtrace-perl/current/t/by_index.t
branches/upstream/libdevel-backtrace-perl/current/t/examples.t
branches/upstream/libdevel-backtrace-perl/current/t/pod-coverage.t
branches/upstream/libdevel-backtrace-perl/current/t/pod.t
Added: branches/upstream/libdevel-backtrace-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/Build.PL?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/Build.PL (added)
+++ branches/upstream/libdevel-backtrace-perl/current/Build.PL Wed Mar 19 03:46:27 2008
@@ -1,0 +1,22 @@
+use strict;
+use warnings;
+use Module::Build;
+
+my $builder = Module::Build->new(
+ create_readme => 1,
+ create_makefile_pl => 'traditional',
+ module_name => 'Devel::Backtrace',
+ license => 'perl',
+ dist_author => 'Christoph Bussenius <pepe at cpan.org>',
+ dist_version_from => 'lib/Devel/Backtrace.pm',
+ requires => {
+ 'String::Escape' => 0,
+ 'Class::Accessor' => 0,
+ },
+ build_requires => {
+ 'Test::More' => 0,
+ },
+# add_to_cleanup => [ 'Devel-Backtrace-*' ],
+);
+
+$builder->create_build_script();
Added: branches/upstream/libdevel-backtrace-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/Changes?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/Changes (added)
+++ branches/upstream/libdevel-backtrace-perl/current/Changes Wed Mar 19 03:46:27 2008
@@ -1,0 +1,18 @@
+Revision history for Devel-Backtrace
+
+0.01 Apr 25 2007
+ First version, released on an unsuspecting world.
+
+0.02 May 11 17:42:40 CEST 2007
+ Disabled a test for Windows, because it failed due to perl features
+ that are not available on Windows.
+
+0.03 May 12 02:19:24 CEST 2007
+ Update documentation
+
+0.04 May 13 01:30:13 CEST 2007
+ Added support for perl 5.9's caller's hinthash.
+ Added by_index method to Devel::Backtrace::Point.
+
+0.05 May 20 19:59:28 CEST 2007
+ Make the tests work with perl 5.9
Added: branches/upstream/libdevel-backtrace-perl/current/INSTALL
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/INSTALL?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/INSTALL (added)
+++ branches/upstream/libdevel-backtrace-perl/current/INSTALL Wed Mar 19 03:46:27 2008
@@ -1,0 +1,37 @@
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the perldoc
+command.
+
+ perldoc Devel::Backtrace
+
+You can also look for information at:
+
+ Search CPAN
+ http://search.cpan.org/dist/Devel-Backtrace
+
+ CPAN Request Tracker:
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=Devel-Backtrace
+
+ AnnoCPAN, annotated CPAN documentation:
+ http://annocpan.org/dist/Devel-Backtrace
+
+ CPAN Ratings:
+ http://cpanratings.perl.org/d/Devel-Backtrace
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007 Christoph Bussenius <pepe at cpan.org>
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
Added: branches/upstream/libdevel-backtrace-perl/current/LICENSE
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/LICENSE?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/LICENSE (added)
+++ branches/upstream/libdevel-backtrace-perl/current/LICENSE Wed Mar 19 03:46:27 2008
@@ -1,0 +1,4 @@
+Copyright (C) 2007 Christoph Bussenius.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
Added: branches/upstream/libdevel-backtrace-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/MANIFEST?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/MANIFEST (added)
+++ branches/upstream/libdevel-backtrace-perl/current/MANIFEST Wed Mar 19 03:46:27 2008
@@ -1,0 +1,17 @@
+Build.PL
+Changes
+examples/basic.pl
+examples/skipme.pl
+INSTALL
+lib/Devel/Backtrace.pm
+lib/Devel/Backtrace/Point.pm
+LICENSE
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/00-load.t
+t/by_index.t
+t/examples.t
+t/pod-coverage.t
+t/pod.t
Added: branches/upstream/libdevel-backtrace-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/META.yml?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/META.yml (added)
+++ branches/upstream/libdevel-backtrace-perl/current/META.yml Wed Mar 19 03:46:27 2008
@@ -1,0 +1,24 @@
+---
+name: Devel-Backtrace
+version: 0.05
+author:
+ - 'Christoph Bussenius <pepe at cpan.org>'
+abstract: Object-oriented backtrace
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ Class::Accessor: 0
+ String::Escape: 0
+build_requires:
+ Test::More: 0
+provides:
+ Devel::Backtrace:
+ file: lib/Devel/Backtrace.pm
+ version: 0.05
+ Devel::Backtrace::Point:
+ file: lib/Devel/Backtrace/Point.pm
+generated_by: Module::Build version 0.2807
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libdevel-backtrace-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/Makefile.PL?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/Makefile.PL (added)
+++ branches/upstream/libdevel-backtrace-perl/current/Makefile.PL Wed Mar 19 03:46:27 2008
@@ -1,0 +1,16 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'PL_FILES' => {},
+ 'INSTALLDIRS' => 'site',
+ 'NAME' => 'Devel::Backtrace',
+ 'EXE_FILES' => [],
+ 'VERSION_FROM' => 'lib/Devel/Backtrace.pm',
+ 'PREREQ_PM' => {
+ 'Test::More' => 0,
+ 'String::Escape' => 0,
+ 'Class::Accessor' => 0
+ }
+ )
+;
Added: branches/upstream/libdevel-backtrace-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/README?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/README (added)
+++ branches/upstream/libdevel-backtrace-perl/current/README Wed Mar 19 03:46:27 2008
@@ -1,0 +1,89 @@
+NAME
+ Devel::Backtrace - Object-oriented backtrace
+
+VERSION
+ This is version 0.05.
+
+SYNOPSIS
+ my $backtrace = Devel::Backtrace->new;
+
+ print $backtrace; # use automatic stringification
+ # See EXAMPLES to see what the output might look like
+
+ print $backtrace->point(0)->line;
+
+METHODS
+ Devel::Backtrace->new([$start])
+ Constructs a new "Devel::Backtrace" which is filled with all the
+ information "caller($i)" provides, where $i starts from $start. If no
+ argument is given, $start defaults to 0.
+
+ If $start is 1 (or higher), the backtrace won't contain the information
+ that (and where) Devel::Backtrace::new() was called.
+
+ $backtrace->point($i)
+ Returns the i'th tracepoint as a Devel::Backtrace::Point object (see its
+ documentation for how to access every bit of information).
+
+ Note that the following code snippet will print the information of
+ "caller($start+$i)":
+
+ print Devel::Backtrace->new($start)->point($i)
+
+ $backtrace->points()
+ Returns a list of all tracepoints. In scalar context, the number of
+ tracepoints is returned.
+
+ $backtrace->skipme([$package])
+ This method deletes all leading tracepoints that contain information
+ about calls within $package. Afterwards the $backtrace will look as
+ though it had been created with a higher value of $start.
+
+ If the optional parameter $package is not given, it defaults to the
+ calling package.
+
+ The effect is similar to what the Carp module does.
+
+ This module ships with an example "skipme.pl" that demonstrates how to
+ use this method.
+
+ $backtrace->to_string()
+ Returns a string that contains one line for each tracepoint. It will
+ contain the information from "Devel::Backtrace::Point"'s to_string()
+ method. To get more information, use the to_long_string() method.
+
+ Note that you don't have to call to_string() if you print a
+ "Devel::Backtrace" object or otherwise treat it as a string, as the
+ stringification operator is overloaded.
+
+ See "EXAMPLES".
+
+ $backtrace->to_long_string()
+ Returns a very long string that contains several lines for each trace
+ point. The result will contain every available bit of information. See
+ "to_long_string" in Devel::Backtrace::Point for an example of what the
+ result looks like.
+
+EXAMPLES
+ A sample stringification might look like this:
+
+ Devel::Backtrace::new called from main (foo.pl:10)
+ main::bar called from main (foo.pl:6)
+ main::foo called from main (foo.pl:13)
+
+SEE ALSO
+ Devel::StackTrace does mostly the same as this module. I'm afraid I
+ haven't noticed it until I uploaded this module.
+
+ Carp::Trace is a simpler module which gives you a backtrace in string
+ form.
+
+AUTHOR
+ Christoph Bussenius <pepe at cpan.org>
+
+COPYRIGHT
+ Copyright (C) 2007 Christoph Bussenius.
+
+ This program is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
Added: branches/upstream/libdevel-backtrace-perl/current/examples/basic.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/examples/basic.pl?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/examples/basic.pl (added)
+++ branches/upstream/libdevel-backtrace-perl/current/examples/basic.pl Wed Mar 19 03:46:27 2008
@@ -1,0 +1,62 @@
+#!perl
+use strict;
+use warnings;
+
+use Devel::Backtrace;
+
+sub foo {
+ bar();
+}
+
+sub bar {
+ my $backtrace1 = Devel::Backtrace->new;
+ print "First backtrace:\n$backtrace1\n";
+
+ my $backtrace2 = Devel::Backtrace->new(1);
+ print "Second (shorter) backtrace:\n$backtrace2\n";
+
+ my $backtrace3 = Devel::Backtrace->new(2);
+ print "Third (even shorter) backtrace:\n$backtrace3\n";
+
+ print "The third backtrace in a very long form:\n";
+ print "(Note that the bitmask may depend on the perl version.)\n";
+ print $backtrace3->to_long_string, "\n";
+
+ print "The line number from the second line of the first backtrace:\n";
+ print $backtrace1->point(1)->line, "\n";
+}
+
+
+foo();
+
+__END__
+
+Output:
+
+First backtrace:
+Devel::Backtrace::new called from main (basic.pl:12)
+main::bar called from main (basic.pl:8)
+main::foo called from main (basic.pl:30)
+
+Second (shorter) backtrace:
+main::bar called from main (basic.pl:8)
+main::foo called from main (basic.pl:30)
+
+Third (even shorter) backtrace:
+main::foo called from main (basic.pl:30)
+
+The third backtrace in a very long form:
+(Note that the bitmask may depend on the perl version.)
+package: main
+filename: basic.pl
+line: 30
+subroutine: main::foo
+hasargs: 1
+wantarray: undef
+evaltext: undef
+is_require: undef
+hints: 2
+bitmask: UUUUUUUUUUUU\05
+
+The line number from the second line of the first backtrace:
+8
Added: branches/upstream/libdevel-backtrace-perl/current/examples/skipme.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/examples/skipme.pl?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/examples/skipme.pl (added)
+++ branches/upstream/libdevel-backtrace-perl/current/examples/skipme.pl Wed Mar 19 03:46:27 2008
@@ -1,0 +1,64 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Devel::Backtrace;
+
+# This script demonstrates the use of the skipme method.
+
+Foo::foo1();
+
+{
+ package Foo;
+
+ sub foo1 {
+ foo2();
+ }
+
+ sub foo2 {
+ Bar::bar1();
+ }
+}
+
+{
+ package Bar;
+
+ sub bar1 {
+ bar2();
+ }
+
+ sub bar2 {
+ Baz::baz1();
+ }
+}
+
+{
+ package Baz;
+
+ sub baz1 {
+ baz2();
+ }
+
+ sub baz2 {
+ baz3();
+ }
+
+ sub baz3 {
+ my $backtrace = Devel::Backtrace->new;
+
+ # Tell Devel::Backtrace that we are not interested in what Baz method
+ # calls which Baz method.
+ $backtrace->skipme;
+
+ print $backtrace;
+ }
+}
+
+__END__
+
+Output:
+
+Baz::baz1 called from Bar (skipme.pl:30)
+Bar::bar2 called from Bar (skipme.pl:26)
+Bar::bar1 called from Foo (skipme.pl:18)
+Foo::foo2 called from Foo (skipme.pl:14)
+Foo::foo1 called from main (skipme.pl:8)
Added: branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace.pm?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace.pm (added)
+++ branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace.pm Wed Mar 19 03:46:27 2008
@@ -1,0 +1,176 @@
+package Devel::Backtrace;
+use strict;
+use warnings;
+use Devel::Backtrace::Point;
+
+use overload '""' => \&to_string;
+
+=head1 NAME
+
+Devel::Backtrace - Object-oriented backtrace
+
+=head1 VERSION
+
+This is version 0.05.
+
+=cut
+
+our $VERSION = '0.05';
+
+=head1 SYNOPSIS
+
+ my $backtrace = Devel::Backtrace->new;
+
+ print $backtrace; # use automatic stringification
+ # See EXAMPLES to see what the output might look like
+
+ print $backtrace->point(0)->line;
+
+=head1 METHODS
+
+=head2 Devel::Backtrace->new([$start])
+
+Constructs a new C<Devel::Backtrace> which is filled with all the information
+C<caller($i)> provides, where C<$i> starts from C<$start>. If no argument is
+given, C<$start> defaults to 0.
+
+If C<$start> is 1 (or higher), the backtrace won't contain the information that
+(and where) Devel::Backtrace::new() was called.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my ($start) = @_;
+
+ $start = 0 unless defined $start;
+
+ my @backtrace;
+ for (my $deep = $start; my @caller = caller($deep); ++$deep) {
+ push @backtrace, \@caller;
+ }
+ $_ = Devel::Backtrace::Point->new($_) for @backtrace;
+
+ return bless \@backtrace, $class;
+}
+
+=head2 $backtrace->point($i)
+
+Returns the i'th tracepoint as a L<Devel::Backtrace::Point> object (see its documentation
+for how to access every bit of information).
+
+Note that the following code snippet will print the information of
+C<caller($start+$i)>:
+
+ print Devel::Backtrace->new($start)->point($i)
+
+=cut
+
+sub point {
+ my $this = shift;
+ my ($i) = @_;
+ return $this->[$i];
+}
+
+=head2 $backtrace->points()
+
+Returns a list of all tracepoints. In scalar context, the number of
+tracepoints is returned.
+
+=cut
+
+sub points {
+ my $this = shift;
+ return @$this;
+}
+
+=head2 $backtrace->skipme([$package])
+
+This method deletes all leading tracepoints that contain information about calls
+within C<$package>. Afterwards the C<$backtrace> will look as though it had
+been created with a higher value of C<$start>.
+
+If the optional parameter C<$package> is not given, it defaults to the calling
+package.
+
+The effect is similar to what the L<Carp> module does.
+
+This module ships with an example "skipme.pl" that demonstrates how to use this
+method.
+
+=cut
+
+sub skipme {
+ my $this = shift;
+ my $package = @_ ? $_[0] : caller;
+
+ my $skip;
+ $skip = shift @$this while @$this and $package eq $this->point(0)->package;
+ return $skip;
+}
+
+=head2 $backtrace->to_string()
+
+Returns a string that contains one line for each tracepoint. It will contain
+the information from C<Devel::Backtrace::Point>'s to_string() method. To get
+more information, use the to_long_string() method.
+
+Note that you don't have to call to_string() if you print a C<Devel::Backtrace>
+object or otherwise treat it as a string, as the stringification operator is
+overloaded.
+
+See L</EXAMPLES>.
+
+=cut
+
+sub to_string {
+ my $this = shift;
+ return join '', map "$_\n", $this->points;
+}
+
+
+=head2 $backtrace->to_long_string()
+
+Returns a very long string that contains several lines for each trace point.
+The result will contain every available bit of information. See
+L<Devel::Backtrace::Point/to_long_string> for an example of what the result
+looks like.
+
+=cut
+
+sub to_long_string {
+ my $this = shift;
+ return join "\n", map $_->to_long_string, $this->points;
+}
+
+
+1
+__END__
+
+=head1 EXAMPLES
+
+A sample stringification might look like this:
+
+ Devel::Backtrace::new called from main (foo.pl:10)
+ main::bar called from main (foo.pl:6)
+ main::foo called from main (foo.pl:13)
+
+=head1 SEE ALSO
+
+L<Devel::StackTrace> does mostly the same as this module. I'm afraid I haven't
+noticed it until I uploaded this module.
+
+L<Carp::Trace> is a simpler module which gives you a backtrace in string form.
+
+=head1 AUTHOR
+
+Christoph Bussenius <pepe at cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2007 Christoph Bussenius.
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace/Point.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace/Point.pm?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace/Point.pm (added)
+++ branches/upstream/libdevel-backtrace-perl/current/lib/Devel/Backtrace/Point.pm Wed Mar 19 03:46:27 2008
@@ -1,0 +1,197 @@
+package Devel::Backtrace::Point;
+use strict;
+use warnings;
+use Carp;
+use String::Escape qw(printable);
+
+=head1 NAME
+
+Devel::Backtrace::Point - Object oriented access to the information caller()
+provides
+
+=head1 SYNOPSIS
+
+ print Devel::Backtrace::Point->new([caller(0)])->to_long_string;
+
+=head1 DESCRIPTION
+
+This class is a nice way to access all the information caller provides on a
+given level. It is used by L<Devel::Backtrace>, which generates an array of
+all trace points.
+
+=cut
+
+use base qw(Class::Accessor::Fast);
+use overload '""' => \&to_string;
+use constant;
+
+BEGIN {
+ my @known_fields = (qw(package filename line subroutine hasargs wantarray
+ evaltext is_require hints bitmask hinthash));
+ # The number of caller()'s return values depends on the perl version. For
+ # instance, hinthash is not available below perl 5.9. We try and see how
+ # many fields are supported
+ my $supported_fields_number = () = caller(0)
+ or die "Caller doesn't work as expected";
+
+ # If not all known fields are supported, remove some
+ while (@known_fields > $supported_fields_number) {
+ pop @known_fields;
+ }
+
+ # If not all supported fields are known, add placeholders
+ while (@known_fields < $supported_fields_number) {
+ push @known_fields, "_unknown".scalar(@known_fields);
+ }
+
+ constant->import (FIELDS => @known_fields);
+}
+
+=head1 METHODS
+
+=head2 $p->package, $p->filename, $p->line, $p->subroutine, $p->hasargs,
+$p->wantarray, $p->evaltext, $p->is_require, $p->hints, $p->bitmask,
+$p->hinthash
+
+See L<perlfunc/caller> for documentation of these fields.
+
+hinthash is only available in perl 5.9 and higher. When this module is loaded,
+it tests how many values caller returns. Depending on the result, it adds the
+necessary accessors. Thus, you should be able to find out if your perl
+supports hinthash by using L<UNIVERSAL/can>:
+
+ Devel::Backtrace::Point->can('hinthash');
+
+=cut
+
+__PACKAGE__->mk_ro_accessors(FIELDS);
+
+=head2 $p->by_index($i)
+
+You may also access the fields by their index in the list that caller()
+returns. This may be useful if some future perl version introduces a new field
+for caller, and the author of this module doesn't react in time.
+
+=cut
+
+sub by_index {
+ my ($this, $idx) = @_;
+ my $fieldname = (FIELDS)[$idx];
+ unless (defined $fieldname) {
+ croak "There is no field with index $idx.";
+ }
+ return $this->$fieldname();
+}
+
+=head2 new([caller($i)])
+
+This constructs a Devel::Backtrace object. The argument must be a reference to
+an array holding the return values of caller(). This array must have either
+three or ten elements (or eleven if hinthash is supported) (see
+L<perlfunc/caller>).
+
+=cut
+
+sub new {
+ my $class = shift;
+ my ($caller) = @_;
+
+ my %data;
+
+ unless ('ARRAY' eq ref $caller) {
+ croak 'That is not an array reference.';
+ }
+
+ if (@$caller == (() = FIELDS)) {
+ for (FIELDS) {
+ $data{$_} = $caller->[keys %data]
+ }
+ } elsif (@$caller == 3) {
+ @data{qw(package filename line)} = @$caller;
+ } else {
+ croak 'That does not look like the return values of caller.';
+ }
+
+ return $class->SUPER::new(\%data);
+}
+
+=head2 $tracepoint->to_string()
+
+Returns a string of the form "Blah::subname called from main (foo.pl:17)".
+This means that the subroutine C<subname> from package C<Blah> was called by
+package C<main> in C<foo.pl> line 17.
+
+If you print a C<Devel::Backtrace::Point> object or otherwise treat it as a
+string, to_string() will be called automatically due to overloading.
+
+=cut
+
+sub to_string {
+ my $this = shift;
+
+ return $this->subroutine
+ . ' called from '
+ . $this->package . ' ('
+ . $this->filename . ':'
+ . $this->line . ')';
+}
+
+=head2 $tracepoint->to_long_string()
+
+This returns a string which lists all available fields in a table that spans
+several lines.
+
+Example:
+
+ package: main
+ filename: /tmp/foo.pl
+ line: 6
+ subroutine: main::foo
+ hasargs: 1
+ wantarray: undef
+ evaltext: undef
+ is_require: undef
+ hints: 0
+ bitmask: \00\00\00\00\00\00\00\00\00\00\00\00
+
+hinthash is not included in the output, as it is a hash.
+
+=cut
+
+sub to_long_string {
+ my $this = shift;
+ return join '', grep {
+ ! /^_/
+ } map {
+ "$_: " .
+ (defined ($this->{$_}) ? printable($this->{$_}) : 'undef')
+ . "\n"
+ } FIELDS;
+}
+
+=head2 FIELDS
+
+This constant contains a list of all the available field names. The number of
+fields depends on your perl version.
+
+=cut
+
+1
+__END__
+
+=head1 SEE ALSO
+
+L<Devel::Backtrace>
+
+=head1 AUTHOR
+
+Christoph Bussenius <pepe at cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2007 Christoph Bussenius.
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libdevel-backtrace-perl/current/t/00-load.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/t/00-load.t?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/t/00-load.t (added)
+++ branches/upstream/libdevel-backtrace-perl/current/t/00-load.t Wed Mar 19 03:46:27 2008
@@ -1,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Devel::Backtrace' );
+}
+
+diag( "Testing Devel::Backtrace $Devel::Backtrace::VERSION, Perl $], $^X" );
Added: branches/upstream/libdevel-backtrace-perl/current/t/by_index.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/t/by_index.t?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/t/by_index.t (added)
+++ branches/upstream/libdevel-backtrace-perl/current/t/by_index.t Wed Mar 19 03:46:27 2008
@@ -1,0 +1,19 @@
+#!perl
+
+use Test::More tests => 2;
+
+use Devel::Backtrace;
+
+sub get_caller_index {
+ my $idx = shift;
+ my $bt = Devel::Backtrace->new;
+ return $bt->point(1)->by_index($idx);
+}
+
+my $sub = get_caller_index(3); # 3 is subroutine
+is($sub, 'main::get_caller_index', 'field 3');
+
+eval {
+ get_caller_index(7000);
+};
+like($@, qr/There is no field with index 7000/, 'field 7000');
Added: branches/upstream/libdevel-backtrace-perl/current/t/examples.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/t/examples.t?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/t/examples.t (added)
+++ branches/upstream/libdevel-backtrace-perl/current/t/examples.t Wed Mar 19 03:46:27 2008
@@ -1,0 +1,56 @@
+#!perl
+
+use strict;
+use warnings;
+use Test::More;
+
+# This script tests whether the scripts in the "examples" directory do print
+# what they should print.
+
+BEGIN {
+ # Several arguments for open, "-|" needed.
+ # This will only work on non-windows, perl >= 5.8.0
+ $^O =~ /MSWin32/i
+ and plan skip_all => 'This test requires an operating system.';
+ local $@;
+ eval 'use 5.008_000; 1'
+ or plan skip_all => "This test won't work on your perl version.";
+}
+
+use File::Spec;
+
+my $exampledir = 'examples';
+if (! -d $exampledir) {
+ $exampledir = File::Spec->catfile('..', $exampledir);
+}
+chdir($exampledir) or die "$exampledir: $!";
+
+my @examples = <*.pl>;
+
+plan tests => scalar(@examples);
+
+for my $example (@examples) {
+ open my $pipe, '-|', $^X, $example
+ or die "run $example: $!";
+ my $output = do {local $/; <$pipe>};
+ die $! unless defined $output;
+ close $pipe or die "$example: exited $?";
+ open my $examplefh, '<', $example or die "open $example: $!";
+ my $content = do {local $/; <$examplefh>};
+ defined $content or die "read $example: $!";
+ my ($expected_output) = $content =~ /^Output:\s*^(.*)\Z/ms
+ or die "$example corrupt";
+
+ for ($output, $expected_output) {
+ # The bitmask is not portable
+ s/^bitmask:.*//m;
+
+ # hints and hinthash depend on the perl version
+ s/^hint.*//mg;
+
+ # Avoid any newline problems
+ $_ = join "\n", m{[^\015\012]+}g;
+ }
+
+ is($output, $expected_output, $example);
+}
Added: branches/upstream/libdevel-backtrace-perl/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/t/pod-coverage.t?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/t/pod-coverage.t (added)
+++ branches/upstream/libdevel-backtrace-perl/current/t/pod-coverage.t Wed Mar 19 03:46:27 2008
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: branches/upstream/libdevel-backtrace-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-backtrace-perl/current/t/pod.t?rev=17853&op=file
==============================================================================
--- branches/upstream/libdevel-backtrace-perl/current/t/pod.t (added)
+++ branches/upstream/libdevel-backtrace-perl/current/t/pod.t Wed Mar 19 03:46:27 2008
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
More information about the Pkg-perl-cvs-commits
mailing list