Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'master' of github.com:bioperl/bioperl-live

Add support for meme verions 4
  • Loading branch information...
commit 8d3df58e65bb7aba1d47fb304d2917bcb2b1f5fb 2 parents 251eb6a + 9f42b69
Brian Osborne bosborne authored
Showing with 521 additions and 12,083 deletions.
  1. +0 −376 Bio/Biblio.pm
  2. +0 −146 Bio/Biblio/Article.pm
  3. +0 −197 Bio/Biblio/BiblioBase.pm
  4. +0 −152 Bio/Biblio/Book.pm
  5. +0 −141 Bio/Biblio/BookArticle.pm
  6. +0 −382 Bio/Biblio/IO.pm
  7. +0 −545 Bio/Biblio/IO/medline2ref.pm
  8. +0 −747 Bio/Biblio/IO/medlinexml.pm
  9. +0 −148 Bio/Biblio/IO/pubmed2ref.pm
  10. +0 −312 Bio/Biblio/IO/pubmedxml.pm
  11. +0 −140 Bio/Biblio/Journal.pm
  12. +0 −147 Bio/Biblio/JournalArticle.pm
  13. +0 −216 Bio/Biblio/MedlineArticle.pm
  14. +0 −140 Bio/Biblio/MedlineBook.pm
  15. +0 −152 Bio/Biblio/MedlineBookArticle.pm
  16. +0 −146 Bio/Biblio/MedlineJournal.pm
  17. +0 −153 Bio/Biblio/MedlineJournalArticle.pm
  18. +0 −138 Bio/Biblio/Organisation.pm
  19. +0 −144 Bio/Biblio/Patent.pm
  20. +0 −155 Bio/Biblio/Person.pm
  21. +0 −142 Bio/Biblio/Proceeding.pm
  22. +0 −136 Bio/Biblio/Provider.pm
  23. +0 −159 Bio/Biblio/PubmedArticle.pm
  24. +0 −147 Bio/Biblio/PubmedBookArticle.pm
  25. +0 −160 Bio/Biblio/PubmedJournalArticle.pm
  26. +0 −261 Bio/Biblio/Ref.pm
  27. +0 −137 Bio/Biblio/Service.pm
  28. +0 −137 Bio/Biblio/TechReport.pm
  29. +0 −136 Bio/Biblio/Thesis.pm
  30. +0 −144 Bio/Biblio/WebResource.pm
  31. +98 −107 Bio/Cluster/SequenceFamily.pm
  32. +0 −300 Bio/DB/Biblio/biofetch.pm
  33. +0 −657 Bio/DB/Biblio/eutils.pm
  34. +0 −555 Bio/DB/Biblio/soap.pm
  35. +0 −495 Bio/DB/BiblioI.pm
  36. +372 −0 Bio/DB/GenericWebAgent.pm
  37. +11 −11 Bio/DB/HIV/HIVQueryHelper.pm
  38. +4 −4 Bio/DB/Query/HIVQuery.pm
  39. +1 −1  Bio/DB/Query/WebQuery.pm
  40. +2 −2 Bio/DB/TFBS/transfac_pro.pm
  41. +1 −1  Bio/DB/WebDBSeqI.pm
  42. +1 −1  Bio/Index/Hmmer.pm
  43. +1 −1  Bio/Nexml/Factory.pm
  44. +1 −1  Bio/PopGen/Population.pm
  45. +1 −1  Bio/Root/Utilities.pm
  46. +2 −2 Bio/SeqIO/agave.pm
  47. +1 −1  Bio/SeqIO/bsml.pm
  48. +3 −3 Bio/SeqIO/chadoxml.pm
  49. +2 −2 Bio/SeqIO/entrezgene.pm
  50. +1 −1  Bio/SeqIO/gbxml.pm
  51. +1 −1  Bio/SeqIO/genbank.pm
  52. +1 −1  Bio/SeqIO/phd.pm
  53. +1 −1  Bio/SeqIO/qual.pm
  54. +1 −1  Bio/SeqIO/scf.pm
  55. +1 −1  Bio/SeqIO/strider.pm
  56. +1 −1  Bio/Tools/Alignment/Consed.pm
  57. +1 −1  Bio/Tools/Analysis/DNA/ESEfinder.pm
  58. +1 −1  Bio/Tools/Analysis/Protein/NetPhos.pm
  59. +1 −1  Bio/Tools/Phylo/PAML.pm
  60. +2 −2 Bio/Tools/Phylo/PAML/Codeml.pm
  61. +1 −1  Bio/Tools/SeqPattern.pm
  62. +2 −2 Bio/Variation/IO/xml.pm
  63. +5 −0 Changes
  64. +0 −229 examples/biblio/biblio-eutils-example.pl
  65. +0 −234 examples/biblio/biblio-soap-example.pl
  66. +0 −116 examples/biblio/biblio_soap.pl
  67. +0 −2  scripts/biblio/TAG
  68. +0 −493 scripts/biblio/bp_biblio.pl
  69. +0 −139 t/Biblio/Biblio.t
  70. +0 −545 t/Biblio/References.t
  71. +0 −70 t/Biblio/biofetch.t
  72. +0 −40 t/Biblio/eutils.t
  73. +0 −1,336 t/data/stress_test_medline.xml
  74. +0 −483 t/data/stress_test_pubmed.xml
