[Bio] / Sprout / HyperLink.pm Repository:
ViewVC logotype

Annotation of /Sprout/HyperLink.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     #
4 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
5 :     # for Interpretations of Genomes. All Rights Reserved.
6 :     #
7 :     # This file is part of the SEED Toolkit.
8 :     #
9 :     # The SEED Toolkit is free software. You can redistribute
10 :     # it and/or modify it under the terms of the SEED Toolkit
11 :     # Public License.
12 :     #
13 :     # You should have received a copy of the SEED Toolkit Public License
14 :     # along with this program; if not write to the University of Chicago
15 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
16 :     # Genomes at veronika@thefig.info or download a copy from
17 :     # http://www.theseed.org/LICENSE.TXT.
18 :     #
19 :    
20 :     package HyperLink;
21 :    
22 :     use strict;
23 :     use Tracer;
24 :     use CGI qw(-nosticky);
25 :    
26 :     =head1 HyperLink Package
27 :    
28 :     =head2 Introduction
29 :    
30 :     This is a dinky object that can be used to encode and decode hyperlinks. The
31 :     client can extract the text value, the URL value, or an HTML representation. It
32 : parrello 1.2 also contains L</Encode> and L</Decode> methods for use by L<ERDB>.
33 : parrello 1.1
34 :     The hyperlink is stored in the database with the text first, to make
35 :     indexing more natural. The text is followed by a space, then the URL,
36 :     another space, a double color (C<::>), and the length.
37 :    
38 :     The fields in this object are as follows.
39 :    
40 :     =over 4
41 :    
42 :     =item text
43 :    
44 :     The text of the hyperlink.
45 :    
46 :     =item link
47 :    
48 :     The URL of the link.
49 :    
50 :     =back
51 :    
52 :     =head2 Constructors
53 :    
54 :     =head3 new
55 :    
56 :     my $hl = HyperLink->new($text, $link);
57 :    
58 :     Construct a new HyperLink object.
59 :    
60 :     =over 4
61 :    
62 :     =item text
63 :    
64 :     Text for the link.
65 :    
66 :     =item link (optional)
67 :    
68 :     URL to which we should link.
69 :    
70 :     =back
71 :    
72 :     =cut
73 :    
74 :     sub new {
75 :     # Get the parameters.
76 :     my ($class, $text, $link) = @_;
77 :     # Convert an empty or zero link to an undefined one.
78 :     my $url = (! $link ? undef : $link);
79 :     # Create the HyperLink object.
80 :     my $retVal = {
81 :     text => $text,
82 :     link => $url,
83 :     };
84 :     # Bless and return it.
85 :     bless $retVal, $class;
86 :     return $retVal;
87 :     }
88 :    
89 :     =head3 newFromHtml
90 :    
91 :     my $hl = HyperLink->new_from_html($htmlLink)
92 :    
93 :     Create a HyperLink object from an HTML link tag.
94 :    
95 :     =over 4
96 :    
97 :     =item htmlLink
98 :    
99 :     Anchor href tag containing the URL and the link text.
100 :    
101 :     =back
102 :    
103 :     =cut
104 :    
105 :     sub newFromHtml {
106 :     # Get the parameters.
107 :     my ($class, $htmlLink) = @_;
108 :     # Declare the return variable.
109 :     my $retVal;
110 :     # Parse the HTML.
111 :     if ($htmlLink =~ /^<a.*?\shref="([^"]+).*>([^<]+)<\/a>$/) {
112 :     # Here it's a real anchor tag. We need to unescape the text,
113 :     # then pass the text and URL to the real constructor.
114 :     my $link = $1;
115 :     my $text = CGI::unescapeHTML($2);
116 :     $retVal = new($class, $text, $link);
117 :     } else {
118 :     # Here it's just text. Unescape the whole thing and pass it
119 :     # without a link.
120 :     $retVal = CGI::unescapeHTML($htmlLink);
121 :     }
122 :     # Return the result.
123 :     return $retVal;
124 :     }
125 :    
126 :     =head2 Public Methods
127 :    
128 :     =head3 Decode
129 :    
130 :     my $hl = HyperLink->Decode($string);
131 :    
132 :     Convert a string from the database to a Hyperlink object.
133 :    
134 :     =over 4
135 :    
136 :     =item string
137 :    
138 : parrello 1.2 String read from an L<ERDB> database.
139 : parrello 1.1
140 :     =item RETURN
141 :    
142 :     Returns a Hyperlink object represented by the string.
143 :    
144 :     =back
145 :    
146 :     =cut
147 :    
148 :     sub Decode {
149 :     # Get the parameters.
150 :     my ($class, $string) = @_;
151 :     # Unescape the input string.
152 :     my $realString = Tracer::UnEscape($string);
153 :     # The default is to treat the string as all text, without a URL.
154 :     my $text = $realString;
155 :     my $url;
156 :     # Get the length of the text. This is stored at the end of the string
157 :     # as a number preceded by a double colon.
158 :     if ($realString =~ /::(\d+)$/) {
159 :     # Save the parsed length.
160 :     my $textLen = $1;
161 :     # Split off the text.
162 :     $text = substr($realString, 0, $textLen);
163 :     my $leftOver = substr($realString, $textLen);
164 :     # Now we need to peel out the url.
165 :     if ($leftOver =~ /(\S+)\s::/) {
166 :     $url = $1;
167 :     }
168 :     }
169 :    
170 :     # Form a hyperlink out of the two pieces.
171 :     my $retVal = HyperLink->new($text, $url);
172 :     return $retVal;
173 :     }
174 :    
175 :     =head3 Encode
176 :    
177 :     my $string = $hl->Encode();
178 :    
179 :     Return the database representation for a hyperlink.
180 :    
181 :     =cut
182 :    
183 :     sub Encode {
184 :     # Get the parameters.
185 :     my ($self) = @_;
186 :     # Compute the return value. First, we get the text length.
187 :     my ($text, $url) = ($self->{text}, $self->{link});
188 :     my $textLen = length($text);
189 :     # Assemble the pieces.
190 :     my $string = "$text $url ::$textLen";
191 :     # Escape the assembled string.
192 :     my $retVal = Tracer::Escape($string);
193 :     # Return the result.
194 :     return $retVal;
195 :     }
196 :    
197 :     =head3 text
198 :    
199 :     my $message = $hl->text();
200 :    
201 :     Return the text of a hyperlink.
202 :    
203 :     =cut
204 :    
205 :     sub text {
206 :     # Get the parameters.
207 :     my ($self) = @_;
208 :     # Return the result.
209 :     return $self->{text};
210 :     }
211 :    
212 :     =head3 link
213 :    
214 :     my $message = $hl->link();
215 :    
216 :     Return the URL of a hyperlink.
217 :    
218 :     =cut
219 :    
220 :     sub link {
221 :     # Get the parameters.
222 :     my ($self) = @_;
223 :     # Return the result.
224 :     return $self->{link};
225 :     }
226 :    
227 :     =head3 html
228 :    
229 :     my $message = $hl->html();
230 :    
231 :     Return the HTML representation of a hyperlink.
232 :    
233 :     =cut
234 :    
235 :     sub html {
236 :     # Get the parameters.
237 :     my ($self) = @_;
238 :     # Declare the return variable.
239 :     my $retVal;
240 :     # Do we have a URL?
241 :     if (defined $self->{link}) {
242 :     # Yes, wrap it around the text.
243 :     $retVal = CGI::a({ href => $self->{link} }, CGI::escapeHTML($self->{text}));
244 :     } else {
245 :     # No, return the text alone.
246 :     $retVal = $self->{text};
247 :     }
248 :     # Return the result.
249 :     return $retVal;
250 :     }
251 :    
252 :    
253 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3