File Coverage

blib/lib/Netscape/Bookmarks/Link.pm
Criterion Covered Total %
statement 105 122 86.0
branch 40 54 74.0
condition 2 3 66.6
subroutine 22 26 84.6
pod 16 21 76.1
total 185 226 81.8


line stmt bran cond sub pod time code
1             package Netscape::Bookmarks::Link;
2              
3             =encoding utf8
4              
5             =head1 NAME
6              
7             Netscape::Bookmarks::Link - manipulate, or create Netscape Bookmarks links
8              
9             =head1 SYNOPSIS
10              
11             use Netscape::Bookmarks::Link;
12              
13             my $category = new Netscape::Bookmarks::Category { ... };
14             my $link = new Netscape::Bookmarks::Link {
15             TITLE => 'this is the title',
16             DESCRIPTION => 'this is the description',
17             HREF => 'http://www.perl.org',
18             ADD_DATE => 937862073,
19             LAST_VISIT => 937862073,
20             LAST_MODIFIED => 937862073,
21             ALIAS_ID => 4,
22             }
23              
24             $category->add($link);
25              
26              
27             #print a Netscape compatible file
28             print $link->as_string;
29              
30             =head1 DESCRIPTION
31              
32             The Netscape bookmarks file has several basic components:
33              
34             title
35             folders (henceforth called categories)
36             links
37             aliases
38             separators
39              
40             On disk, Netscape browsers store this information in HTML. In the browser,
41             it is displayed under the "Bookmarks" menu. The data can be manipulated
42             through the browser interface.
43              
44             This module allows one to manipulate the links in for a Netscape bookmarks
45             file. A link has these attributes, only some of which may be present:
46              
47             title
48             description
49             HREF (i.e. URL)
50             ADD_DATE
51             LAST_MODIFIED
52             LAST_VISIT
53             ALIAS_OF
54             ALIAS_ID
55              
56             Additionally, Mozilla (the open source version of Navigator) uses these
57             attributes:
58              
59             SHORTCUTURL
60             ICON
61             SCHEDULE
62             LAST_PING
63             LAST_CHARSET
64             PING_CONTENT_LEN
65             PING_STATUS
66              
67             =head1 METHODS
68              
69             =over 4
70              
71             =cut
72              
73 6     6   24487 use strict;
  6         10  
  6         184  
74              
75 6     6   29 use base qw( Netscape::Bookmarks::AcceptVisitor Netscape::Bookmarks::Isa );
  6         9  
  6         1189  
76 6     6   33 use subs qw();
  6         9  
  6         130  
77 6     6   31 use vars qw( $DEBUG $VERSION $ERROR );
  6         10  
  6         348  
78              
79 6     6   5485 use URI;
  6         45391  
  6         9454  
