view release on metacpan or  search on metacpan

lib/Class/MethodMapper.pm  view on Meta::CPAN

  if (@_) {
    $self->set($method => $_[0]);
  } else {
    my ($p, $file, $line) = caller;
    $self->get($method, $file, $line);
  }
}


sub DESTROY {
  my $self = shift;

  for my $type (keys %$self) {
    for my $param (keys %{$self->{$type}}) {
      undef $self->{$type}->{$param};
    }
  }
  #FIXME: find out what this was for, and how to change it to
  #make it not give warnings on subclasses
  #$self->SUPER::DESTROY;
}

=item save('type', \&callback, @args)

loops over all the keys that have type 'type' and calls

    &$callback ($self, $key, $value, @args);

for each of them, where $key is the value of each key and $value
is the hashref for its value.

=cut

sub save {
    my ($self, $type, $callback, @args) = @_;

    my %copy = $self->get_map($type);
    foreach my $key (keys %copy) {
      &$callback ($self, $key, $self->{$key}, @args);
   }
}

=item save_config ('filename')

saves all 'parameter' type key/value pairs to 'filename'

=cut

sub save_config {
  my $self = shift;
  my $file = shift;

  my $fh = new IO::File (">$file");
  unless (defined $fh) {
    warn "MethodMapper: couldn't save state to $file: $!";
    return 0;
  }

  my $host = Sys::Hostname::hostname;
  my $username = getpwuid($REAL_USER_ID);

  $self =~ /^(.*?)=/;
  my $class = $1;

  print $fh "#\n";
  print $fh "# $class Configuration\n";
  print $fh "# Last modified: $username\@$host ".localtime()."\n";
  print $fh "#\n\n";

  my $cb = sub {
    my ($self, $key, $value) = @_;
    my $v = '';

    if (not defined $value->{value}) {
      $v = '';
    } else {
      $v = $value->{value};
    }

    my $t = sprintf "%-20s", $key;
    print $fh "\n";

    print $fh "# $value->{doc}\n";
    if ($value->{domain} eq 'ref') {
      local $Data::Dumper::Indent = 1;
      local $Data::Dumper::Terse = 1;
      print $fh "$t => ", Data::Dumper->Dump ([$v]);
    } else {
      print $fh "$t => $v\n";
    }
  };

  $self->save ('parameter', $cb);
  print $fh "\n";
  $fh->close;

  return 1;
}

=item (\&callback, @args)

loads earlier saved values of the object keys back by calling

    &$callback ($self, @args);

it expects the callback to return a ($key, $value) list. keeps
looping till the callback function returns an undefined key.

=cut

sub restore {
  my ($self, $callback, @args) = @_;

  while (1) {
    my ($key, $value) = &$callback ($self, @args);
    return unless defined $key;
    if (defined $value) {
      $self->set ($key, $value);
    }
  }