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   74754 use strict;
  6         22  
  6         219  
74              
75 6     6   34 use base qw( Netscape::Bookmarks::AcceptVisitor Netscape::Bookmarks::Isa );
  6         13  
  6         1415  
76 6     6   49 use subs qw();
  6         14  
  6         151  
77 6     6   37 use vars qw( $DEBUG $VERSION $ERROR );
  6         13  
  6         403  
78              
79 6     6   3767 use URI;
  6         44154  
  6         9640  
80              
81             $VERSION = "2.303";
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 880 my $class = shift;
104 456         740 my $param = shift;
105              
106 456         876 my $self = {};
107 456         931 bless $self, $class;
108              
109 456         1297 my $url = URI->new( $param->{HREF} );
110 456 50       76067 unless( ref $url ) {
111 0         0 $ERROR = "[$$param{HREF}] is not a valid URL";
112 0         0 return -1;
113             }
114 456         1126 $self->{HREF} = $url;
115              
116 456         986 foreach my $k ( qw(SHORTCUTURL ICON LAST_CHARSET SCHEDULE PING_STATUS) ) {
117 2280         4600 $self->{$k} = $param->{$k};
118             }
119              
120 456         842 foreach my $k ( qw(ADD_DATE LAST_MODIFIED LAST_VISIT ALIASID ALIASOF
121             LAST_PING PING_CONTENT_LEN) ) {
122 3192 50 66     8083 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         6721 $self->{$k} = $param->{$k};
127             }
128              
129 456 50       966 unless( $param->{'TITLE'} ) {
130 0         0 $ERROR = "The TITLE cannot be null.";
131 0         0 return -3;
132             }
133              
134 456         840 $self->{'TITLE'} = $param->{'TITLE'};
135              
136 456         973 $self->{'DESCRIPTION'} = $param->{'DESCRIPTION'};
137              
138 456         1336 $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 500 my $self = shift;
151              
152 238         993 $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 453 my $self = shift;
163              
164 229         653 $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 481 my $self = shift;
176              
177 229         557 $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 447 my $self = shift;
189              
190 229         567 $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 618 my( $self, $title ) = @_;
203              
204 229 50       650 $self->{'TITLE'} = $title if defined $title;
205              
206 229         758 $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 588 my( $self, $description ) = @_;
219              
220 232 100       619 $self->{'DESCRIPTION'} = $description if defined $description;
221              
222 232         726 $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 474 my $self = shift;
236 231         468 my $data = shift;
237              
238 231 100       611 $self->{'ALIASID'} = $data if defined $data;
239              
240 231         629 $self->{'ALIASID'}
241             }
242              
243             =item $obj->shortcuturl
244              
245             =cut
246              
247             sub shortcuturl {
248 229     229 1 610 my( $self, $shortcuturl ) = @_;
249              
250 229 50       592 $self->{'SHORTCUTURL'} = $shortcuturl if defined $shortcuturl;
251              
252 229         572 $self->{'SHORTCUTURL'}
253             }
254              
255             =item $obj->icon
256              
257             =cut
258              
259             sub icon {
260 229     229 1 588 my( $self, $icon ) = @_;
261              
262 229 50       571 $self->{'ICON'} = $icon if defined $icon;
263              
264 229         545 $self->{'ICON'}
265             }
266              
267             =item $obj->schedule
268              
269             =cut
270              
271             sub schedule {
272 229     229 1 544 my( $self, $schedule ) = @_;
273              
274 229 50       579 $self->{'SCHEDULE'} = $schedule if defined $schedule;
275              
276 229         549 $self->{'SCHEDULE'}
277             }
278              
279             =item $obj->last_ping
280              
281             =cut
282              
283             sub last_ping {
284 229     229 1 572 my( $self, $last_ping ) = @_;
285              
286 229 50       548 $self->{'LAST_PING'} = $last_ping if defined $last_ping;
287              
288 229         531 $self->{'LAST_PING'}
289             }
290              
291             =item $obj->ping_content_len
292              
293             =cut
294              
295             sub ping_content_len {
296 229     229 1 552 my( $self, $ping_content_len ) = @_;
297              
298 229 50       569 $self->{'PING_CONTENT_LEN'} = $ping_content_len if defined $ping_content_len;
299              
300 229         564 $self->{'PING_CONTENT_LEN'}
301             }
302              
303             =item $obj->ping_status
304              
305             =cut
306              
307             sub ping_status
308             {
309 229     229 1 512 my( $self, $ping_status ) = @_;
310              
311 229 50       646 $self->{'PING_STATUS'} = $ping_status if defined $ping_status;
312              
313 229         520 $self->{'PING_STATUS'}
314             }
315              
316             =item $obj->last_charset
317              
318             =cut
319              
320             sub last_charset {
321 229     229 1 544 my( $self, $charset ) = @_;
322              
323 229 50       596 $self->{'LAST_CHARSET'} = $charset if defined $charset;
324              
325 229         604 $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 454 my $self = shift;
339              
340 229         551 $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 551 my $self = shift;
397              
398 229         615 my $link = $self->href;
399 229         2136 my $title = $self->title;
400 229         632 my $aliasid = $self->aliasid;
401 229         606 my $aliasof = $self->aliasof;
402 229         635 my $add_date = $self->add_date;
403 229         605 my $last_visit = $self->last_visit;
404 229         607 my $last_modified = $self->last_modified;
405 229         560 my $shortcuturl = $self->shortcuturl;
406 229         594 my $icon = $self->icon;
407 229         593 my $last_charset = $self->last_charset;
408 229         594 my $schedule = $self->schedule;
409 229         560 my $last_ping = $self->last_ping;
410 229         589 my $ping_content_len = $self->ping_content_len;
411 229         569 my $ping_status = $self->ping_status;
412              
413 229 100       679 $aliasid = defined $aliasid ? qq|ALIASID="$aliasid"| : '';
414 229 50       604 $aliasof = defined $aliasof ? qq|ALIASOF="$aliasof"| : '';
415 229 100       639 $add_date = $add_date ? qq|ADD_DATE="$add_date"| : '';
416 229 100       579 $last_visit = $last_visit ? qq|LAST_VISIT="$last_visit"| : '';
417 229 100       532 $last_modified = $last_modified ? qq|LAST_MODIFIED="$last_modified"| : '';
418              
419 229 50       494 $shortcuturl = $shortcuturl ? qq|SHORTCUTURL="$shortcuturl"| : '';
420 229 50       505 $icon = $icon ? qq|ICON="$icon"| : '';
421 229 100       526 $last_charset = $last_charset ? qq|LAST_CHARSET="$last_charset"| : '';
422              
423 229 100       513 $schedule = $schedule ? qq|SCHEDULE="$schedule"| : '';
424 229 100       593 $last_ping = $last_ping ? qq|LAST_PING="$last_ping"| : '';
425 229 100       488 $ping_content_len = $ping_content_len ? qq|PING_CONTENT_LEN="$ping_content_len"| : '';
426 229 100       494 $ping_status = $ping_status ? qq|PING_STATUS="$ping_status"| : '';
427              
428 229         1274 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       792 $attr = " " . $attr if $attr;
433              
434 229         540 my $desc = '';
435 229 100       663 $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         595 $desc =~ s/\s+$//;
447              
448 229         1590 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__