r18278 - in /trunk/libdevel-backtrace-perl: Changes MANIFEST META.yml README debian/changelog examples/basic.pl examples/dollarat.pl lib/Devel/Backtrace.pm lib/Devel/Backtrace/Point.pm t/basic.t t/dollarat.t t/examples.t t/skipme.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Wed Apr 2 19:43:02 UTC 2008
Author: gregoa-guest
Date: Wed Apr 2 19:43:02 2008
New Revision: 18278
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=18278
Log:
New upstream release.
Added:
trunk/libdevel-backtrace-perl/t/basic.t
- copied unchanged from r18277, branches/upstream/libdevel-backtrace-perl/current/t/basic.t
trunk/libdevel-backtrace-perl/t/dollarat.t
- copied unchanged from r18277, branches/upstream/libdevel-backtrace-perl/current/t/dollarat.t
trunk/libdevel-backtrace-perl/t/skipme.t
- copied unchanged from r18277, branches/upstream/libdevel-backtrace-perl/current/t/skipme.t
Removed:
trunk/libdevel-backtrace-perl/t/examples.t
Modified:
trunk/libdevel-backtrace-perl/Changes
trunk/libdevel-backtrace-perl/MANIFEST
trunk/libdevel-backtrace-perl/META.yml
trunk/libdevel-backtrace-perl/README
trunk/libdevel-backtrace-perl/debian/changelog
trunk/libdevel-backtrace-perl/examples/basic.pl
trunk/libdevel-backtrace-perl/examples/dollarat.pl
trunk/libdevel-backtrace-perl/lib/Devel/Backtrace.pm
trunk/libdevel-backtrace-perl/lib/Devel/Backtrace/Point.pm
Modified: trunk/libdevel-backtrace-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-backtrace-perl/Changes?rev=18278&op=diff
==============================================================================
--- trunk/libdevel-backtrace-perl/Changes (original)
+++ trunk/libdevel-backtrace-perl/Changes Wed Apr 2 19:43:02 2008
@@ -37,3 +37,12 @@
0.09 Sun Mar 30 16:08:25 CEST 2008
Documentation fixes
Added version to Devel::Backtrace::Point
+
+0.10 Wed Apr 2 02:51:43 CEST 2008
+ Format strings for stringification.
+ Level information in Devel::Backtrace::Point.
+ Fix a warning in examples/dollarat.pl in perl 5.10.
+ Change the test system. Previously it used to automatically run the
+ examples, but now it's independent from the examples because that's
+ more flexible.
+ Again, added some fixes to make the tests work on all platforms.
Modified: trunk/libdevel-backtrace-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-backtrace-perl/MANIFEST?rev=18278&op=diff
==============================================================================
--- trunk/libdevel-backtrace-perl/MANIFEST (original)
+++ trunk/libdevel-backtrace-perl/MANIFEST Wed Apr 2 19:43:02 2008
@@ -13,7 +13,9 @@
META.yml
README
t/00-load.t
+t/basic.t
t/by_index.t
-t/examples.t
+t/dollarat.t
t/pod-coverage.t
t/pod.t
+t/skipme.t
Modified: trunk/libdevel-backtrace-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-backtrace-perl/META.yml?rev=18278&op=diff
==============================================================================
--- trunk/libdevel-backtrace-perl/META.yml (original)
+++ trunk/libdevel-backtrace-perl/META.yml Wed Apr 2 19:43:02 2008
@@ -1,6 +1,6 @@
---
name: Devel-Backtrace
-version: 0.09
+version: 0.10
author:
- 'Christoph Bussenius <pepe at cpan.org>'
abstract: Object-oriented backtrace
@@ -16,10 +16,10 @@
provides:
Devel::Backtrace:
file: lib/Devel/Backtrace.pm
- version: 0.09
+ version: 0.10
Devel::Backtrace::Point:
file: lib/Devel/Backtrace/Point.pm
- version: 0.09
+ version: 0.10
Devel::DollarAt:
file: lib/Devel/DollarAt.pm
version: 0.02
Modified: trunk/libdevel-backtrace-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-backtrace-perl/README?rev=18278&op=diff
==============================================================================
--- trunk/libdevel-backtrace-perl/README (original)
+++ trunk/libdevel-backtrace-perl/README Wed Apr 2 19:43:02 2008
@@ -2,7 +2,7 @@
Devel::Backtrace - Object-oriented backtrace
VERSION
- This is version 0.09.
+ This is version 0.10.
SYNOPSIS
my $backtrace = Devel::Backtrace->new;
@@ -13,7 +13,11 @@
print $backtrace->point(0)->line;
METHODS
- Devel::Backtrace->new([$start])
+ Devel::Backtrace->new()
+ Optional parameters: -start => $start, -format => $format
+
+ If only one parameter is given, it will be used as $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.
@@ -57,6 +61,8 @@
This means that skipmysubs usually deletes more lines than skipme would.
+ "skipmysubs" was added in Devel::Backtrace version 0.06.
+
See also "EXAMPLES" and the example "skipme.pl".
$backtrace->to_string()
@@ -88,9 +94,21 @@
If MyPackage called skipme, the first two lines would be removed. If it
called skipmysubs, the first three lines would be removed.
+ If you don't like the format, you can change it:
+
+ my $backtrace = Devel::Backtrace->new(-format => '%I. %s');
+
+ This would produce a stringification of the following form:
+
+ 0. Devel::Backtrace::new
+ 1. MyPackage::test2
+ 2. MyPackage::test1
+ 3. main::bar
+ 4. main::foo
+
SEE ALSO
Devel::StackTrace does mostly the same as this module. I'm afraid I
- haven't noticed it until I uploaded this module.
+ hadn't noticed it until I uploaded this module.
Carp::Trace is a simpler module which gives you a backtrace in string
form.
Modified: trunk/libdevel-backtrace-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-backtrace-perl/debian/changelog?rev=18278&op=diff
==============================================================================
--- trunk/libdevel-backtrace-perl/debian/changelog (original)
+++ trunk/libdevel-backtrace-perl/debian/changelog Wed Apr 2 19:43:02 2008
@@ -1,3 +1,9 @@
+libdevel-backtrace-perl (0.10-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregor+debian at comodo.priv.at> Wed, 02 Apr 2008 21:41:17 +0200
+
libdevel-backtrace-perl (0.09-1) unstable; urgency=low
[ Roberto C. Sanchez ]
Modified: trunk/libdevel-backtrace-perl/examples/basic.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-backtrace-perl/examples/basic.pl?rev=18278&op=diff
==============================================================================
--- trunk/libdevel-backtrace-perl/examples/basic.pl (original)
+++ trunk/libdevel-backtrace-perl/examples/basic.pl Wed Apr 2 19:43:02 2008
@@ -27,6 +27,11 @@
print "The called package from the first line of the first backtrace:\n";
print $backtrace1->point(0)->called_package, "\n";
+
+ my $backtrace4 = Devel::Backtrace->new(-start => 1,
+ -format => 'subroutine %s, package %c from %p');
+ print "bar call in different format:\n";
+ print $backtrace4->point(0);
}
@@ -39,20 +44,20 @@
First backtrace:
Devel::Backtrace::new called from main (examples/basic.pl:12)
main::bar called from main (examples/basic.pl:8)
-main::foo called from main (examples/basic.pl:33)
+main::foo called from main (examples/basic.pl:38)
Second (shorter) backtrace:
main::bar called from main (examples/basic.pl:8)
-main::foo called from main (examples/basic.pl:33)
+main::foo called from main (examples/basic.pl:38)
Third (even shorter) backtrace:
-main::foo called from main (examples/basic.pl:33)
+main::foo called from main (examples/basic.pl:38)
The third backtrace in a very long form:
(Note that the bitmask may depend on the perl version.)
package: main
filename: examples/basic.pl
-line: 33
+line: 38
subroutine: main::foo
hasargs: 1
wantarray: undef
@@ -66,3 +71,6 @@
The called package from the first line of the first backtrace:
Devel::Backtrace
+
+bar call in different format:
+subroutine main::bar, package main from main
Modified: trunk/libdevel-backtrace-perl/examples/dollarat.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-backtrace-perl/examples/dollarat.pl?rev=18278&op=diff
==============================================================================
--- trunk/libdevel-backtrace-perl/examples/dollarat.pl (original)
+++ trunk/libdevel-backtrace-perl/examples/dollarat.pl Wed Apr 2 19:43:02 2008
@@ -3,17 +3,12 @@
use warnings;
use Devel::DollarAt;
-eval '0/0; "foo"';
+eval 'print 0/0';
-# Don't worry about the "foo"; it serves to make perl 5.8 and 5.10 output the
-# same line number so I can use this example in the tests.
+# Output: Error line is 1
+print "Error line is ", $@->line, "\n";
-print "Error line is ", $@->line, "\n";
+# Output: Error text is Illegal division by zero at (eval 3) line 1.
print "Error text is $@";
-__END__
-
-Output:
-
-Error line is 1
-Error text is Illegal division by zero at (eval 3) line 1.
+# Note: In perl 5.8 and below, the line gets reported as 2.
Modified: trunk/libdevel-backtrace-perl/lib/Devel/Backtrace.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-backtrace-perl/lib/Devel/Backtrace.pm?rev=18278&op=diff
==============================================================================
--- trunk/libdevel-backtrace-perl/lib/Devel/Backtrace.pm (original)
+++ trunk/libdevel-backtrace-perl/lib/Devel/Backtrace.pm Wed Apr 2 19:43:02 2008
@@ -2,6 +2,7 @@
use strict;
use warnings;
use Devel::Backtrace::Point;
+use Carp;
use overload '""' => \&to_string;
@@ -11,11 +12,11 @@
=head1 VERSION
-This is version 0.09.
-
-=cut
-
-our $VERSION = '0.09';
+This is version 0.10.
+
+=cut
+
+our $VERSION = '0.10';
=head1 SYNOPSIS
@@ -28,7 +29,11 @@
=head1 METHODS
-=head2 Devel::Backtrace->new([$start])
+=head2 Devel::Backtrace->new()
+
+Optional parameters: -start => $start, -format => $format
+
+If only one parameter is given, it will be used as $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
@@ -41,15 +46,38 @@
sub new {
my $class = shift;
- my ($start) = @_;
-
- $start = 0 unless defined $start;
+ my (@opts) = @_;
+
+ my $start;
+ my %pointopts;
+
+ if (1 == @opts) {
+ $start = shift @opts;
+ }
+ while (my $opt = shift @opts) {
+ if ('-format' eq $opt) {
+ $pointopts{$opt} = shift @opts;
+ } elsif ('-start' eq $opt) {
+ $start = shift @opts;
+ } else {
+ croak "Unknown option $opt";
+ }
+ }
+
+ if (defined $start) {
+ $pointopts{'-skip'} = $start;
+ } else {
+ $start = 0;
+ }
my @backtrace;
for (my $deep = $start; my @caller = caller($deep); ++$deep) {
- push @backtrace, \@caller;
- }
- $_ = Devel::Backtrace::Point->new($_) for @backtrace;
+ push @backtrace, Devel::Backtrace::Point->new(
+ \@caller,
+ -level => $deep,
+ %pointopts,
+ );
+ }
return bless \@backtrace, $class;
}
@@ -104,11 +132,20 @@
my $this = shift;
my $package = @_ ? $_[0] : caller;
- my $skip;
+ my $skip = 0;
+ my $skipped;
while (@$this and $package eq $this->point(0)->package) {
- $skip = shift @$this;
- }
- return $skip;
+ $skipped = shift @$this;
+ $skip++;
+ }
+ $this->_adjustskip($skip);
+ return $skipped;
+}
+
+sub _adjustskip {
+ my ($this, $newskip) = @_;
+
+ $_->_skip($newskip + ($_->_skip || 0)) for $this->points;
}
=head2 $backtrace->skipmysubs([$package])
@@ -122,6 +159,8 @@
This means that skipmysubs usually deletes more lines than skipme would.
+C<skipmysubs> was added in Devel::Backtrace version 0.06.
+
See also L</EXAMPLES> and the example "skipme.pl".
=cut
@@ -130,11 +169,14 @@
my $this = shift;
my $package = @_ ? $_[0] : caller;
- my $skip = $this->skipme($package);
+ my $skipped = $this->skipme($package);
+ my $skip = 0;
while (@$this and $package eq $this->point(0)->called_package) {
- $skip = shift @$this;
- }
- return $skip;
+ $skipped = shift @$this;
+ $skip++;
+ }
+ $this->_adjustskip($skip);
+ return $skipped;
}
=head2 $backtrace->to_string()
@@ -188,9 +230,21 @@
If MyPackage called skipme, the first two lines would be removed. If it called
skipmysubs, the first three lines would be removed.
+If you don't like the format, you can change it:
+
+ my $backtrace = Devel::Backtrace->new(-format => '%I. %s');
+
+This would produce a stringification of the following form:
+
+ 0. Devel::Backtrace::new
+ 1. MyPackage::test2
+ 2. MyPackage::test1
+ 3. main::bar
+ 4. main::foo
+
=head1 SEE ALSO
-L<Devel::StackTrace> does mostly the same as this module. I'm afraid I haven't
+L<Devel::StackTrace> does mostly the same as this module. I'm afraid I hadn't
noticed it until I uploaded this module.
L<Carp::Trace> is a simpler module which gives you a backtrace in string form.
Modified: trunk/libdevel-backtrace-perl/lib/Devel/Backtrace/Point.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-backtrace-perl/lib/Devel/Backtrace/Point.pm?rev=18278&op=diff
==============================================================================
--- trunk/libdevel-backtrace-perl/lib/Devel/Backtrace/Point.pm (original)
+++ trunk/libdevel-backtrace-perl/lib/Devel/Backtrace/Point.pm Wed Apr 2 19:43:02 2008
@@ -1,7 +1,7 @@
package Devel::Backtrace::Point;
use strict;
use warnings;
-our $VERSION = '0.09';
+our $VERSION = '0.10';
use Carp;
use String::Escape qw(printable);
@@ -67,9 +67,21 @@
__PACKAGE__->mk_ro_accessors(FIELDS);
+=head2 $p->level
+
+This is the level given to new(). It's intended to be the parameter that was
+given to caller().
+
+=cut
+
+__PACKAGE__->mk_ro_accessors('level');
+
=head2 $p->called_package
This returns the package that $p->subroutine is in.
+
+If $p->subroutine does not contain '::', then '(unknown)' is returned. This is
+the case if $p->subroutine is '(eval)'.
=cut
@@ -106,11 +118,24 @@
three or ten elements (or eleven if hinthash is supported) (see
L<perlfunc/caller>).
-=cut
+Optional additional parameters:
+
+ -format => 'formatstring',
+ -level => $i
+
+The format string will be used as a default for to_string().
+
+The level should be the parameter that was given to caller() to obtain the
+caller information.
+
+=cut
+
+__PACKAGE__->mk_ro_accessors('_format');
+__PACKAGE__->mk_accessors('_skip');
sub new {
my $class = shift;
- my ($caller) = @_;
+ my ($caller, %opts) = @_;
my %data;
@@ -128,7 +153,25 @@
croak 'That does not look like the return values of caller.';
}
+ for my $opt (keys %opts) {
+ if ('-format' eq $opt) {
+ $data{'_format'} = $opts{$opt};
+ } elsif ('-level' eq $opt) {
+ $data{'level'} = $opts{$opt};
+ } elsif ('-skip' eq $opt) {
+ $data{'_skip'} = $opts{$opt};
+ } else {
+ croak "Unknown option $opt";
+ }
+ }
+
return $class->SUPER::new(\%data);
+}
+
+sub _virtlevel {
+ my $this = shift;
+
+ return $this->level - ($this->_skip || 0);
}
=head2 $tracepoint->to_string()
@@ -140,16 +183,75 @@
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
+Optional parameters: -format => 'formatstring'
+
+The format string changes the appearance of the return value. It can contain
+C<%p> (package), C<%c> (called_package), C<%f> (filename), C<%l> (line), C<%s>
+(subroutine), C<%a> (hasargs), C<%e> (evaltext), C<%r> (is_require), C<%h>
+(hints), C<%b> (bitmask), C<%i> (level), C<%I> (level, see below).
+
+The difference between C<%i> and C<%I> is that the former is the argument to
+caller() while the latter is actually the index in $backtrace->points(). C<%i>
+and C<%I> are different if C<-start>, skipme() or skipmysubs() is used in
+L<Devel::Backtrace>.
+
+If no format string is given, the one passed to C<new> will be used. If none
+was given to C<new>, the format string defaults to 'default', which is an
+abbreviation for C<%s called from %p (%f:%l)>.
+
+Format strings have been added in Devel-Backtrace-0.10.
+
+=cut
+
+my %formats = (
+ 'default' => '%s called from %p (%f:%l)',
+);
+
+my %percent = (
+ 'p' => 'package',
+ 'c' => 'called_package',
+ 'f' => 'filename',
+ 'l' => 'line',
+ 's' => 'subroutine',
+ 'a' => 'hasargs',
+ 'w' => 'wantarray',
+ 'e' => 'evaltext',
+ 'r' => 'is_require',
+ 'h' => 'hints',
+ 'b' => 'bitmask',
+ 'i' => 'level',
+ 'I' => '_virtlevel',
+);
sub to_string {
- my $this = shift;
-
- return $this->subroutine
- . ' called from '
- . $this->package . ' ('
- . $this->filename . ':'
- . $this->line . ')';
+ my ($this, @opts) = @_;
+
+ my %opts;
+ if (defined $opts[0]) { # check that we are not called as stringification
+ %opts = @opts;
+ }
+
+ my $format = $this->_format();
+
+ for my $opt (keys %opts) {
+ if ($opt eq '-format') {
+ $format = $opts{$opt};
+ } else {
+ croak "Unknown option $opt";
+ }
+ }
+
+ $format = 'default' unless defined $format;
+ $format = $formats{$format} if exists $formats{$format};
+
+ my $result = $format;
+ $result =~ s{%(\S)} {
+ my $percent = $percent{$1} or croak "Unknown symbol %$1\n";
+ my $val = $this->$percent();
+ defined($val) ? printable($val) : 'undef';
+ }ge;
+
+ return $result;
}
=head2 $tracepoint->to_long_string()
@@ -176,12 +278,13 @@
sub to_long_string {
my $this = shift;
- return join '', grep {
- ! /^_/
- } map {
+ return join '',
+ map {
"$_: " .
(defined ($this->{$_}) ? printable($this->{$_}) : 'undef')
. "\n"
+ } grep {
+ ! /^_/ && 'hinthash' ne $_
} FIELDS;
}
More information about the Pkg-perl-cvs-commits
mailing list