—
—
—
—

              
# -----------------------------------------------------------------------------
HideShow 78 lines of Pod
=encoding utf8
=head1 NAME
Quiq::Stacktrace - Generiere und visualisiere einen Stacktrace
=head1 SYNOPSIS
  use Quiq::Stacktrace;
   
  my $st = Quiq::Stacktrace->new; # generiere Stacktrace
  print $st->asString,"\n";       # visualisiere Stacktrace
   
  -or-
   
  print Quiq::Stacktrace->asString,"\n"; # in einem Aufruf
=head1 DESCRIPTION
Ein Objekt der Klasse repräsentiert die Aufrufhierarchie des
laufenden Perl-Programms zum Zeitpunkt der Instantiierung des
Stacktrace-Objektes.
Die Klasse kann zum Debuggen verwendet werden oder bei der
Erzeugung von Exceptions.
Folgendes Beispielprogramm (test.pl)
  #!/usr/bin/env perl
   
  use Quiq::Stacktrace;
   
  sub a {
      b();
  }
   
  sub b {
      c();
  }
   
  sub c {
      print Quiq::Stacktrace->asString,"\n";
  }
   
  a();
erzeugt die Ausgabe
  main::a() [+17 ./test.pl]
    main::b() [+6 ./test.pl]
      main::c() [+10 ./test.pl]
        Quiq::Stacktrace::asString() [+14 ./test.pl]
Von oben nach unten gelesen gibt der Stacktrace die Hierarchie der
Subroutine-Aufrufe (= Methoden oder Funktionsaufrufe) in der
Aufrufreihenfolge wieder. Jede Zeile beschreibt einen Subroutine-Aufruf:
  main::a() [+17 ./test.pl]
  ^     ^     ^  ^
  |     |     |  +-- Datei, in der der Aufruf steht
  |     |     +-- Zeilennummer, an der der Aufruf in der Datei steht
  |     +-- Name der aufgerufenen Subroutine
  +-- Package, zu dem die Subroutine gehört
Die in eckigen Klammern genannte Quelltextposition kann bei
Aufruf von vi(1), emacs(1) oder less(1) benutzt werden,
um unmittelbar auf die entsprechende Zeile zu positionieren:
  $ less +17 ./test.pl
Der unterste Eintrag im Stacktrace ist der Aufruf des
Konstruktors L<new|"new() - Konstruktor">() oder der Methode L<asString|"asString() - Visualisiere Stacktrace-Objekt">(), wenn sie
als Klassenmethode gerufen wird. Sollen Stacktrace-Frames am
Ende weggelassen werden, kann dies durch Angabe des Parameters
$i erreicht werden.
=cut
# -----------------------------------------------------------------------------
package Quiq::Stacktrace;
use v5.10;
use strict;
use warnings;
our $VERSION = '1.225';
# -----------------------------------------------------------------------------
HideShow 33 lines of Pod
=head1 METHODS
=head2 Instantiierung
=head3 new() - Konstruktor
=head4 Synopsis
  $st = $class->new;
  $st = $class->new($i);
=head4 Arguments
=over 4
=item $i (Default: 0)
Anzahl der Stackframes vom Ende des Stacktrace, die nicht
berücksichtigt werden. Ist $i == 0 (was der Default ist), werden
alle Frames berücksichtigt.
=back
=head4 Description
Instantiiere ein Stacktrace-Objekt und liefere eine Referenz auf diese
Objekt zurück. Das Stacktrace-Objekt repräsentiert die Aufruf-Hierarchie
des laufenden Perl-Programms zum Zeitpunkt der Instantiierung. Letztes
Element in der Hierarchie ist der Konstruktor-Aufruf. Soll der
Stacktrace vorher enden, wird der Parameter $i gesetzt.
=cut
# -----------------------------------------------------------------------------
sub new {
    my $class = shift;
    my $i = shift || 0;
    my @frames;
    while (my (undef,$file,$line,$sub) = caller $i++) {
        push @frames,[$file,$line,$sub];
    }
    return bless \@frames,$class;
}
# -----------------------------------------------------------------------------
HideShow 26 lines of Pod
=head2 Externe Repräsentation
=head3 asString() - Visualisiere Stacktrace-Objekt
=head4 Synopsis
  $str = $st->asString;
  $str = $class->asString($i);
=head4 Arguments
=over 4
=item $i (Default: 0)
Siehe L<new|"new() - Konstruktor">().
=back
=head4 Description
Visualisiere das Stacktrace-Objekt in Form einer Zeichenkette und liefere
diese zurück. Aufbau der Zeichenkette siehe Abschnitt DESCRIPTION.
=cut
# -----------------------------------------------------------------------------
sub asString {
    my $self = ref $_[0]? $_[0]: $_[0]->new(($_[1] || 0)+1);
    if (!ref $self) {
        my $i = shift || 0;
        $self = $self->new($i);
    }
    my $str = '';
    my $i = 0;
    for my $frame (reverse @$self) {
        my ($file,$line,$sub) = @$frame;
        $sub .= "()" if $sub ne '(eval)';
        $str .= sprintf "%s%s [+%s %s]\n",('  'x$i++),$sub,$line,$file;
    }
    chomp $str;
    return $str;
}
# -----------------------------------------------------------------------------
HideShow 19 lines of Pod
=head1 VERSION
1.225
=head1 AUTHOR
Frank Seitz, L<http://fseitz.de/>
=head1 COPYRIGHT
Copyright (C) 2025 Frank Seitz
=head1 LICENSE
This code is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
# -----------------------------------------------------------------------------
1;
# eof