File Coverage

blib/lib/Netscape/Bookmarks.pm
Criterion Covered Total %
statement 87 108 80.5
branch 36 54 66.6
condition 11 21 52.3
subroutine 17 20 85.0
pod 4 8 50.0
total 155 211 73.4


line stmt bran cond sub pod time code
1             package Netscape::Bookmarks;
2 5     5   254052 use v5.10;
  5         48  
3              
4             =encoding utf8
5              
6             =head1 NAME
7              
8             Netscape::Bookmarks - parse, manipulate, or create Netscape Bookmarks files
9              
10             =head1 SYNOPSIS
11              
12             use Netscape::Bookmarks;
13              
14             # parse an existing file
15             my $bookmarks = Netscape::Bookmarks->new( $bookmarks_file );
16              
17             # -- OR --
18             # start a new Bookmarks structure
19             my $bookmarks = Netscape::Bookmarks->new;
20              
21             # print a Netscape compatible file
22             print $bookmarks->as_string;
23              
24              
25             =head1 DESCRIPTION
26              
27             THIS IS AN ABANDONED MODULE. THERE IS NO SUPPORT. YOU CAN ADOPT IT
28             IF YOU LIKE: https://pause.perl.org/pause/query?ACTION=pause_04about#takeover
29              
30             The Netscape bookmarks file has several basic components:
31              
32             title
33             folders (henceforth called categories)
34             links
35             aliases
36             separators
37              
38             On disk, Netscape browsers store this information in HTML.
39             In the browser, it is displayed under the "Bookmarks" menu.
40             The data can be manipulated through the browser interface.
41              
42             This module allows one to manipulate the bookmarks file
43             programmatically. One can parse an existing bookmarks file,
44             manipulate the information, and write it as a bookmarks file
45             again. Furthermore, one can skip the parsing step to create
46             a new bookmarks file and write it in the proper format to be
47             used by a Netscape browser.
48              
49             The Bookmarks module simply parses the bookmarks file passed
50             to it as the only argument to the constructor:
51              
52             my $bookmarks = Netscape::Bookmarks->new( $bookmarks_file );
53              
54             The returned object is a C object, since
55             the bookmark file is simply a collection of categories that
56             contain any of the components listed above. The top level
57             (i.e. root) category is treated specially and defines the
58             title of the bookmarks file.
59              
60             C is used behind the scenes to build the data structure (a
61             simple list of lists (of lists ...)). C,
62             C, C, or
63             C objects can be stored in a
64             C object. C
65             objects are treated as references to C
66             objects, so changes to one affect the other.
67              
68             Methods for manipulating this object are in the
69             C module. Methods for dealing with the
70             objects contained in a C object are in
71             their appropriate modules.
72              
73             =over 4
74              
75             =cut
76              
77 5     5   57 use strict;
  5         9  
  5         133  
78              
79 5     5   26 use base qw(HTML::Parser);
  5         7  
  5         2427  
80 5     5   27778 use subs qw();
  5         116  
  5         155  
81 5         452 use vars qw(@ISA
82             $DEBUG
83             $VERSION
84             @category_stack
85             $flag
86             %link_data
87             %category_data
88             $netscape
89             $state
90             $current_link
91             $ID
92             $text_flag
93 5     5   26 );
  5         9  
94              
95 5     5   25 use HTML::Entities;
  5         9  
  5         409  
96 5     5   23 use HTML::Parser;
  5         9  
  5         94  
97              
98 5     5   1984 use Netscape::Bookmarks::Alias;
  5         12  
  5         126  
99 5     5   1855 use Netscape::Bookmarks::Category;
  5         14  
  5         165  
100 5     5   2231 use Netscape::Bookmarks::Link;
  5         16  
  5         167  
101 5     5   2048 use Netscape::Bookmarks::Separator;
  5         13  
  5         110  
102 5     5   27 use Netscape::Bookmarks::Isa;
  5         11  
  5         4455  