376 Bio/Biblio.pm
View
@@ -1,376 +0,0 @@
-#
-# BioPerl module Bio::Biblio
-#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
-#
-# Cared for by Martin Senger <senger@ebi.ac.uk>
-# For copyright and disclaimer see below.
-#
-
-# POD documentation - main docs before the code
-
-=head1 NAME
-
-Bio::Biblio - A Bibliographic Query Service module
-
-=head1 SYNOPSIS
-
- use Bio::Biblio;
- my $biblio = Bio::Biblio->new();
-
- print $biblio->find ('perl')->get_count . "\n";
-
- my $collection = $biblio->find ('brazma', 'authors');
- while ( $collection->has_next ) {
- print $collection->get_next;
- }
-
- # The new() method can accept parameters, for example:
-
- $biblio = Bio::Biblio->new
- (-access => 'soap',
- -location => 'http://www.ebi.ac.uk/openbqs/services/MedlineSRS',
- -destroy_on_exit => '0');
-
- # See below for some one-liners
-
-=head1 DESCRIPTION
-
-This is a class whose instances can access bibliographic
-repositories. It allows one to query a bibliographic database (such as
-MEDLINE) and then to retrieve resulting citations from it. The
-citations are returned in an XML format which is native to the
-repository but there are also supporting modules for converting them
-into Perl objects.
-
-The detailed descriptions of all query and retrieval methods are in
-L<Bio::DB::BiblioI> (an interface). All those methods should be
-called on instances of this (Bio::Biblio) module.
-
-The module complies (with some simplifications) with the specification
-described in the B<OpenBQS> project. Its home page is at
-L<http://www.ebi.ac.uk/~senger/openbqs>.
-
-The module also gives an access to a set of controlled vocabularies
-and their values. It allows one to introspect bibliographic repositories
-and to find what citation resource types (such as journal and book
-articles, patents or technical reports) are provided, and what
-attributes they have, eventually what attribute values are allowed.
-
-Here are some one-liners:
-
- perl -MBio::Biblio -e 'print new Bio::Biblio->get_by_id ("12368254")'
- perl -MBio::Biblio \
- -e 'print join ("\n", @{ Bio::Biblio->new->find ("brazma")->get_all_ids })'
- perl -MBio::Biblio \
- -e 'print Bio::Biblio->new->find ("Java")->find ("perl")->get_count'
-
-
-=head1 OVERVIEW OF CLASSES AND PACKAGES
-
-=over
-
-=item L<Bio::Biblio>
-
-This is the main class to be used by the end users. It
-loads a real implementation for a particular access protocol according
-to the argument I<-access>. At the time of writing this documentation
-there is only one available access module implementing all query and
-retrieval methods:
-
- -access => soap
-
-This module implements all methods defined in the interface
-I<Bio::DB::BiblioI> (see L<Bio::DB::BiblioI>) by delegating
-calls to a loaded low-level module (e.g. see
-L<Bio::DB::Biblio::soap>).
-
-Note that there are other modules which do not use the SOAP protocol
-and do not implement all query methods - nevertheless they have retrieval
-methods and can be used in the same way:
-
- -access => biofetch
-
-Lacking documentation:
-
- -access => eutils
-
-=item Bio::DB::BiblioI
-
-This is an interface defining all methods that can be called on
-I<Bio::Biblio> instances.
-
-=item Bio::DB::Biblio::soap
-
-This is a real implementation of all methods defined in
-Bio::DB::BiblioI using SOAP protocol (calling a WebService
-based on SOAP). This class should not be instantiated directly (use
-I<Bio::Biblio> instead). See L<Bio::DB::BiblioI> for details.
-
-=item Bio::Biblio::IO
-
-This module instantiates and uses a converter of the citations read by
-any of the access methods mentioned above. See L<Bio::Biblio::IO> for
-details.
-
-=item Bio::Biblio::IO::medlinexml and Bio::Biblio::IO::medline2ref
-
-A converter of MEDLINE citations in XML into Perl objects.
-
-=item Bio::Biblio::IO::pubmedxml and Bio::Biblio::IO::pubmed2ref
-
-A converter of PUBMED citations in XML into Perl objects.
-
-=back
-
-=head1 FEEDBACK
-
-=head2 Mailing Lists
-
-User feedback is an integral part of the evolution of this and other
-Bioperl modules. Send your comments and suggestions preferably to
-the Bioperl mailing list. Your participation is much appreciated.
-
- bioperl-l@bioperl.org - General discussion
- http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-
-=head2 Support
-
-Please direct usage questions or support issues to the mailing list:
-
-I<bioperl-l@bioperl.org>
-
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
-with code and data examples if at all possible.
-
-=head2 Reporting Bugs
-
-Report bugs to the Bioperl bug tracking system to help us keep track
-of the bugs and their resolution. Bug reports can be submitted via the
-web:
-
- https://redmine.open-bio.org/projects/bioperl/
-
-=head1 AUTHOR
-
-Martin Senger (martin.senger@gmail.com)
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved.
-
-This module is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 DISCLAIMER
-
-This software is provided "as is" without warranty of any kind.
-
-=head1 SEE ALSO
-
-=over
-
-=item *
-
-OpenBQS home page: http://www.ebi.ac.uk/~senger/openbqs/
-
-=item *
-
-Comments to the Perl client: http://www.ebi.ac.uk/~senger/openbqs/Client_perl.html
-
-=back
-
-=head1 APPENDIX
-
-The main documentation details are to be found in
-L<Bio::DB::BiblioI>.
-
-Here is the rest of the object methods. Internal methods are preceded
-with an underscore _.
-
-=cut
-
-
-# Let the code begin...
-
-
-package Bio::Biblio;
-use strict;
-use warnings;
-use parent qw(Bio::Root::Root Bio::DB::BiblioI);
-
-# -----------------------------------------------------------------------------
-
-=head2 new
-
- Usage : my $obj = Bio::Biblio->new(@args);
- Returns : Bio::Biblio object on success, or undef on failure
- Args : This module recognizes and uses:
-
- -access => 'soap'
- It indicates what lower-level module to load.
- Default is 'soap'.
-
- -location => 'http://...'
- It says where to find a bibliographic query service.
- The format and contents of this argument is dependent
- on the '-access' argument.
-
- For 'soap' access it is a URL of a WebService.
- Default is http://www.ebi.ac.uk/openbqs/services/MedlineSRS
-
- Other arguments can be given here but they are
- recognized by the lower-level module
- (e.g. see Bio::DB::Biblio::soap).
-
-It builds, populates and returns a new I<Bio::Biblio> object. This is
-how it is seen from the outside. But in fact, it builds, populates and
-returns a more specific lower-level object, for example
-I<Bio::DB::Biblio::soap> object - which one it is depends on the
-parameter I<-access>.
-
-The real initialization is done in the method I<_initialize> of the
-lower-level object.
-
-This method can also be used for I<cloning> an existing object and
-changing or adding new attributes to it in the same time. This is,
-however, not particulary useful for the casual users of this module,
-because the query methods (see L<Bio::DB::BiblioI>) themselves
-already return cloned objects with more refined query
-collections. Anyway this is how the cloning can be done:
-
- use Bio::Biblio;
- my $biblio = Bio::Biblio->new();
-
- # this will create a new object which will NOT send a 'destroy'
- # message to the remote server when its life ends
- my $clone = $biblio->new (-destroy-on-exit => '0');
-
-=cut
-
-sub new {
- my ($caller,@args) = @_;
- my $class = ref($caller) || $caller;
-
- # if $caller is an object, or if it is an underlying
- # 'real-work-doing' class (e.g. Bio::DB::Biblio::soap) then
- # we want to call SUPER to create and bless an object
-
- if ($class =~ /Bio::DB::Biblio::(\S+)/) {
- my ($self) = $class->SUPER::new (@args);
-
- # now the $self is an empty object - we will populate it from
- # the $caller - if $caller is an object
-
- if (ref ($caller)) {
- %{ $self } = %{ $caller };
- }
-
- # and finally add values from '@args' into the newly created
- # object (the values will overwrite the values copied above)
-
- $self->_initialize (@args);
- return $self;
-
- # this is called only the first time when somebody calls: 'new
- # Bio::Biblio (...)', and it actually loads a 'real-work-doing'
- # module and call this new() method again (unless the loaded
- # module has its own new() method)
-
- } else {
- my %param = @args;
- @param { map { lc $_ } keys %param } = values %param; # lowercase keys
- my $access =
- $param {'-access'} ||
- $class->_guess_access ( $param {'-location'} ) ||
- 'soap';
- $access = "\L$access"; # normalize capitalization to lower case
-
- # load module with the real implementation - as defined in $access
- return unless (&_load_access_module ($access));
-
- # this will call this same method new() - but rather its the
- # upper (object) branche
- return "Bio::DB::Biblio::$access"->new (@args);
- }
-}
-
-# -----------------------------------------------------------------------------
-
-=head2 _load_access_module
-
- Usage : $class->_load_access_module ($access)
- Returns : 1 on success, undef on failure
- Args : 'access' should contain the last part of the
- name of a module who does the real implementation
-
-It does (in run-time) a similar thing as
-
- require Bio::DB::Biblio::$access
-
-It prints an error on STDERR if it fails to find and load the module
-(for example, because of the compilation errors in the module).
-
-=cut
-
-sub _load_access_module {
- my ($access) = @_;
- my ($module, $load, $m);
-
- $module = "_<Bio/DB/Biblio/$access.pm";
- $load = "Bio/DB/Biblio/$access.pm";
-
- return 1 if $main::{$module};
- eval {
- require $load;
- };
-
- if ( $@ ) {
- Bio::Root::Root->throw (<<END);
-$load: $access cannot be found or loaded
-Exception $@
-For more information about the Biblio system please see the Bio::Biblio docs.
-END
- ;
- return;
- }
- return 1;
-}
-
-# -----------------------------------------------------------------------------
-
-=head2 _guess_access
-
- Usage : $class->_guess_access ($location)
- Returns : string with a guessed access protocol (e.g. 'soap')
- Args : 'location' defines where to find a bibliographic service
- in a protocol-dependent manner (e.g. for SOAP it is
- a URL of a bibliographic WebService)
-
-It makes an expert guess what kind of access/transport protocol should
-be used based on the I<location> of the service (e.g. if the
-I<location> looks like an IOR then the access protocol is probably
-CORBA).
-
-=cut
-
-# this is kept here for the future when more access protocols
-# (e.g. CORBA) may be available for accessing bibliographic query
-# services
-
-sub _guess_access {
-# my ($class, $location) = @_;
- return 'soap';
-}
-
-=head2 VERSION and Revision
-
- Usage : print $Bio::Biblio::VERSION;
- print $Bio::Biblio::Revision;
-
-=cut
-
-1;
-__END__
146 Bio/Biblio/Article.pm
View
@@ -1,146 +0,0 @@
-#
-# BioPerl module for Bio::Biblio::Article
-#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
-#
-# Cared for by Martin Senger <senger@ebi.ac.uk>
-# For copyright and disclaimer see below.
-
-# POD documentation - main docs before the code
-
-=head1 NAME
-
-Bio::Biblio::Article - Representation of a general article
-
-=head1 SYNOPSIS
-
- $obj = Bio::Biblio::Article->new(-identifier => '123abc',
- -first_page => 23,
- -last_page => 68);
- #--- OR ---
-
- $obj = Bio::Biblio::Article->new();
- $obj->identifier ('123abc');
- $obj->first_page (23);
- $obj->last_page (68);
-
-=head1 DESCRIPTION
-
-A storage object for a general article.
-See its place in the class hierarchy in
-http://www.ebi.ac.uk/~senger/openbqs/images/bibobjects_perl.gif
-
-=head2 Attributes
-
-The following attributes are specific to this class
-(however, you can also set and get all attributes defined in the parent classes):
-
- first_page
- last_page
-
-
-=head1 SEE ALSO
-
-=over 4
-
-=item *
-
-OpenBQS home page: http://www.ebi.ac.uk/~senger/openbqs/
-
-=item *
-
-Comments to the Perl client: http://www.ebi.ac.uk/~senger/openbqs/Client_perl.html
-
-=back
-
-=head1 FEEDBACK
-
-=head2 Mailing Lists
-
-User feedback is an integral part of the evolution of this and other
-Bioperl modules. Send your comments and suggestions preferably to
-the Bioperl mailing list. Your participation is much appreciated.
-
- bioperl-l@bioperl.org - General discussion
- http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-
-=head2 Support
-
-Please direct usage questions or support issues to the mailing list:
-
-I<bioperl-l@bioperl.org>
-
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
-with code and data examples if at all possible.
-
-=head2 Reporting Bugs
-
-Report bugs to the Bioperl bug tracking system to help us keep track
-of the bugs and their resolution. Bug reports can be submitted via the
-web:
-
- https://redmine.open-bio.org/projects/bioperl/
-
-=head1 AUTHORS
-
-Heikki Lehvaslaiho (heikki-at-bioperl-dot-org),
-Martin Senger (senger@ebi.ac.uk)
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved.
-
-This module is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 DISCLAIMER
-
-This software is provided "as is" without warranty of any kind.
-
-=cut
-
-
-# Let the code begin...
-
-
-package Bio::Biblio::Article;
-use strict;
-
-
-use base qw(Bio::Biblio::Ref);
-
-#
-# a closure with a list of allowed attribute names (these names
-# correspond with the allowed 'get' and 'set' methods); each name also
-# keep what type the attribute should be (use 'undef' if it is a
-# simple scalar)
-#
-{
- my %_allowed =
- (
- _first_page => undef,
- _last_page => undef,
- );
-
- # return 1 if $attr is allowed to be set/get in this class
- sub _accessible {
- my ($self, $attr) = @_;
- exists $_allowed{$attr} or $self->SUPER::_accessible ($attr);
- }
-
- # return an expected type of given $attr
- sub _attr_type {
- my ($self, $attr) = @_;
- if (exists $_allowed{$attr}) {
- return $_allowed{$attr};
- } else {
- return $self->SUPER::_attr_type ($attr);
- }
- }
-}
-
-
-1;
-__END__
197 Bio/Biblio/BiblioBase.pm
View
@@ -1,197 +0,0 @@
-#
-# BioPerl module for Bio::Biblio::BiblioBase
-#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
-#
-# Cared for by Martin Senger <senger@ebi.ac.uk>
-# For copyright and disclaimer see below.
-
-# POD documentation - main docs before the code
-
-=head1 NAME
-
-Bio::Biblio::BiblioBase - An abstract base for other biblio classes
-
-=head1 SYNOPSIS
-
- # do not instantiate this class directly
-
-=head1 DESCRIPTION
-
-It is a base class where all other biblio data storage classes inherit
-from. It does not reflect any real-world object, it exists only for
-convenience, in order to have a place for shared code.
-
-=head2 new()
-
-The I<new()> class method constructs a new biblio storage object. It
-accepts list of named arguments - the same names as attribute names
-prefixed with a minus sign. Available attribute names are listed in
-the documentation of the individual biblio storage objects.
-
-=head2 Accessors
-
-All attribute names can be used as method names. When used without any
-parameter the method returns current value of the attribute (or
-undef), when used with a value the method sets the attribute to this
-value and also returns it back. The set method also checks if the type
-of the new value is correct.
-
-=head2 Custom classes
-
-If there is a need for new attributes, create your own class which
-usually inherits from I<Bio::Biblio::Ref>. For new types of providers
-and journals, let your class inherit directly from this
-I<Bio::Biblio::BiblioBase> class.
-
-=head1 FEEDBACK
-
-=head2 Mailing Lists
-
-User feedback is an integral part of the evolution of this and other
-Bioperl modules. Send your comments and suggestions preferably to
-the Bioperl mailing list. Your participation is much appreciated.
-
- bioperl-l@bioperl.org - General discussion
- http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-
-=head2 Support
-
-Please direct usage questions or support issues to the mailing list:
-
-I<bioperl-l@bioperl.org>
-
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
-with code and data examples if at all possible.
-
-=head2 Reporting Bugs
-
-Report bugs to the Bioperl bug tracking system to help us keep track
-of the bugs and their resolution. Bug reports can be submitted via the
-web:
-
- https://redmine.open-bio.org/projects/bioperl/
-
-=head1 AUTHOR
-
-Martin Senger (senger@ebi.ac.uk)
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved.
-
-This module is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 DISCLAIMER
-
-This software is provided "as is" without warranty of any kind.
-
-=cut
-
-
-# Let the code begin...
-
-
-package Bio::Biblio::BiblioBase;
-use strict;
-use vars qw($AUTOLOAD);
-
-
-use base qw(Bio::Root::Root);
-
-# these methods should not be called here;
-# they should be implemented by a subclass
-sub _accessible { shift->throw_not_implemented(); }
-sub _attr_type { shift->throw_not_implemented(); }
-
-#
-# deal with 'set_' and 'get_' methods
-#
-sub AUTOLOAD {
- my ($self, $newval) = @_;
- if ($AUTOLOAD =~ /.*::(\w+)/ && $self->_accessible ("_$1")) {
- my $attr_name = "_$1";
- my $attr_type = $self->_attr_type ($attr_name);
- my $ref_sub =
- sub {
- my ($this, $new_value) = @_;
- return $this->{$attr_name} unless defined $new_value;
-
- # here we continue with 'set' method
- my ($newval_type) = ref ($new_value) || 'string';
- my ($expected_type) = $attr_type || 'string';
-# $this->throw ("In method $AUTOLOAD, trying to set a value of type '$newval_type' but '$expected_type' is expected.")
- $this->throw ($this->_wrong_type_msg ($newval_type, $expected_type, $AUTOLOAD))
- unless ($newval_type eq $expected_type) or
- UNIVERSAL::isa ($new_value, $expected_type);
-
- $this->{$attr_name} = $new_value;
- return $new_value;
- };
-
- no strict 'refs';
- *{$AUTOLOAD} = $ref_sub;
- use strict 'refs';
- return $ref_sub->($self, $newval);
- }
-
- $self->throw ("No such method: $AUTOLOAD");
-}
-
-#
-
-sub new {
- my ($caller, @args) = @_;
- my $class = ref ($caller) || $caller;
-
- # create and bless a new instance
- my ($self) = $class->SUPER::new (@args);
-
- # make a hashtable from @args
- my %param = @args;
- @param { map { lc $_ } keys %param } = values %param; # lowercase keys
-
- # set all @args into this object with 'set' values;
- # change '-key' into '_key', and making keys lowercase
- my $new_key;
- foreach my $key (keys %param) {
- ($new_key = $key) =~ s/-/_/og; # change it everywhere, why not
- my $method = lc (substr ($new_key, 1)); # omitting the first '_'
- no strict 'refs';
- $method->($self, $param { $key });
- }
-
- # done
- return $self;
-}
-
-#
-# set methods test whether incoming value is of a correct type;
-# here we return message explaining it
-#
-sub _wrong_type_msg {
- my ($self, $given_type, $expected_type, $method) = @_;
- my $msg = 'In method ';
- if (defined $method) {
- $msg .= $method;
- } else {
- $msg .= (caller(1))[3];
- }
- return ("$msg: Trying to set a value of type '$given_type' but '$expected_type' is expected.");
-}
-
-#
-# probably just for debugging
-# TBD: to decide...
-#
-sub print_me {
- my ($self) = @_;
- require Data::Dumper;
- return Data::Dumper->Dump ( [$self], ['Citation']);
-}
-
-1;
-__END__
152 Bio/Biblio/Book.pm
View
@@ -1,152 +0,0 @@
-#
-# BioPerl module for Bio::Biblio::Book
-#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
-#
-# Cared for by Martin Senger <senger@ebi.ac.uk>
-# For copyright and disclaimer see below.
-
-# POD documentation - main docs before the code
-
-=head1 NAME
-
-Bio::Biblio::Book - Representation of a book
-
-=head1 SYNOPSIS
-
- $obj = Bio::Biblio::Book->new(-identifier => '123abc',
- -editor => Bio::Biblio::Person->new
- (-lastname => 'Loukides'),
- -isbn => '0-596-00068-5');
- #--- OR ---
-
- $obj = Bio::Biblio::Book->new();
- $obj->isbn ('0-596-00068-5');
-
-=head1 DESCRIPTION
-
-A storage object for a book.
-See its place in the class hierarchy in
-http://www.ebi.ac.uk/~senger/openbqs/images/bibobjects_perl.gif
-
-=head2 Attributes
-
-The following attributes are specific to this class
-(however, you can also set and get all attributes defined in the parent classes):
-
- edition
- editor type: Bio::Biblio::Provider
- isbn
- series
- title
- volume
-
-=head1 SEE ALSO
-
-=over 4
-
-=item *
-
-OpenBQS home page: http://www.ebi.ac.uk/~senger/openbqs/
-
-=item *
-
-Comments to the Perl client: http://www.ebi.ac.uk/~senger/openbqs/Client_perl.html
-
-=back
-
-=head1 FEEDBACK
-
-=head2 Mailing Lists
-
-User feedback is an integral part of the evolution of this and other
-Bioperl modules. Send your comments and suggestions preferably to
-the Bioperl mailing list. Your participation is much appreciated.
-
- bioperl-l@bioperl.org - General discussion
- http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-
-=head2 Support
-
-Please direct usage questions or support issues to the mailing list:
-
-I<bioperl-l@bioperl.org>
-
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
-with code and data examples if at all possible.
-
-=head2 Reporting Bugs
-
-Report bugs to the Bioperl bug tracking system to help us keep track
-of the bugs and their resolution. Bug reports can be submitted via the
-web:
-
- https://redmine.open-bio.org/projects/bioperl/
-
-=head1 AUTHORS
-
-Heikki Lehvaslaiho (heikki-at-bioperl-dot-org),
-Martin Senger (senger@ebi.ac.uk)
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved.
-
-This module is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 DISCLAIMER
-
-This software is provided "as is" without warranty of any kind.
-
-=cut
-
-
-# Let the code begin...
-
-
-package Bio::Biblio::Book;
-use strict;
-
-
-use base qw(Bio::Biblio::Ref);
-
-#
-# a closure with a list of allowed attribute names (these names
-# correspond with the allowed 'get' and 'set' methods); each name also
-# keep what type the attribute should be (use 'undef' if it is a
-# simple scalar)
-#
-{
- my %_allowed =
- (
- _edition => undef,
- _editor => 'Bio::Biblio::Provider',
- _isbn => undef,
- _series => undef,
- _title => undef,
- _volume => undef,
- );
-
- # return 1 if $attr is allowed to be set/get in this class
- sub _accessible {
- my ($self, $attr) = @_;
- exists $_allowed{$attr} or $self->SUPER::_accessible ($attr);
- }
-
- # return an expected type of given $attr
- sub _attr_type {
- my ($self, $attr) = @_;
- if (exists $_allowed{$attr}) {
- return $_allowed{$attr};
- } else {
- return $self->SUPER::_attr_type ($attr);
- }
- }
-}
-
-
-1;
-__END__
141 Bio/Biblio/BookArticle.pm
View
@@ -1,141 +0,0 @@
-#
-# BioPerl module for Bio::Biblio::BookArticle
-#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
-#
-# Cared for by Martin Senger <senger@ebi.ac.uk>
-# For copyright and disclaimer see below.
-
-# POD documentation - main docs before the code
-
-=head1 NAME
-
-Bio::Biblio::BookArticle - Representation of a book article
-
-=head1 SYNOPSIS
-
- $obj = Bio::Biblio::BookArticle->new(-identifier => '123abc',
- -book => Bio::Biblio::Book->new());
- #--- OR ---
-
- $obj = Bio::Biblio::BookArticle->new();
- $obj->book (Bio::Biblio::Book->new());
-
-
-=head1 DESCRIPTION
-
-A storage object for a book article.
-See its place in the class hierarchy in
-http://www.ebi.ac.uk/~senger/openbqs/images/bibobjects_perl.gif
-
-=head2 Attributes
-
-The following attributes are specific to this class
-(however, you can also set and get all attributes defined in the parent classes):
-
- book type: Bio::Biblio::Book
-
-=head1 SEE ALSO
-
-=over 4
-
-=item *
-
-OpenBQS home page: http://www.ebi.ac.uk/~senger/openbqs/
-
-=item *
-
-Comments to the Perl client: http://www.ebi.ac.uk/~senger/openbqs/Client_perl.html
-
-=back
-
-=head1 FEEDBACK
-
-=head2 Mailing Lists
-
-User feedback is an integral part of the evolution of this and other
-Bioperl modules. Send your comments and suggestions preferably to
-the Bioperl mailing list. Your participation is much appreciated.
-
- bioperl-l@bioperl.org - General discussion
- http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-
-=head2 Support
-
-Please direct usage questions or support issues to the mailing list:
-
-I<bioperl-l@bioperl.org>
-
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
-with code and data examples if at all possible.
-
-=head2 Reporting Bugs
-
-Report bugs to the Bioperl bug tracking system to help us keep track
-of the bugs and their resolution. Bug reports can be submitted via the
-web:
-
- https://redmine.open-bio.org/projects/bioperl/
-
-=head1 AUTHORS
-
-Heikki Lehvaslaiho (heikki-at-bioperl-dot-org),
-Martin Senger (senger@ebi.ac.uk)
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved.
-
-This module is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 DISCLAIMER
-
-This software is provided "as is" without warranty of any kind.
-
-=cut
-
-
-# Let the code begin...
-
-
-package Bio::Biblio::BookArticle;
-use strict;
-
-
-use base qw(Bio::Biblio::Article);
-
-#
-# a closure with a list of allowed attribute names (these names
-# correspond with the allowed 'get' and 'set' methods); each name also
-# keep what type the attribute should be (use 'undef' if it is a
-# simple scalar)
-#
-{
- my %_allowed =
- (
- _book => 'Bio::Biblio::Book',
- );
-
- # return 1 if $attr is allowed to be set/get in this class
- sub _accessible {
- my ($self, $attr) = @_;
- exists $_allowed{$attr} or $self->SUPER::_accessible ($attr);
- }
-
- # return an expected type of given $attr
- sub _attr_type {
- my ($self, $attr) = @_;
- if (exists $_allowed{$attr}) {
- return $_allowed{$attr};
- } else {
- return $self->SUPER::_attr_type ($attr);
- }
- }
-}
-
-
-1;
-__END__
382 Bio/Biblio/IO.pm
View
@@ -1,382 +0,0 @@
-#
-# BioPerl module for Bio::Biblio::IO
-#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
-#
-# Cared for by Martin Senger <senger@ebi.ac.uk>
-# For copyright and disclaimer see below.
-
-# POD documentation - main docs before the code
-
-=head1 NAME
-
-Bio::Biblio::IO - Handling the bibliographic references
-
-=head1 SYNOPSIS
-
- use Bio::Biblio::IO;
-
- # getting citations from a file
- $in = Bio::Biblio::IO->new ('-file' => 'myfile.xml' ,
- '-format' => 'medlinexml');
- # --- OR ---
-
- # getting citations from a string
- $in = Bio::Biblio::IO->new ('-data' => '<MedlineCitation>...</MedlineCitation>' ,
- '-format' => 'medlinexml');
- #--- OR ---
-
- # getting citations from a string if IO::String is installed
- use IO::String;
- $in = Bio::Biblio::IO->new ('-fh' => IO::String->new ($citation),
- '-format' => 'medlinexml');
-
- $in = Bio::Biblio::IO->new(-fh => $io_handle , '-format' => 'medlinexml');
-
- #--- OR ---
-
- # getting citations from any IO handler
- $in = Bio::Biblio::IO->new('-fh' => $io_handle ,
- '-format' => 'medlinexml');
-
-
- # now, having $in, we can read all citations
- while ( my $citation = $in->next_bibref() ) {
- &do_something_with_citation ($citation);
- }
-
- #--- OR ---
-
- # again reading all citation but now a callback defined in your
- # code is used (note that the reading starts already when new()
- # is called)
- $io = Bio::Biblio::IO->new('-format' => 'medlinexml',
- '-file' => $testfile,
- '-callback' => \&callback);
- sub callback {
- my $citation = shift;
- print $citation->{'_identifier'} . "\n";
- }
-
- #Now, to actually get a citation in an XML format,
- #use I<Bio::Biblio> module which returns an XML string:
-
- use Bio::Biblio;
- use Bio::Biblio::IO;
- my $xml = Bio::Biblio->new->get_by_id ('12368254');
- my $reader = Bio::Biblio::IO->new ('-data' => $xml,
- '-format' => 'medlinexml');
-
- while (my $citation = $reader->next_bibref()) {
- #... do something here with $citation
- }
-
- #And, finally, the resulting citation can be received in different
- #output formats:
-
- $io = Bio::Biblio::IO->new('-format' => 'medlinexml',
- '-result' => 'raw');
- #--- OR ---
-
- $io = Bio::Biblio::IO->new('-format' => 'medlinexml',
- '-result' => 'medline2ref');
-
- #--- OR ---
-
- $io = Bio::Biblio::IO->new('-format' => 'pubmedxml',
- '-result' => 'pubmed2ref');
-
-=head1 DESCRIPTION
-
-Bio::Biblio::IO is a handler module for accessing bibliographic
-citations. The citations can be in different formats - assuming that
-there is a corresponding module knowing that format in Bio::Biblio::IO
-directory (e.g. Bio::Biblio::IO::medlinexml). The format (and the
-module name) is given by the argument I<-format>.
-
-Once an instance of C<Bio::Biblio::IO> class is available, the
-citations can be read by calling repeatedly method I<next_bibref>:
-
- while (my $citation = $reader->next_bibref()) {
- ... do something here with $citation
- }
-
-However, this may imply that all citations were already read into the
-memory. If you expect a huge amount of citations to be read, you may
-choose a I<callback> option. Your subroutine is specified in the
-C<new()> method and is called everytime a new citation is available
-(see an example above in SYNOPSIS).
-
-The citations returned by I<next_bibref> or given to your callback
-routine can be of different formats depending on the argument
-I<-result>. One result type is I<raw> and it is represented by a
-simple, not blessed hash table:
-
- $io = Bio::Biblio::IO->new('-result' => 'raw');
-
-What other result formats are available depends on the module who
-reads the citations in the first place. At the moment, the following
-ones are available:
-
- $io = Bio::Biblio::IO->new('-result' => 'medline2ref');
-
-This is a default result format for reading citations by the
-I<medlinexml> module. The C<medlinexml> module is again the default
-one. Which means that you can almost omit arguments (you still need to
-say where the citations come from):
-
- $io = Bio::Biblio::IO->new('-file' => 'data/medline_data.xml');
-
-Another result format available is for PUBMED citations (which is a
-super-set of the MEDLINE citations having few more tags):
-
- $io = Bio::Biblio::IO->new('-format' => 'pubmedxml',
- '-result' => 'pubmed2ref',
- '-data' => $citation);
-
-Or, because C<pubmed2ref> is a default one for PUBMED citations, you can say just:
-
- $io = Bio::Biblio::IO->new('-format' => 'pubmedxml',
- '-data' => $citation);
-
-Both C<medline2ref> and C<pubmed2ref> results are objects defined in
-the directory C<Bio::Biblio>.
-
-=head1 SEE ALSO
-
-=over 4
-
-=item *
-
-An example script I<examples/biblio.pl>. It has many options and its
-own help. The relevant options to this IO module are I<-f>
-(specifying what file to read) and I<-O> (specifying what result
-format to achieve).
-
-=item *
-
-OpenBQS home page: http://www.ebi.ac.uk/~senger/openbqs
-
-=item *
-
-Comments to the Perl client: http://www.ebi.ac.uk/~senger/openbqs/Client_perl.html
-
-=back
-
-=head1 FEEDBACK
-
-=head2 Mailing Lists
-
-User feedback is an integral part of the evolution of this
-and other Bioperl modules. Send your comments and suggestions preferably
- to one of the Bioperl mailing lists.
-Your participation is much appreciated.
-
- bioperl-l@bioperl.org - General discussion
- http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-
-=head2 Support
-
-Please direct usage questions or support issues to the mailing list:
-
-I<bioperl-l@bioperl.org>
-
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
-with code and data examples if at all possible.
-
-=head2 Reporting Bugs
-
-Report bugs to the Bioperl bug tracking system to help us keep track
-the bugs and their resolution. Bug reports can be submitted via the
-web:
-
- https://redmine.open-bio.org/projects/bioperl/
-
-=head1 AUTHOR
-
-Martin Senger (senger@ebi.ac.uk)
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved.
-
-This module is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 DISCLAIMER
-
-This software is provided "as is" without warranty of any kind.
-
-=head1 APPENDIX
-
-The rest of the documentation details each of the object
-methods. Internal methods are preceded with a _
-
-=cut
-
-
-# Let the code begin...
-
-package Bio::Biblio::IO;
-
-use strict;
-
-use Symbol;
-
-use base qw(Bio::Root::Root Bio::Root::IO);
-
-my $entry = 0;
-
-sub new {
- my ($caller, @args) = @_;
- my $class = ref ($caller) || $caller;
-
- # if $caller is an object, or if it is an underlying
- # 'real-work-doing' class (e.g. Bio::Biblio::IO::medlinexml) then
- # we want to call SUPER to create and bless an object
- if( $class =~ /Bio::Biblio::IO::(\S+)/ ) {
- my ($self) = $class->SUPER::new (@args);
- $self->_initialize (@args);
- return $self;
-
- # this is called only the first time when somebody calls: 'new
- # Bio::Biblio::IO (...)', and it actually loads a 'real-work-doing'
- # module and call this new() method again (unless the loaded
- # module has its own new() method)
- } else {
- my %param = @args;
- @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
- my $format = $param{'-format'} ||
- $class->_guess_format( $param{-file} || $ARGV[0] ) ||
- 'medlinexml';
- $format = "\L$format"; # normalize capitalization to lower case
-
- # load module with the real implementation - as defined in $format
- return unless (&_load_format_module ($format));
-
- # this will call this same method new() - but rather its
- # upper (object) branche
- return "Bio::Biblio::IO::$format"->new(@args);
- }
-}
-
-sub newFh {
- my $class = shift;
- return unless my $self = $class->new(@_);
- return $self->fh;
-}
-
-
-sub fh {
- my $self = shift;
- my $class = ref($self) || $self;
- my $s = Symbol::gensym;
- tie $$s,$class,$self;
- return $s;
-}
-
-# _initialize is chained for all Bio::Biblio::IO classes
-
-sub _initialize {
- my ($self, @args) = @_;
- # initialize the IO part
- $self->_initialize_io (@args);
-}
-
-=head2 next_bibref
-
- Usage : $citation = stream->next_bibref
- Function: Reads the next citation object from the stream and returns it.
- Returns : a Bio::Biblio::Ref citation object, or something else
- (depending on the '-result' argument given in the 'new()'
- method).
- Args : none
-
-=cut
-
-sub next_bibref {
- my ($self) = shift;
- $self->throw ("Sorry, you cannot read from a generic Bio::Biblio::IO object.");
-}
-
-# -----------------------------------------------------------------------------
-
-=head2 _load_format_module
-
- Usage : $class->_load_format_module ($format)
- Returns : 1 on success, undef on failure
- Args : 'format' should contain the last part of the
- name of a module who does the real implementation
-
-It does (in run-time) a similar thing as
-
- require Bio::Biblio::IO::$format
-
-It throws an exception if it fails to find and load the module
-(for example, because of the compilation errors in the module).
-
-=cut
-
-sub _load_format_module {
- my ($format) = @_;
- my ($module, $load, $m);
-
- $module = "_<Bio/Biblio/IO/$format.pm";
- $load = "Bio/Biblio/IO/$format.pm";
-
- return 1 if $main::{$module};
- eval {
- require $load;
- };
- if ( $@ ) {
- Bio::Root::Root->throw (<<END);
-$load: $format cannot be found or loaded
-Exception $@
-For more information about the Biblio system please see the Bio::Biblio::IO docs.
-END
- ;
- return;
- }
- return 1;
-}
-
-=head2 _guess_format
-
- Usage : $class->_guess_format ($filename)
- Returns : string with a guessed format of the input data (e.g. 'medlinexml')
- Args : a file name whose extension can help to guess its format
-
-It makes an expert guess what kind of data are in the given file
-(but be prepare that $filename may be empty).
-
-=cut
-
-sub _guess_format {
- my $class = shift;
- return unless $_ = shift;
- return 'medlinexml' if (/\.(xml|medlinexml)$/i);
- return;
-}
-
-sub DESTROY {
- my $self = shift;
-
- $self->close();
-}
-
-sub TIEHANDLE {
- my ($class,$val) = @_;
- return bless {'biblio' => $val}, $class;
-}
-
-sub READLINE {
- my $self = shift;
- return $self->{'biblio'}->next_bibref() unless wantarray;
- my (@list, $obj);
- push @list, $obj while $obj = $self->{'biblio'}->next_bibref();
- return @list;
-}
-
-1;
545 Bio/Biblio/IO/medline2ref.pm
View
@@ -1,545 +0,0 @@
-#
-# BioPerl module Bio::Biblio::IO::medline2ref.pm
-#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
-#
-# Cared for by Martin Senger <senger@ebi.ac.uk>
-# For copyright and disclaimer see below.
-
-# POD documentation - main docs before the code
-
-=head1 NAME
-
-Bio::Biblio::IO::medline2ref - A converter of a raw hash to MEDLINE citations
-
-=head1 SYNOPSIS
-
- # to be written
-
-=head1 DESCRIPTION
-
- # to be written
-
-=head1 FEEDBACK
-
-=head2 Mailing Lists
-
-User feedback is an integral part of the evolution of this and other
-Bioperl modules. Send your comments and suggestions preferably to
-the Bioperl mailing list. Your participation is much appreciated.
-
- bioperl-l@bioperl.org - General discussion
- http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-
-=head2 Support
-
-Please direct usage questions or support issues to the mailing list:
-
-I<bioperl-l@bioperl.org>
-
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
-with code and data examples if at all possible.
-
-=head2 Reporting Bugs
-
-Report bugs to the Bioperl bug tracking system to help us keep track
-of the bugs and their resolution. Bug reports can be submitted via the
-web:
-
- https://redmine.open-bio.org/projects/bioperl/
-
-=head1 AUTHOR
-
-Martin Senger (senger@ebi.ac.uk)
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved.
-
-This module is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 DISCLAIMER
-
-This software is provided "as is" without warranty of any kind.
-
-=head1 APPENDIX
-
-Here is the rest of the object methods. Internal methods are preceded
-with an underscore _.
-
-=cut
-
-
-# Let the code begin...
-
-
-package Bio::Biblio::IO::medline2ref;
-
-use strict;
-
-use Bio::Biblio::MedlineJournal;
-use Bio::Biblio::MedlineBook;
-use Bio::Biblio::Provider;
-use Bio::Biblio::Person;
-use Bio::Biblio::Organisation;
-
-use base qw(Bio::Root::Root);
-
-# -----------------------------------------------------------------------------
-sub new {
- my ($caller, @args) = @_;
- my $class = ref ($caller) || $caller;
-
- # object creation and blessing
- my ($self) = $class->SUPER::new (@args);
-
- # make a hashtable from @args
- my %param = @args;
- @param { map { lc $_ } keys %param } = values %param; # lowercase keys
-
- # copy all @args into this object (overwriting what may already be
- # there) - changing '-key' into '_key', and making keys lowercase
- my $new_key;
- foreach my $key (keys %param) {
- ($new_key = $key) =~ s/^-/_/;
- $self->{ lc $new_key } = $param { $key };
- }
-
- # done
- return $self;
-}
-
-# ---------------------------------------------------------------------
-#
-# Here is the core...
-#
-# ---------------------------------------------------------------------
-
-sub _load_instance {
- my ($self, $source) = @_;
-
- #
- # MEDLINE has only JournalArticles and BookArticles
- # but we may create a general Ref if there is no attribute 'article'
- #
- my $result;
- my $article = $$source{'article'};
- if (defined $article) {
- if (defined $$article{'journal'}) {
- $result = $self->_new_instance ('Bio::Biblio::MedlineJournalArticle');
- $result->type ('JournalArticle');
- } elsif (defined $$article{'book'}) {
- $result = $self->_new_instance ('Bio::Biblio::MedlineBookArticle');
- $result->type ('BookArticle');
- } else {
- $result->type ('MedlineArticle');
- }
- }
- $result = $self->_new_instance ('Bio::Biblio::Ref') unless defined $result;
- return $result;
-}
-
-sub convert {
- my ($self, $source) = @_;
- my $result = $self->_load_instance ($source);
-
- if (defined $result->type) {
- if ($result->type eq 'JournalArticle') {
- &_convert_journal_article ($result, $source);
- } elsif ($result->type eq 'BookArticle') {
- &_convert_book_article ($result, $source);
- } elsif ($result->type eq 'Article') {
- &_convert_article ($result, $source);
- }
- }
-
- #
- # now do the attributes which are the same for all resource types
- #
-
- # ...identification is now by MedlineID but the trend is to replace
- # it by PMID (I have heard) theefore we keep both also separately
- # from the 'identifier'
- if (defined $$source{'medlineID'}) {
- $result->identifier ($$source{'medlineID'});
- } else {
- $result->identifier ($$source{'PMID'});
- }
- $result->pmid ($$source{'PMID'}) if defined $$source{'PMID'};
- $result->medline_id ($$source{'medlineID'}) if defined $$source{'medlineID'};
-
- # ...few others
- $result->citation_owner ($$source{'owner'}) if defined $$source{'owner'};
- $result->status ($$source{'status'}) if defined $$source{'status'};
- $result->number_of_references ($$source{'numberOfReferences'}) if defined $$source{'numberOfReferences'};
-
- # ...entry status of the citation in the repository
- my $date;
- if (defined $$source{'dateRevised'}) {
- $result->last_modified_date (&_convert_date ($$source{'dateRevised'}));
- $date = &_convert_date ($$source{'dateCreated'});
- $result->date_created ($date) if defined $date;
- $date = &_convert_date ($$source{'dateCompleted'});
- $result->date_completed ($date) if defined $date;
- } elsif (defined $$source{'dateCompleted'}) {
- $result->last_modified_date (&_convert_date ($$source{'dateCompleted'}));
- $date = &_convert_date ($$source{'dateCreated'});
- $result->date_created ($date) if defined $date;
- } elsif (defined $$source{'dateCreated'}) {
- $result->last_modified_date (&_convert_date ($$source{'dateCreated'}));
- }
-
- # ...put citation subsets in a comma-separated string
- if (defined $$source{'citationSubsets'}) {
- $result->repository_subset (join (',', @{ $$source{'citationSubsets'} }));
- }
-
- # ...MEDLINE's Comments & Corrections will be arrays of hashes
- if (defined $$source{'commentsCorrections'}) {
- my $corr = $$source{'commentsCorrections'};
- $result->comment_ons ($$corr{'commentOns'}) if defined $$corr{'commentOns'};
- $result->comment_ins ($$corr{'commentIns'}) if defined $$corr{'commentIns'};
- $result->erratum_ins ($$corr{'erratumIns'}) if defined $$corr{'erratumIns'};
- $result->erratum_fors ($$corr{'erratumFors'}) if defined $$corr{'erratumFors'};
- $result->original_report_ins ($$corr{'originalReportIns'}) if defined $$corr{'originalReportIns'};
- $result->republished_froms ($$corr{'republishedFroms'}) if defined $$corr{'republishedFroms'};
- $result->republished_ins ($$corr{'republishedIns'}) if defined $$corr{'republishedIns'};
- $result->retraction_ofs ($$corr{'retractionOfs'}) if defined $$corr{'retractionOfs'};
- $result->retraction_ins ($$corr{'retractionIns'}) if defined $$corr{'retractionIns'};
- $result->summary_for_patients_ins ($$corr{'summaryForPatientsIns'}) if defined $$corr{'summaryForPatientsIns'};
- $result->update_ins ($$corr{'updateIns'}) if defined $$corr{'updateIns'};
- $result->update_ofs ($$corr{'updateOfs'}) if defined $$corr{'updateOfs'};
- }
-
- # ...MEDLINE's GeneSymbols are put in a comma-separated string
- if (defined $$source{'geneSymbols'}) {
- $result->gene_symbols (join (',', @{ $$source{'geneSymbols'} }));
- }
-
- # ...MEDLINE's GeneralNotes into an array of hashtables, each one
- # having keys for the 'owner' and the 'note'
- $result->general_notes ($$source{'generalNotes'}) if defined $$source{'generalNotes'};
-
- # ...MEDLINE's PersonalNameSubjects into contributors (TBD: is that correct?)
- if (defined $$source{'personalNameSubjects'}) {
- my @contributors;
- foreach my $person ( @{ $$source{'personalNameSubjects'} } ) {
- push (@contributors, &_convert_personal_name ($person));
- }
- $result->contributors (\@contributors);
- }
-
- # ...MEDLINE's OtherAbstract into an array of hashtables, each one
- # having keys for the 'type', 'AbstractText' and the 'copyright'
- $result->other_abstracts ($$source{'otherAbstracts'}) if defined $$source{'otherAbstracts'};
-# if (defined $$source{'otherAbstracts'}) {
-# my @other_abstracts = ();
-# foreach my $oa ( @{ $$source{'otherAbstracts'} } ) {
-# if (defined $$oa{'abstractText'}) {
-# my $abstract = $$oa{'abstractText'};
-# delete $$oa{'abstractText'};
-# $$oa{'abstract'} = $$abstract{'abstractText'};
-# $$oa{'rights'} = $$abstract{'copyrightInformation'} if defined $$abstract{'copyrightInformation'};
-# push (@other_abstracts, $oa);
-# }
-# }
-# $result->other_abstracts (\@other_abstracts);
-# }
-
- # ...MEDLINE's OtherIDs into an array of hashtables, each one
- # having keys for the 'id', and 'source'
- $result->other_ids ($$source{'otherIDs'}) if defined $$source{'otherIDs'};
-
- # ...MEDLINE's Chemicals - store them as an array of hashtables
- # (each one for each Chemical)
- $result->chemicals ($$source{'chemicals'}) if defined $$source{'chemicals'};
-
- # MeshHeadings are put on two places:
- # - a complete information in a property called "MeshHeadings", and
- # - only descriptors in the hashtable "subject_headings", together
- # with the word "MeSH" in "subject_headings_source"
- if (defined $$source{'meshHeadings'}) {
- $result->mesh_headings ($$source{'meshHeadings'});
- my %subject_headings;
- foreach my $mesh ( @{ $$source{'meshHeadings'} } ) {
- $subject_headings{ $$mesh{'descriptorName'} } = 1 if defined $$mesh{'descriptorName'};
- }
- if (%subject_headings) {
- $result->subject_headings (\%subject_headings);
- $result->subject_headings_source ('Mesh');
- }
- }
-
- # ...MEDLINE's keyword lists are merger all together (this may not
- # be good idea - but again the keywords are better accessible
- # -TBD?)
- if (defined $$source{'keywordLists'}) {
- my %keywords;
- foreach my $keywords ( @{ $$source{'keywordLists'} } ) {
- if ($$keywords{'keywords'}) {
- foreach my $keyword ( @{ $$keywords{'keywords'} } ) {
- $keywords{$keyword} = 1;
- }
- }
- }
- $result->keywords (\%keywords) if %keywords;
- }
-
- # Done!
- return $result;
-}
-
-# load a module (given as a real module name, e.g. 'Bio::Biblio::MedlineJournalArticle'),
-# call new() method on it, and return the instance returned by the new() method
-sub _new_instance {
- my ($self, $module) = @_;
- my ($filename);
- ($filename = $module . '.pm') =~ s|\:\:|/|g;
- eval { require $filename; };
- $self->throw ("Loading error when trying '$filename'. $@\n") if $@;
- return $module->new;
-}
-
-#
-# see OpenBQS specification (http://www.ebi.ac.uk/~senger/openbqs/) how
-# a date should be coded;
-# TBD: this can be improved - checking is missing, timezones,
-# converting to UTC...
-# Also note that this routine does not convert 'medline_date' - it
-# is stored in a separate attribute without ant conversion.
-#
-sub _convert_date {
- my ($date) = @_;
- return unless
- exists $$date{'year'} or
- exists $$date{'month'} or
- exists $$date{'day'} or
- exists $$date{'hour'} or
- exists $$date{'minute'} or
- exists $$date{'second'};
-
-
- my $converted = (exists $$date{'year'} ? $$date{'year'} : '0000');
-
- if (exists $$date{'month'}) {
- $converted .= '-' . $$date{'month'};
- } elsif (exists $$date{'day'}) {
- $converted .= '-00';
- }
-
- if (exists $$date{'day'}) {
- $converted .= '-' . $$date{'day'};
- } elsif (exists $$date{'hour'}) {
- $converted .= '-00';
- }
-
- if (exists $$date{'hour'}) {
- $converted .= 'T' . $$date{'hour'} .
- ':' . (exists $$date{'minute'} ? $$date{'minute'} : '00') .
- ':' . (exists $$date{'second'} ? $$date{'second'} : '00') . 'Z';
- }
- return $converted;
-}
-
-# $person is a hash with persons attributes - we need to create and
-# return a Bio::Biblio::Person object
-sub _convert_personal_name {
- my ($person) = @_;
- foreach my $key (keys %$person) {
- $$person{"_$key"} = $$person{$key};
- delete $$person{$key};
- }
- Bio::Biblio::Person->new(%$person);
-}
-
-#
-# takes journal article related attributes from $article and convert
-# them into $result and at the end call _convert_article (which is
-# shared with book article)
-#
-sub _convert_journal_article {
- my ($result, $source) = @_;
- my $article = $$source{'article'};
-
- # create and populate both a Journal and a resulting Article objects
- my $from_journal = $$article{'journal'};
- my $journal = Bio::Biblio::MedlineJournal->new();
- $journal->name ($$from_journal{'title'}) if defined $$from_journal{'title'};
- $journal->issn ($$from_journal{'iSSN'}) if defined $$from_journal{'iSSN'};
- $journal->abbreviation ($$from_journal{'iSOAbbreviation'}) if defined $$from_journal{'iSOAbbreviation'};
- $journal->coden ($$from_journal{'coden'}) if defined $$from_journal{'coden'};
- if (defined $$from_journal{'journalIssue'}) {
- my $issue = $$from_journal{'journalIssue'};
- $result->volume ($$issue{'volume'}) if defined $$issue{'volume'};
- $result->issue ($$issue{'issue'}) if defined $$issue{'issue'};
-
- if (defined $$issue{'pubDate'}) {
- my $pub_date = $$issue{'pubDate'};
- my $converted = &_convert_date ($pub_date);
- $result->date ($converted) if defined $converted;
-
- # Some parts of a MEDLINE date are stored just as properties
- # because they have almost non-parseable format :-).
- $result->medline_date ($$pub_date{'medlineDate'}) if defined $$pub_date{'medlineDate'};
- $result->season ($$pub_date{'season'}) if defined $$pub_date{'season'};
- }
- }
-
- # ...some attributes are in journalInfo (which is outside of the article)
- my $journal_info = $$source{'journalInfo'};
- if (defined $journal_info) {
- $journal->country ($$journal_info{'country'}) if defined $$journal_info{'country'};
- $journal->medline_ta ($$journal_info{'medlineTA'}) if defined $$journal_info{'medlineTA'};
- $journal->medline_code ($$journal_info{'medlineCode'}) if defined $$journal_info{'medlineCode'};
- $journal->nlm_unique_id ($$journal_info{'nlmUniqueID'}) if defined $$journal_info{'nlmUniqueID'};
- }
-
- $result->journal ($journal);
- &_convert_article ($result, $source);
-}
-
-#
-# takes book article related attributes from $article and convert
-# them into $result and at the end call _convert_article (which is
-# shared with journal article)
-#
-sub _convert_book_article {
- my ($result, $source) = @_;
- my $article = $$source{'article'};
-
- # create and populate both book and resulting article objects
- my $from_book = $$article{'book'};
- my $book = Bio::Biblio::MedlineBook->new();
- $book->title ($$from_book{'title'}) if defined $$from_book{'title'};
- $book->volume ($$from_book{'volume'}) if defined $$from_book{'volume'};
- $book->series ($$from_book{'collectionTitle'}) if defined $$from_book{'collectionTitle'};
-
- if (defined $$from_book{'pubDate'}) {
- my $pub_date = $$from_book{'pubDate'};
- my $converted = &_convert_date ($pub_date);
- $result->pub_date ($converted) if defined $converted;
-
- # Some parts of a MEDLINE date are stored just as properties
- # because they have almost non-parseable format :-).
- $result->medline_date ($$pub_date{'medlineDate'}) if defined $$pub_date{'medlineDate'};
- $result->season ($$pub_date{'season'}) if defined $$pub_date{'season'};
- }
-
- if (defined $$from_book{'publisher'}) {
- my $publisher = Bio::Biblio::Organisation->new();
- $publisher->name ($$from_book{'publisher'});
- $book->publisher ($publisher);
- }
-
- my @authors = &_convert_providers ($$from_book{'authors'});
- $book->authors (\@authors) if @authors;
-
- $result->book ($book);
- &_convert_article ($result, $source);
-}
-
-#
-# takes from $source article related attributes and convert them into
-# $article (these attributes are the same both for journal and book
-# articles
-#
-sub _convert_article {
- my ($article, $source) = @_;
- my $from_article = $$source{'article'};
-
- $article->title ($$from_article{'articleTitle'}) if defined $$from_article{'articleTitle'};
- $article->affiliation ($$from_article{'affiliation'}) if defined $$from_article{'affiliation'};
- $article->vernacular_title ($$from_article{'vernacularTitle'}) if defined $$from_article{'vernacularTitle'};
- $article->date_of_electronic_publication
- ($$from_article{'dateOfElectronicPublication'}) if defined $$from_article{'dateOfElectronicPublication'};
-
- if (defined $$from_article{'pagination'}) {
- my $pagination = $$from_article{'pagination'};
- $article->first_page ($$pagination{'startPage'}) if defined $$pagination{'startPage'};
- $article->last_page ($$pagination{'endPage'}) if defined $$pagination{'endPage'};
- $article->medline_page ($$pagination{'medlinePgn'}) if defined $$pagination{'medlinePgn'};
- }
-
- if (defined $$from_article{'abstract'}) {
- my $abstract = $$from_article{'abstract'};
- $article->abstract ($$abstract{'abstractText'}) if defined $$abstract{'abstractText'};
- $article->abstract_type ('text/plain');
- $article->rights ($$abstract{'copyrightInformation'}) if defined $$abstract{'copyrightInformation'};
- }
-
- if (defined $$from_article{'languages'}) {
- my $languages = $$from_article{'languages'}; # ref-array
- if ( @{ $languages } > 0) {
- $article->language ( $$languages[0] );
- }
- if ( @{ $languages } > 1) {
- $article->other_languages (join (',', @{ $languages }));
- }
- }
-
- my @authors = &_convert_providers ($$from_article{'authors'});
- if (@authors) {
- $article->authors (\@authors);
- $article->author_list_complete
- ($$from_article{'authorListComplete'}) if defined $$from_article{'authorListComplete'};
- }
-
- # references to database entries are prefixed with database name
- # (separated by a slash)
- use Bio::Annotation::DBLink;
- if (defined $$from_article{'dataBanks'}) {
- my $databanks = $$from_article{'dataBanks'}; # a ref-array
- my @references;
- foreach my $bank ( @{ $databanks } ) {
- my $db_name = $$bank{'dataBankName'};
- if (defined $$bank{'accessionNumbers'}) {
- foreach my $accn ( @{ $$bank{'accessionNumbers'} } ) {
- my $dblink = Bio::Annotation::DBLink->new(-primary_id => $accn);
- $dblink->database ($db_name); # it does not matter if it is undef
- push (@references, $dblink);
- }
- }
- }
- if (@references) {
- $article->cross_references (\@references);
- $article->cross_references_list_complete
- ($$from_article{'dataBankListComplete'}) if defined $$from_article{'dataBankListComplete'};
- }
- }
-
- # grants are stored in an array of hashtables (each of the
- # hashtables has keys agency, grantID and acronym)
- $article->grants ($$from_article{'grants'}) if defined $$from_article{'grants'};
- $article->grant_list_complete
- ($$from_article{'grantListComplete'}) if defined $$from_article{'grandListComplete'};
-
-}
-
-#
-# takes a ref-array of providers - they can be persons or
-# organisations, and returns an array of converted providers
-#
-sub _convert_providers {
- my ($providers) = @_;
- return () unless defined $providers;
-
- my @results;
- foreach my $provider ( @{ $providers } ) {
- if (defined $$provider{'personalName'}) {
- my $converted = &_convert_personal_name ($$provider{'personalName'});
- push (@results, $converted) if defined $converted;
- } elsif (defined $$provider{'collectiveName'}) {
- push (@results, Bio::Biblio::Organisation->new(-name => $$provider{'collectiveName'}));
- } else {
- Bio::Biblio::Provider->new();
- }
- }
- return () unless @results;
- return @results;
-}
-
-1;
-__END__
747 Bio/Biblio/IO/medlinexml.pm
View
@@ -1,747 +0,0 @@
-#
-# BioPerl module Bio::Biblio::IO::medlinexml.pm
-#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
-#
-# Cared for by Martin Senger <senger@ebi.ac.uk>
-# For copyright and disclaimer see below.
-
-# POD documentation - main docs before the code
-
-=head1 NAME
-
-Bio::Biblio::IO::medlinexml - A converter of XML files with MEDLINE citations
-
-=head1 SYNOPSIS
-
-Do not use this object directly, it is recommended to access it and use
-it through the I<Bio::Biblio::IO> module:
-
- use Bio::Biblio::IO;
- my $io = Bio::Biblio::IO->new(-format => 'medlinexml');
-
-=head1 DESCRIPTION
-
-This object reads bibliographic citations in XML/MEDLINE format and
-converts them into I<Bio::Biblio::RefI> objects. It is an
-implementation of methods defined in I<Bio::Biblio::IO>.
-
-=head1 FEEDBACK
-
-=head2 Mailing Lists
-
-User feedback is an integral part of the evolution of this and other
-Bioperl modules. Send your comments and suggestions preferably to
-the Bioperl mailing list. Your participation is much appreciated.
-
- bioperl-l@bioperl.org - General discussion
- http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-
-=head2 Support
-
-Please direct usage questions or support issues to the mailing list:
-
-I<bioperl-l@bioperl.org>
-
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
-with code and data examples if at all possible.
-
-=head2 Reporting Bugs
-
-Report bugs to the Bioperl bug tracking system to help us keep track
-of the bugs and their resolution. Bug reports can be submitted via the
-web:
-
- https://redmine.open-bio.org/projects/bioperl/
-
-=head1 AUTHOR
-
-Martin Senger (senger@ebi.ac.uk)
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved.
-
-This module is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 DISCLAIMER
-
-This software is provided "as is" without warranty of any kind.
-
-=head1 APPENDIX
-
-The main documentation details are to be found in
-L<Bio::Biblio::IO>.
-
-Here is the rest of the object methods. Internal methods are preceded
-with an underscore _.
-
-=cut
-
-
-# Let the code begin...
-
-
-package Bio::Biblio::IO::medlinexml;
-use vars qw(@Citations $Callback $Convert @ObjectStack @PCDataStack);
-use vars qw(%PCDATA_NAMES %SIMPLE_TREATMENT %POP_DATA_AND_PEEK_OBJ %POP_OBJ_AND_PEEK_OBJ);
-use vars qw(%POP_AND_ADD_ELEMENT %POP_AND_ADD_DATA_ELEMENT);
-
-use strict;
-
-use XML::Parser;
-
-use base qw(Bio::Biblio::IO);
-
-# -----------------------------------------------------------------------------
-
-sub _initialize {
- my ($self, @args) = @_;
-
- # make a hashtable from @args
- my %param = @args;
- @param { map { lc $_ } keys %param } = values %param; # lowercase keys
-
- # copy all @args into this object (overwriting what may already be
- # there) - changing '-key' into '_key', and making keys lowercase
- my $new_key;
- foreach my $key (keys %param) {
- ($new_key = $key) =~ s/^-/_/;
- $self->{ lc $new_key } = $param { $key };
- }
-
- # find the format for output - and put it into a global $Convert
- # because it will be used by the event handler who knows nothing
- # about this object
- my $result = $self->{'_result'} || 'medline2ref';
- $result = "\L$result"; # normalize capitalization to lower case
-
- # a special case is 'raw' when no converting module is loaded
- # and citations will be returned as a hashtable (the one which
- # is created during parsing XML file/stream)
- unless ($result eq 'raw') {
-
- # load module with output converter - as defined in $result
- if (defined &Bio::Biblio::IO::_load_format_module ($result)) {
- $Convert = "Bio::Biblio::IO::$result"->new (@args);
- }
- }
-
- # create an instance of the XML parser
- # (unless it is already there...)
- $self->{'_xml_parser'} = new XML::Parser (Handlers => {Init => \&handle_doc_start,
- Start => \&handle_start,
- End => \&handle_end,
- Char => \&handle_char,
- Final => \&handle_doc_end})
- unless $self->{'_xml_parser'};
-
- # if there is an argument '-callback' then start parsing at once -
- # the registered event handlers will use 'callback' to report
- # back after each citation
- #
- # we need to remember this situation also in a global variable
- # because the event handler subroutines know nothing about this
- # object (unfortunately)
- if ($Callback = $self->{'_callback'}) {
- $self->_parse;
- }
-}
-
-# -----------------------------------------------------------------------------
-
-sub _parse {
- my ($self) = shift;
-
-
- if (defined $self->{'_file'}) {
- $self->{'_xml_parser'}->parsefile ($self->{'_file'});
- } elsif (defined $self->{'_fh'}) {
- my $fh = $self->{'_fh'};
- if (ref ($fh) and UNIVERSAL::isa ($fh, 'IO::Handler')) {
- $self->{'_xml_parser'}->parse ($fh);
- } else {
- my $data;
- $data .= $_ while <$fh>;
- $self->{'_xml_parser'}->parse ($data);
- }
- } elsif ($self->{'_data'}) {
- $self->{'_xml_parser'}->parse ($self->{'_data'});
- } else {
- $self->throw ("XML source to be parsed is unknown. Should be given in the new().");
- }
-
- # when parsing is done all citations have already been delivered
- # to the caller using her callbacks - and nothing to be stored
- # here, or parser put all citations into global @Cittaions where
- # we want to copy there into this instance - so any caller can
- # start parsing other XML input without overwriting already read
- # citations from the first parser
- if (@Citations) {
- $self->{'_citations'} = [];
- foreach my $cit (@Citations) {
- push (@{ $self->{'_citations'} }, $cit);
- undef $cit;
- }
- undef @Citations;
- }
-}
-
-# ---------------------------------------------------------------------
-#
-# Here is an implementation of Bio::Biblio::IO methods
-#
-# ---------------------------------------------------------------------
-
-# global variables used by the XML event handlers
-# TBD: make them accessible at least ONLY from this module...
-@Citations = ();
-$Callback = undef;
-$Convert = undef;
-@ObjectStack = (); # it has Hash-Ref elements
-@PCDataStack = (); # it has String elements
-
-sub next_bibref {
- my ($self) = @_;
- $self->throw ("Method 'next_bibref' should not be called when a '-callback' argument given.")
- if $self->{'_callback'};
-
- # parse the whole input into memory (global @Citations)
- # and then copy it into this object
- $self->_parse unless $self->{'_citations'};
-
- # return the next citation (and forget it here)
- shift (@{ $self->{'_citations'} });
-}
-
-# ---------------------------------------------------------------------
-#
-# Here are the event handlers (they do the real job!)
-#
-# Note that these methods do not know anything about the object they
-# are part of - they are called as subroutines. not as methods.
-# It also means that they need to use global variables to store and
-# exchnage intermediate results.
-#
-# ---------------------------------------------------------------------
-
-#
-# This is a list of #PCDATA elements.
-#
-%PCDATA_NAMES = (
- 'AbstractText' => 1,
- 'AccessionNumber' => 1,
- 'Acronym' => 1,
- 'Affiliation' => 1,
- 'Agency' => 1,
- 'ArticleTitle' => 1,
- 'CASRegistryNumber' => 1,
- 'CitationSubset' => 1,
- 'Coden' => 1,
- 'CollectionTitle' => 1,
- 'CollectiveName' => 1,
- 'CopyrightInformation' => 1,
- 'Country' => 1,
- 'DataBankName' => 1,
- 'DateOfElectronicPublication' => 1,
- 'Day' => 1,
- 'Descriptor' => 1,
- 'DescriptorName' => 1,
- 'EndPage' => 1,
- 'FirstName' => 1,
- 'ForeName' => 1,
- 'GeneralNote' => 1,
- 'GeneSymbol' => 1,
- 'GrantID' => 1,
- 'Hour' => 1,
- 'ISOAbbreviation' => 1,
- 'ISSN' => 1,
- 'Initials' => 1,
- 'Issue' => 1,
- 'Keyword' => 1,
- 'Language' => 1,
- 'LastName' => 1,
- 'MedlineCode' => 1,
- 'MedlineDate' => 1,
- 'MedlineID' => 1,
- 'MedlinePgn' => 1,
- 'MedlineTA' => 1,
- 'MiddleName' => 1,
- 'Minute' => 1,
- 'Month' => 1,
- 'NameOfSubstance' => 1,
- 'NlmUniqueID' => 1,
- 'Note' => 1,
- 'NumberOfReferences' => 1,
- 'OtherID' => 1,
- 'PMID' => 1,
- 'PublicationType' => 1,
- 'Publisher' => 1,
- 'QualifierName' => 1,
- 'RefSource' => 1,
- 'RegistryNumber' => 1,
- 'Season' => 1,
- 'Second' => 1,
- 'SpaceFlightMission' => 1,
- 'StartPage' => 1,
- 'SubHeading' => 1,
- 'Suffix' => 1,
- 'Title' => 1,
- 'VernacularTitle' => 1,
- 'Volume' => 1,
- 'Year' => 1,
- );
-
-%SIMPLE_TREATMENT = (
- 'MeshHeading' => 1,
- 'Author' => 1,
- 'Article' => 1,
- 'Book' => 1,
- 'Investigator' => 1,
- 'Chemical' => 1,
- 'Pagination' => 1,
- 'MedlineJournalInfo' => 1,
- 'JournalIssue' => 1,
- 'Journal' => 1,
- 'DateCreated' => 1,
- 'DateCompleted' => 1,
- 'DateRevised' => 1,
- 'PubDate' => 1,
- 'Abstract' => 1,
- 'Grant' => 1,
- 'CommentsCorrections' => 1,
- 'CommentOn' => 1,
- 'CommentIn' => 1,
- 'ErratumFor' => 1,
- 'ErratumIn' => 1,
- 'OriginalReportIn' => 1,
- 'RepublishedFrom' => 1,
- 'RepublishedIn' => 1,
- 'RetractionOf' => 1,
- 'RetractionIn' => 1,
- 'SummaryForPatientsIn' => 1,
- 'UpdateIn' => 1,
- 'UpdateOf' => 1,
- 'DataBank' => 1,
- 'KeywordList' => 1,
- 'DeleteCitation' => 1,
- );
-
-%POP_DATA_AND_PEEK_OBJ = (
- 'Descriptor' => 1,
- 'DescriptorName' => 1,
- 'Year' => 1,
- 'Month' => 1,
- 'Day' => 1,
- 'LastName' => 1,
- 'Initials' => 1,
- 'FirstName' => 1,
- 'ForeName' => 1,
- 'NameOfSubstance' => 1,
- 'RegistryNumber' => 1,
- 'CASRegistryNumber' => 1,
- 'MiddleName' => 1,
- 'NlmUniqueID' => 1,
- 'MedlineTA' => 1,
- 'MedlinePgn' => 1,
- 'MedlineCode' => 1,
- 'Country' => 1,
- 'ISSN' => 1,
- 'ArticleTitle' => 1,
- 'Issue' => 1,
- 'AbstractText' => 1,
- 'VernacularTitle' => 1,
- 'GrantID' => 1,
- 'Agency' => 1,
- 'Acronym' => 1,
- 'MedlineDate' => 1,
- 'NumberOfReferences' => 1,
- 'RefSource' => 1,
- 'DataBankName' => 1,
- 'CopyrightInformation' => 1,
- 'Suffix' => 1,
- 'Note' => 1,
- 'CollectiveName' => 1,
- 'Hour' => 1,
- 'Minute' => 1,
- 'Second' => 1,
- 'Season' => 1,
- 'Coden' => 1,
- 'ISOAbbreviation' => 1,
- 'Publisher' => 1,
- 'CollectionTitle' => 1,
- 'DateOfElectronicPublication' => 1,
- 'StartPage' => 1,
- 'EndPage' => 1,
- 'Volume' => 1,
- 'Title' => 1,
- );
-
-%POP_OBJ_AND_PEEK_OBJ = (
- 'Pagination' => 1,
- 'JournalIssue' => 1,
- 'Journal' => 1,
- 'DateCreated' => 1,
- 'Article' => 1,
- 'DateCompleted' => 1,
- 'DateRevised' => 1,
- 'CommentsCorrections' => 1,
- 'Book' => 1,
- 'PubDate' => 1,
- 'Abstract' => 1,
- );
-
-%POP_AND_ADD_DATA_ELEMENT = (
- 'Keyword' => 'keywords',
- 'PublicationType' => 'publicationTypes',
- 'CitationSubset' => 'citationSubsets',
- 'Language' => 'languages',
- 'AccessionNumber' => 'accessionNumbers',
- 'GeneSymbol' => 'geneSymbols',
- 'SpaceFlightMission' => 'spaceFlightMissions',
- );
-
-
-%POP_AND_ADD_ELEMENT = (
- 'OtherAbstract' => 'otherAbstracts',
- 'Chemical' => 'chemicals',
- 'KeywordList' => 'keywordLists',
- 'Grant' => 'grants',
- 'UpdateIn' => 'updateIns',
- 'CommentOn' => 'commentOns',
- 'CommentIn' => 'commentIns',
- 'DataBank' => 'dataBanks',
- 'PersonalNameSubject' => 'personalNameSubjects',
- 'ErratumFor' => 'erratumFors',
- 'ErratumIn' => 'erratumIns',
- 'RepublishedFrom' => 'republishedFroms',
- 'RepublishedIn' => 'republishedIns',
- 'RetractionOf' => 'retractionOfs',
- 'RetractionIn' => 'retractionIns',
- 'UpdateOf' => 'updateOfs',
- 'OriginalReportIn' => 'originalReportIns',
- 'SummaryForPatientsIn' => 'summaryForPatientsIns',
- 'MeshHeading' => 'meshHeadings',
- );
-
-sub handle_doc_start {
- @Citations = ();
- @ObjectStack = ();
- @PCDataStack = ();
-}
-
-sub handle_doc_end {
- undef @ObjectStack;
- undef @PCDataStack;
-}
-
-sub handle_char {
- my ($expat, $str) = @_;
-
- # this may happen with whitespaces between tags;
- # but because I have not created an entry for data on the stack
- # I can also ignore such data, can't I
- return if $#PCDataStack < 0;
-
- $PCDataStack [$#PCDataStack] .= $str;
-}
-
-
-
-
-=head2 VERSION and Revision
-
- Usage : print $Bio::Biblio::IO::medlinexml::VERSION;
- print $Bio::Biblio::IO::medlinexml::Revision;
-
-=cut
-
-
-sub handle_start {
- my ($expat, $e, %attrs) = @_;
-# &_debug_object_stack ("START", $e);
-
- #
- # The #PCDATA elements which have an attribute list must
- # be first here - because for them I create entries both on
- # the @PCDataStack _and_ on @ObjectStack.
- #
- if ($e eq 'QualifierName' or
- $e eq 'SubHeading') {
- my %p = ();
- $p{'majorTopic'} = $attrs{'MajorTopicYN'} if $attrs{'MajorTopicYN'};
- push (@ObjectStack, \%p);
- }
-
- if ($e eq 'GeneralNote') {
- my %p = ();
- $p{'owner'} = $attrs{'Owner'} if $attrs{'Owner'};
- push (@ObjectStack, \%p);
- }
-
- if ($e eq 'OtherID') {
- my %p = ();
- $p{'source'} = $attrs{'Source'};
- push (@ObjectStack, \%p);
- }
-
- #
- # A special treatment is for attributes for personal name.
- # Because there is no XML element 'PersonalName' I need to
- # to put yet another object on @ObjectStack unless there is
- # already one.
- #
- if ($e eq 'LastName' or
- $e eq 'FirstName' or
- $e eq 'MidleName' or
- $e eq 'Initials' or
- $e eq 'ForeName' or
- $e eq 'Suffix') {
- my $peek = $ObjectStack[$#ObjectStack];
- push (@ObjectStack, {'type' => 'PersonalName'})
- unless (ref $peek and &_eq_hash_elem ($peek, 'type', 'PersonalName'));
- }
-
- #
- # Then we have #PCDATA elements without an attribute list.
- # For them I create an entry on @PCDataStack.
- #
- if (exists $PCDATA_NAMES{$e}) {
- push (@PCDataStack, '');
-
- #
- # And finally, all non-PCDATA elements go to the objectStack
- #
- } elsif (exists $SIMPLE_TREATMENT{$e}) {
- push (@ObjectStack, {});
-
- } elsif ($e eq 'PersonalNameSubject') {
- push (@ObjectStack, {'type' => 'PersonalName'});
-
- } elsif ($e eq 'DescriptorName' or
- $e eq 'Descriptor') {
- if (&_eq_hash_elem (\%attrs, 'MajorTopicYN', "Y")) {
- my $peek = $ObjectStack[$#ObjectStack];
- $$peek{'descriptorMajorTopic'} = "Y";
- }
-
- } elsif ($e eq 'MedlineCitation' ||
- $e eq 'NCBIArticle') {
- my %p = ( 'type' => 'MedlineCitation' );
- $p{'owner'} = $attrs{'Owner'} if $attrs{'Owner'};
- $p{'status'} = $attrs{'Status'} if $attrs{'Status'};
- push (@ObjectStack, \%p);
-
- } elsif ($e eq 'GrantList') {
- if (&_eq_hash_elem (\%attrs, 'CompleteYN', "N")) {
- my $peek = $ObjectStack[$#ObjectStack];
- $$peek{'grantListComplete'} = "N";
- }
-
- } elsif ($e eq 'DataBankList') {
- if (&_eq_hash_elem (\%attrs, 'CompleteYN', "N")) {
- my $peek = $ObjectStack[$#ObjectStack];
- $$peek{'dataBankListComplete'} = "N";
- }
-
- } elsif ($e eq 'AuthorList') {
- if (&_eq_hash_elem (\%attrs, 'CompleteYN', "N")) {