source: bookmarks/trunk/lib/Bookmarks.pm @ 103

package Bookmarks;

use Moose;

use SQL::Interp qw{:all};
use URI;

use Bookmark;
use Bookmarks::Search;

has dbh      => ( is => 'rw' );
has base_uri => ( is => 'ro', isa => 'URI' );

has _sth_tags_from_uri => (
    is       => 'ro',
    init_arg => undef,
    lazy     => 1,
    default  => sub { $_[0]->dbh->prepare('select tag from tags where uri = ? order by tag'); },
);

sub BUILD {
    my $self = shift;
    my $args = shift;

    if (!$self->dbh) {
        if ($args->{dbname}) {
            require DBI;
            $self->dbh(DBI->connect("dbi:SQLite:dbname=$$args{dbname}", "", "", { RaiseError => 1, PrintError => 0 }));
            # enable foreign key support (requires DBD::SQLite 1.26_05 or above (sqlite 3.6.19 or above))
            $self->dbh->do('pragma foreign_keys = on;');
        } else {
            #TODO: figure out how to make croak play nice with Moose to get the user-visible caller line
            die "No dbh or dbname specified in the constructor";
        }
    }
}

sub create_tables {
    my $self = shift;
    require File::Slurp;
    require File::Basename;
    my $table_definitions = File::Slurp::read_file(File::Basename::dirname($INC{'Bookmarks.pm'}) . "/../bookmarks.sql");
    $self->dbh->{sqlite_allow_multiple_statements} = 1;
    $self->dbh->do($table_definitions);
    $self->dbh->{sqlite_allow_multiple_statements} = 0;
    return $self;
}

sub get_bookmark {
    my $self = shift;
    my $params = shift;

    # look for bookmark by id or uri
    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;
    return unless $bookmark;

    return Bookmark->new({
        %$bookmark,
        exists     => 1,
        tags       => [ $self->get_tags({ uri => $bookmark->{uri} }) ],
        base_uri   => $self->base_uri,
        collection => $self,
    });
}

sub _sql_where_clause {
    my $self = shift;
    my $search = shift;

    # build the where clause
    my @sql;
    if (@{ $search->tags }) {
        push @sql, 'where resources.uri in';
        # subquery to find tagged URIs
        push @sql, '(';
        my $intersect = 0;
        for my $tag (@{ $search->tags }) {
            push @sql, 'intersect' if $intersect;
            push @sql, 'select uri from tags where tag =', \$tag;
            $intersect++;
        }
        push @sql, ')';
    }
    if ($search->query) {
        my $fuzzy_match = '%' . $search->query . '%';
        push @sql, (@{ $search->tags } ? 'and' : 'where'), 'title like', \$fuzzy_match;
    }
    return @sql;
}

sub search {
    my $self = shift;
    my $params = shift || {};
    my $search = Bookmarks::Search->new($params);

    # build the query
    my @sql;

    push @sql, 'select * from resources join bookmarks on resources.uri = bookmarks.uri';
    push @sql, $self->_sql_where_clause($search);
    push @sql, 'order by ctime desc';
    push @sql, ('limit', \$search->limit) if $search->limit;
    # an offset is only allowed if we have a limit clause
    push @sql, ('offset', \$search->offset) if $search->limit && $search->offset;

    my ($sql, @bind) = sql_interp(@sql);

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

    my @resources;
    while (my $resource = $sth_resource->fetchrow_hashref) {
        push @resources, Bookmark->new({
            %$resource,
            exists     => 1,
            tags       => [ $self->get_tags({ uri => $resource->{uri} }) ],
            base_uri   => $self->base_uri,
            collection => $self,
        });
    }
    $search->results(\@resources);

    return $search;
}

