package PSP::Error;

# Copyright (c) 2000, FundsXpress Financial Network, Inc.
# This library is free software released under the GNU Lesser General
# Public License, Version 2.1.  Please read the important licensing and
# disclaimer information included below.

# $Id: Error.pm,v 1.1.1.2 2003/12/06 19:47:26 hartmans Exp $

use strict;

=head1 NAME

 PSP::Error - manages a heirarchy of errors.

=head1 SYNOPSIS

 #more to come.

=head1 DESCRIPTION

more to come.

=cut

use PSP::parent;
@PSP::Error::ISA = qw(PSP::parent);

=head1 METHODS

=head2 new

 class
 (PSP::Error $this)
   new (PSP::FieldSpace $fs, hash \%field_set, 
	str $name, string[] \@children_order, string [] \@field_order)

DESCRIPTION:

This is the constructor for this package\'s object. Basically, this
simply takes all the input data and makes it member data of the
object. Note that C<$children_order> and C<$field_order> must be
complete orderings and it is the callers responsibility to ensure that
they all. Generally the children of this class should provide a
default ordering which can be overidden; thus allowing users to supply
null or partial lists, or possibly not worry about it.

=cut

sub new {
  my ($proto, $name, $fs, $args) = @_;
  $args ||= [];

  my $this = $proto->SUPER::new();

  $this->name($name);
  $this->fieldspace($fs);
  $this->{_label} = undef;
  $this->{_args} = $args;
  ($this->{_type} = ref($proto)||$proto) =~ s/PSP::Error::(.*?)$/\L$1/ or
    $this->{_type} = 'base';

  return $this;
}

=head2 matches

 instance
 (boolean does_match) matches (string pattern)

DESCRIPTION:

=cut 

sub matches {
  my ($this,$pattern) = @_;
  return $this->{_name} eq $pattern;
}

=head2 name and fieldspace

 instance
 (str $name) name ([str $name])

 instance
 (fieldspace $fs) fieldspace ([fieldspace $fs])

 instance
 (str $label) label ([str $label])

DESCRIPTION:

Returns and possibly sets the name and/or fieldspace for this error object.

=cut

sub name {
  my ($this,$name) = @_;
  defined $name and $this->{_name} = $name;
  return $this->{_name};
}
sub fieldspace {
  my ($this,$fieldspace) = @_;
  defined $fieldspace and $this->{_fieldspace} = $fieldspace;
  return $this->{_fieldspace};
}
sub label {
  my ($this,$label) = @_;
  defined $label and $this->{_label} = $label;
  return "" if ! defined $this->{_label};
  return $this->{_label};
}

=head2 add_error and remove_error

 instance
 (boolean $success) add_error (str $message[, string labels[] ])
 instance
 (boolean $success) remove_error ([ string labels[] ])

DESCRIPTION:

Adds an error possibly identified by labels[] to this.  Returns true on 
success.

=cut

sub add_error {
  my ($this, $arg, @labels) = @_;

  # find the node in the error tree where the message array will be.
  my $node = $this;
  for my $name (@labels) {
    my $child_node = $node->find_child($name);
    $node = $child_node || $node->add_child($node->new($name));
  }
  # add input error arg.
  push @{$node->{_args}}, $arg;
}
sub remove_error {
  my ($this, @labels) = @_;

  # find the node in the error tree where the message array will be.
  my $node = $this;
  my $prev_node;
  for my $name (@labels) {
    my $child_node = $node->find_child($name);
    $prev_node = $node;
    $node = $child_node or return;
  }
  $prev_node and $prev_node->del_child($node);
}

=head2 as_string

Should print the error messages associated with the fields associated
with the error object.

=cut

sub as_string {
  my ($this,$node,$indent) = @_;
  $node ||= $this;
  $indent ||= "";

  my $str = "";
  if (defined @{$node->{_args}}) {
    $str .= $node->label().
      join("",map { $indent.$_."\n" } @{$node->{_args}});
  }

  $indent .= "  ";
  for my $child ($node->children()) {
    $str .= $child->as_string($child,$indent);
  }

  return $str;
}

sub as_html {
  my ($this, $node, $indent) = @_;
  $node ||= $this;
  $indent ||= "";

  my $str = "";
  if (@{$node->{_args}}) {
    $str .= $node->label().$indent.
      join("<br>\n$indent", @{$node->{_args}})."<br>\n";
  }

  $indent .= "&nbsp; ";
  for my $child ($node->children) {
    $str .= $child->as_html($child,$indent);
  }

  return $str;
}

sub as_bullets {
  my ($this, $node, $indent) = @_;
  $node ||= $this;
  $indent ||= "";

  my $str = "";
  if (@{$node->{_args}}) {
    $str .= $node->label().$indent.
      join("<br>\n$indent", @{$node->{_args}})."\n";
  }

  $indent .= "  ";
  my $children_str = "";
  for my $child ($node->children) {
    my $new_str = $child->as_bullets($child,$indent) or next;
    $children_str .= "<li>\n".$new_str;
  }
  $children_str and $str .= "<ul>\n$children_str</ul>\n";

  return $str;
}

sub isa {
  my ($this, $type) = @_;
  return ($type eq $this->{_type});
}

sub free_internals {
  my ($this) = @_;

  $this->SUPER::free();

  delete $this->{fieldspace};
}

1;
__END__

=head1 BUGS

No known bugs, but this does not mean no bugs exist.

=head1 SEE ALSO

L<PSP::parent>

=head1 COPYRIGHT

 PSP - Perl Server Pages
 Copyright (c) 2000, FundsXpress Financial Network, Inc.

 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
 License as published by the Free Software Foundation; either
 version 2 of the License, or (at your option) any later version.

 BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 License for more details.

 You should have received a copy of the GNU Lesser General Public
 License along with this library; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA

=cut