Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/Biblio/MedlineBookArticle.pm @ 0:1f6dce3d34e0
Uploaded
| author | mahtabm |
|---|---|
| date | Thu, 11 Apr 2013 02:01:53 -0400 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:1f6dce3d34e0 |
|---|---|
| 1 # $Id: MedlineBookArticle.pm,v 1.3 2002/10/22 07:45:11 lapp Exp $ | |
| 2 # | |
| 3 # BioPerl module for Bio::Biblio::MedlineBookArticle | |
| 4 # | |
| 5 # Cared for by Martin Senger <senger@ebi.ac.uk> | |
| 6 # For copyright and disclaimer see below. | |
| 7 | |
| 8 # POD documentation - main docs before the code | |
| 9 | |
| 10 =head1 NAME | |
| 11 | |
| 12 Bio::Biblio::MedlineBookArticle - Representation of a MEDLINE book article | |
| 13 | |
| 14 =head1 SYNOPSIS | |
| 15 | |
| 16 $obj = new Bio::Biblio::MedlineBookArticle | |
| 17 (-title => 'Getting started'. | |
| 18 -book => new Bio::Biblio::MedlineBook); | |
| 19 --- OR --- | |
| 20 | |
| 21 $obj = new Bio::Biblio::MedlineBookArticle; | |
| 22 $obj->title ('Getting started'); | |
| 23 | |
| 24 =head1 DESCRIPTION | |
| 25 | |
| 26 A storage object for a MEDLINE book. | |
| 27 See its place in the class hierarchy in | |
| 28 http://industry.ebi.ac.uk/openBQS/images/bibobjects_perl.gif | |
| 29 | |
| 30 =head2 Attributes | |
| 31 | |
| 32 The following attributes are specific to this class | |
| 33 (however, you can also set and get all attributes defined in the parent classes): | |
| 34 | |
| 35 book type: Bio::Biblio::MedlineBook | |
| 36 | |
| 37 =head1 SEE ALSO | |
| 38 | |
| 39 =over | |
| 40 | |
| 41 =item * | |
| 42 | |
| 43 OpenBQS home page: http://industry.ebi.ac.uk/openBQS | |
| 44 | |
| 45 =item * | |
| 46 | |
| 47 Comments to the Perl client: http://industry.ebi.ac.uk/openBQS/Client_perl.html | |
| 48 | |
| 49 =back | |
| 50 | |
| 51 =head1 FEEDBACK | |
| 52 | |
| 53 =head2 Mailing Lists | |
| 54 | |
| 55 User feedback is an integral part of the evolution of this and other | |
| 56 Bioperl modules. Send your comments and suggestions preferably to | |
| 57 the Bioperl mailing list. Your participation is much appreciated. | |
| 58 | |
| 59 bioperl-l@bioperl.org - General discussion | |
| 60 http://bioperl.org/MailList.shtml - About the mailing lists | |
| 61 | |
| 62 =head2 Reporting Bugs | |
| 63 | |
| 64 Report bugs to the Bioperl bug tracking system to help us keep track | |
| 65 of the bugs and their resolution. Bug reports can be submitted via | |
| 66 email or the web: | |
| 67 | |
| 68 bioperl-bugs@bioperl.org | |
| 69 http://bugzilla.bioperl.org/ | |
| 70 | |
| 71 =head1 AUTHORS | |
| 72 | |
| 73 Heikki Lehvaslaiho (heikki@ebi.ac.uk), | |
| 74 Martin Senger (senger@ebi.ac.uk) | |
| 75 | |
| 76 =head1 COPYRIGHT | |
| 77 | |
| 78 Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved. | |
| 79 | |
| 80 This module is free software; you can redistribute it and/or modify | |
| 81 it under the same terms as Perl itself. | |
| 82 | |
| 83 =head1 DISCLAIMER | |
| 84 | |
| 85 This software is provided "as is" without warranty of any kind. | |
| 86 | |
| 87 =cut | |
| 88 | |
| 89 | |
| 90 # Let the code begin... | |
| 91 | |
| 92 | |
| 93 package Bio::Biblio::MedlineBookArticle; | |
| 94 use strict; | |
| 95 use vars qw(@ISA); | |
| 96 | |
| 97 use Bio::Biblio::BookArticle; | |
| 98 use Bio::Biblio::MedlineArticle; | |
| 99 | |
| 100 @ISA = qw(Bio::Biblio::BookArticle Bio::Biblio::MedlineArticle); | |
| 101 | |
| 102 # | |
| 103 # a closure with a list of allowed attribute names (these names | |
| 104 # correspond with the allowed 'get' and 'set' methods); each name also | |
| 105 # keep what type the attribute should be (use 'undef' if it is a | |
| 106 # simple scalar) | |
| 107 # | |
| 108 { | |
| 109 my %_allowed = | |
| 110 ( | |
| 111 _book => 'Bio::Biblio::MedlineBook', | |
| 112 ); | |
| 113 | |
| 114 # return 1 if $attr is allowed to be set/get in this class | |
| 115 sub _accessible { | |
| 116 my ($self, $attr) = @_; | |
| 117 exists $_allowed{$attr} or $self->SUPER::_accessible ($attr); | |
| 118 return 1 if exists $_allowed{$attr}; | |
| 119 foreach my $parent (@ISA) { | |
| 120 return 1 if $parent->_accessible ($attr); | |
| 121 } | |
| 122 } | |
| 123 | |
| 124 # return an expected type of given $attr | |
| 125 # return an expected type of given $attr | |
| 126 sub _attr_type { | |
| 127 my ($self, $attr) = @_; | |
| 128 if (exists $_allowed{$attr}) { | |
| 129 return $_allowed{$attr}; | |
| 130 } else { | |
| 131 foreach my $parent (@ISA) { | |
| 132 if ($parent->_accessible ($attr)) { | |
| 133 return $parent->_attr_type ($attr); | |
| 134 } | |
| 135 } | |
| 136 } | |
| 137 return 'unknown'; | |
| 138 } | |
| 139 } | |
| 140 | |
| 141 | |
| 142 1; | |
| 143 __END__ |
