branch-1-6/Bio/Tools/EUtilities/Link/UrlLink.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Tools::EUtilities::Link::UrlLink
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Chris Fields
   8 #
   9 # Copyright Chris Fields
  10 #
  11 # You may distribute this module under the same terms as perl itself
  12 #
  13 # POD documentation - main docs before the code
  14 #
  15 # Part of the EUtilities BioPerl package
  16
  17 =head1 NAME
  18
  19 Bio::Tools::EUtilities::Link::UrlLink - class for EUtils UrlLinks
  20
  21 =head1 SYNOPSIS
  22
  23   # ...
  24
  25 =head1 DESCRIPTION
  26
  27   # ...
  28
  29 =head1 FEEDBACK
  30
  31 =head2 Mailing Lists
  32
  33 User feedback is an integral part of the
  34 evolution of this and other Bioperl modules. Send
  35 your comments and suggestions preferably to one
  36 of the Bioperl mailing lists. Your participation
  37 is much appreciated.
  38
  39   bioperl-l@lists.open-bio.org               - General discussion
  40   http://www.bioperl.org/wiki/Mailing_lists  - About the mailing lists
  41
  42 =head2 Support
  43
  44 Please direct usage questions or support issues to the mailing list:
  45
  46 I<bioperl-l@bioperl.org>
  47
  48 rather than to the module maintainer directly. Many experienced and
  49 reponsive experts will be able look at the problem and quickly
  50 address it. Please include a thorough description of the problem
  51 with code and data examples if at all possible.
  52
  53 =head2 Reporting Bugs
  54
  55 Report bugs to the Bioperl bug tracking system to
  56 help us keep track the bugs and their resolution.
  57 Bug reports can be submitted via the web.
  58
  59   http://bugzilla.open-bio.org/
  60
  61 =head1 AUTHOR
  62
  63 Email cjfields at bioperl dot org
  64
  65 =head1 APPENDIX
  66
  67 The rest of the documentation details each of the
  68 object methods. Internal methods are usually
  69 preceded with a _
  70
  71 =cut
  72
  73 # Let the code begin...
  74
  75 package Bio::Tools::EUtilities::Link::UrlLink;
  76
  77 use base qw(Bio::Root::Root Bio::Tools::EUtilities::EUtilDataI);
  78 use Data::Dumper;
  79
  80 =head2 get_dbfrom
  81
  82  Title    : get_dbfrom
  83  Usage    :
  84  Function :
  85  Returns  :
  86  Args     :
  87
  88 =cut
  89
  90 sub get_dbfrom { return shift->{'_dbfrom'}; }
  91
  92 =head2 get_attribute
  93
  94  Title    : get_attribute
  95  Usage    :
  96  Function :
  97  Returns  :
  98  Args     :
  99
 100 =cut
 101
 102 sub get_attribute { return shift->{'_attribute'}; }
 103
 104 =head2 get_icon_url
 105
 106  Title    : get_icon_url
 107  Usage    :
 108  Function :
 109  Returns  :
 110  Args     :
 111
 112 =cut
 113
 114 sub get_icon_url { return shift->{'_iconurl'}; }
 115
 116 =head2 get_subject_type
 117
 118  Title    :
 119  Usage    :
 120  Function :
 121  Returns  :
 122  Args     :
 123
 124 =cut
 125
 126 sub get_subject_type { return shift->{'_subjecttype'}; }
 127
 128 =head2 get_url
 129
 130  Title    : get_url
 131  Usage    :
 132  Function :
 133  Returns  :
 134  Args     :
 135
 136 =cut
 137
 138 sub get_url {
 139     my $self = shift;
 140     # fix Entrz LinkOut URLS without the full URL
 141     if ($self->{'_url'} && $self->{'_url'} =~ m{^/}) {
 142         $self->{'_url'} = 'http://www.ncbi.nih.gov'.$self->{'_url'};
 143     }
 144     return $self->{'_url'};
 145 }
 146
 147 =head2 get_link_name
 148
 149  Title    : get_link_name
 150  Usage    :
 151  Function :
 152  Returns  :
 153  Args     :
 154
 155 =cut
 156
 157 sub get_link_name { return shift->{'_linkname'};  }
 158
 159 =head2 get_provider_name
 160
 161  Title    : get_provider_name
 162  Usage    :
 163  Function :
 164  Returns  :
 165  Args     :
 166
 167 =cut
 168
 169 sub get_provider_name { return shift->{'_provider_name'}; }
 170
 171 =head2 get_provider_abbr
 172
 173  Title    : get_provider_abbr
 174  Usage    :
 175  Function :
 176  Returns  :
 177  Args     :
 178
 179 =cut
 180
 181 sub get_provider_abbr { return shift->{'_provider_nameabbr'}; }
 182
 183 =head2 get_provider_id
 184
 185  Title    : get_provider_id
 186  Usage    :
 187  Function :
 188  Returns  :
 189  Args     :
 190
 191 =cut
 192
 193 sub get_provider_id { return shift->{'_provider_id'}[0]; }
 194
 195 =head2 get_provider_icon_url
 196
 197  Title    : get_provider_icon_url
 198  Usage    :
 199  Function :
 200  Returns  :
 201  Args     :
 202
 203 =cut
 204
 205 sub get_provider_icon_url { return shift->{'_provider_iconurl'}; }
 206
 207 =head2 get_provider_url
 208
 209  Title    : get_provider_url
 210  Usage    :
 211  Function :
 212  Returns  :
 213  Args     :
 214
 215 =cut
 216
 217 sub get_provider_url { return shift->{'_provider_url'}; }
 218
 219 # private method
 220
 221 sub _add_data {
 222     my ($self, $data) = @_;
 223     if (exists $data->{Provider}) {
 224         map {$self->{'_provider_'.lc $_} = $data->{Provider}->{$_};
 225             } keys %{$data->{Provider}};
 226         delete $data->{Provider};
 227     }
 228     map {$self->{'_'.lc $_} = $data->{$_} if $data->{$_}} keys %$data;
 229 }
 230
 231 =head2 to_string
 232
 233  Title    : to_string
 234  Usage    : $foo->to_string()
 235  Function : converts current object to string
 236  Returns  : none
 237  Args     : (optional) simple data for text formatting
 238  Note     : Used generally for debugging and for various print methods
 239
 240 =cut
 241
 242 sub to_string {
 243     my $self = shift;
 244     my $level = shift || 0;
 245     my $pad = 20 - $level;
 246     #        order     method                    name
 247     my %tags = (1 => ['get_link_name'          => 'Link Name'],
 248                 2 => ['get_subject_type'       => 'Subject Type'],
 249                 3 => ['get_dbfrom'             => 'DB From'],
 250                 4 => ['get_attribute'          => 'Attribute'],
 251                 6 => ['get_icon_url'           => 'IconURL'],
 252                 7 => ['get_url'                => 'URL'],
 253                 8 => ['get_provider_name'      => 'Provider'],
 254                 9 => ['get_provider_abbr'      => 'ProvAbbr'],
 255                 10 => ['get_provider_id'       => 'ProvID'],
 256                 11 => ['get_provider_url'      => 'ProvURL'],
 257                 12 => ['get_provider_icon_url' => 'ProvIcon'],
 258                 );
 259     my $string = '';
 260     for my $tag (sort {$a <=> $b} keys %tags) {
 261         my ($m, $nm) = ($tags{$tag}->[0], $tags{$tag}->[1]);
 262         my $content = $self->$m();
 263         next unless $content;
 264         $string .= sprintf("%-*s%-*s%s\n",
 265             $level, '',
 266             $pad, $nm,
 267             $self->_text_wrap(':',
 268                  ' ' x ($pad + $level).':',
 269                  $content ));
 270     }
 271     return $string;
 272 }
 273
 274 1;
 275