lib/MOBY/Config.pm

   1 package MOBY::Config;
   2
   3 BEGIN {}
   4 use strict;
   5 use Carp;
   6 use MOBY::dbConfig;
   7 use vars qw($AUTOLOAD);
   8 use Text::Shellwords;
   9 use vars '$VERSION', '@ISA', '@EXPORT', '$CONFIG';
  10 @ISA    = qw(Exporter);
  11 @EXPORT = ('$CONFIG');
  12 {
  13
  14         #Encapsulated class data
  15         #___________________________________________________________
  16         #ATTRIBUTES
  17         my %_attr_data =    #         DEFAULT           ACCESSIBILITY
  18           (
  19                 mobycentral      => [ undef, 'read/write' ],
  20                 mobyobject       => [ undef, 'read/write' ],
  21                 mobynamespace    => [ undef, 'read/write' ],
  22                 mobyservice      => [ undef, 'read/write' ],
  23                 mobyrelationship => [ undef, 'read/write' ],
  24                 valid_secondary_datatypes => [["String", "Integer", "DateTime", "Float"],  'read'],
  25                 primitive_datatypes => [["String", "Integer", "DateTime", "Float", "Boolean"], 'read'],
  26
  27           );
  28
  29         #_____________________________________________________________
  30         # METHODS, to operate on encapsulated class data
  31         # Is a specified object attribute accessible in a given mode
  32         sub _accessible {
  33                 my ( $self, $attr, $mode ) = @_;
  34                 $_attr_data{$attr}[1] =~ /$mode/;
  35         }
  36
  37         # Classwide default value for a specified object attribute
  38         sub _default_for {
  39                 my ( $self, $attr ) = @_;
  40                 $_attr_data{$attr}[0];
  41         }
  42
  43         # List of names of all specified object attributes
  44         sub _standard_keys {
  45                 keys %_attr_data;
  46         }
  47 }
  48
  49 # the expected sections (listed above) will have their dbConfig objects available
  50 # as methods.  The unexpected sections will have their dbConfig objects available
  51 # by $dbConfig = $CONFIG->{section_title}
  52 sub new {
  53         my ( $caller, %args ) = @_;
  54
  55         #print STDERR "creating MOBY::Config\n";
  56         my $caller_is_obj = ref($caller);
  57         my $class         = $caller_is_obj || $caller;
  58         my $self          = bless {}, $class;
  59         foreach my $attrname ( $self->_standard_keys ) {
  60                 if ( exists $args{$attrname} && defined $args{$attrname} ) {
  61                         $self->{$attrname} = $args{$attrname};
  62                 } elsif ($caller_is_obj) {
  63                         $self->{$attrname} = $caller->{$attrname};
  64                 } else {
  65                         $self->{$attrname} = $self->_default_for($attrname);
  66                 }
  67         }
  68         my $file = $ENV{MOBY_CENTRAL_CONFIG};
  69         ( -e $file ) || die "MOBY Configuration file $file doesn't exist $!\n";
  70         chomp $file;
  71         if ( ( -e $file ) && ( !( -d $file ) ) ) {
  72             open IN, $file
  73                 or die
  74                 "can't open MOBY Configuration file $file for unknown reasons: $!\n";
  75         }
  76         my @sections = split /(\[\s*\S+\s*\][^\[]*)/s, join "", <IN>;
  77
  78         #print STDERR "split into @sections\n";
  79         foreach my $section (@sections) {
  80
  81                 #print STDERR "calling MOBY::dbConfig\n";
  82                 my $dbConfig =
  83                   MOBY::dbConfig->new( section => $section )
  84                   ; # this is an object full of strings, no actual connections.  It represents the information in the config file
  85                 next unless $dbConfig;
  86                 my $dbname = $dbConfig->section_title;
  87                 next unless $dbname;
  88
  89 #print STDERR "setting the COnfig dbConfig for the title $dbname with object $dbConfig\n\n";
  90                 $self->{$dbname} = $dbConfig;
  91         }
  92         $CONFIG = $self;
  93         return $self;
  94 }
  95
  96 sub getDataAdaptor {
  97         my ( $self, %args ) = @_;
  98         my $source = $args{datasource} || $args{source} || "mobycentral";
  99         if ( $self->{"${source}Adaptor"} ) { return $self->{"${source}Adaptor"} }
 100         ;    # read from cache
 101         my $username = $self->$source->{username};# $self->$source returns a MOBY::dbConfig object
 102         my $password = $self->$source->{password};
 103         my $port     = $self->$source->{port};
 104         my $dbname   = $self->$source->{dbname};
 105         my $url      = $self->$source->{url};
 106         my $adaptor  = $self->$source->{adaptor};
 107         eval "require $adaptor";
 108         return undef if $@;
 109         my $ADAPTOR = $adaptor->new(    # by default, this is queryapi::mysql
 110                                          username => $username,
 111                                          password => $password,
 112                                          port     => $port,
 113                                          dbname   => $dbname,
 114                                          url      => $url,
 115         );
 116         if ($ADAPTOR) {
 117                 $self->{"${source}Adaptor"} = $ADAPTOR;    # cache it
 118                 return $ADAPTOR;
 119         } else {
 120                 return undef;
 121         }
 122 }
 123 sub DESTROY { }
 124
 125 sub AUTOLOAD {
 126         no strict "refs";
 127         my ( $self, $newval ) = @_;
 128         $AUTOLOAD =~ /.*::(\w+)/;
 129         my $attr = $1;
 130         if ( $self->_accessible( $attr, 'write' ) ) {
 131                 *{$AUTOLOAD} = sub {
 132                         if ( defined $_[1] ) { $_[0]->{$attr} = $_[1] }
 133                         return $_[0]->{$attr};
 134                 };    ### end of created subroutine
 135 ###  this is called first time only
 136                 if ( defined $newval ) {
 137                         $self->{$attr} = $newval;
 138                 }
 139                 return $self->{$attr};
 140         } elsif ( $self->_accessible( $attr, 'read' ) ) {
 141                 *{$AUTOLOAD} = sub {
 142                         return $_[0]->{$attr};
 143                 };    ### end of created subroutine
 144                 return $self->{$attr};
 145         }
 146
 147         # Must have been a mistake then...
 148         croak "No such method: $AUTOLOAD";
 149 }
 150 1;