sub get_tags {
    my $self = shift;
    my $params = shift;
    if (my $uri = $params->{uri}) {
        # get the tags for a particular URI
        $self->_sth_tags_from_uri->execute($uri);
        return map { $$_[0] } @{ $self->_sth_tags_from_uri->fetchall_arrayref };
    } else {
        # return all tags
        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 $search = $params->{search};

    my @sql;

    push @sql, 'select tag, count(tag) as count from tags';
    push @sql, 'join resources on tags.uri = resources.uri' if $search->query;

    # build the where clause
    if (@{ $search->tags }) {
        push @sql, 'where tags.uri in (';
        my $intersect = 0;
        for my $tag (@{ $search->tags }) {
            push @sql, 'intersect' if $intersect;
            push @sql, 'select uri from tags where tag = ', \$tag;
            $intersect++;
        }
        push @sql, ') and tag not in ', $search->tags, '';
    }
    if ($search->query) {
        my $fuzzy_match = '%' . $search->query . '%';
        push @sql, (@{ $search->tags } ? 'and' : 'where'), 'title like', \$fuzzy_match;
    }

    push @sql, 'group by tag order by tag';

    my ($sql, @bind) = sql_interp(@sql);
    my $sth = $self->dbh->prepare($sql);
    $sth->execute(@bind);
    return @{ $sth->fetchall_arrayref({}) };
}

sub get_last_modified_time {
    my $self = shift;
    my $sth = $self->dbh->prepare('select mtime from bookmarks order by mtime desc limit 1');
    $sth->execute;
    my ($mtime) = $sth->fetchrow_array;
    return $mtime;
}

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

    #TODO: accept a pre-made Bookmark object in addition to a hash
    my $uri = $bookmark->{uri};
    my $title = $bookmark->{title};
    my $ctime = $bookmark->{ctime} || time;
    my $mtime = $bookmark->{mtime} || $ctime;
    my $id = $bookmark->{id};

    # 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 $bookmark_exists = 0;
    my ($sql_bookmark, @bind_bookmark) = sql_interp(
        'insert into bookmarks', { ($id ? (id => $id) : ()), uri => $uri, ctime => $ctime, mtime => $mtime }
    );
    my $sth_bookmark = $self->dbh->prepare($sql_bookmark);
    eval {
        $sth_bookmark->execute(@bind_bookmark);
    };
    if ($@) {
        if ($@ =~ /column uri is not unique/) {
            # this is not truly an error condition; the bookmark was already there
            # set this flag so that later we can update the mtime if tags change
            $bookmark_exists = 1;
        } else {
            die $@;
        }
    }

    my $changed_tags = $self->_update_tags($uri, $bookmark->{tags});

    if ($bookmark_exists && $changed_tags) {
        # update the mtime if the bookmark already existed but the tags were changed
        my $sth_update = $self->dbh->prepare('update bookmarks set mtime = ? where uri = ?');
        $sth_update->execute($mtime, $uri);
    }

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

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

    my $mtime = time;

    # update the URI, if it has changed
    my $changed_uri = 0;
    my $sth_current = $self->dbh->prepare('select uri from bookmarks where id = ?');
    $sth_current->execute($bookmark->id);
    my ($stored_uri) = $sth_current->fetchrow_array;

    if ($stored_uri ne $bookmark->uri) {
        # the URI has changed
        my $sth_update_uri = $self->dbh->prepare('update resources set uri = ? where uri = ?');
        $sth_update_uri->execute($bookmark->uri, $stored_uri);
        $changed_uri++;
    }

    # update the title, if it has changed
    my $changed_title = 0;
    my $sth_current_title = $self->dbh->prepare('select title from resources where uri = ?');
    $sth_current_title->execute($bookmark->uri);
    my ($stored_title) = $sth_current_title->fetchrow_array;

    if ($stored_title ne $bookmark->title) {
        my $sth_update = $self->dbh->prepare('update resources set title = ? where uri = ?');
        $sth_update->execute($bookmark->title, $bookmark->uri);
        $changed_title++;
    }

    # update the tags, if they have changed
    my $changed_tags = $self->_update_tags($bookmark->uri, $bookmark->tags);

    # update the mtime, if the bookmark has actually been changed
    if ($changed_uri or $changed_title or $changed_tags) {
        # update the mtime if the bookmark already existed but the tags were changed
        my $sth_update = $self->dbh->prepare('update bookmarks set mtime = ? where uri = ?');
        $sth_update->execute($mtime, $bookmark->uri);
    }

    # return the bookmark
    return $bookmark;
}

sub _update_tags {
    my $self = shift;
    my ($uri, $tags) = @_;

    my $changed_tags = 0;
    my %new_tags = map { $_ => 1 } @{ $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);
            $changed_tags++;
        } 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);
        $changed_tags++;
    }

    # how many tags have changed?
    return $changed_tags;
}


# module returns true
1;