package App::bif;
use strict;
use warnings;
use feature 'state';
use utf8;    # for render_table
use Bif::Mo;
use Carp ();
use Config::Tiny;
use File::HomeDir;
use Log::Any qw/$log/;
use Path::Tiny qw/path rootdir cwd/;

our $VERSION = '0.1.5_3';
our $pager;

sub DBVERSION { 1 }
sub MSWin32   { $^O eq 'MSWin32' }

has debug => (
    is => 'rw',
);

has db => (
    is      => 'ro',
    default => \&_build_db,
);

has dbw => (
    is      => 'rw',           # for bif-new-repo?
    default => \&_build_dbw,
);

has _colours => (
    is      => 'ro',
    default => {},
);

has config => (
    is      => 'ro',
    default => {},
);

has no_pager => (
    is      => 'rw',
    default => sub {
        my $self = shift;
        return ( !-t STDOUT ) || $self->opts->{no_pager};
    },
);

has now => (
    is      => 'ro',
    default => sub { time },
);

has opts => (
    is       => 'ro',
    required => 1,
);

has repo => (
    is      => 'rw',            # needed by init
    default => \&_build_repo,
);

has term_width => (
    is      => 'ro',
    default => sub {
        my $width;
        if (MSWin32) {
            require Term::Size::Win32;
            $width = ( Term::Size::Win32::chars(*STDOUT) )[0] || 80;
        }
        else {
            require Term::Size::Perl;
            $width = ( Term::Size::Perl::chars(*STDOUT) )[0] || 80;
        }
        $log->debugf( 'bif: terminal width %d', $width );
        return $width;
    },
);

has term_height => (
    is      => 'ro',
    default => sub {
        my $height;
        if (MSWin32) {
            require Term::Size::Win32;
            $height = ( Term::Size::Win32::chars(*STDOUT) )[1] || 40;
        }
        else {
            require Term::Size::Perl;
            $height = ( Term::Size::Perl::chars(*STDOUT) )[1] || 40;
        }
        $log->debugf( 'bif: terminal height %d', $height );
        return $height;
    },
);

has user_repo => (
    is      => 'ro',
    default => \&_build_user_repo,
);

has user_db => (
    is      => 'ro',
    default => \&_build_user_db,
);

has user_dbw => (
    is      => 'ro',
    default => \&_build_user_dbw,
);

has work_buffer => ( is => 'rw', );

