package Error::Pure::Output::Text;

# Pragmas.
use base qw(Exporter);
use strict;
use warnings;

# Modules.
use Readonly;

# Constants.
Readonly::Array our @EXPORT_OK => qw(err_bt_pretty err_line err_line_all);
Readonly::Scalar my $SPACE => q{ };

# Version.
our $VERSION = 0.13;

# Pretty print of backtrace.
sub err_bt_pretty {
	my @errors = @_;
	my @ret;
	my $l_ar = _lenghts(@errors);
	foreach my $error_hr (@errors) {
		my @msg = @{$error_hr->{'msg'}};
		my $e = shift @msg;
		chomp $e;
		push @ret, 'ERROR: '.$e;
		while (@msg) {
			my $f = shift @msg;
			my $t = shift @msg;

			if (! defined $f) {
				last;
			}
			my $ret = $f;
			if (defined $t) {
				$ret .= ': '.$t;
			}
			push @ret, $ret;
		}
		foreach my $i (0 .. $#{$error_hr->{'stack'}}) {
			my $st = $error_hr->{'stack'}->[$i];
			my $ret = $st->{'class'};
			$ret .=  $SPACE x ($l_ar->[0] - length $st->{'class'});
			$ret .=  $st->{'sub'};
			$ret .=  $SPACE x ($l_ar->[1] - length $st->{'sub'});
			$ret .=  $st->{'prog'};
			$ret .=  $SPACE x ($l_ar->[2] - length $st->{'prog'});
			$ret .=  $st->{'line'};
			push @ret, $ret;
		}
	}
	return wantarray ? @ret : (join "\n", @ret)."\n";
}

sub err_line_all {
	my @errors = @_;
	my $ret;
	foreach my $error_hr (@errors) {
		$ret .= _err_line($error_hr);
	}
	return $ret;
}

# Pretty print line error.
sub err_line {
	my @errors = @_;
	return _err_line($errors[-1]);
}

# Gets length for errors.
sub _lenghts {
	my @errors = @_;
	my $l_ar = [0, 0, 0];
	foreach my $error_hr (@errors) {
		foreach my $st (@{$error_hr->{'stack'}}) {
			if (length $st->{'class'} > $l_ar->[0]) {
				$l_ar->[0] = length $st->{'class'};
			}
			if (length $st->{'sub'} > $l_ar->[1]) {
				$l_ar->[1] = length $st->{'sub'};
			}
			if (length $st->{'prog'} > $l_ar->[2]) {
				$l_ar->[2] = length $st->{'prog'};
			}
		}
	}
	$l_ar->[0] += 2;
	$l_ar->[1] += 2;
	$l_ar->[2] += 2;
	return $l_ar;
}

# Pretty print line error.
sub _err_line {
	my $error_hr = shift;
	my $stack_ar = $error_hr->{'stack'};
	my $msg = $error_hr->{'msg'};
	my $prog = $stack_ar->[0]->{'prog'};
	$prog =~ s/^\.\///gms;
	my $e = $msg->[0];
	chomp $e;
	return "#Error [$prog:$stack_ar->[0]->{'line'}] $e\n";
}

1;

__END__

=pod

=encoding utf8

=head1 NAME

Error::Pure::Output::Text - Output subroutines for Error::Pure.

=head1 SYNOPSIS

 use Error::Pure::Output::Text qw(err_bt_pretty err_line err_line_all);
 print err_bt_pretty(@errors);
 print err_line_all(@errors);
 print err_line(@errors);

=head1 SUBROUTINES

=over 8

=item B<err_bt_pretty(@errors)>

 Returns string with full backtrace in scalar context.
 Returns array of full backtrace lines in array context.
 Format of error is:
         ERROR: %s
         %s: %s
         ...
         %s %s %s %s
         ...
 Values of error are:
         message
         message as key, $message as value
         ...
         sub, caller, program, line

