view release on metacpan or  search on metacpan

lib/AddressBook/Config.pm  view on Meta::CPAN

use AddressBook;
use strict;
use Carp;
use XML::DOM;

use vars qw($VERSION);

$VERSION = '0.13';

$AddressBook::Config::config_file = "/etc/AddressBook.conf";

#----------------------------------------------------------------
sub new {
  my $class=shift;
  my %args = @_;
  my $self = {};
  bless ($self,$class);
  my ($parser,$config,$field,$field_name,$attr,$db_type,$db_field_name,$db,$select,$option,$value);
  $self->{config_file} = $args{config_file} || $AddressBook::Config::config_file;
  eval {
    $parser = XML::DOM::Parser->new(ErrorContext=>1,
				    ParseParamEnt=>1,
				    ProtocolEncoding=>'UTF-8');
    $config = $parser->parsefile($self->{config_file});
  };
  if ($@ || ! $config) {
    $self->configError("Error reading config file: $@");
  }
  foreach $field ($config->getElementsByTagName("field")){
    $field_name=$field->getAttribute("name");
    foreach $attr ($field->getAttributes->getValues) {
      $self->{meta}->{$field_name}->{$attr->getName} = $attr->getValue;
    }
    foreach $db ($field->getElementsByTagName("db")) {
      $db_type=$db->getAttribute("type");
      $db_field_name=$db->getAttribute("name");
      $self->{generic2db}->{$field_name}->{$db_type} = $db_field_name;
      $self->{db2generic}->{$db_type}->{$db_field_name} = $field_name;
      foreach $attr ($db->getAttributes->getValues) {
	if ($attr->getName !~ /^type|name$/) {
	  $self->{dbmeta}->{$db_type}->{$field_name}->{$attr->getName} = $attr->getValue;
	}
      }
    }
  }
  my ($n) = $config->getElementsByTagName("databases");
  my ($db_name);
  if ($n) {
    foreach $db ($n->getElementsByTagName("*")) {
      $db_name=$db->getTagName;
      foreach $attr ($db->getAttributes->getValues) {
	$self->{db}->{$db_name}->{$attr->getName} = $attr->getValue;
      }
    }
  }
  foreach (keys %{$self->{db2generic}}) {
    if (! exists $self->{db}->{$_}->{driver}) {
      $self->{db}->{$_}->{driver} = $_;
    }
  }
  $self->validate();
  return $self;
}
#----------------------------------------------------------------
sub validate {
  my $self=shift;
  my $class = ref $self || croak "Not a method call.";
  my ($db);
  foreach $db (keys %{$self->{db}}) {
    next unless ($self->{db}->{$db}->{key_fields});
    foreach  (split ",", $self->{db}->{$db}->{key_fields}) {
      if (! exists $self->{db2generic}->{$db}->{$_}) {
	$self->configError("key field \"$_\" is not a valid attribute for backend $db");
      }
    }
  }
}
#----------------------------------------------------------------
sub configError {
  my $self=shift;
  my $class = ref $self || croak "Not a method call.";
  my $msg = shift; 
  croak "Configuration File Error (".$self->{config_file}."):\n$msg\n";
}
#----------------------------------------------------------------

=head2 getMeta
  
  %meta = %{$config->getMeta(attr=>$attr)}
  %meta = %{$config->getMeta(attr=>$attr,db=>$db)}

Returns an attribute metadata hash

=cut

sub getMeta {
  my $self = shift;
  my $class = ref $self || croak "Not a method call.";
  my %args = @_;
  my %ret;
  if (exists $args{attr} && exists $self->{meta}->{$args{attr}}) {
    %ret = %{$self->{meta}->{$args{attr}}};
  }
  if ($args{db}) {
    foreach (keys %{$self->{dbmeta}->{$args{db}}->{$args{attr}}}) {
      $ret{$_} = $self->{dbmeta}->{$args{db}}->{$args{attr}}->{$_};
    }
  }
  return \%ret;
}

1;
__END__

=head1 AUTHOR

David L. Leigh, <dleigh@sameasiteverwas.net>

=head1 SEE ALSO

L<AddressBook>
L<AddressBook::Entry>

=cut