lib/MOBY/Client/Registration.pm

   1 #$Id: Registration.pm,v 1.10 2004/12/14 20:47:04 kawas Exp $
   2
   3 =head1 NAME
   4
   5 MOBY::Client::Registration - an object to wrap the registration XML from MOBY Central
   6
   7 =cut
   8
   9 =head1 SYNOPSIS
  10
  11  my $reg = $Central->registerService(%args);
  12  if ($reg->success){
  13          print "registered successfully ",$reg->registration_id,"\n";
  14  } else {
  15          print "registration failed ",$reg->message,"\n";
  16  }
  17
  18 =cut
  19
  20 =head1 DESCRIPTION
  21
  22 simply turns the registration XML into a hash
  23
  24 =head1 AUTHORS
  25
  26 Mark Wilkinson (markw@illuminae.com)
  27
  28 BioMOBY Project:  http://www.biomoby.org
  29
  30
  31 =cut
  32
  33 =head1 METHODS
  34
  35 =head2 new
  36
  37  Title     :    new
  38  Usage     :    my $MOBY = MOBY::Client::Registration->new(%args)
  39  Function  :
  40  Returns   :    MOBY::Client::Registration object
  41  Args      :    registration_id => $id
  42                 message => $message
  43                 success => $success
  44
  45 =cut
  46
  47 =head2 success
  48
  49 get/set the value
  50
  51 =head2 registration_id
  52
  53 get/set the value
  54
  55 =head2 id (same as registration_id)
  56
  57 get/set the value
  58
  59 =head2 message
  60
  61 get/set the value
  62
  63 =head2 RDF
  64
  65 get/set the value
  66
  67 =cut
  68
  69 package MOBY::Client::Registration;
  70 use strict;
  71 use Carp;
  72 use vars qw($AUTOLOAD);
  73 {
  74
  75         #Encapsulated class data
  76         #___________________________________________________________
  77         #ATTRIBUTES
  78         my %_attr_data =    #                                   DEFAULT         ACCESSIBILITY
  79           (
  80                 success         => [ 0,     'read/write' ],
  81                 message         => [ "OK",  'read/write' ],
  82                 registration_id => [ undef, 'read/write' ],
  83                 RDF             => [ undef, 'read/write' ],
  84           );
  85
  86         #_____________________________________________________________
  87         # METHODS, to operate on encapsulated class data
  88         # Is a specified object attribute accessible in a given mode
  89         sub _accessible {
  90                 my ( $self, $attr, $mode ) = @_;
  91                 $_attr_data{$attr}[1] =~ /$mode/;
  92         }
  93
  94         # Classwide default value for a specified object attribute
  95         sub _default_for {
  96                 my ( $self, $attr ) = @_;
  97                 $_attr_data{$attr}[0];
  98         }
  99
 100         # List of names of all specified object attributes
 101         sub _standard_keys {
 102                 keys %_attr_data;
 103         }
 104 }
 105
 106 sub id {
 107         my ( $self, $val ) = @_;
 108         $self->registration_id( $val ) if defined $val;
 109         return $self->registration_id;
 110 }
 111
 112 sub new {
 113         my ( $caller, %args ) = @_;
 114         my $caller_is_obj = ref( $caller );
 115         my $class         = $caller_is_obj || $caller;
 116         my $self          = bless {}, $class;
 117         foreach my $attrname ( $self->_standard_keys ) {
 118                 if ( exists $args{$attrname} && defined $args{$attrname} ) {
 119                         $self->{$attrname} = $args{$attrname};
 120                 } elsif ( $caller_is_obj ) {
 121                         $self->{$attrname} = $caller->{$attrname};
 122                 } else {
 123                         $self->{$attrname} = $self->_default_for( $attrname );
 124                 }
 125         }
 126         return $self;
 127 }
 128 sub DESTROY { }
 129
 130 sub AUTOLOAD {
 131         no strict "refs";
 132         my ( $self, $newval ) = @_;
 133         $AUTOLOAD =~ /.*::(\w+)/;
 134         my $attr = $1;
 135         if ( $self->_accessible( $attr, 'write' ) ) {
 136                 *{$AUTOLOAD} = sub {
 137                         if ( defined $_[1] ) { $_[0]->{$attr} = $_[1] }
 138                         return $_[0]->{$attr};
 139                 };    ### end of created subroutine
 140 ###  this is called first time only
 141                 if ( defined $newval ) {
 142                         $self->{$attr} = $newval;
 143                 }
 144                 return $self->{$attr};
 145         } elsif ( $self->_accessible( $attr, 'read' ) ) {
 146                 *{$AUTOLOAD} = sub {
 147                         return $_[0]->{$attr};
 148                 };    ### end of created subroutine
 149                 return $self->{$attr};
 150         }
 151
 152         # Must have been a mistake then...
 153         croak "No such method: $AUTOLOAD";
 154 }
 155 1;