File Coverage

blib/lib/Netscape/Bookmarks/Category.pm
Criterion Covered Total %
statement 138 185 74.5
branch 44 62 70.9
condition 23 33 69.7
subroutine 26 35 74.2
pod 21 22 95.4
total 252 337 74.7


line stmt bran cond sub pod time code
1             package Netscape::Bookmarks::Category;
2              
3             =encoding utf8
4              
5             =head1 NAME
6              
7             Netscape::Bookmarks::Category - manipulate, or create Netscape Bookmarks files
8              
9             =head1 SYNOPSIS
10              
11             use Netscape::Bookmarks;
12              
13             #parse an existing file
14             my $bookmarks = new Netscape::Bookmarks $bookmarks_file;
15              
16             #print a Netscape compatible file
17             print $bookmarks->as_string;
18              
19             =head1 DESCRIPTION
20              
21             The Netscape bookmarks file has several basic components:
22              
23             title
24             folders (henceforth called categories)
25             links
26             aliases
27             separators
28              
29             On disk, Netscape browsers store this information in HTML. In the browser,
30             it is displayed under the "Bookmarks" menu. The data can be manipulated
31             through the browser interface.
32              
33             This module allows one to manipulate the bookmarks file programmatically. One
34             can parse an existing bookmarks file, manipulate the information, and write it
35             as a bookmarks file again. Furthermore, one can skip the parsing step to create
36             a new bookmarks file and write it in the proper format to be used by a Netscape
37             browser.
38              
39             The Bookmarks.pm module simply parses the bookmarks file passed to it as the
40             only argument to the constructor:
41              
42             my $bookmarks = new Netscape::Bookmarks $bookmarks_file;
43              
44             The returned object is a Netscape::Bookmarks::Category object, since the bookmark file is
45             simply a collection of categories that contain any of the components listed
46             above. The top level (i.e. root) category is treated specially and defines the
47             title of the bookmarks file.
48              
49             =head1 METHODS
50              
51             =over 4
52              
53             =cut
54              
55 6     6   73519 use strict;
  6         27  
  6         226  
56              
57 6     6   82 use base qw( Netscape::Bookmarks::AcceptVisitor Netscape::Bookmarks::Isa );
  6         13  
  6         1285  
58 6     6   46 use subs qw();
  6         13  
  6         168  
59 6     6   34 use vars qw( $VERSION $ERROR $LAST_ID %IDS );
  6         17  
  6         443  
60              
61 6     6   41 use constant START_LIST => '

';

  6         17  
  6         555  
62 6     6   44 use constant END_LIST => '

';

  6         28  
  6         353  
63 6     6   40 use constant START_LIST_ITEM => '
';
  6         14  
  6         334  
64 6     6   48 use constant TAB => ' ';
  6         14  
  6         358  
65 6     6   38 use constant FOLDED_TRUE => 1;
  6         12  
  6         306  
66 6     6   37 use constant FOLDED_FALSE => 0;
  6         20  
  6         295  
67 6     6   35 use constant TRUE => 'true';
  6         11  
  6         13219  
