branch-1-6/Bio/Biblio/Book.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Biblio::Book
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Martin Senger <senger@ebi.ac.uk>
   8 # For copyright and disclaimer see below.
   9
  10 # POD documentation - main docs before the code
  11
  12 =head1 NAME
  13
  14 Bio::Biblio::Book - Representation of a book
  15
  16 =head1 SYNOPSIS
  17
  18     $obj = Bio::Biblio::Book->new(-identifier => '123abc',
  19                                   -editor => Bio::Biblio::Person->new
  20                                             (-lastname => 'Loukides'),
  21                                   -isbn  => '0-596-00068-5');
  22   #--- OR ---
  23
  24     $obj = Bio::Biblio::Book->new();
  25     $obj->isbn ('0-596-00068-5');
  26
  27 =head1 DESCRIPTION
  28
  29 A storage object for a book.
  30 See its place in the class hierarchy in
  31 http://www.ebi.ac.uk/~senger/openbqs/images/bibobjects_perl.gif
  32
  33 =head2 Attributes
  34
  35 The following attributes are specific to this class
  36 (however, you can also set and get all attributes defined in the parent classes):
  37
  38   edition
  39   editor    type: Bio::Biblio::Provider
  40   isbn
  41   series
  42   title
  43   volume
  44
  45 =head1 SEE ALSO
  46
  47 =over 4
  48
  49 =item *
  50
  51 OpenBQS home page: http://www.ebi.ac.uk/~senger/openbqs/
  52
  53 =item *
  54
  55 Comments to the Perl client: http://www.ebi.ac.uk/~senger/openbqs/Client_perl.html
  56
  57 =back
  58
  59 =head1 FEEDBACK
  60
  61 =head2 Mailing Lists
  62
  63 User feedback is an integral part of the evolution of this and other
  64 Bioperl modules. Send your comments and suggestions preferably to
  65 the Bioperl mailing list.  Your participation is much appreciated.
  66
  67   bioperl-l@bioperl.org                  - General discussion
  68   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  69
  70 =head2 Support
  71
  72 Please direct usage questions or support issues to the mailing list:
  73
  74 I<bioperl-l@bioperl.org>
  75
  76 rather than to the module maintainer directly. Many experienced and
  77 reponsive experts will be able look at the problem and quickly
  78 address it. Please include a thorough description of the problem
  79 with code and data examples if at all possible.
  80
  81 =head2 Reporting Bugs
  82
  83 Report bugs to the Bioperl bug tracking system to help us keep track
  84 of the bugs and their resolution. Bug reports can be submitted via the
  85 web:
  86
  87   http://bugzilla.open-bio.org/
  88
  89 =head1 AUTHORS
  90
  91 Heikki Lehvaslaiho (heikki-at-bioperl-dot-org),
  92 Martin Senger (senger@ebi.ac.uk)
  93
  94 =head1 COPYRIGHT
  95
  96 Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved.
  97
  98 This module is free software; you can redistribute it and/or modify
  99 it under the same terms as Perl itself.
 100
 101 =head1 DISCLAIMER
 102
 103 This software is provided "as is" without warranty of any kind.
 104
 105 =cut
 106
 107
 108 # Let the code begin...
 109
 110
 111 package Bio::Biblio::Book;
 112 use strict;
 113
 114
 115 use base qw(Bio::Biblio::Ref);
 116
 117 #
 118 # a closure with a list of allowed attribute names (these names
 119 # correspond with the allowed 'get' and 'set' methods); each name also
 120 # keep what type the attribute should be (use 'undef' if it is a
 121 # simple scalar)
 122 #
 123 {
 124     my %_allowed =
 125         (
 126          _edition => undef,
 127          _editor => 'Bio::Biblio::Provider',
 128          _isbn => undef,
 129          _series => undef,
 130          _title => undef,
 131          _volume => undef,
 132     );
 133
 134     # return 1 if $attr is allowed to be set/get in this class
 135     sub _accessible {
 136         my ($self, $attr) = @_;
 137         exists $_allowed{$attr} or $self->SUPER::_accessible ($attr);
 138     }
 139
 140     # return an expected type of given $attr
 141     sub _attr_type {
 142         my ($self, $attr) = @_;
 143         if (exists $_allowed{$attr}) {
 144             return $_allowed{$attr};
 145         } else {
 146             return $self->SUPER::_attr_type ($attr);
 147         }
 148     }
 149 }
 150
 151
 152 1;
 153 __END__