lib/MOBY/dbConfig.pm

   1 package MOBY::dbConfig;
   2 use strict;
   3 use Carp;
   4 use vars qw($AUTOLOAD);
   5 use Text::Shellwords;
   6 {
   7
   8         #Encapsulated class data
   9         #___________________________________________________________
  10         #ATTRIBUTES
  11         my %_attr_data =    #                                   DEFAULT         ACCESSIBILITY
  12           (
  13                 section_title => [ undef, 'read/write' ],
  14                 username      => [ undef, 'read/write' ],
  15                 password      => [ undef, 'read/write' ],
  16                 dbname        => [ undef, 'read/write' ],
  17                 port          => [ undef, 'read/write' ],
  18                 proxy         => [ undef, 'read/write' ],
  19                 adaptor => [ "MOBY::Adaptor::moby::queryapi::mysql", 'read/write' ],
  20                 url     => [ undef,                                  'read/write' ],
  21                 section => [ undef,                                  'read/write' ],
  22           );
  23
  24         #_____________________________________________________________
  25         # METHODS, to operate on encapsulated class data
  26         # Is a specified object attribute accessible in a given mode
  27         sub _accessible {
  28                 my ( $self, $attr, $mode ) = @_;
  29                 $_attr_data{$attr}[1] =~ /$mode/;
  30         }
  31
  32         # Classwide default value for a specified object attribute
  33         sub _default_for {
  34                 my ( $self, $attr ) = @_;
  35                 $_attr_data{$attr}[0];
  36         }
  37
  38         # List of names of all specified object attributes
  39         sub _standard_keys {
  40                 keys %_attr_data;
  41         }
  42
  43         sub database_title {
  44                 my ( $self, $val ) = @_;
  45                 $self->section_title($val) if $val;
  46                 return $self->section_title;
  47         }
  48 }
  49
  50 # this object will contain the full hash of what is in the config file, even if
  51 # the key/value pairs are not expected.  Only the expected key/value pairs will be available as
  52 # methods, however (i.e. those in the _standard_keys hash above)
  53 sub new {
  54         my ( $caller, %args ) = @_;
  55         my $caller_is_obj = ref($caller);
  56         my $class         = $caller_is_obj || $caller;
  57         my $self          = bless {}, $class;
  58         foreach my $attrname ( $self->_standard_keys ) {
  59                 if ( exists $args{$attrname} && defined $args{$attrname} ) {
  60                         $self->{$attrname} = $args{$attrname};
  61                 } elsif ($caller_is_obj) {
  62                         $self->{$attrname} = $caller->{$attrname};
  63                 } else {
  64                         $self->{$attrname} = $self->_default_for($attrname);
  65                 }
  66         }
  67         my $key;
  68
  69         #eval {$key = $self->_readSections($self->section);};
  70         $key = $self->_readSections( $self->section );
  71
  72    #if ($@){die "MOBY Configuration file is misconfigured: dbConfig line 71\n";}
  73    #print STDERR "I received the key $key\n";
  74         return undef unless $key;
  75         return undef unless $key =~ /\S/;
  76
  77         #print STDERR "returning the dbConfig object for database title $key\n";
  78         $self->section_title($key);
  79         return $self;
  80 }
  81
  82 sub _readSections {
  83         my ( $self, $section ) = @_;
  84         my $key;
  85         my @lines = split "\n", $section;
  86         while ( my $l = shift @lines ) {
  87                 chomp $l;
  88                 next unless $l;
  89                 next if $l =~ /\s*\#/;    # ignore comments
  90                 next unless $l =~ /\S/;   # ignore pure whitespace;
  91
  92                 #print STDERR "reading line $l\n";
  93                 if ( $l =~ /\[(\w+)\]/ ) {
  94                         $key = $1;
  95                         while ( my $l2 = shift @lines ) {
  96                                 chomp $l2;
  97                                 last unless ( $l2 =~ /\S/ );
  98                                 my @terms = shellwords($l2);
  99                                 last unless ( scalar @terms > 2 );
 100                                 $self->{ $terms[0] } = $terms[2];
 101                         }
 102                 }
 103         }
 104
 105    #print STDERR "returning key $key with terms ",(keys %{$self->{$key}})," \n";
 106         return $key;    # will be undef if this was not a valid section
 107 }
 108 sub DESTROY { }
 109
 110 sub AUTOLOAD {
 111         no strict "refs";
 112         my ( $self, $newval ) = @_;
 113         $AUTOLOAD =~ /.*::(\w+)/;
 114         my $attr = $1;
 115         if ( $self->_accessible( $attr, 'write' ) ) {
 116                 *{$AUTOLOAD} = sub {
 117                         if ( defined $_[1] ) { $_[0]->{$attr} = $_[1] }
 118                         return $_[0]->{$attr};
 119                 };    ### end of created subroutine
 120 ###  this is called first time only
 121                 if ( defined $newval ) {
 122                         $self->{$attr} = $newval;
 123                 }
 124                 return $self->{$attr};
 125         } elsif ( $self->_accessible( $attr, 'read' ) ) {
 126                 *{$AUTOLOAD} = sub {
 127                         return $_[0]->{$attr};
 128                 };    ### end of created subroutine
 129                 return $self->{$attr};
 130         }
 131
 132         # Must have been a mistake then...
 133         croak "No such method: $AUTOLOAD";
 134 }
 135 1;