view release on metacpan or  search on metacpan

Widgets.pm  view on Meta::CPAN

overriding them) then the following keys should always be recognised:

  Key             Description
  ====================================================
  FOREGROUND      Foreground colour
  BACKGROUND      Background colour
  BORDERCOL       Border (foreground) colour
  CAPTIONCOL      Caption (foreground) colour
  BORDER          Whether or not to display a border
  CAPTION         The string to use as the caption

The colours will default to the terminal foreground/background defaults.
Other arguments may have defaults defined by the descendent classes.

=cut

sub new {
  my $class = shift;
  my $conf = shift;
  my $self = {};

  bless $self, $class;

  if ($self->_conf(%$conf)) {
    $self->_copy($self->{CONF}, $self->{OCONF});
    return $self;
  } else {
    return undef;
  }
}

=head2 _conf

  $obj->_conf(%conf);

This method should be overridden in your descendant class.  As mentioned
above, it should do any initialisation and validation required, based on
the passed configuration hash.  It should return a 1 or 0, depending on
whether any critical errors were encountered during instantiation.

B<Note:>  your B<_conf> method should call, as a last act, 
B<SUPER::_conf>.  This is important to do, since this method takes care
of some colour initialisation steps for you automatically.  The following keys
are known by this module, and are used by certain rendering and initiation
methods:

  Field              Default      Description
  ============================================================
  FOREGROUND   (terminal default) Default foreground colour
  BACKGROUND   (terminal default) Default background colour
  BORDERCOL       (FOREGROUND)    Default border colour
  CAPTIONCOL      (FOREGROUND)    Default caption colour

As a final note, here are some rules regarding the structure of your
configuration hash.  You *must* save your state information in this hash.  
Another subroutine will copy that information after object instantiation 
in order to support the reset method.  Also note that everything stored 
in this should *not* be more than one additional level deep (in other 
words, values can be hash or array refs, but none of the values in *that* 
structure should be refs), otherwise those refs will be copied over, instead 
of the data inside the structure.  This essentially destroys your backup.

If you have special requirements, override the _copy method as well.

=cut

sub _conf {
  my $self = shift;
  my %conf = @_;
  my ($df, $db, $c);

  # Set the foreground/background, if it wasn't set already
  pair_content(0, $df, $db);
  $conf{FOREGROUND} = (grep { $colours{$_} == $df } keys %colours)[0]
    unless (exists $conf{FOREGROUND});
  $conf{BACKGROUND} = (grep { $colours{$_} == $db } keys %colours)[0]
    unless (exists $conf{BACKGROUND});
  $conf{BORDERCOL} = $conf{FOREGROUND} unless exists $conf{BORDERCOL};
  $conf{CAPTIONCOL} = $conf{FOREGROUND} unless exists $conf{CAPTIONCOL};

  # Lowercase all colours
  foreach (qw(FOREGROUND BACKGROUND CAPTIONCOL BORDERCOL)) {
    $conf{$_} = lc($conf{$_}) };

  # Save conf hashes
  $self->{CONF} = {%conf};
  $self->{OCONF} = {};

  return 1;
}

=head2 _copy

  $obj->_copy($href1, $href2);

This method copies the contents of $href1 to $href2.  This will only copy two
levels of data, so any reference values deeper than that will be passed by
reference, not as a copy of reference's (dereferenced) value.

=cut

sub _copy {
  # Synchronises the current data record with the old 
  # data record.
  # 
  # Internal use only.

  my $self = shift;
  my ($data, $odata) = @_;
  my $field;

  # Empty the target hash
  %$odata = ();

  # Copy each element to the target
  foreach $field (keys %$data) {
    if (ref($$data{$field}) eq 'ARRAY') {
      $$odata{$field} = [ @{$$data{$field}} ];
    } elsif (ref($$data{$field}) eq 'HASH') {
      $$odata{$field} = { %{$$data{$field}} };
    } else {