80              
81             $VERSION = "2.301";
82              
83             =item Netscape::Bookmarks::Link-Enew( \%hash )
84              
85             Creates a new Link object. The hash reference argument
86             can have the following keys to set the properties of the
87             link:
88              
89             HREF
90             ADD_DATE
91             LAST_MODIFIED
92             LAST_VISIT
93             ALIASID
94             ALIASOF
95              
96             SHORTCUTURL
97             ICON
98             LAST_CHARSET
99              
100             =cut
101              
102             sub new {
103 456     456 1 785 my $class = shift;
104 456         664 my $param = shift;
105              
106 456         802 my $self = {};
107 456         925 bless $self, $class;
108              
109 456         1669 my $url = URI->new( $param->{HREF} );
110 456 50       97255 unless( ref $url ) {
111 0         0 $ERROR = "[$$param{HREF}] is not a valid URL";
112 0         0 return -1;
113             }
114 456         1120 $self->{HREF} = $url;
115              
116 456         949 foreach my $k ( qw(SHORTCUTURL ICON LAST_CHARSET SCHEDULE PING_STATUS) ) {
117 2280         5360 $self->{$k} = $param->{$k};
118             }
119              
120 456         870 foreach my $k ( qw(ADD_DATE LAST_MODIFIED LAST_VISIT ALIASID ALIASOF
121             LAST_PING PING_CONTENT_LEN) ) {
122 3192 50 66     11026 if( defined $param->{$k} and $param->{$k} =~ /\D/ ) {
123 0         0 $ERROR = "[$$param{$k}] is not a valid $k";
124 0         0 return -2;
125             }
126 3192         8234 $self->{$k} = $param->{$k};
127             }
128              
129 456 50       1187 unless( $param->{'TITLE'} ) {
130 0         0 $ERROR = "The TITLE cannot be null.";
131 0         0 return -3;
132             }
133              
134 456         990 $self->{'TITLE'} = $param->{'TITLE'};
135              
136 456         907 $self->{'DESCRIPTION'} = $param->{'DESCRIPTION'};
137              
138 456         1544 $self;
139             }
140              
141              
142             =item $obj->href
143              
144             Returns the URL of the link. The URL appears in the HREF attribute of
145             the anchor tag.
146              
147             =cut
148              
149             sub href {
150 238     238 1 337 my $self = shift;
151              
152 238         964 $self->{'HREF'}->as_string
153             }
154              
155             =item $obj->add_date
156              
157             Returns the date when the link was added, in Unix epoch time.
158              
159             =cut
160              
161             sub add_date {
162 229     229 1 356 my $self = shift;
163              
164 229         453 $self->{'ADD_DATE'}
165             }
166              
167             =item $obj->last_modified
168              
169             Returns the date when the link was last modified, in Unix epoch time. Returns
170             zero if no information is available.
171              
172             =cut
173              
174             sub last_modified {
175 229     229 1 314 my $self = shift;
176              
177 229         438 $self->{'LAST_MODIFIED'}
178             }
179              
180             =item $obj->last_visit
181              
182             Returns the date when the link was last vistied, in Unix epoch time. Returns
183             zero if no information is available.
184              
185             =cut
186              
187             sub last_visit {
188 229     229 1 332 my $self = shift;
189              
190 229         553 $self->{'LAST_VISIT'}
191             }
192              
193             =item $obj->title( [ TITLE ] )
194              
195             Sets the link title with the given argument, and returns the link title.
196             If the argument is not defined (e.g. not specified), returns the current
197             link title.
198              
199             =cut
200              
201             sub title {
202 229     229 1 404 my( $self, $title ) = @_;
203              
204 229 50       529 $self->{'TITLE'} = $title if defined $title;
205              
206 229         594 $self->{'TITLE'}
207             }
208              
209             =item $obj->description( [ DESCRIPTION ] )
210              
211             Sets the link description with the given argument, and returns the link
212             description. If the argument is not defined (e.g. not specified),
213             returns the current link description.
214              
215             =cut
216              
217             sub description {
218 232     232 1 361 my( $self, $description ) = @_;
219              
220 232 100       538 $self->{'DESCRIPTION'} = $description if defined $description;
221              
222 232         697 $self->{'DESCRIPTION'}
223             }
224              
225             =item $obj->alias_id
226              
227             Returns the alias id of a link. Links with aliases are assigned an ALIAS_ID which
228             associates them with the alias. The alias contains the same value in it's ALIAS_OF
229             field. The Netscape::Bookmarks::Alias module handles aliases as references to
230             Netscape::Bookmarks::Link objects.
231              
232             =cut
233              
234             sub aliasid {
235 231     231 0 315 my $self = shift;
236 231         322 my $data = shift;
237              
238 231 100       535 $self->{'ALIASID'} = $data if defined $data;
239              
240 231         468 $self->{'ALIASID'}
241             }
242              
243             =item $obj->shortcuturl
244              
245             =cut
246              
247             sub shortcuturl {
248 229     229 1 357 my( $self, $shortcuturl ) = @_;
249              
250 229 50       520 $self->{'SHORTCUTURL'} = $shortcuturl if defined $shortcuturl;
251              
252 229         459 $self->{'SHORTCUTURL'}
253             }
254              
255             =item $obj->icon
256              
257             =cut
258              
259             sub icon {
260 229     229 1 333 my( $self, $icon ) = @_;
261              
262 229 50       545 $self->{'ICON'} = $icon if defined $icon;
263              
264 229         478 $self->{'ICON'}
265             }
266              
267             =item $obj->schedule
268              
269             =cut
270              
271             sub schedule {
272 229     229 1 335 my( $self, $schedule ) = @_;
273              
274 229 50       531 $self->{'SCHEDULE'} = $schedule if defined $schedule;
275              
276 229         426 $self->{'SCHEDULE'}
277             }
278              
279             =item $obj->last_ping
280              
281             =cut
282              
283             sub last_ping {
284 229     229 1 336 my( $self, $last_ping ) = @_;
285              
286 229 50       479 $self->{'LAST_PING'} = $last_ping if defined $last_ping;
287              
288 229         420 $self->{'LAST_PING'}
289             }
290              
291             =item $obj->ping_content_len
292              
293             =cut
294              
295             sub ping_content_len {
296 229     229 1 353 my( $self, $ping_content_len ) = @_;
297              
298 229 50       486 $self->{'PING_CONTENT_LEN'} = $ping_content_len if defined $ping_content_len;
299              
300 229         444 $self->{'PING_CONTENT_LEN'}
301             }
302              
303             =item $obj->ping_status
304              
305             =cut
306              
307             sub ping_status
308             {
309 229     229 1 342 my( $self, $ping_status ) = @_;
310              
311 229 50       515 $self->{'PING_STATUS'} = $ping_status if defined $ping_status;
312              
313 229         436 $self->{'PING_STATUS'}
314             }
315              
316             =item $obj->last_charset
317              
318             =cut
319              
320             sub last_charset {
321 229     229 1 340 my( $self, $charset ) = @_;
322              
323 229 50       521 $self->{'LAST_CHARSET'} = $charset if defined $charset;
324              
325 229         445 $self->{'LAST_CHARSET'}
326             }
327              
328             # =item $obj->alias_of
329             #
330             # Returns the target id of a link. Links with aliases are assigned an ALIAS_ID which
331             # associates them with the alias. The alias contains the same value in it's ALIAS_OF
332             # field. The Netscape::Bookmarks::Alias module handles aliases as references to
333             # Netscape::Bookmarks::Link objects.
334             #
335             # =cut
336              
337             sub aliasof {
338 229     229 0 306 my $self = shift;
339              
340 229         428 $self->{'ALIASOF'}
341             }
342              
343             # =item $obj->append_title
344             #
345             # Adds to the title - used mostly for the HTML parser, although it can
346             # be used to add a title if none exists (which is an error, though).
347             #
348             # =cut
349              
350             sub append_title {
351 0     0 0 0 my $self = shift;
352 0         0 my $text = shift;
353              
354 0         0 $self->{'TITLE'} .= $text;
355             }
356              
357             # =item $obj->append_description
358             #
359             # Adds to the description - used mostly for the HTML parser, although
360             # it can be used to add a description if none exists.
361             #
362             # =cut
363             #
364             sub append_description {
365 0     0 0 0 my $self = shift;
366 0         0 my $text = shift;
367              
368 0         0 $self->{'DESCRIPTION'} .= $text;
369             }
370              
371             # just show me what you think is in the link. i use this for
372             # debugging.
373             #
374             sub print_dump {
375 0     0 0 0 my $self = shift;
376              
377 0         0 print <<"HERE";
378             $$self{TITLE}
379 0         0 @{[($$self{HREF})->as_string]}
380             $$self{ADD_DATE}
381             $$self{LAST_MODIFIED}
382             $$self{LAST_VISIT}
383             $$self{ALIASID}
384              
385             HERE
386              
387             }
388              
389             =item $obj->as_string
390              
391             Returns a Netscape compatible bookmarks file based on the Bookmarks object.
392              
393             =cut
394              
395             sub as_string {
396 229     229 1 340 my $self = shift;
397              
398 229         530 my $link = $self->href;
399 229         1953 my $title = $self->title;
400 229         544 my $aliasid = $self->aliasid;
401 229         599 my $aliasof = $self->aliasof;
402 229         497 my $add_date = $self->add_date;
403 229         502 my $last_visit = $self->last_visit;
404 229         528 my $last_modified = $self->last_modified;
405 229         544 my $shortcuturl = $self->shortcuturl;
406 229         510 my $icon = $self->icon;
407 229         509 my $last_charset = $self->last_charset;
408 229         507 my $schedule = $self->schedule;
409 229         525 my $last_ping = $self->last_ping;
410 229         524 my $ping_content_len = $self->ping_content_len;
411 229         502 my $ping_status = $self->ping_status;
412              
413 229 100       560 $aliasid = defined $aliasid ? qq|ALIASID="$aliasid"| : '';
414 229 50       513 $aliasof = defined $aliasof ? qq|ALIASOF="$aliasof"| : '';
415 229 100       559 $add_date = $add_date ? qq|ADD_DATE="$add_date"| : '';
416 229 100       524 $last_visit = $last_visit ? qq|LAST_VISIT="$last_visit"| : '';
417 229 100       451 $last_modified = $last_modified ? qq|LAST_MODIFIED="$last_modified"| : '';
418              
419 229 50       430 $shortcuturl = $shortcuturl ? qq|SHORTCUTURL="$shortcuturl"| : '';
420 229 50       450 $icon = $icon ? qq|ICON="$icon"| : '';
421 229 100       484 $last_charset = $last_charset ? qq|LAST_CHARSET="$last_charset"| : '';
422              
423 229 100       430 $schedule = $schedule ? qq|SCHEDULE="$schedule"| : '';
424 229 100       433 $last_ping = $last_ping ? qq|LAST_PING="$last_ping"| : '';
425 229 100       467 $ping_content_len = $ping_content_len ? qq|PING_CONTENT_LEN="$ping_content_len"| : '';
426 229 100       432 $ping_status = $ping_status ? qq|PING_STATUS="$ping_status"| : '';
427              
428 229         1073 my $attr = join " ", grep( $_ ne '', ($aliasid, $aliasof, $add_date, $last_visit,
429             $last_modified, $icon, $schedule, $last_ping, $shortcuturl, $last_charset,
430             $ping_content_len, $ping_status, ) );
431              
432 229 100       737 $attr = " " . $attr if $attr;
433              
434 229         387 my $desc = '';
435 229 100       514 $desc = "\n\t
" . $self->description if $self->description;
436              
437             #XXX: when the parser gets the Link description, it also picks up
438             #the incidental whitespace between the description and the
439             #next item, so we need to remove this before we print it.
440             #
441             #this is just a kludge though, since we should solve the
442             #actual problem as it happens. however, since this is a
443             #stream parser and we don't know when the description ends
444             #until the next thing starts (since there is no closing DD tag,
445             #we don't know when to strip whitespace.
446 229         389 $desc =~ s/\s+$//;
447              
448 229         1530 return qq|$title$desc|;
449             }
450              
451             =item $obj->remove
452              
453             Performs any clean up necessary to remove this object from the
454             Bookmarks tree. Although this method does not remove Alias objects
455             which point to the Link, it probably should.
456              
457             =cut
458              
459             sub remove {
460 0     0 1   my $self = shift;
461              
462 0           return 1;
463             }
464              
465             "if you want to believe everything you read, so be it."
466              
467             __END__