lib/MOBY/authority.pm

   1 #!/usr/bin/perl -w
   2 package MOBY::authority;
   3 use strict;
   4 use Carp;
   5 use MOBY::Config;
   6 use vars qw($AUTOLOAD @ISA);
   7
   8 =head1 NAME
   9
  10 MOBY::authority - a lightweight connection to the
  11 authority table in the database
  12
  13 =head1 SYNOPSIS
  14
  15  use MOBY::authority;
  16  my $Instance = MOBY::authority->new(
  17        authority_common_name => "genbank",
  18        authority_uri => "ncbi.nlm.nih.gov",
  19        contact_email => "mr.BIG@ncbi.nlm.nih.gov",
  20
  21  )
  22  print $Instance->authority_id;
  23
  24
  25 =cut
  26
  27 =head1 DESCRIPTION
  28
  29 representation of the authority table.  Can write to the database
  30
  31 =head1 AUTHORS
  32
  33 Mark Wilkinson (mwilkinson@gene.pbi.nrc.ca)
  34
  35
  36 =cut
  37
  38 {
  39
  40         # Encapsulated:
  41         # DATA
  42         #___________________________________________________________
  43         #ATTRIBUTES
  44         my %_attr_data =    #                                   DEFAULT         ACCESSIBILITY
  45           (
  46                 authority_common_name => [ undef, 'read/write' ],
  47                 authority_uri         => [ undef, 'read/write' ],
  48                 contact_email         => [ undef, 'read/write' ],
  49                 dbh                   => [ undef, 'read/write' ],
  50           );
  51
  52         #_____________________________________________________________
  53         # METHODS, to operate on encapsulated class data
  54         # Is a specified object attribute accessible in a given mode
  55         sub _accessible {
  56                 my ( $self, $attr, $mode ) = @_;
  57                 $_attr_data{$attr}[1] =~ /$mode/;
  58         }
  59
  60         # Classwide default value for a specified object attribute
  61         sub _default_for {
  62                 my ( $self, $attr ) = @_;
  63                 $_attr_data{$attr}[0];
  64         }
  65
  66         # List of names of all specified object attributes
  67         sub _standard_keys {
  68                 keys %_attr_data;
  69         }
  70         sub authority_id {
  71                 die "AUTHORITY_ID is deprecated.  fix your code!\n";
  72         }
  73 }
  74
  75 sub new {
  76         my ( $caller, %args ) = @_;
  77         my $caller_is_obj = ref($caller);
  78         return $caller if $caller_is_obj;
  79         my $class = $caller_is_obj || $caller;
  80         my $proxy;
  81         my $self = bless {}, $class;
  82         foreach my $attrname ( $self->_standard_keys ) {
  83                 if ( exists $args{$attrname} ) {
  84                         $self->{$attrname} = $args{$attrname};
  85                 } elsif ($caller_is_obj) {
  86                         $self->{$attrname} = $caller->{$attrname};
  87                 } else {
  88                         $self->{$attrname} = $self->_default_for($attrname);
  89                 }
  90         }
  91         my $dbh = $self->dbh;
  92         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
  93         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
  94
  95         my $result = $adaptor->query_authority(authority_uri => $self->authority_uri);
  96         my $row = shift(@$result);
  97         unless ($row) {
  98                 my $insertid = $adaptor->insert_authority(
  99                                                         authority_common_name => $self->authority_common_name,
 100                                                         authority_uri => $self->authority_uri,
 101                                                         contact_email => $self->contact_email);
 102         } else {
 103                 $self->authority_common_name($row->{authority_common_name});
 104                 $self->authority_uri($row->{authority_uri});
 105                 $self->contact_email($row->{contact_email});
 106         }
 107         return $self;
 108 }
 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 sub DESTROY { }
 136 1;