source: bookmarks/trunk/Bookmarks.pm @ 11

package Bookmarks;

use Class::Accessor 'antlers';
use SQL::Interp qw{:all};
use Bookmark;

has dbh      => ( is => 'ro' );
has base_uri => ( is => 'ro' );

sub get_bookmark {
    my $self = shift;
    my $params = shift;
    my $sth;
    if ($params->{id}) {
        $sth = $self->dbh->prepare('select id,resources.uri,title,ctime,mtime from bookmarks join resources on bookmarks.uri=resources.uri where id=?');
        $sth->execute($params->{id});
    } elsif ($params->{uri}) {
        $sth = $self->dbh->prepare('select id,resources.uri,title,ctime,mtime from bookmarks join resources on bookmarks.uri=resources.uri where resources.uri=?');
        $sth->execute($params->{uri});
    } else {
        die "Must specify either id or uri";
    }
    my $bookmark = $sth->fetchrow_hashref;
    if ($bookmark) {
        my $sth_tag = $self->dbh->prepare('select tag from tags where uri = ? order by tag');
        $sth_tag->execute($bookmark->{uri});
        $bookmark->{tags} = [ map { $$_[0] } @{ $sth_tag->fetchall_arrayref } ];
        if ($self->base_uri) {
            $bookmark->{bookmark_uri} = $self->base_uri . $bookmark->{id};
        }
    }
    return $bookmark;
}

sub get_resources {
    my $self = shift;
    my $params = shift;
    my $tag = $params->{tag};
    my $limit = $params->{limit};

    my ($sql, @bind) = sql_interp(
        'select * from resources join bookmarks on resources.uri = bookmarks.uri',
        ($tag   ? ('join tags on resources.uri = tags.uri where tags.tag =', \$tag) : ''),
        'order by ctime desc',
        ($limit ? ('limit', \$limit) : ''),
    );

    my $sth_resource = $self->dbh->prepare($sql);
    $sth_resource->execute(@bind);

    my $sth_tag = $self->dbh->prepare('select tag from tags where uri = ? order by tag');
    my @resources;
    while (my $resource = $sth_resource->fetchrow_hashref) {
        $sth_tag->execute($resource->{uri});
        $resource->{tags} = [ map { $$_[0] } @{ $sth_tag->fetchall_arrayref } ];
        if ($self->base_uri) {
            $resource->{bookmark_uri} = $self->base_uri . $resource->{id};
        }
        push @resources, $resource;
    }
    return @resources;
}

sub get_tags {
    my $self = shift;
    my $params = shift;
    my $tag = $params->{selected};
    my $sth_all_tags = $self->dbh->prepare('select tag, count(tag) as count, tag = ? as selected from tags group by tag order by tag');
    $sth_all_tags->execute($tag);
    my $all_tags = $sth_all_tags->fetchall_arrayref({});
    return @{ $all_tags };
}

sub get_cotags {
    my $self = shift;
    my $params = shift;
    my $tag = $params->{tag};
    my $sth = $self->dbh->prepare('select tag, count(tag) as count from tags where tag != ? and uri in (select uri from tags where tag = ?) group by tag order by tag');
    $sth->execute($tag, $tag);
    return @{ $sth->fetchall_arrayref({}) };
}

sub add {
    my $self = shift;
    my $bookmark = shift;

    my $uri = $bookmark->{uri};
    my $title = $bookmark->{title};
    #TODO: accept a ctime or mtime
    my $mtime = my $ctime = $bookmark->{ctime} || time;

    # create an entry for the resource
    my $sth_resource = $self->dbh->prepare('insert into resources (uri, title) values (?, ?)');
    eval {
        $sth_resource->execute($uri, $title);
    };
    if ($@) {
        if ($@ =~ /column uri is not unique/) {
            # this is not truly an error condition; the resource is already listed
            # update the title instead
            my $sth_update = $self->dbh->prepare('update resources set title = ? where uri = ?');
            $sth_update->execute($title, $uri);
        } else {
            die $@;
        }
    }

    # create the bookmark
    my $sth_bookmark = $self->dbh->prepare('insert into bookmarks (uri, ctime, mtime) values (?, ?, ?)');
    eval {
        $sth_bookmark->execute($uri, $ctime, $mtime);
    };
    if ($@) {
        if ($@ =~ /column uri is not unique/) {
            # this is not truly an error condition; the bookmark was already there
            # update the mtime instead
            # TODO: only update mtime if the tag list is changed?
            my $sth_update = $self->dbh->prepare('update bookmarks set mtime = ? where uri = ?');
            $sth_update->execute($mtime, $uri);
        } else {
            die $@;
        }
    }

    my %new_tags = map { $_ => 1 } @{ $bookmark->{tags} };
    my $sth_delete_tag = $self->dbh->prepare('delete from tags where uri = ? and tag = ?');
    my $sth_insert_tag = $self->dbh->prepare('insert into tags (uri, tag) values (?, ?)');
    my $sth_current_tags = $self->dbh->prepare('select tag from tags where uri = ?');
    $sth_current_tags->execute($uri);
    while (my ($tag) = $sth_current_tags->fetchrow_array) {
        if (!$new_tags{$tag}) {
            # if a current tag is not in the new tags, remove it from the database
            $sth_delete_tag->execute($uri, $tag);
        } else {
            # if a new tag is already in the database, remove it from the list of tags to add
            delete $new_tags{$tag};
        }
    }
    for my $tag (keys %new_tags) {
        $sth_insert_tag->execute($uri, $tag);
    }

=begin

    # clear all tags
    my $sth_delete_tag = $self->dbh->prepare('delete from tags where uri = ?');
    $sth_delete_tag->execute($uri);
    my $sth_tag = $self->dbh->prepare('insert into tags (uri, tag) values (?, ?)');
    for my $tag (@{ $bookmark->{tags} }) {
        #print $tag, "\n";
        # prevent duplicate (uri,tag) pairs in the database
        # TODO: should POST with a set of tags ever remove tags?
        eval {
            $sth_tag->execute($uri, $tag);
        };
        if ($@) {
            if ($@ =~ /columns uri, tag are not unique/) {
                # this is not truly an error condition; the tag was already there
            } else {
                die $@;
            }
        }
    }

=cut

    # return the newly created or updated bookmark
    return $self->get_bookmark({ uri => $uri });
}

# module returns true
1;