68              
69             $VERSION = "2.303";
70              
71             %IDS = ();
72             $LAST_ID = -1;
73              
74             =item Netscape::Bookmarks::Category-Enew( \%hash )
75              
76             The new method creates a Category. It takes a hash reference
77             that specifies the properties of the category. The valid keys
78             in that hash are
79              
80             folded collapsed state of the category ( 1 or 0 )
81             title
82             add_date
83             description
84              
85             =cut
86              
87             sub new
88             {
89 78     78 1 162 my $class = shift;
90 78         126 my $param = shift;
91              
92 78         125 my $self = {};
93 78         165 bless $self, $class;
94              
95 78 100       203 $self->{'folded'} = FOLDED_TRUE unless $param->{'folded'} == FOLDED_FALSE;
96 78 100       182 $self->{'personal_toolbar_folder'} = TRUE if $param->{'personal_toolbar_folder'};
97              
98 78 100 66     526 unless( exists $IDS{$param->{'id'}} or $param->{'id'} =~ /\D/)
99             {
100 12         33 $param->{'id'} = ++$LAST_ID;
101 12         37 $IDS{$LAST_ID}++;
102             }
103              
104 78 50 66     251 if( defined $param->{'add_date'} and $param->{'add_date'} =~ /\D/ )
105             {
106 0         0 $param->{'add_date'} = 0;
107             }
108              
109 78         216 $self->{'mozilla'} = $param->{'mozilla'};
110 78         163 $self->{'title'} = $param->{'title'};
111 78         133 $self->{'add_date'} = $param->{'add_date'};
112 78         159 $self->{'last_modified'} = $param->{'last_modified'};
113 78         131 $self->{'id'} = $param->{'id'};
114 78         151 $self->{'description'} = $param->{'description'};
115 78         185 $self->{'thingys'} = [];
116              
117 78         210 $self;
118             }
119              
120             sub mozilla
121             {
122 41     41 0 100 my $self = shift;
123 41         78 my $value = shift;
124              
125 41 50       157 $self->{'mozilla'} = $value if defined $value;
126              
127 41         165 $self->{'mozilla'};
128             }
129              
130             =item $category-Eadd( $object )
131              
132             The add() function adds an element to a category. The element must be a Alias,
133             Link, Category, or Separator object. Returns TRUE or FALSE.
134              
135             =cut
136              
137             sub add
138             {
139 536     536 1 888 my $self = shift;
140 536         789 my $thingy = shift;
141              
142             return unless
143 536 50 100     1564 ref $thingy eq 'Netscape::Bookmarks::Link' or
      100        
      66        
144             ref $thingy eq 'Netscape::Bookmarks::Category' or
145             ref $thingy eq 'Netscape::Bookmarks::Separator' or
146             ref $thingy eq 'Netscape::Bookmarks::Alias';
147              
148 536         858 push @{ $self->{'thingys'} }, $thingy;
  536         1621  
149             }
150              
151             =item $category-Eremove_element( $object )
152              
153             Removes the given object from the Category by calling the object's
154             remove() method.
155              
156             Returns the number of objects removed from the Category.
157              
158             =cut
159              
160             sub remove_element
161             {
162 0     0 1 0 my $self = shift;
163 0         0 my $thingy = shift;
164              
165 0         0 my $old_count = $self->count;
166              
167             $self->{'thingys'} =
168 0 0       0 [ grep { $_ ne $thingy and $_->remove } $self->elements ];
  0         0  
169              
170 0         0 return $old_count - $self->count;
171             }
172              
173             =item $category-Eremove()
174              
175             Performs any clean up necessary to remove this object from the
176             Bookmarks tree. Although this method does not recursively remove
177             objects which it contains, it probably should.
178              
179             =cut
180              
181 0     0 1 0 sub remove { 1; }
182              
183             =item $category-Etitle( [ TITLE ] )
184              
185             Returns title to the category. With a
186             defined argument TITLE, it replaces the current
187             title.
188              
189             =cut
190              
191             sub title
192             {
193 39     39 1 89 my $self = shift;
194              
195 39 50       140 if( defined $_[0] )
196             {
197 0         0 $self->{'title'} = shift;
198             }
199              
200 39         127 $self->{'title'};
201             }
202              
203             =item $category-Eid()
204              
205             Returns the ID of the category. This is an arbitrary, unique number.
206              
207             =cut
208              
209             sub id
210             {
211 37     37 1 71 my $self = shift;
212              
213 37         104 $self->{'id'};
214             }
215              
216             =item $category-Edescription( [ DESCRIPTION ] )
217              
218             Returns the description of the category. With a
219             defined argument DESCRIPTION, it replaces the current
220             description.
221              
222             =cut
223              
224             sub description
225             {
226 49     49 1 113 my $self = shift;
227              
228 49 100       140 if( defined $_[0] )
229             {
230 10         23 $self->{'description'} = shift;
231             }
232              
233 49         144 $self->{'description'};
234             }
235              
236             =item $category-Efolded( $object )
237              
238             Returns the folded state of the category (TRUE or FALSE). If the category is
239             "folded", Netscape shows a collapsed folder for this category.
240              
241             =cut
242              
243             sub folded
244             {
245 37     37 1 75 my $self = shift;
246              
247 37 100       153 return $self->{'folded'} ? 1 : 0;
248             }
249              
250             =item $category-Eadd_date()
251              
252             Returns the ADD_DATE attribute of the category.
253              
254             =cut
255              
256             sub add_date
257             {
258 37     37 1 81 my $self = shift;
259              
260 37         91 return $self->{'add_date'};
261             }
262              
263             =item $category-Elast_modified()
264              
265             Returns the LAST_MODIFIED attribute of the category.
266              
267             =cut
268              
269             sub last_modified
270             {
271 37     37 1 73 my $self = shift;
272              
273 37         92 return $self->{'last_modified'};
274             }
275              
276             =item $category-Epersonal_toolbar_folder()
277              
278             Returns the PERSONAL_TOOLBAR_FOLDER attribute of the category.
279              
280             =cut
281              
282             sub personal_toolbar_folder
283             {
284 37     37 1 72 my $self = shift;
285              
286 37         91 return $self->{'personal_toolbar_folder'};
287             }
288              
289             =item $category-Eelements()
290              
291             In scalar context returns an array reference to the elements in
292             the category. In list context returns a list of the elements in
293             the category.
294              
295             =cut
296              
297             sub elements
298             {
299 44     44 1 96 my $self = shift;
300              
301 44 50       129 if( wantarray ) { @{ $self->{'thingys'} } }
  44         74  
  44         214  
302 0         0 else { $self->{'thingys'} }
303             }
304              
305             =item $category-Ecount()
306              
307             Returns a count of the number of objects in the Category.
308              
309             =cut
310              
311 0     0 1 0 sub count { scalar @{ $_[0]->{'thingys'} } }
  0         0  
