source: bookmarks/trunk/Bookmarks.pm @ 48

Last change on this file since 48 was 47, checked in by peter, 11 years ago
  • added a create_tables method to Bookmarks that uses the bookmarks.sql file to create the tables
  • added an "init" command to the bkmk script
File size: 9.0 KB
Line 
1package Bookmarks;
2
3use Moose;
4use SQL::Interp qw{:all};
5use URI;
6use Bookmark;
7
8has dbh      => ( is => 'rw' );
9has base_uri => ( is => 'ro', isa => 'URI' );
10
11has _sth_tags_from_uri => (
12    is       => 'ro',
13    init_arg => undef,
14    lazy     => 1,
15    default  => sub { $_[0]->dbh->prepare('select tag from tags where uri = ? order by tag'); },
16);
17
18sub BUILD {
19    my $self = shift;
20    my $args = shift;
21
22    if (!$self->dbh) {
23        if ($args->{dbname}) {
24            require DBI;
25            $self->dbh(DBI->connect("dbi:SQLite:dbname=$$args{dbname}", "", "", { RaiseError => 1, PrintError => 0 }));
26            # enable foreign key support (requires DBD::SQLite 1.26_05 or above (sqlite 3.6.19 or above))
27            $self->dbh->do('pragma foreign_keys = on;');
28        } else {
29            #TODO: figure out how to make croak play nice with Moose to get the user-visible caller line
30            die "No dbh or dbname specified in the constructor";
31        }
32    }
33}
34
35sub create_tables {
36    my $self = shift;
37    require File::Slurp;
38    my $table_definitions = File::Slurp::read_file('bookmarks.sql');
39    $self->dbh->{sqlite_allow_multiple_statements} = 1;
40    $self->dbh->do($table_definitions);
41    $self->dbh->{sqlite_allow_multiple_statements} = 0;
42    return $self;
43}
44
45sub get_bookmark {
46    my $self = shift;
47    my $params = shift;
48
49    # look for bookmark by id or uri
50    my $sth;
51    if ($params->{id}) {
52        $sth = $self->dbh->prepare('select id,resources.uri,title,ctime,mtime from bookmarks join resources on bookmarks.uri=resources.uri where id=?');
53        $sth->execute($params->{id});
54    } elsif ($params->{uri}) {
55        $sth = $self->dbh->prepare('select id,resources.uri,title,ctime,mtime from bookmarks join resources on bookmarks.uri=resources.uri where resources.uri=?');
56        $sth->execute($params->{uri});
57    } else {
58        die "Must specify either id or uri";
59    }
60    my $bookmark = $sth->fetchrow_hashref;
61    return unless $bookmark;
62
63    return Bookmark->new({
64        %$bookmark,
65        tags     => [ $self->get_tags({ uri => $bookmark->{uri} }) ],
66        base_uri => $self->base_uri,
67    });
68}
69
70sub get_bookmarks {
71    my $self = shift;
72    my $params = shift;
73    my $tags = $params->{tag} || [];
74    my $limit = $params->{limit};
75    my $offset = $params->{offset};
76
77    # build the query
78    my @sql;
79
80    if (!ref $tags) {
81        $tags = [ $tags ];
82    }
83    if (@$tags) {
84        my $intersect = 0;
85        for my $tag (@{ $tags }) {
86            push @sql, 'intersect' if $intersect;
87            push @sql, 'select resources.*, bookmarks.* from resources join bookmarks on resources.uri = bookmarks.uri';
88            push @sql, 'join tags on resources.uri = tags.uri where tags.tag =', \$tag;
89            $intersect++;
90        }
91    } else {
92        push @sql, 'select * from resources join bookmarks on resources.uri = bookmarks.uri';
93    }
94    push @sql, 'order by ctime desc';
95    push @sql, ('limit', \$limit) if $limit;
96    # an offset is only allowed if we have a limit clause
97    push @sql, ('offset', \$offset) if $limit && $offset;
98
99    my ($sql, @bind) = sql_interp(@sql);
100
101    my $sth_resource = $self->dbh->prepare($sql);
102    $sth_resource->execute(@bind);
103
104    my @resources;
105    while (my $resource = $sth_resource->fetchrow_hashref) {
106        push @resources, Bookmark->new({
107            %$resource,
108            tags     => [ $self->get_tags({ uri => $resource->{uri} }) ],
109            base_uri => $self->base_uri,
110        });
111    }
112    return @resources;
113}
114
115sub get_tags {
116    my $self = shift;
117    my $params = shift;
118    if (my $uri = $params->{uri}) {
119        # get the tags for a particular URI
120        $self->_sth_tags_from_uri->execute($uri);
121        return map { $$_[0] } @{ $self->_sth_tags_from_uri->fetchall_arrayref };
122    } else {
123        # return all tags
124        my $tag = $params->{selected};
125        my $sth_all_tags = $self->dbh->prepare('select tag, count(tag) as count, tag = ? as selected from tags group by tag order by tag');
126        $sth_all_tags->execute($tag);
127        my $all_tags = $sth_all_tags->fetchall_arrayref({});
128        return @{ $all_tags };
129    }
130}
131
132sub get_cotags {
133    my $self = shift;
134    my $params = shift;
135    my $tags = $params->{tag} || [];
136    if (!ref $tags) {
137        $tags = [ $tags ];
138    }
139    my @sql;
140
141    push @sql, 'select tag, count(tag) as count from tags';
142    if (@$tags) {
143        push @sql, 'where uri in (';
144        my $intersect = 0;
145        for my $tag (@{ $tags }) {
146            push @sql, 'intersect' if $intersect;
147            push @sql, 'select uri from tags where tag = ', \$tag;
148            $intersect++;
149        }
150        push @sql, ') and tag not in ', $tags, '';
151    }
152    push @sql, 'group by tag order by tag';
153
154    my ($sql, @bind) = sql_interp(@sql);
155    my $sth = $self->dbh->prepare($sql);
156    $sth->execute(@bind);
157    return @{ $sth->fetchall_arrayref({}) };
158}
159
160sub add {
161    my $self = shift;
162    my $bookmark = shift;
163
164    my $uri = $bookmark->{uri};
165    my $title = $bookmark->{title};
166    my $ctime = $bookmark->{ctime} || time;
167    my $mtime = $bookmark->{mtime} || $ctime;
168    my $id = $bookmark->{id};
169
170    # create an entry for the resource
171    my $sth_resource = $self->dbh->prepare('insert into resources (uri, title) values (?, ?)');
172    eval {
173        $sth_resource->execute($uri, $title);
174    };
175    if ($@) {
176        if ($@ =~ /column uri is not unique/) {
177            # this is not truly an error condition; the resource is already listed
178            # update the title instead
179            my $sth_update = $self->dbh->prepare('update resources set title = ? where uri = ?');
180            $sth_update->execute($title, $uri);
181        } else {
182            die $@;
183        }
184    }
185
186    # create the bookmark
187    my $bookmark_exists = 0;
188    my ($sql_bookmark, @bind_bookmark) = sql_interp(
189        'insert into bookmarks', { ($id ? (id => $id) : ()), uri => $uri, ctime => $ctime, mtime => $mtime }
190    );
191    my $sth_bookmark = $self->dbh->prepare($sql_bookmark);
192    eval {
193        $sth_bookmark->execute(@bind_bookmark);
194    };
195    if ($@) {
196        if ($@ =~ /column uri is not unique/) {
197            # this is not truly an error condition; the bookmark was already there
198            # set this flag so that later we can update the mtime if tags change
199            $bookmark_exists = 1;
200        } else {
201            die $@;
202        }
203    }
204
205    my $changed_tags = $self->_update_tags($uri, $bookmark->{tags});
206
207    if ($bookmark_exists && $changed_tags) {
208        # update the mtime if the bookmark already existed but the tags were changed
209        my $sth_update = $self->dbh->prepare('update bookmarks set mtime = ? where uri = ?');
210        $sth_update->execute($mtime, $uri);
211    }
212
213    # return the newly created or updated bookmark
214    return $self->get_bookmark({ uri => $uri });
215}
216
217sub update {
218    my $self = shift;
219    my $bookmark = shift;
220
221    my $mtime = time;
222
223    my $changed_uri = 0;
224    my $sth_current = $self->dbh->prepare('select uri from bookmarks where id = ?');
225    $sth_current->execute($bookmark->id);
226    my ($stored_uri) = $sth_current->fetchrow_array;
227
228    if ($stored_uri ne $bookmark->uri) {
229        # the URI has changed
230        my $sth_update_uri = $self->dbh->prepare('update resources set uri = ? where uri = ?');
231        $sth_update_uri->execute($bookmark->uri, $stored_uri);
232        $changed_uri++;
233    }
234
235    # update the title
236    # TODO: only do this if the title has changed
237    # TODO: should we update mtime if the title changes?
238    my $sth_update = $self->dbh->prepare('update resources set title = ? where uri = ?');
239    $sth_update->execute($bookmark->title, $bookmark->uri);
240
241    my $changed_tags = $self->_update_tags($bookmark->uri, $bookmark->tags);
242
243    if ($changed_uri or $changed_tags) {
244        # update the mtime if the bookmark already existed but the tags were changed
245        my $sth_update = $self->dbh->prepare('update bookmarks set mtime = ? where uri = ?');
246        $sth_update->execute($mtime, $bookmark->uri);
247    }
248
249    # return the bookmark
250    return $bookmark;
251}
252
253sub _update_tags {
254    my $self = shift;
255    my ($uri, $tags) = @_;
256
257    my $changed_tags = 0;
258    my %new_tags = map { $_ => 1 } @{ $tags };
259    my $sth_delete_tag = $self->dbh->prepare('delete from tags where uri = ? and tag = ?');
260    my $sth_insert_tag = $self->dbh->prepare('insert into tags (uri, tag) values (?, ?)');
261    my $sth_current_tags = $self->dbh->prepare('select tag from tags where uri = ?');
262    $sth_current_tags->execute($uri);
263    while (my ($tag) = $sth_current_tags->fetchrow_array) {
264        if (!$new_tags{$tag}) {
265            # if a current tag is not in the new tags, remove it from the database
266            $sth_delete_tag->execute($uri, $tag);
267            $changed_tags++;
268        } else {
269            # if a new tag is already in the database, remove it from the list of tags to add
270            delete $new_tags{$tag};
271        }
272    }
273    for my $tag (keys %new_tags) {
274        $sth_insert_tag->execute($uri, $tag);
275        $changed_tags++;
276    }
277
278    # how many tags have changed?
279    return $changed_tags;
280}
281
282
283# module returns true
2841;
Note: See TracBrowser for help on using the repository browser.