Bio/Tools/EUtilities/Link/UrlLink.pm

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