103              
104             $VERSION = "2.304";
105              
106             $ID = 0;
107             $DEBUG = $ENV{NS_DEBUG} || 0;
108              
109 0     0 0 0 sub XML { 'XML' };
110              
111             =item new( [filename] )
112              
113             The constructor takes a filename as its single (optional) argument.
114             If you do not give C an argument, an empty
115             C object is returned so that
116             you can start to build up your new Bookmarks file. If the file
117             that you name does not exist, C is returned in scalar
118             context and an empty list is returned in list context. If the
119             file does exist it is parsed with C with the
120             internal parser subclass defined in the same package as C.
121             If the parsing finishes without error a C
122             object is returned.
123              
124             =cut
125              
126             sub new {
127 4     4 1 1679 my($class, $file) = @_;
128              
129 4 50       15 unless( $file ) {
130 0         0 my $cat = Netscape::Bookmarks::Category->new();
131 0         0 return $cat;
132             }
133              
134 4 50 33     100 return unless ( -e $file or ref $file );
135              
136 4         36 my $self = HTML::Parser->new();
137 4         268 $self->unbroken_text(1);
138              
139 4         8 bless $self, $class;
140              
141 4         30 $self->parse_file( $file );
142              
143 4         74 return $netscape;
144             }
145              
146             sub mozilla {
147 6     6 0 11 my $self = shift;
148 6         89 my $value = shift;
149              
150 6 100       29 $self->{'mozilla'} = $value if defined $value;
151              
152 6         63 $self->{'mozilla'};
153             }
154              
155             sub parse_string {
156 0     0 0 0 my $data_ref = shift;
157              
158 0         0 my $self = HTML::Parser->new();
159 0         0 bless $self, __PACKAGE__;
160              
161 0         0 my $length = length $$data_ref;
162 0         0 my $pos = 0;
163              
164 0         0 while( $pos < $length ) {
165             #512 bytes seems to be the magic number
166             #to make this work efficiently. don't know
167             #why really - its an HTML::Parser thing
168 0         0 $self->parse( substr( $$data_ref, $pos, 512 ) );
169 0         0 $pos += 512;
170             }
171              
172 0         0 $self->eof;
173              
174 0         0 return $netscape; # a global variable
175             }
176              
177             sub start {
178 1324     1324 1 3546 my($self, $tag, $attr) = @_;
179              
180 1324         1582 $text_flag = 0;
181              
182 1324 100 100     3666 if( $tag eq 'a' ) {
    100          
    100          
    100          
183 458         612 $state = 'anchor';
184 458         1688 %link_data = %$attr;
185             }
186             elsif( $tag eq 'h3' or $tag eq 'h1' ) {
187 78         114 $state = 'category';
188 78         262 %category_data = %$attr;
189             }
190             elsif( $tag eq 'hr' ) {
191 4         22 my $item = Netscape::Bookmarks::Separator->new();
192 4         9 $category_stack[-1]->add( $item );
193             }
194             elsif( $tag eq 'meta' ) {
195 2         6 $self->mozilla(1);
196             }
197              
198 1324         6316 $flag = $tag
199             }
200              
201             sub text {
202 1262     1262 1 3240 my($self, $text) = @_;
203              
204 1262 100       1811 if($text_flag) {
205 4 50 0     14 if( not defined $flag ) {
    0 0        
    0          
    0          
206             # sometimes $flag is not set (haven't figured out when that
207             # is), so without this no-op, you get a perl5.6.1 warning
208             # about "uninitialized value in string eq"
209 4         6 1;
210             }
211             elsif( $flag eq 'h1' or $flag eq 'h3' ) {
212 0         0 $category_stack[-1]->title( $text );
213             }
214             elsif( $flag eq 'a' and not exists $link_data{'aliasof'} ) {
215 0         0 $current_link->title( $text );
216             }
217             elsif( $flag eq 'dd' ) {
218 0 0       0 if( $state eq 'category' ) {
    0          
219 0         0 $category_stack[-1]->description( $text );
220             }
221             elsif( $state eq 'anchor' ) {
222 0         0 $current_link->description( $text );
223             }
224             }
225              
226             }
227             else {
228 1258 100 100     3314 if( not defined $flag ) {
    100 66        
    100          
    100          
    100          
    100          
229             # sometimes $flag is not set (haven't figured out when that
230             # is), so without this no-op, you get a perl5.6.1 warning
231             # about "uninitialized value in string eq"
232 544         606 1;
233             }
234             elsif( $flag eq 'h1' ) {
235             $netscape = Netscape::Bookmarks::Category->new(
236             {
237             title => $text,
238             folded => 0,
239             add_date => $category_data{'add_date'},
240 4         17 last_modified => $category_data{'last_modified'},
241             mozilla => $self->mozilla,
242             id => $ID++,
243             } );
244              
245 4         16 push @category_stack, $netscape;
246             }
247             elsif( $flag eq 'h3' ) {
248             #print STDERR "Personal Toolbar is [$category_data{'personal_toolbar_folder'}] for [$text]\n";
249             my $cat = Netscape::Bookmarks::Category->new(
250             {
251             title => $text,
252             folded => exists $category_data{'folded'},
253             add_date => $category_data{'add_date'},
254             last_modified => $category_data{'last_modified'},
255             personal_toolbar_folder => $category_data{'personal_toolbar_folder'},
256 74   66     613 id => $category_data{'id'} || $ID++,
257             });
258              
259 74         257 $category_stack[-1]->add( $cat );
260 74         118 push @category_stack, $cat;
261             }
262             elsif( $flag eq 'a' and not exists $link_data{'aliasof'} ) {
263             my $item = Netscape::Bookmarks::Link->new( {
264             HREF => $link_data{'href'},
265             ADD_DATE => $link_data{'add_date'},
266             LAST_MODIFIED => $link_data{'last_modified'},
267             LAST_VISIT => $link_data{'last_visit'},
268             ALIASID => $link_data{'aliasid'},
269             SHORTCUTURL => $link_data{'shortculurl'},
270             ICON => $link_data{'icon'},
271             LAST_CHARSET => $link_data{'last_charset'},
272             SCHEDULE => $link_data{'schedule'},
273             LAST_PING => $link_data{'last_ping'},
274             PING_CONTENT_LEN => $link_data{'ping_content_len'},
275 456         2905 PING_STATUS => $link_data{'ping_status'},
276             TITLE => $text,
277             });
278              
279 456 50       1280 unless( ref $item ) {
280 0 0       0 print "ERROR: $Netscape::Bookmarks::Link::ERROR\n" if $DEBUG;
281 0         0 return;
282             }
283              
284 456 100       804 if( defined $link_data{'aliasid'} ) {
285             &Netscape::Bookmarks::Alias::add_target(
286 2         12 $item, $link_data{'aliasid'} )
287             }
288              
289 456         1371 $category_stack[-1]->add( $item );
290 456         657 $current_link = $item;
291             }
292             elsif( $flag eq 'a' and defined $link_data{'aliasof'} ) {
293 2         15 my $item = Netscape::Bookmarks::Alias->new( $link_data{'aliasof'} );
294 2 50       14 unless( ref $item ) {
295 0         0 return;
296             }
297              
298 2         10 $category_stack[-1]->add( $item );
299 2         3 $current_link = $item;
300             }
301             elsif( $flag eq 'dd' ) {
302 12 100       25 if( $state eq 'category' ) {
    50          
303 10         42 $category_stack[-1]->description( $text );
304             }
305             elsif( $state eq 'anchor' ) {
306 2         9 $current_link->description( $text );
307             }
308             }
309             }
310              
311 1262         4502 $text_flag = 1;
312             }
313              
314             sub end {
315 618     618 1 1297 my($self, $tag, $attr) = @_;
316              
317 618         773 $text_flag = 0;
318 618 100       1096 pop @category_stack if $tag eq 'dl';
319             # what does the next line do and why?
320             # if it is there then the
part of a link is discarded
321             # not having this line doesn't seem to break things.
322             # bug identified by Daniel Hottinger
323             #$current_link = undef if $tag eq 'a';
324 618         2109 $flag = undef;
325             }
326              
327       0 0   sub my_init {}
328              
329             "Seeing is believing";
330              
331             =back
332              
333             =head1 AUTHOR
334              
335             brian d foy C<< >>
336              
337             =head1 COPYRIGHT AND LICENSE
338              
339             Copyright © 2002-2019, brian d foy . All rights reserved.
340              
341             This program is free software; you can redistribute it and/or modify
342             it under the terms of the Artistic License 2.0.
343              
344             =head1 SEE ALSO
345              
346             L,
347             L,
348             L,
349             L,
350             L.
351              
352             =cut