Bookmarks.pm

001 #############################
002 package Bookmarks;
003 #############################
004 # Admin browser bookmarks
005 # Mike Schilli, 2004
006 # m@perlmeister.com
007 #############################
008 
009 use Storable;
010 use CGI qw(:all *dl *dt);
011 use Tree::DAG_Node;
012 our @ISA= qw(Tree::DAG_Node);
013 
014 #############################
015 sub insert {
016 #############################
017   my($self, $text, $link, 
018      $fname) = @_;
019 
020   my $folder;
021 
022     # Search folder node
023   for($self->daughters()) {
024     if($_->
025       attributes()->{path} eq 
026       $fname) {
027         $folder = $_;
028         last;
029     }
030   }
031     # Not found? Create it.
032   unless(defined $folder) {
033     $folder = 
034       $self->new_daughter({
035         attributes => {
036           type => "folder",
037           path => $fname,
038         },
039       });
040   }
041       # Add it and return obj
042   return $folder->
043     new_daughter({
044       attributes => {
045         type => "entry",
046         text => $text,
047         link => $link,
048       },
049     });
050 }
051 
052 #############################
053 sub folders {
054 #############################
055   my($self) = @_;
056     
057   return map {
058     $_->attributes()->{path} 
059   } $self->daughters();
060 }
061 
062 #############################
063 sub as_html {
064 #############################
065   my($self, $nav) = @_;
066 
067   my $html = start_dl();
068 
069   for my $f ($self->
070               daughters()) {
071 
072     $html .= dt(
073       b($f->attributes()->
074           {path}), 
075       $nav->(
076         $f->SUPER::address())
077     );
078 
079     for my $bm ($f->
080                daughters()) {
081       my $bma = 
082        $bm->SUPER::address();
083 
084       my($link, $text) = 
085         map { $bm->
086          attributes()->{$_} 
087         } qw(link text);
088 
089       $html .= dd(
090         a({href => $link},
091           $text
092          ), $nav->($bma));
093     }
094   }
095 
096   $html .= end_dl();
097 
098   return $html;
099 }
100 
101 #############################
102 sub move_up {
103 #############################
104   my($self, $address) = @_;
105 
106   my $node = 
107     $self->SUPER::address(
108                    $address);
109 
110   if(my $left = 
111       $node->left_sister()) {
112     $node->
113         unlink_from_mother();
114     $left->
115       add_left_sister($node);
116   }
117 }
118 
119 #############################
120 sub move_down {
121 #############################
122     my($self, $address) = @_;
123 
124     my $node = 
125        $self->SUPER::address(
126                    $address);
127     if(my $right =
128      $node->right_sister()) {
129       $node->
130         unlink_from_mother();
131       $right->
132         add_right_sister(
133                       $node);
134     }
135 }
136 
137 #############################
138 sub delete {
139 #############################
140   my($self, $address) = @_;
141 
142   my $node = 
143        $self->SUPER::address(
144                    $address);
145   $node->
146         unlink_from_mother();
147 }
148 
149 #############################
150 sub restore {
151 #############################
152   my($class, $filename) = @_;
153 
154   my $self = 
155     retrieve($filename) or
156     die "Cannot retrieve " .
157         "$filename ($!)";
158 }
159 
160 #############################
161 sub save {
162 #############################
163   my($self, $filename) = @_;
164 
165   store $self, $filename or
166     die "Cannot save " .
167         "$filename ($!)";
168 }
169 
170 1;