########################################### package Bookmarks; ########################################### # Administer browser bookmarks # Mike Schilli, 2004, m@perlmeister.com ########################################### use Storable; use CGI qw(:all *dl *dt); use Tree::DAG_Node; our @ISA = qw(Tree::DAG_Node); ########################################### sub insert { ########################################### my($self, $text, $link, $folder_name) = @_; my $folder; # Search folder node for($self->daughters()) { if($_->attributes()->{path} eq $folder_name) { $folder = $_; last; } } # Not found? Create it. unless(defined $folder) { $folder = $self->new_daughter( { attributes => { type => "folder", path => $folder_name, }, }); } # Add it return $folder->new_daughter( { attributes => { type => "entry", text => $text, link => $link, }, }); } ########################################### sub folders { ########################################### my($self) = @_; return map { $_->attributes()->{path} } $self->daughters(); } ########################################### sub as_html { ########################################### my($self, $nav) = @_; my $html = start_dl(); for my $folder ($self->daughters()) { $html .= dt( b($folder->attributes()->{path}), $nav->($folder->SUPER::address())); for my $bm ($folder->daughters()) { my $bma = $bm->SUPER::address(); my($link, $text) = map { $bm->attributes()->{$_} } qw(link text); my $a = $bm->attributes(); $html .= dd(a({href => $link}, $text), $nav->($bma)); } } $html .= end_dl(); return $html; } ########################################### sub move_up { ########################################### my($self, $address) = @_; my $node = $self->SUPER::address($address); if(my $left = $node->left_sister()) { $node->unlink_from_mother(); $left->add_left_sister($node); } } ########################################### sub move_down { ########################################### my($self, $address) = @_; my $node = $self->SUPER::address($address); if(my $right = $node->right_sister()) { $node->unlink_from_mother(); $right->add_right_sister($node); } } ########################################### sub delete { ########################################### my($self, $address) = @_; my $node = $self->SUPER::address($address); $node->unlink_from_mother(); } ########################################### sub restore { ########################################### my($class, $filename) = @_; my $self = retrieve($filename) or die "Cannot retrieve $filename ($!)"; } ########################################### sub save { ########################################### my($self, $filename) = @_; store $self, $filename or die "Cannot save $filename ($!)"; } 1;