sub BUILD {
    my $self = shift;
    my $opts = $self->opts;

    # For Term::ANSIColor
    $ENV{ANSI_COLORS_DISABLED} //= $opts->{no_color} || !-t STDOUT;

    binmode STDIN,  ':encoding(utf8)';
    binmode STDOUT, ':encoding(utf8)';

    if ($self->debug($self->debug // $opts->{debug})) {
        require Log::Any::Adapter;
        if ( exists $INC{'Test/More.pm'} ) {

            # Log::Any::Adapter::Diag can be found in t/lib/
            Log::Any::Adapter->set('Diag');
        }
        else {
            Log::Any::Adapter->set('+App::bif::LAA');
        }
        $self->start_pager();
    }

    $log->infof( 'bif: %s %s', ref $self, $opts );

    return;
}

sub _build_user_repo {
    my $self = shift;
    my $repo = path( File::HomeDir->my_home, '.bifu' )->absolute;

    $self->err( 'UserRepoNotFound',
        'user repository not found (try "bif init -u -i")' )
      unless -d $repo;

    $log->debug( 'bif: user_repo: ' . $repo );

    my $file = $repo->child('config');
    return $repo unless $file->exists;

    my $config = $self->config;
    my $conf = Config::Tiny->read( $file, 'utf8' )
      || return $self->err( 'ConfigNotFound',
        $file . ' ' . Config::Tiny->errstr );

    # Merge in the repo config with the current context (user) config
    while ( my ( $k1, $v1 ) = each %$conf ) {
        if ( ref $v1 eq 'HASH' ) {
            while ( my ( $k2, $v2 ) = each %$v1 ) {
                if ( $k1 eq '_' ) {
                    $config->{$k2} = $v2;
                }
                else {
                    $config->{$k1}->{$k2} = $v2;
                }
            }
        }
        else {
            $config->{$k1} = $v1;
        }
    }

    return $repo;
}

sub _build_repo {
    my $self = shift;
    $self->user_repo;    # build user repo first

    my $repo = $self->find_repo('.bif')
      || $self->err( 'RepoNotFound', 'directory not found: .bif' );

    $log->debug( 'bif: repo: ' . $repo );

    my $file = $repo->child('config');
    return $repo unless $file->exists;

    $log->debug( 'bif: repo_conf: ' . $file );

    # Trigger user config
    $self->user_repo;

    my $config = $self->config;
    my $conf = Config::Tiny->read( $file, 'utf8' )
      || return $self->err( 'ConfigNotFound',
        $file . ' ' . Config::Tiny->errstr );

    # Merge in the repo config with the current context (user) config
    while ( my ( $k1, $v1 ) = each %$conf ) {
        if ( ref $v1 eq 'HASH' ) {
            while ( my ( $k2, $v2 ) = each %$v1 ) {
                if ( $k1 eq '_' ) {
                    $config->{$k2} = $v2;
                }
                else {
                    $config->{$k1}->{$k2} = $v2;
                }
            }
        }
        else {
            $config->{$k1} = $v1;
        }
    }

    return $repo;
}

sub dbfile {
    my $self    = shift;
    my $version = shift;
    return sprintf( 'db-v%d.sqlite3', $version );
}

sub _build_user_db {
    my $self = shift;
    my $file = $self->user_repo->child( $self->dbfile( $self->DBVERSION ) );

    return $self->err( 'DBNotFound', 'database not found: %s', $file )
      unless -f $file;

    my $dsn = 'dbi:SQLite:dbname=' . $file;

    require Bif::DB;
    my $db =
      Bif::DB->connect( $dsn, undef, undef, undef, $self->opts->{debug} );

    $log->debug( 'bif: user_db: ' . $dsn );
    $log->debug( 'bif: SQLite version: ' . $db->{sqlite_version} );

    return $db;
}

sub _build_user_dbw {
    my $self = shift;
    my $file = $self->user_repo->child( $self->dbfile( $self->DBVERSION ) );

    return $self->err( 'DBNotFound', 'database not found: %s', $file )
      unless -f $file;

    my $dsn = 'dbi:SQLite:dbname=' . $file;

    require Bif::DBW;
    my $dbw =
      Bif::DBW->connect( $dsn, undef, undef, undef, $self->opts->{debug} );

    $log->debug( 'bif: user_dbw: ' . $dsn );
    $log->debug( 'bif: SQLite version: ' . $dbw->{sqlite_version} );

    return $dbw;
}

sub _build_db {
    my $self = shift;
    my $file = $self->repo->child( $self->dbfile( $self->DBVERSION ) );

    return $self->err( 'DBNotFound', 'database not found: %s', $file )
      unless -f $file;

    my $dsn = 'dbi:SQLite:dbname=' . $file;

    require Bif::DB;
    my $db =
      Bif::DB->connect( $dsn, undef, undef, undef, $self->opts->{debug} );

    $log->debug( 'bif: db: ' . $dsn );
    $log->debug( 'bif: SQLite version: ' . $db->{sqlite_version} );

    return $db;
}

sub _build_dbw {
    my $self = shift;
    my $file = $self->repo->child( $self->dbfile( $self->DBVERSION ) );

    return $self->err( 'DBNotFound', 'database not found: %s', $file )
      unless -f $file;

    my $dsn = 'dbi:SQLite:dbname=' . $file;

    require Bif::DBW;
    my $dbw =
      Bif::DBW->connect( $dsn, undef, undef, undef, $self->opts->{debug} );

    $log->debug( 'bif: dbw: ' . $dsn );
    $log->debug( 'bif: SQLite version: ' . $dbw->{sqlite_version} );

    return $dbw;
}

### class methods ###

sub new_cmd {
    my $self  = shift;
    my $class = shift;

    Carp::croak($@) unless eval "require $class;";

    return $class->new( %$self, @_ );
}

sub dispatch {
    my $self  = shift;
    my $class = shift;
    my $ref   = shift || {};

    Carp::croak($@) unless eval "require $class;";

    return $class->new( %$self, %$ref )->run;
}

# Run user defined aliases
sub run {
    my $self  = shift;
    my $opts  = $self->opts;
    my @cmd   = @{ $opts->{alias} };
    my $alias = shift @cmd;

    use File::HomeDir;
    use Path::Tiny;

    my $repo = path( File::HomeDir->my_home, '.bifu' );
    die usage(qq{unknown COMMAND or ALIAS "$alias"}) unless -d $repo;

    # Trigger user config
    $self->user_repo;
    my $str = $self->config->{'user.alias'}->{$alias}
      or die usage(qq{unknown COMMAND or ALIAS "$alias"});

    # Make sure these options are correctly passed through (or not)
    delete $opts->{alias};
    $opts->{debug}     = undef if exists $opts->{debug};
    $opts->{no_pager}  = undef if exists $opts->{no_pager};
    $opts->{no_color}  = undef if exists $opts->{no_color};
    $opts->{user_repo} = undef if exists $opts->{user_repo};

    unshift( @cmd, split( ' ', $str ) );

    use OptArgs qw/class_optargs/;
    my ( $class, $newopts ) = OptArgs::class_optargs( 'App::bif', $opts, @cmd );

    return $class->new(
        opts      => $newopts,
        user_repo => $self->user_repo,
    )->run;
}

sub find_repo {
    my $self = shift;
    my $name = shift;

    return $self->user_repo if $self->opts->{user_repo};

    my $try = cwd;

    while (1) {
        if ( -d ( my $repo = $try->child($name) ) ) {
            return $repo;
        }
        elsif ( -f $repo ) { # inside a repo directory
            return $try;
        }
        last if $try->is_rootdir;
        $try = $try->parent;
    }

    return;
}

sub colours {
    my $self = shift;
    state $have_term_ansicolor = require Term::ANSIColor;

    return map { '' } @_ if $self->opts->{no_color};

    my $ref = $self->_colours;
    map { $ref->{$_} //= Term::ANSIColor::color($_) } @_;
    return map { $ref->{$_} } @_ if wantarray;
    return $ref->{ $_[0] };
}

sub header {
    my $self = shift;
    state $reset = $self->colours(qw/reset/);
    state $dark  = $self->colours(qw/dark/);

    my ( $key, $val, $val2 ) = @_;
    return [
        ( $key ? $key . ':' : '' ) . $reset,
        $val . ( defined $val2 ? $dark . ' <' . $val2 . '>' : '' ) . $reset
    ];
}

sub s2hms {
    my $self = shift;
    my $s    = shift;

    return sprintf(
        '%+0.2d:%0.2d:%0.2d',
        int( $s / 3600 ),
        int( ( $s - 3600 * int( $s / 3600 ) ) / 60 ),
        $s % 60
    );
}

sub s2hm {
    my $self = shift;
    my $s    = shift;

    return sprintf( '%+0.2d:%0.2d',
        int( $s / 3600 ),
        int( $s - 3600 * int( $s / 3600 ) ) / 60 );
}

sub datetime2s {
    my $self   = shift;
    my $dt     = shift;
    my $new_dt = $dt;

    if ( $dt =~ m/^(\d?\d):(\d{2})$/ ) {
        my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
          localtime(time);

        $new_dt = sprintf(
            '%0.4d-%0.2d-%0.2d %0.2d:%0.2d:%0.2d',
            $year + 1900,
            $mon + 1, $mday, $1, $2, 0
        );
    }
    elsif ( $dt =~ m/^(\d{2}):(\d{2}):(\d{2})$/ ) {
        my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
          localtime(time);

        $new_dt = sprintf(
            '%0.4d-%0.2d-%0.2d %0.2d:%0.2d:%0.2d',
            $year + 1900,
            $mon + 1, $mday, $1, $2, $3
        );
    }
    elsif ( $dt =~ m/^yesterday (\d?\d):(\d{2})$/ ) {
        my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
          localtime( time - 24 * 60 * 60 );

        $new_dt = sprintf(
            '%0.4d-%0.2d-%0.2d %0.2d:%0.2d:%0.2d',
            $year + 1900,
            $mon + 1, $mday, $1, $2, 0
        );
    }
    elsif ( $dt =~ m/^yesterday (\d?\d):(\d{2}):(\d{2})$/ ) {
        my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
          localtime( time - 24 * 60 * 60 );

        $new_dt = sprintf(
            '%0.4d-%0.2d-%0.2d %0.2d:%0.2d:%0.2d',
            $year + 1900,
            $mon + 1, $mday, $1, $2, $3
        );
    }
    elsif ( $dt =~ m/^(\d{4})-(\d{2})-(\d{2})$/ ) {
        $new_dt .= $dt . ' 00:00:00';
    }
    elsif ( $dt =~ m/^(\d{4})-(\d{2})-(\d{2}) (\d?\d):(\d{2})$/ ) {
        $new_dt = $dt . ':00';
    }

    $log->debugf( 'datetime2s "%s" -> "%s"', $dt, $new_dt );
    if ( $new_dt =~ m/^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/ ) {
        require Time::Local;
        return Time::Local::timelocal( $6, $5, $4, $3, $2 - 1, $1 - 1900 );
    }

    return $self->err( 'InvalidDateTime', 'invalid date/time string: %s', $dt );
}

sub ctime_ago {
    my $self = shift;
    my $row  = shift;

    state $have_time_piece    = require Time::Piece;
    state $have_time_duration = require Time::Duration;

    use locale;

    return (
        Time::Duration::ago( $row->{ctime_age}, 1 ),
        Time::Piece->strptime( $row->{ctime} + $row->{ctimetz}, '%s' )
          ->strftime('%a %F %R ') . $row->{ctimetzhm}
    );
}

sub mtime_ago {
    my $self = shift;
    my $row  = shift;

    state $have_time_piece    = require Time::Piece;
    state $have_time_duration = require Time::Duration;

    use locale;

    return (
        Time::Duration::ago( $row->{mtime_age}, 1 ),
        Time::Piece->strptime( $row->{mtime} + $row->{mtimetz}, '%s' )
          ->strftime('%a %F %R ') . $row->{mtimetzhm}
    );
}

sub err {
    my $self = shift;
    Carp::croak('err($type, $msg, [$arg])') unless @_ >= 2;
    my $err = shift;
    my $msg = shift;

    die $msg if eval { $msg->isa('Bif::Error') };
    my ( $red, $reset ) = $self->colours(qw/red reset/);

    $msg = $red . 'error:' . $reset . ' ' . $msg . "\n";

    die Bif::Error->new( $self->opts, $err, $msg, @_ );
}

sub ok {
    my $self = shift;
    Carp::croak('ok($type, [$arg])') unless @_;
    my $ok = shift;
    return Bif::OK->new( $self->opts, $ok, @_ );
}

sub start_pager {
    my $self  = shift;
    my $lines = shift;

    return if $pager or $self->no_pager;

    if ($lines) {
        my $term_height = $self->term_height;
        if ( $lines <= $term_height ) {
            $log->debug("bif: no start_pager ($lines <= $term_height)");
            return;
        }
    }

    local $ENV{'LESS'} = '-FXeR';
    local $ENV{'MORE'} = '-FXer' unless MSWin32;

    require App::bif::Pager;
    $pager = App::bif::Pager->new;

    $log->debugf( 'bif: start_pager (fileno: %d)', fileno( $pager->fh ) );

    return $pager;
}

sub end_pager {
    my $self = shift;
    return unless $pager;

    $log->debug('bif: end_pager');
    $pager = undef;
    return;
}

sub user_id {
    my $self = shift;
    my $id   = $self->db->xval(
        select => 'bif.identity_id',
        from   => 'bifkv bif',
        where  => { 'bif.key' => 'self' },
    );
    return $id;
}

sub uuid2id {
    my $self = shift;
    my $try  = shift // Carp::confess 'uuid2id needs defined';
    my $opts = $self->opts;
    Carp::croak 'usage' if @_;

    return $try unless exists $opts->{uuid} && $opts->{uuid};
    my @list = $self->db->uuid2id($try);

    return $self->err( 'UuidNotFound', "uuid not found: $try" )
      unless @list;

    return $self->err( 'UuidAmbiguous',
        "ambiguious uuid: $try\n    "
          . join( "\n    ", map { "$_->[1] -> ID:$_->[0]" } @list ) )
      if @list > 1;

    return $list[0]->[0];
}

sub get_project {
    my $self = shift;
    my $path = shift // Carp::confess 'path must be defined';
    my $db   = $self->db;

    my @matches = $db->get_projects($path);

    return $self->err( 'ProjectNotFound', "project not found: $path" )
      unless @matches;

    return $matches[0] if 1 == @matches;

    return $self->err( 'AmbiguousPath',
        "ambiguous path \"$path\" matches the following:\n" . '    '
          . join( "\n    ", map { "$_->{path}" } @matches ) );
}

sub get_hub {
    my $self = shift;
    my $name = shift;
    my $db   = $self->db;

    if ( $name =~ m/^(\d+)$/ ) {
        return $db->xhashref(
            select     => [qw/h.id p.name t.kind t.uuid t.first_change_id/],
            from       => 'hubs h',
            inner_join => 'projects p',
            on         => 'p.id = h.id',
            inner_join => 'topics t',
            on         => 't.id = h.id',
            where      => { 'h.id' => $name },
        );
    }

    my ($hub) = $db->xhashref(
        select           => [qw/h.id p.name t.kind t.uuid t.first_change_id/],
        from             => 'hubs h',
        inner_join       => 'projects p',
        on               => 'p.id = h.id',
        inner_join       => 'topics t',
        on               => 't.id = h.id',
        where            => { 'p.name' => $self->uuid2id($name) },
        union_all_select => [qw/h.id p.name t.kind t.uuid t.first_change_id/],
        from             => 'hub_repos hr',
        inner_join       => 'hubs h',
        on               => 'h.id = hr.hub_id',
        inner_join       => 'topics t',
        on               => 't.id = h.id',
        inner_join       => 'projects p',
        on               => 'p.id = h.id',
        where            => { 'hr.location' => $name },
    );

    return $self->err( 'HubNotFound', "hub not found: $name" )
      unless $hub;

    return $hub;
}

sub render_table {
    my $self   = shift;
    my $format = shift;
    my $header = shift;
    my $data   = shift;
    my $indent = shift || 0;

    my ( $white, $dark, $reset ) = $self->colours(qw/yellow dark reset/);
    require Text::FormatTable;

    my $table = Text::FormatTable->new($format);

    if ($header) {
        $header->[0] = $white . $header->[0];
        push( @$header, ( pop @$header ) . $reset );
        $table->head(@$header);
    }

    foreach my $row (@$data) {
        $table->row(@$row);
    }

    my $term_width = $self->term_width;
    return $table->render($term_width) unless $indent;

    my $str = $table->render( $term_width - $indent );

    my $prefix = ' ' x $indent;
    $str =~ s/^/$prefix/gm;
    return $str;
}

sub prompt_edit {
    my $self = shift;
    my %args = (
        opts           => {},
        abort_on_empty => 1,
        val            => '',
        @_,
    );

    $args{txt} //= "\n";
    $args{txt} .= " 
# Please enter your message. Lines starting with '#'
# are ignored. Empty content aborts.
#
";

    my $now = time;

    foreach my $key ( sort keys %{ $args{opts} } ) {
        next if $key =~ m/^_/;
        next unless defined $args{opts}->{$key};
        $args{txt} .= "#     $key: $args{opts}->{$key}\n";
    }

    require IO::Prompt::Tiny;
    if ( IO::Prompt::Tiny::_is_interactive() ) {
        require App::bif::Editor;
        $args{val} = App::bif::Editor->new( txt => $args{txt} )->result;
    }

    $args{val} =~ s/^#.*//gm;
    $args{val} =~ s/^\n+//s;
    $args{val} =~ s/\n*$/\n/s;

    if ( $args{abort_on_empty} ) {
        return $self->err( 'EmptyContent', 'aborting due to empty content.' )
          if $args{val} =~ m/^[\s\n]*$/s;
    }

    return $args{val};
}

my $old = '';

sub lprint {
    my $self = shift;
    my $msg  = shift;

    if ( $pager or $self->opts->{debug} ) {
        return print $msg . "\n";
    }

    local $| = 1;

    my $chars = print ' ' x length($old), "\b" x length($old), $msg, "\r";
    $old = $msg =~ m/\n/ ? '' : $msg;
    return $chars;
}

sub get_change {
    my $self            = shift;
    my $token           = shift // Carp::croak('get_change needs defined');
    my $first_change_id = shift;

    return $self->err( 'InvalidChangeID',
        "invalid change ID (must be cID): $token" )
      unless $token =~ m/^c(\d+)$/;

    my $id = $1;
    my $db = $self->db;

    my $data = $db->xhashref(
        select => [ 'c.id AS id', 'c.uuid AS uuid', ],
        from   => 'changes c',
        where => { 'c.id' => $id },
    );

    return $self->err( 'ChangeNotFound', "change not found: $token" )
      unless $data;

    if ($first_change_id) {
        my $t = $db->xhashref(
            select => 1,
            from   => 'changes_tree ct',
            where  => {
                'ct.child'  => $id,
                'ct.parent' => $first_change_id,
            },
        );

        return $self->err( 'FirstChangeMismatch',
            'first change id mismatch: c%d / c%d',
            $first_change_id, $id )
          unless $t;
    }

    return $data;
}

sub get_topic {
    my $self = shift;

    my $token = shift // Carp::confess('get_topic needs defined');
    my $kind  = shift;
    my $db    = $self->db;

    state $have_qv = DBIx::ThinSQL->import(qw/ qv bv /);

    if ( $token =~ m/^\d+$/ ) {
        my $data = $db->xhashref(
            select => [
                't.id AS id',
                't.kind AS kind',
                't.uuid AS uuid',
                't.first_change_id AS first_change_id',
            ],
            from  => 'topics t',
            where => { 't.id' => $token },
        );

        return $self->err( 'WrongKind', 'topic (%s) is not a %s: %d',
            $data->{kind}, $kind, $token )
          if $data && $kind && $kind ne $data->{kind};

        return $data if $data;
    }

    my $pinfo = eval { $self->get_project($token) };
    die $@ if ( $@ && $@->isa('Bif::Error::AmbiguousPath') );
    return $pinfo if $pinfo;

    $kind ||= 'topic';
    return $self->err( 'TopicNotFound', "$kind not found: $token" );
}

sub current_work {
    my $self = shift;
    return $self->dbw->xhashref(
        select => [
            't.id AS id',
            't.kind AS kind',
            'tp.path AS path',
            'wb.start AS start',
            'wb.billable AS billable',
        ],
        from       => 'work_buffers wb',
        inner_join => 'topics t',
        on         => 't.id = wb.topic_id',
        inner_join => 'topic_path tp',
        on         => 'tp.id = t.id',
        where      => { 'wb.stop' => undef },
    );
}

sub start_work {
    my $self = shift;
    my $args = {@_};
    my $dbw  = $self->dbw;

    if ( $args->{save} ) {
        my $ref = $dbw->xhashref(
            select => '*',
            from   => 'work_buffers',
            where  => { stop => undef },
        );

        if ($ref) {
            $self->stop_work( stop => $args->{start} );
            $self->work_buffer($ref);
        }
    }

    return $self->dbw->xdo(
        insert_into => 'work_buffers',
        values      => {
            topic_id      => $args->{id},
            start         => $args->{start},
            start_comment => $args->{start_comment},
            stop          => $args->{stop},
            stop_comment  => $args->{stop_comment},
            billable      => $args->{billable},
        },
    );
}

sub stop_work {
    my $self = shift;
    my $args = {@_};
    my $dbw  = $self->dbw;

    $dbw->xdo(
        update => 'work_buffers',
        set    => {
            stop         => $args->{stop},
            stop_comment => $args->{stop_comment},
        },
        where => { stop => undef },
    );

    if ( $args->{restore} and my $ref = $self->work_buffer ) {

        $self->start_work(
            id            => $ref->{topic_id},
            start         => $args->{stop},
            start_comment => $ref->{start_comment},
            billable      => $ref->{billable},
        );

        $self->work_buffer(undef);
    }
}

sub new_change {
    my $self = shift;
    my %vals = @_;
    my $dbw  = $self->dbw;

    $vals{id} ||= $dbw->nextval('changes');
    my ( $author, $author_contact, $author_contact_method, $author_shortname )
      = $dbw->xlist(
        select     => [qw/e.name ecm.mvalue ecm.method i.shortname/],
        from       => 'bifkv b',
        inner_join => 'entities e',
        on         => 'e.id = b.identity_id',
        inner_join => 'identities i',
        on         => 'i.id = b.identity_id',
        inner_join => 'entity_contact_methods ecm',
        on         => 'ecm.id = e.default_contact_method_id',
        where      => { key => 'self' },
      );
    $vals{author}                //= $author;
    $vals{author_contact}        //= $author_contact;
    $vals{author_contact_method} //= $author_contact_method;
    $vals{author_shortname}      //= $author_shortname;

    return $self->err( 'NoSelfIdentity',
        'no "self" identity defined at change begin' )
      unless $vals{author};

    $dbw->xdo(
        insert_into => 'func_begin_change',
        values      => \%vals,
    );

    return $vals{id};
}

sub check {
    my $self = shift;
    my $id   = shift;
    my $db   = shift || $self->db;

    state $have_changeset = require Bif::DB::Plugin::ChangeUUIDv1;
    state $have_yaml      = require YAML::Tiny;
    state $have_encode    = require Encode;
    state $have_digest    = require Digest::SHA;

    my $changeset =
      $db->uchangeset_v1($id) || Carp::croak "invalid change.id: $id";

    my $begin = shift @$changeset;
    my $end   = pop @$changeset;
    my $uuid  = delete $end->{uuid};
    my $short = substr( $uuid, 0, 8 );

    foreach my $x (@$changeset) {
        next
          unless ref $x eq 'HASH'
          && exists $x->{_delta}
          && $x->{_delta} =~ m/^new_/;

        delete $x->{uuid};
    }

    my $yaml = YAML::Tiny::Dump( [ $begin, @$changeset, $end ] );
    my $sha1 = Digest::SHA::sha1_hex( Encode::encode( 'UTF-8', $yaml ) );

    my $action = $db->xval(
        select => ['c.action'],
        from   => 'changes c',
        where  => { 'c.id' => $id },
    );

    my ( $red, $reset ) = $self->colours( 'red', 'reset' );
    return ( 1, "[change: $id <$short>] $action" ) if $uuid eq $sha1;
    return ( 0, "[change: $id <$short>] $action ${red}INVALID$reset" );
}

sub end_change {
    my $self = shift;
    my $dbw  = $self->dbw;
    my %args = @_;

    my $iid = $dbw->xval(
        select => [ 'bif.identity_id', ],
        from   => 'bifkv bif',
        where  => { 'bif.key' => 'self' },
    );

    return $self->err( 'NoSelfIdentity',
        'no "self" identity defined at change end' )
      unless $iid;

    $dbw->xdo(
        insert_into => 'func_end_change',
        values      => {
            identity_id => $iid,
            %args,
        },
    );

    $dbw->xdo(
        insert_into => 'func_merge_changes',
        values      => { merge => 1 },
    );

    my $change_id = $dbw->xval( select => 'currval("changes")' );
    my ( $ok, $str ) = $self->check( $change_id, $dbw );
    return print $str. "\n" if $ok;

    # Show the diff to see what's wrong
    $self->new_cmd(
        'App::bif::show::change',
        db   => $self->dbw,    # to make current txn visible
        opts => {
            uid  => 'c' . $change_id,
            diff => 1,
        }
    )->run;

    my $keep_invalid = $dbw->xval(
        select => 'bool_val',
        from   => 'bifkv',
        where  => { key => 'keep_invalid' },
    );
    return $self->err( 'InvalidUUID', $str ) unless $keep_invalid;
    return print $str;
}

sub DESTROY {
    my $self = shift;
    Log::Any::Adapter->remove( $self->{_bif_log_any_adapter} )
      if $self->{_bif_log_any_adapter};
}

package Bif::OK;
use overload
  bool     => sub { 1 },
  '""'     => \&as_string,
  fallback => 1;

sub new {
    my $proto = shift;
    my $opts  = shift;
    $opts->{_bif_ok_type} = shift || Carp::confess('missing type');
    $opts->{_bif_ok_msg}  = shift || '';
    $opts->{_bif_ok_msg} = sprintf( $opts->{_bif_ok_msg}, @_ ) if @_;

    my $class = $proto . '::' . $opts->{_bif_ok_type};
    {
        no strict 'refs';
        *{ $class . '::ISA' } = [$proto];
    }

    return bless {%$opts}, $class;
}

sub as_string {
    my $self = shift;
    return $self->{_bif_ok_msg}
      if $self->{_bif_ok_msg} && !ref $self->{_bif_ok_msg};
    return ref $self;
}

package Bif::Error;
use overload
  bool     => sub { 1 },
  fallback => 1;

our @ISA = ('Bif::OK');

1;

__END__

=head1 NAME

=for bif-doc #perl

App::bif - A base class for App::bif::* commands

=head1 VERSION

0.1.5_3 (2015-06-30)

=head1 SYNOPSIS

    # In App/bif/command/name.pm
    use strict;
    use warnings;
    use parent 'App::bif';

    sub run {
        my $self = shift;
        my $db   = $self->db;
        my $data = $db->xarrayref(...);

        return $self->err( 'SomeFailure', 'something failed' )
          if ( $self->{command_option} );

        $self->start_pager;

        print $self->render_table( ' r  l  l ',
            [qw/ ID Title Status /], $data, );



        return $self->ok('CommandName');
    }

=head1 DESCRIPTION

B<App::bif> provides a context/configuration class for bif commands to
inherit from.  The above synopsis is the basic template for any bif
command. At run time the C<run> method is called.

B<App::bif> sets the encoding of C<STDOUT> and C<STDIN> to utf-8 when
it is loaded.

=head1 CONSTRUCTOR

=over 4

=item new( opts => $opts )

Initializes the common elements of all bif scripts. Requires the
options hashref as provided by L<OptArgs> but also returns it.

=over

=item * Sets the package variable C<$App::bif::STDOUT_TERMINAL> to
true if C<STDOUT> is connected to a terminal.

=item * Sets the environment variable C<ANSI_COLORS_DISABLED> to
1 if C<STDOUT> is I<not> connected to a terminal, in order to disable
L<Term::ANSIColor> functions.

=item * Starts a pager if C<--debug> is true, unless C<--no-pager> is
also set to true or C<STDOUT> is not connected to a terminal.

=item * Adds unfiltered logging via L<Log::Any::Adapter::Stdout>.

=back

=back


=head1 ATTRIBUTES

To be documented.

=head1 METHODS

=over 4

=item colours( @colours ) -> @codes

Calls C<color()> from L<Term::ANSIColor> on every string from
C<@colours> and returns the results. Returns empty strings if the
environment variable C<$ANSI_COLORS_DISABLED> is true (set by the
C<--no-color> option).

=item header( $key, $val, $val2 ) -> ArrayRef

Returns a two or three element arrayref formatted as so:

    ["$key:", $val, "<$val2>"]

Colours are used to make the $val2 variable darker. The result is
generally used when rendering tables by log and show commands.

=item ago( $epoch, $offset ) -> $string, $timestamp

Uses L<Time::Duration> to generate a human readable $string indicating
how long ago UTC $epoch was (with $offset in +/- seconds) plus a
regular timestamp string.

=item err( $err, $message, [ @args ])

Throws an exception that stringifies to C<$message> prefixed with
"fatal: ". The exception is an object from the C<Bif::Error::$err>
class which is used by test scripts to reliably detect the type of
error. If C<@args> exists then C<$message> is assumed to be a format
string to be converted with L<sprintf>.

=item ok( $type, [ $arg ])

Returns a C<Bif::OK::$type> object, either as a reference to C<$arg> or
as a reference to the class name. Every App::bif::* command should
return such an object, which can be tested for by tests.

=item start_pager([ $rows ])

Start a pager (less, more, etc) on STDOUT using L<IO::Pager>, provided
that C<--no-pager> has not been used. The pager handle encoding is set
to utf-8. If the optional C<$rows> has been given then the pager will
only be started if L<Term::Size> reports the height of the terminal as
being less than C<$rows>.

=item end_pager

Stops the pager on STDOUT if it was previously started.

=item user_repo -> Path::Tiny

Returns the location of the user repository directory.  Raises a
'UserRepoNotFound' error on failure.

=item user_db -> Bif::DB::db

Returns a read-only handle for the SQLite database containing
user-specific data.

=item user_dbw -> Bif::DBW::db

Returns a read-write handle for the SQLite database containing
user-specific data.

=item repo -> Path::Tiny

Return the path to the first '.bif' directory found starting from the
current working directory and searching upwards. Raises a
'RepoNotFound' error on failure.

=item db -> Bif::DB::db

Returns a handle for the SQLite database in the current respository (as
found by C<bif_repo>). The handle is only good for read operations -
use C<$self->dbw> when inserting,updating or deleting from the
database.

You should manually import any L<DBIx::ThinSQL> functions you need only
after calling C<bif_db>, in order to keep startup time short for cases
such as when the repository is not found.

=item dbw -> Bif::DBW::db

Returns a handle for the SQLite database in the current respository (as
found by C<bif_repo>). The handle is good for INSERT, UPDATE and DELETE
operations.

You should manually import any L<DBIx::ThinSQL> functions you need only
after calling C<$self->dbw>, in order to keep startup time short for
cases such as when the repository is not found.

=item new_cmd($class, %attrs)

Loads C<$class> and creates a new object from that class populated with
the attributes from C<$self> plus the attributes in the C<%attrs> HASH.

=item dispatch($class, $attrs)

Loads the bif class C<$class>, creates a new object populated with the
attributes from C<$self> plus the attributes in the HASHref C<$attrs>
and runs the C<run()> method.

=item run

B<App::bif> is responsible for expanding user aliases and redispatching
to the actual command. Needs to be documented .... sorry.

=item user_id -> Int

Returns the topic ID for the user (self) identity.

=item uuid2id( $try ) -> Int

Returns C<$try> unless a C<< $self->{uuid} >> option has been set.
Returns C<< Bif::DB->uuid2id($try) >> if the lookup succeeds or else
raises an error.

=item get_project( $path ) -> HashRef

Calls C<get_project> from C<Bif::DB> and returns a single hashref.
Raises an error if no project is found.  C<$path> is interpreted as a
string of the form C<PROJECT[@HUB]>.

=item get_hub( $name ) -> HashRef

Looks up the hub where $name is either the topic ID, the hub name, or a
hub location and returns the equivalent of C<get_topic($ID)> plus the
hub name.

=item render_table( $format, \@header, \@data, [ $indent ] ) -> Str

Uses L<Text::FormatTable> to construct a table of <@data>, aligned and
spaced according to C<$format>, preceded by a C<@header>. If C<$indent>
is greater than zero then the entire table is indented by that number
of spaces.

=item prompt_edit( %options ) -> Str

If the environment is interactive this function will invoke an editor
and return the result. All comment lines (beginning with '#') are
removed. TODO: describe %options.

=item lprint( $msg ) -> Int

If a pager is not active this method prints C<$msg> to STDOUT and
returns the cursor to the beginning of the line.  The next call
over-writes the previously printed text before printing the new
C<$msg>. In this way a continually updating status can be displayed.

=item get_change( $CID, [$first_change_id] ) -> HashRef

Looks up the change identified by C<$CID> (of the form "c23") and
returns a hash reference containg the following keys:

=over

=item * id - the change ID

=item * uuid - the universally unique identifier of the change

=back

An ChangeNotFound error will be raised if the change does not exist. If
C<$first_change_id> is provided then a check will be made to ensure
that that C<$CID> is a child of <$first_change_id> with a
FirstChangeMismatch error thrown if that is not the case.

=item get_topic( $TOKEN ) -> HashRef

Looks up the topic identified by C<$TOKEN> and returns undef or a hash
reference containg the following keys:

=over

=item * id - the topic ID

=item * first_change_id - the change_id that created the topic

=item * kind - the type of the topic

=item * uuid - the universally unique identifier of the topic

=back

=item current_work -> HashRef

Returns a hashref representing the currently open work buffer:

=over

=item * id

=item * kind

=item * path

=item * start

=item * billable

=back

=item start_work(%opts)

Creates a new entry in the work_buffers table.

=over

=item * id

=item * start

=item * start_comment

=item * stop

=item * stop_comment

=item * billable

=item * restore

=back

=item stop_work(%opts)

Finalizes an open entry in the work_buffers table.

=over

=item * stop

=item * stop_comment

=item * save

=back

=item new_change( %args ) -> Int

Creates a new row in the changes table according to the content of
C<%args> (must include at least a C<message> value) and the current
context (identity). Returns the integer ID of the change.

=item check( $id ) -> (Bool,Str)

Computes the uuid of the change $id and compares it against the stored
uuid value. Returns two variables: the first is a true/false scalar
indicating validity, and the second is a human-readable status string.

A valid uuid example:

    [u.a83372c(.11)] some action string

An invalid uuid example:

    [u.328ea8b(.12)] another action string INVALID

=item s2hms($seconds) -> '+hh:mm:ss'

Converts the integer C<$seconds> into a string representing the hours,
minutes and seconds that make up the delta.

=item s2hm($seconds) -> '+hh:mm'

Converts the integer C<$seconds> into a string representing the hours
and minutes that make up the delta.

=item datetime2s($str) -> $epoch

Converts a partial date/time string into a UNIX epoch, with certain
assumptions as to the date. Accepts the following variations:

=over

=item * [h]h:mm

=item * [h]h:mm:ss

=item * yesterday [h]h:mm

=item * yesterday [h]h:mm:ss

=item * yyyy-mm-dd

=item * yyyy-mm-dd [h]h:mm

=item * yyyy-mm-dd [h]h:mm:ss

=back

=back

=head1 SEE ALSO

L<Bif::DB>, L<Bif::DBW>

=head1 AUTHOR

Mark Lawrence E<lt>nomad@null.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2013-2015 Mark Lawrence <nomad@null.net>

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 3 of the License, or (at your
option) any later version.