=item B<err_line_all(@errors)>

 Returns string with errors each on one line.
 Use all errors in @errors structure.
 Format of error line is: "#Error [%s:%s] %s\n"
 Values of error line are: $program, $line, $message

=item B<err_line(@errors)>

 Returns string with error on one line.
 Use last error in @errors structure..
 Format of error is: "#Error [%s:%s] %s\n"
 Values of error are: $program, $line, $message

=back

=head1 ERRORS

 None.

=head1 EXAMPLE1

 # Pragmas.
 use strict;
 use warnings;

 # Modules.
 use Error::Pure::Output::Text qw(err_bt_pretty);

 # Fictional error structure.
 my $err_hr = {
         'msg' => [
                 'FOO',
                 'KEY',
                 'VALUE',
         ],
         'stack' => [
                 {
                         'args' => '(2)',
                         'class' => 'main',
                         'line' => 1,
                         'prog' => 'script.pl',
                         'sub' => 'err',
                 }, {
                         'args' => '',
                         'class' => 'main',
                         'line' => 20,
                         'prog' => 'script.pl',
                         'sub' => 'eval {...}',
                 }
         ],
 };

 # Print out.
 print scalar err_bt_pretty($err_hr);

 # Output:
 # ERROR: FOO
 # KEY: VALUE
 # main  err         script.pl  1
 # main  eval {...}  script.pl  20

=head1 EXAMPLE2

 # Pragmas.
 use strict;
 use warnings;

 # Modules.
 use Error::Pure::Output::Text qw(err_line_all);

 # Fictional error structure.
 my @err = (
         {
                 'msg' => [
                         'FOO',
                         'BAR',
                 ],
                 'stack' => [
                         {
                                 'args' => '(2)',
                                 'class' => 'main',
                                 'line' => 1,
                                 'prog' => 'script.pl',
                                 'sub' => 'err',
                         }, {
                                 'args' => '',
                                 'class' => 'main',
                                 'line' => 20,
                                 'prog' => 'script.pl',
                                 'sub' => 'eval {...}',
                         }
                 ],
         }, {
                 'msg' => ['XXX'],
                 'stack' => [
                         {
                                 'args' => '',
                                 'class' => 'main',
                                 'line' => 2,
                                 'prog' => 'script.pl',
                                 'sub' => 'err',
                         },
                 ],
         }
 );

 # Print out.
 print err_line_all(@err);

 # Output:
 # #Error [script.pl:1] FOO
 # #Error [script.pl:2] XXX

=head1 EXAMPLE3

 # Pragmas.
 use strict;
 use warnings;

 # Modules.
 use Error::Pure::Output::Text qw(err_line);

 # Fictional error structure.
 my $err_hr = {
         'msg' => [
                 'FOO',
                 'BAR',
         ],
         'stack' => [
                 {
                         'args' => '(2)',
                         'class' => 'main',
                         'line' => 1,
                         'prog' => 'script.pl',
                         'sub' => 'err',
                 }, {
                         'args' => '',
                         'class' => 'main',
                         'line' => 20,
                         'prog' => 'script.pl',
                         'sub' => 'eval {...}',
                 }
         ],
 };

 # Print out.
 print err_line($err_hr);

 # Output:
 # #Error [script.pl:1] FOO

=head1 DEPENDENCIES

L<Exporter>,
L<Readonly>.

=head1 SEE ALSO

L<Error::Pure>,
L<Error::Pure::AllError>,
L<Error::Pure::Die>,
L<Error::Pure::Error>,
L<Error::Pure::ErrorList>,
L<Error::Pure::Print>,
L<Error::Pure::Utils>,

=head1 REPOSITORY

L<https://github.com/tupinek/Error-Pure>

=head1 AUTHOR

Michal Špaček L<mailto:skim@cpan.org>

L<http://skim.cz>

=head1 LICENSE AND COPYRIGHT

BSD license.

=head1 VERSION

0.13

=cut