# -----------------------------------------------------------------------------

=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.226';

# -----------------------------------------------------------------------------

=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;
}

# -----------------------------------------------------------------------------

=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;
}

# -----------------------------------------------------------------------------

=head1 VERSION

1.226

=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
