0: #!/usr/bin/perl -w
1:
2: =head1 NAME
3:
4: linkmanager.pm - Package for maintaining a hierarchical bookmark file
5:
6: =head1 SYNOPSIS
7:
8: use linkmanager;
9: my $links = linkmanager->new;
10: $links->read_html('links.htm'); # Read in existing bookmark file
11: # ... then add some new links
12: $links->addlink(
13: 'News', 'IT', 'Slashdot', 'http://slashdot.org');
14: $links->addlink(
15: 'News', 'PERL', 'Perl Monks', 'http://www.perlmonks.org');
16: $links->output_html(links.htm'); # .. then save the new bookmarks
17: # file
18:
19: =head2 Advice
20:
21: The purpose of this module was to provide a flexible and portable
22: method of maintaining bookmarks of URLs. The intention is to retain
23: the data in a generated HTML file, which can be easily read and
24: appended to.
25:
26: This module is NOT suitable for use as a CGI script, but could be made
27: so with appropriate taint checking (FUTURE DEVELOPMENT).
28:
29: Methods for deleting or relocating links do not exist. Simplest
30: method is to edit the table rows in the html bookmark file before
31: reading it in.
32:
33: =head1 METHODS
34:
35: =over
36:
37: =cut
38:
39: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
40: package linkmanager;
41: use strict;
42: use Carp;
43: use vars qw(
44: @ISA
45: $VERSION
46: @EXPORT_OK
47: );
48:
49: $VERSION = "1.0";
50: @ISA = qw(Exporter);
51: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
52:
53:
54: sub new {
55: my $class = shift;
56: my $self = {};
57: bless $self, $class;
58: return $self;
59: }
60: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
61:
62: =head2 addlink method
63:
64: Parameters
65: Parent - The parent section for this link if any, use ''
66: for a root node
67: Section - Which section the link should appear in
68: Title - A brief description of the link
69: Link - URL for the link
70:
71: Returns
72: Nothing.
73:
74: Adds a link to the internal hash array indexed by parent,
75: section and title. Duplicates are overwritten.
76:
77: =cut
78:
79: sub addlink {
80: my $self = shift;
81: croak "bad method call" unless ref $self;
82:
83: my ($parent, $section, $title, $link) = @_;
84: $self->{$parent}{$section}{$title}=$link;
85: }
86: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
87:
88:
89: =head2 getparents method
90:
91: Parameters
92: None.
93:
94: Returns
95: Array containing all parent nodes.
96:
97: =cut
98:
99: sub getparents {
100: my $self = shift;
101: croak "bad method call" unless ref $self;
102:
103: my $parent;
104: my @parents;
105:
106: foreach $parent (sort keys %{ $self }){
107: push @parents, $parent;
108: }
109:
110: return @parents;
111: }
112: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
113:
114:
115:
116: =head2 getsections method
117:
118: Parameters
119: Parent node.
120:
121: Returns
122: Array containing all sections under the specified parent node.
123:
124: =cut
125:
126: sub getsections {
127: my $self = shift;
128: croak "bad method call" unless ref $self;
129: my $parent = shift;
130:
131: my $section;
132: my @sections;
133:
134: foreach $section (sort keys %{ $self->{$parent} }){
135: push @sections, $section;
136: }
137:
138:
139: return @sections;
140: }
141: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
142:
143:
144: =head2 countkids method
145:
146: Parameters
147: Parent node.
148:
149: Returns
150: Scalar count of all titles under parent node, regardless of
151: section.
152:
153: =cut
154:
155: sub countkids {
156: my $self = shift;
157: croak "bad method call" unless ref $self;
158: my $parent = shift;
159:
160: my $section;
161: my @sections;
162: my $section_total;
163: my $parent_total;
164:
165: foreach $section (sort keys %{ $self->{$parent} }){
166: $parent_total+=$self->gettitles($parent, $section);
167: }
168:
169: return $parent_total;
170: }
171: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
172:
173:
174: =head2 getlinks method
175:
176: Parameters
177: Parent node.
178: Section node.
179:
180: Returns
181: Hash containing all titles and links for section and parent
182: node.
183:
184: =cut
185:
186: sub getlinks {
187: my $self = shift;
188: croak "bad method call" unless ref $self;
189: my $parent = shift;
190: my $section = shift;
191:
192: return %{ $self->{$parent}{$section}};
193: }
194: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
195:
196:
197:
198: =head2 gettitles method
199:
200: Parameters
201: Parent node.
202: Section node.
203:
204: Returns
205: Array containing all titles for the section and parent node.
206:
207: =cut
208:
209: sub gettitles {
210: my $self = shift;
211: croak "bad method call" unless ref $self;
212: my $parent = shift;
213: my $section = shift;
214:
215: my $title;
216: my @titles;
217:
218: foreach $section (sort keys %{ $self->{$parent}{$section} }){
219: push @titles, $title;
220: }
221:
222: return @titles;
223:
224: }
225: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
226:
227:
228:
229: =head2 output_html method
230:
231: Parameters
232: None. Links must already have been created before outputting.
233:
234: Returns
235: Nothing.
236:
237: Creates a file with html tables containing the links. Backs up
238: existing file to .bak.
239:
240: =cut
241:
242:
243: sub output_html {
244: my $self = shift;
245: croak "bad method call" unless ref $self;
246:
247: my $file = shift;
248: $file = 'links.htm' unless defined $file;
249:
250: use CGI qw/:form :html param header *table *TR/;
251: use File::Copy;
252: my $date = scalar localtime;
253: my ($section_already_started,
254: $parent_already_started,
255: @sections,
256: $number_of_sections,
257: @titles,
258: $number_of_titles,
259: $parent,
260: @parents,
261: $section,
262: );
263:
264: move($file, "$file.bak"); # backup existing links file
265: # ... MAY not exist so ignore
266: # errors.
267:
268: open(BOOKMARK, ">$file")
269: or die "Unable to write to $file because: $!, Stopped";
270: select BOOKMARK;
271:
272: ### Start the file
273: print
274: comment(header),
275: start_html("Links"),
276: h1("Links created as at $date"),
277: "\n";
278:
279: @parents = (sort $self->getparents);
280:
281: ### Index first
282: for $parent (@parents){
283: print a({-href=>"$file#$parent"}, $parent), "\n";
284: }
285:
286: ### Then tables
287: for $parent (@parents){
288:
289: print a({-name=>"$parent"}, h3($parent)), "\n",
290: "\n",
291: start_table({-border=>1}), "\n";
292:
293: ### Use column headings so that html::tableextract can read
294: ### this later as structured data.
295: print
296: td(b("Section")),
297: td(b("Subsection")),
298: td(b("Title")),
299: td(b("Link")),
300: end_TR(), "\n";
301:
302: $parent_already_started=0;
303:
304: @sections = (sort $self->getsections($parent));
305: $number_of_sections = $self->countkids($parent);
306: for $section (@sections){
307:
308: $section_already_started=0;
309:
310: ### Span rows based on number of entries under parent to
311: ### reduce visual clutter
312: print td({-rowspan=>$number_of_sections},$parent)
313: unless $parent_already_started;
314: $parent_already_started=1;
315:
316: my %self = $self->getlinks($parent, $section);
317: @titles = (sort keys %self);
318: $number_of_titles = $self->gettitles($parent, $section);;
319: foreach my $title (@titles){
320:
321: ### Ditto, span rows based on titles under section to
322: ### reduce visual clutter
323: print td({-rowspan=>$number_of_titles},$section)
324: unless $section_already_started;
325: $section_already_started=1;
326: print
327: td($title),
328: td(a{-href=>"$self{$title}"}, $self{$title}),
329: end_TR(), "\n";
330: }
331: }
332: print end_table(),p();
333:
334: }
335:
336: close BOOKMARK;
337: select STDOUT;
338: }
339: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
340:
341:
342:
343: =head2 read_html method
344:
345: Parameters
346: File to read. Table rows expected to have headings:
347: Section Subsection Title Link
348:
349: Returns
350: Nothing.
351:
352: Internally stores the links found in the tables indexed by parent,
353: section and title.
354:
355: =cut
356:
357:
358: sub read_html{
359: my $self = shift;
360: croak "bad method call" unless ref $self;
361: my $file = shift;
362:
363: ### Prime table extract to grab all data with Section Subsection
364: ### Title Link headings
365: use HTML::TableExtract;
366: my $te = new HTML::TableExtract( headers => [qw(Section Subsection Title Link)] );
367: my $html;
368:
369: ### Grab the html and parse it
370: {
371: local undef $/; #Slurp up the whole file into one html string
372: open(LINKS, "<$file") or die "unable to open file: $file because: $!,";
373: $html = <LINKS>;
374: close LINKS;
375: }
376: $te->parse($html);
377: my ($parent, $section, $title,$link, $last_parent, $last_section);
378:
379: ### Load the links into $self
380: foreach my $ts ($te->table_states) {
381:
382: foreach my $row ($ts->rows) {
383:
384: ($parent,$section,$title,$link)=(@$row);
385:
386: if ($parent eq ''){
387: $parent = $last_parent;
388: } else {
389: $last_parent=$parent;
390: }
391:
392: if ($section eq ''){
393: $section = $last_section;
394: } else {
395: $last_section=$section;
396: }
397:
398: $self->addlink($parent,$section,$title,$link);
399: }
400: }
401:
402: }
403: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
404:
405: =head1 REQUIRES
406:
407: HTML::TableExtract Carp File::Copy CGI
408:
409:
410: =cut
411:
412:
413: ### UPDATE: untabify In reply to Bookmark maintenance by Mungbeans
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |