package App::reposdb;

our $DATE = '2016-06-12'; # DATE
our $VERSION = '0.001'; # VERSION

use 5.010001;
use strict;
use warnings;

our %SPEC;

our $db_schema_spec = {
    latest_v => 2,
    install_v1 => [
        "CREATE TABLE repos (
             name TEXT NOT NULL PRIMARY KEY,
             commit_time INT NOT NULL
         )",
    ],
    upgrade_to_v2 => [
        # we lose data :p but this distro first released at v2 anyway
        "DROP TABLE repos",
        "CREATE TABLE repos (
             name TEXT NOT NULL PRIMARY KEY,
             commit_time INT,
             status_time INT,
             pull_time INT
         )",
    ],
    install => [
        "CREATE TABLE repos (
             name TEXT NOT NULL PRIMARY KEY,
             commit_time INT,
             status_time INT,
             pull_time INT
         )",
    ],
};

my %common_args = (
    reposdb_path => {
        schema => 'str*', # XXX path
    },
);

my %repo_arg = (
    repo => {
        schema => 'str*',
        pos => 0,
    },
);

sub _set_args_default {
    require Cwd;

    my ($args, $set_repo_default) = @_;

    $args->{reposdb_path} //= "$ENV{HOME}/repos.db";
    if ($set_repo_default) {
        my $repo;
        {
            my $cwd = Cwd::getcwd();
            while (1) {
                if (-d ".git") {
                    ($repo = $cwd) =~ s!.+/!!;
                    last;
                }
                chdir ".." or last;
                $cwd =~ s!(.+)/.+!$1! or last;
            }
        }
        $args->{repo} = $repo;
    }
}

sub _connect_db {
    require DBI;
    require SQL::Schema::Versioned;

    my $args = shift;
    my $dbh = DBI->connect("dbi:SQLite:dbname=$args->{reposdb_path}", "", "",
                           {RaiseError=>1});
    my $res = SQL::Schema::Versioned::create_or_update_db_schema(
        dbh => $dbh, spec => $db_schema_spec);
    die "Cannot create/update database schema: $res->[0] - $res->[1]"
        unless $res->[0] == 200;

    $dbh;
}

$SPEC{list_repos} = {
    v => 1.1,
    summary => 'List repositories registered in repos.db',
    args => {
        %common_args,
        detail => {
            schema => 'bool',
            cmdline_aliases => {l=>{}},
        },
    },
};
sub list_repos {
    my %args = @_;

    _set_args_default(\%args);
    my $dbh = _connect_db(\%args);

    my @res;
    my $sth = $dbh->prepare("SELECT * FROM repos");
    $sth->execute;
    while (my $row = $sth->fetchrow_hashref) {
        push @res, $row;
    }

    my $resmeta = {};
    if ($args{detail}) {
        $resmeta->{'table.fields'} =
            [qw/name commit_time status_time pull_time/];
    } else {
        @res = map { $_->{name} } @res;
    }

    [200, "OK", \@res, $resmeta];
}

$SPEC{touch_repo} = {
    v => 1.1,
    args => {
        %common_args,
        %repo_arg,
        commit_time => {
            schema => [bool => is=>1],
        },
        status_time => {
            schema => [bool => is=>1],
        },
        pull_time => {
            schema => [bool => is=>1],
        },
        to => {
            schema => 'date*',
        },
    },
    args_rels => {
        req_some => [1, 3, [qw/commit_time status_time pull_time/]],
    },
};
sub touch_repo {
    my %args = @_;

    _set_args_default(\%args, 1);
    my $dbh = _connect_db(\%args);

    return [400, "Please specify repo name"] unless defined $args{repo};

    $dbh->begin_work;
    $dbh->do("INSERT OR IGNORE INTO repos (name) VALUES (?)", {},
             $args{repo});
    my $now = time();
    if ($args{commit_time}) {
        $dbh->do("UPDATE repos SET commit_time=? WHERE name=?", {},
                 $now, $args{repo});
    }
    if ($args{status_time}) {
        $dbh->do("UPDATE repos SET status_time=? WHERE name=?", {},
                 $now, $args{repo});
    }
    if ($args{pull_time}) {
        $dbh->do("UPDATE repos SET pull_time=? WHERE name=?", {},
                 $now, $args{repo});
    }
    $dbh->commit;
    [200];
}

1;
# ABSTRACT: Utility to manipulate repos.db

__END__

=pod

=encoding UTF-8

=head1 NAME

App::reposdb - Utility to manipulate repos.db

=head1 VERSION

This document describes version 0.001 of App::reposdb (from Perl distribution App-reposdb), released on 2016-06-12.

=head1 SYNOPSIS

See L<reposdb>.

=head1 DESCRIPTION

=head1 FUNCTIONS


=head2 list_repos(%args) -> [status, msg, result, meta]

List repositories registered in repos.db.

This function is not exported.

Arguments ('*' denotes required arguments):

=over 4

=item * B<detail> => I<bool>

=item * B<reposdb_path> => I<str>

=back

Returns an enveloped result (an array).

First element (status) is an integer containing HTTP status code
(200 means OK, 4xx caller error, 5xx function error). Second element
(msg) is a string containing error message, or 'OK' if status is
200. Third element (result) is optional, the actual result. Fourth
element (meta) is called result metadata and is optional, a hash
that contains extra information.

Return value:  (any)


=head2 touch_repo(%args) -> [status, msg, result, meta]

This function is not exported.

Arguments ('*' denotes required arguments):

=over 4

=item * B<commit_time> => I<bool>

=item * B<pull_time> => I<bool>

=item * B<repo> => I<str>

=item * B<reposdb_path> => I<str>

=item * B<status_time> => I<bool>

=item * B<to> => I<date>

=back

Returns an enveloped result (an array).

First element (status) is an integer containing HTTP status code
(200 means OK, 4xx caller error, 5xx function error). Second element
(msg) is a string containing error message, or 'OK' if status is
200. Third element (result) is optional, the actual result. Fourth
element (meta) is called result metadata and is optional, a hash
that contains extra information.

Return value:  (any)

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/App-reposdb>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-App-reposdb>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-reposdb>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2016 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