312              
313             =item $category-Ecategories()
314              
315             Returns a list of the Category objects in the category.
316              
317             =cut
318              
319             sub categories
320             {
321 0     0 1 0 my $self = shift;
322              
323 0         0 my @list = grep ref $_ eq 'Netscape::Bookmarks::Category',
324             $self->elements;
325              
326 0         0 return @list;
327             }
328              
329             =item $category-Elinks()
330              
331             Returns a list of the Link objects in the category.
332              
333             =cut
334              
335             sub links
336             {
337 0     0 1 0 my $self = shift;
338              
339 0         0 my @list = grep ref $_ eq 'Netscape::Bookmarks::Link',
340             $self->elements;
341              
342 0         0 return @list;
343             }
344              
345             =item $category-Eas_headline()
346              
347             Returns an HTML string representation of the category, but not
348             the elements of the category.
349              
350             =cut
351              
352             sub as_headline
353             {
354 37     37 1 83 my $self = shift;
355              
356 37 100       106 my $folded = $self->folded ? "FOLDED" : "";
357 37         108 my $title = $self->title;
358 37         106 my $desc = $self->description;
359 37         108 my $add_date = $self->add_date;
360 37         95 my $last_modified = $self->last_modified;
361 37         100 my $id = $self->id;
362 37         109 my $personal_toolbar_folder = $self->personal_toolbar_folder;
363              
364 37 100 66     173 $desc = defined $desc && $desc ne '' ? "\n
$desc" : "\n";
365              
366 37 100       109 $folded = $folded ? qq|FOLDED| : '';
367 37 100       103 $add_date = $add_date ? qq|ADD_DATE="$add_date"| : '';
368 37 100       108 $last_modified = $last_modified ? qq|LAST_MODIFIED="$last_modified"| : '';
369 37 100       92 $personal_toolbar_folder = $personal_toolbar_folder
370             ? qq|PERSONAL_TOOLBAR_FOLDER="true"| : '';
371 37 100       218 $id = $id =~ m/\D/ ? qq|ID="$id"| : '';
372              
373 37         177 my $attr = join " ", grep $_, ($folded, $add_date, $last_modified,
374             $personal_toolbar_folder, $id );
375              
376 37 50       189 $attr = " " . $attr if $attr;
377 37         218 $attr =~ s/\s+$//; # XXX: ugh
378              
379 37         201 return qq|$title$desc|
380             }
381              
382             =item $category-Erecurse( CODE, [ LEVEL ] )
383              
384             This method performs a depth-first traversal of the Bookmarks
385             tree and executes the CODE reference at each node.
386              
387             The CODE reference receives two arguments - the object on which
388             it should operate and its level in the tree.
389              
390             =cut
391              
392             sub recurse
393             {
394 0     0 1 0 my $self = shift;
395 0         0 my $sub = shift;
396 0   0     0 my $level = shift || 0;
397              
398 0 0       0 unless( ref $sub eq 'CODE' )
399             {
400 0         0 warn "Argument to recurse is not a code reference";
401 0         0 return;
402             }
403              
404 0         0 $sub->( $self, $level );
405              
406 0         0 ++$level;
407 0         0 foreach my $element ( $self->elements )
408             {
409 0 0       0 if( $element->isa( __PACKAGE__ ) )
410             {
411 0         0 $element->recurse( $sub, $level );
412             }
413             else
414             {
415 0         0 $sub->( $element, $level );
416             }
417             }
418 0         0 --$level;
419              
420             }
421              
422             =item $category-Eintroduce( VISITOR, [ LEVEL ] )
423              
424             This method performs a depth-first traversal of the Bookmarks
425             tree and introduces the visitor object to each object.
426              
427             This is different from recurse() which only calls its
428             CODEREF on nodes. The VISITOR operates on nodes and
429             vertices. The VISITOR must have a visit() method
430             recognizable by can(). This method does not trap
431             errors in the VISITOR.
432              
433             See L for details on
434             Visitors.
435              
436             =cut
437              
438             sub introduce
439             {
440 5     5 1 428 my $self = shift;
441 5         13 my $visitor = shift;
442 5   100     19 my $level = shift || 0;
443              
444 5 50       33 unless( $visitor->can('visit') )
445             {
446 0         0 warn "Argument to introduce cannot visit()!";
447 0         0 return;
448             }
449              
450 5         35 $self->visitor( $visitor );
451              
452 5         18 ++$level;
453 5         25 foreach my $element ( $self->elements )
454             {
455              
456 16 100       222 if( $element->isa( __PACKAGE__ ) )
457             {
458 4         26 $element->introduce( $visitor, $level );
459             }
460             else
461             {
462 12         86 $element->visitor( $visitor );
463             }
464              
465             }
466 5         176 --$level;
467              
468             }
469              
470             =item $category-Esort_elements( [ CODE ] )
471              
472             Sorts the elements in the category using the provided CODE
473             reference. If you do not specify a CODE reference, the
474             elements are sorted by title (with the side effect of
475             removing Separators from the Category).
476              
477             This function does not recurse, although you can use
478             the recurse() method to do that.
479              
480             Since the built-in sort() uses the package variables
481             C<$a> and C<$b>, your sort subroutine has to make sure
482             that it is accessing the right C<$a> and C<$b>, which
483             are the ones in the package C.
484             You can start your CODE reference with a package
485             declaration to ensure the right thing happens:
486              
487             my $sub = sub {
488             package Netscape::Bookmarks::Category;
489              
490             $b->title cmp $a->title;
491             };
492              
493             $category->sort_elements( $sub );
494              
495             If you know a better way to do this, please let me know. :)
496              
497             =cut
498              
499             sub sort_elements
500             {
501 0     0 1 0 my $self = shift;
502 0         0 my $sub = shift;
503              
504 0 0 0     0 if( defined $sub and not ref $sub eq 'CODE' )
    0          
505             {
506 0         0 warn "Second argument to sort_elements is not a CODE reference.";
507 0         0 return;
508             }
509             elsif( not defined $sub )
510             {
511 0     0   0 $sub = sub { $a->title cmp $b->title };
  0         0  
512             }
513              
514 0         0 local *my_sorter = $sub;
515              
516             $self->{'thingys'} = [ sort my_sorter
517 0         0 grep { not $_->isa( 'Netscape::Bookmarks::Separator' ) }
518 0         0 @{ $self->{'thingys'} } ];
  0         0  
519             }
520              
521             =item $category-Eas_string()
522              
523             Returns an HTML string representation of the category as the
524             top level category, along with all of the elements of the
525             category and the Categories that it contains, recursively.
526              
527             =cut
528              
529             sub as_string
530             {
531 2     2 1 1568 my $self = shift;
532              
533 2         13 my $title = $self->title;
534 2   100     9 my $desc = $self->description || "\n";
535              
536 2 100       11 my $meta = $self->mozilla ?
537             qq|\n| :
538             '';
539              
540 2         18 my $str = <<"HTML";
541            
542             $meta
545             $title
546            

$title

547              
548             HTML
549              
550 2 100 66     12 $str .= "
" . $desc unless( $self->mozilla and $desc eq "\n" );
551              
552 2         9 $str .= START_LIST . "\n";
553              
554 2         15 foreach my $element ( $self->elements )
555             {
556 34         117 $str .= $self->_as_string( $element, 1 );
557             }
558              
559 2         10 $str .= END_LIST . "\n";
560              
561 2         166 return $str;
562             }
563              
564             # _as_string does most of the work that as_string would normally
565             # do.
566             sub _as_string
567             {
568 268     268   633 my $self = shift;
569 268         526 my $obj = shift;
570 268         523 my $level = shift;
571              
572 268         483 my $str;
573 268 100 100     1161 if( ref $obj eq 'Netscape::Bookmarks::Category' )
    100          
    50          
574             {
575 37         153 $str .= TAB x ($level) . START_LIST_ITEM . $obj->as_headline;
576              
577 37 100       124 unless( $self->mozilla )
578             {
579 4         11 $str .= TAB x ($level-1) . START_LIST . "\n";
580             }
581             else
582             {
583 33         113 $str .= TAB x ($level) . START_LIST . "\n";
584             }
585              
586 37         84 ++$level;
587 37         109 foreach my $ref ( $obj->elements )
588             {
589 234         789 $str .= $self->_as_string( $ref, $level );
590             }
591 37         95 --$level;
592              
593 37         123 $str .= TAB x ($level) . END_LIST . "\n";
594             }
595             elsif( ref $obj eq 'Netscape::Bookmarks::Link' or
596             ref $obj eq 'Netscape::Bookmarks::Alias' )
597             {
598 229         1056 $str .= TAB x ($level) . START_LIST_ITEM
599             . $obj->as_string . "\n"
600             }
601             elsif( ref $obj eq 'Netscape::Bookmarks::Separator' )
602             {
603 2         11 $str .= TAB x ($level) . $obj->as_string . "\n"
604             }
605              
606 268         1396 return $str;
607              
608             }
609              
610             =item $obj->write_file( FILENAME )
611              
612             UNIMPLEMENTED!
613              
614             =cut
615              
616             sub write_file
617             {
618 0     0 1   my $self = shift;
619 0           my $filename = shift;
620              
621 0           return;
622             }
623              
624             "if you want to beleive everything you read, so be it.";
625              
626             __END__