#! /usr/bin/perl

use strict ;
use warnings ;

use DBI ;
use DBD::SQLite ;
use IO::File ;

package OBB ;

# use base 'OBB' ; __PACKAGE__ -> mk_getset ( qw(attr ...) ) ;

sub mk_getset
  { my $self = shift ;
    my @bads = grep ! /^[A-Za-z_]\w*$/, @_ ; die "bad attr [@bads]\n" if @bads ;
    my $sub  = <<'SUB' ;
sub %s::%s { my $self = shift ; $self -> {%s} = shift if @_ ; $self -> {%s} ; }
SUB
    eval sprintf $sub, $self, $_, $_, $_ for @_ ;
  }
sub New  { my $self = shift ; bless { _err => '' }, $self ; }
sub Defs { () ; }
sub Init
  { my $self = shift ;
    my %opts = ( $self -> Defs, @_ ) ;
    my @opts = keys %opts ;
    @$self { @opts } = @opts { @opts } ;
    $self ;
  }
sub Make  { my $self = shift ; $self -> New -> Init ( @_ ) ; }
sub Reset { my $self = shift ; $self -> _err ( '' ) ; $self ; }
sub Err   { my $self = shift ; $self -> _err ( @_ ) ; }

__PACKAGE__ -> mk_getset ( qw(_err) ) ;

1 ;

package TS ;

use Carp qw(confess) ;

use base 'OBB' ; __PACKAGE__ -> mk_getset
  ( qw(file name atrs dbh _tst) ) ;

our $TIME = '_time' ;
our $opt = {} ; sub set_opts { my $self = shift ; $opt = shift ; }
sub optx { my $x = shift ; $opt -> { $x } ; }
sub optv { optx ( 'v' ) ; }
sub optd { optx ( 'd' ) ; }
sub A_is { confess "! #args == $_[0]" unless $_[1] == $_[0] ; }
sub A_ge { confess "! #args >= $_[0]" unless $_[1] >= $_[0] ; }
sub A_in
  { my ( $lst, $cnt ) = @_ ;
    my ( $min, $max ) = @$lst ; my $txt = "[$min,$max]" ;
    confess "#args ($cnt) not in $txt" unless $min <= $cnt and $cnt <= $max ;
  }

sub Defs { ( file => '', name => 'data', atrs => [] ) ; }

sub connect
  { my $self = shift -> Reset ;
    my $file = $self -> file ;
    my $res  = 0 ;
    unless ( $file )
      { $self -> Err ( 'no file' ) ; }
    else
      { my $dbh = DBI -> connect ( "dbi:SQLite:dbname=$file", "", "") ;
        $res = !! $self -> dbh ( $dbh ) ;
      }
    $res ;
  }

sub disconnect
  { my $self = shift -> Reset ;
    my $dbh  = $self -> dbh ;
    my $res  = 0 ;
    unless ( $dbh )
      { $self -> Err ( 'not connected' ) ; }
    elsif ( $dbh -> disconnect )
      { $self -> dbh ( undef ) ; $res = 1 ; }
    else
      { $self -> Err ( "can't disconnect" ) ; }
    $res ;
  }

sub _table_info
  { my $self = shift ;
    my $dbh  = $self -> dbh ;
    my $res  = undef ;
    return $res unless $dbh ;
    my $sth = $dbh -> table_info ( undef, undef, '%', 'TABLE' ) ;
    if ( $sth )
      { $res = $sth -> fetchall_arrayref ; }
    else
      { $self -> Err ( "_table_info : can't" ) ; }
    $res ;
  }

sub _column_info
  { my $self = shift ;
    my $name = shift ;
    my $dbh  = $self -> dbh  ;
    my $res  = undef ;
    return $res unless $dbh and $name ;
    my $sth = $dbh -> column_info ( undef, undef, $name, '%' ) ;
    if ( $sth )
      { $res = $sth -> fetchall_arrayref ; }
    else
      { $self -> Err ( "_column_info : can't" ) ; }
    $res ;
  }

sub _tabs
  { A_is 1, scalar @_ ;
    my $self = shift -> Reset ;
    my $info = $self -> _table_info ;
    my $res  = undef ;
    if ( $info )
      { $res = [ sort map { $_ -> [2] ; } @$info ] ; }
    else
      { $self -> Err ( "_table_info : can't" ) ; }
    $res ;
  }

sub _cols
  { A_is 2, scalar @_ ;
    my $self = shift -> Reset ;
    my $name = shift ;
    my $info = $self -> _column_info ( $name ) ;
    my $res  = undef ;
    if ( $info )
      { $res = [ sort map { $_ -> [3] ; } @$info ] ; }
    else
      { $self -> Err ( "_column_info : can't" ) ; }
    $res ;
  }

sub user_cols
  { A_is 2, scalar @_ ;
    my $self = shift ;
    my $res  = [ grep $_ ne $TIME, @{ $self -> _cols ( @_ ) } ] ;
    wantarray ? @$res : $res ;
  }

sub has_tab
  { A_is 2, scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    scalar grep $_ eq $name, @{ $self -> _tabs } ;
  }

sub add_tab_sql
  { A_in [2,3], scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    my $cols = shift || [] ;
    sprintf "CREATE TABLE %s ( %s integer primary key %s )"
      , $name, $TS::TIME
      , ( @$cols ? map { ", $_" ; } @$cols : '' ) ;
  }

sub add_tab
  { A_is 2, scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    my $res = 1 ;
    unless ( $self -> has_tab ( $name ) )
      { $res = $self -> dbh -> do ( $self -> add_tab_sql ( $name ) ) ;
        printf "added table $name\n" ;
      }
    elsif ( optv )
      { printf "already have table $name\n" ; }
    $res ;
  }

sub del_tab
  { A_is 2, scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    printf "%s table $name\n",
      $self -> has_tab ( $name ) ? 'drop' : '[warn] no' ;
    !! $self -> dbh -> do ( "DROP TABLE IF EXISTS $name" ) ;
  }

sub has_col
  { A_is 3, scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    my $col  = shift ;
    scalar grep $_ eq $col, @{ $self -> _cols ( $name ) } ;
  }

sub add_col
  { A_is 3, scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    my $col  = shift ;
    my $res  = 1 ;
    unless ( $self -> has_col ( $name, $col ) )
      { $res = $self -> dbh -> do ( "ALTER TABLE $name ADD COLUMN $col real" ) ;
        printf "added field $name.$col\n" ;
      }
    elsif ( optv )
      { printf "already have $name.$col\n" ; }
    $res ;
  }

sub _upd_cols_sql
  { A_is 3, scalar @_ ;
    my $name = shift ;
    my $olds = shift ; # list of old names
    my $news = shift ; # list of new names
    my $time = $TS::TIME ;
    my $TIME = "$time integer primary key" ;
    my $oldnams = join ',', $time, @$olds ;
    my $newnams = join ',', $time, @$news ;
    my $oldtyps = join ',', $TIME, map { "$_ real" ; } @$olds ;
    my $newtyps = join ',', $TIME, map { "$_ real" ; } @$news ;
    my $tnam    = "tmp_$name" ;
    my $SQL = <<SQL ;
BEGIN TRANSACTION;
CREATE TEMPORARY TABLE tmp_$name ( $newtyps ) ;
INSERT INTO $tnam ( $newnams ) SELECT $oldnams FROM $name ;
DROP TABLE $name ;
CREATE TABLE $name ( $newtyps ) ;
INSERT INTO $name ( $newnams ) SELECT $newnams FROM $tnam ;
DROP TABLE $tnam ;
COMMIT;
SQL
  }

sub move_col
  { A_is 4, scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    my $old  = shift ;
    my $new  = shift ;
    my $res  = 0 ;
    unless ( $self -> has_col ( $name, $old ) )
      { printf "[err] don't have $name.$old\n" ; }
    elsif ( $old eq $new )
      { printf "[warn] old [$old] == new [$new]\n" ; $res = 1 ; }
    elsif ( $old eq $TS::TIME )
      { printf "[warn] won't move $TS::TIME\n" ; }
    elsif ( $self -> has_col ( $name, $new ) )
      { printf "[err] already have $name.$new\n" ; }
    else
      { printf "move $name.$old $name.$new\n" ;
        my $olds = [ sort $self -> user_cols ( $name ) ] ;
        my $news = [ map { $_ eq $old ? $new : $_ } @$olds ] ;
        my $SQL = _upd_cols_sql $name, $olds, $news ;
        print $SQL if optd ;
        $res = !! $self -> dbh -> do ( $_ ) for split "\n", $SQL ;
      }
    $res ;
  }

sub drop_cols
  { A_ge 3, scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    my @cols = @_ ;
    my %keep ; $keep { $_ } ++ for $self -> user_cols ( $name ) ;
    my $drps = 0 ;
    my $res  = 0 ;
    for my $col ( @cols )
      { if ( $col eq $TS::TIME )
          { printf "[err] won't drop $name.$col\n" ; }
        elsif ( $keep { $col } )
          { printf "drop $name.$col\n" ; $drps ++ ; delete $keep { $col } ; }
        else
          { printf "[err] no $name.$col\n" ; }
      }
    my $keeps = scalar keys %keep ;
    unless ( $keeps )
      { $res = $self -> del_tab ( $name ) ; }
    elsif ( $drps )
      { my $keep = [ sort keys %keep ] ;
        my $SQL = _upd_cols_sql $name, $keep, $keep ;
        print $SQL if optd ;
        $res = !! $self -> dbh -> do ( $_ ) for split "\n", $SQL ;
      }
    else # no change
      { print "no change\n" ; $res = 1 ; }
    $res ;
  }

sub has_row
  { A_is 3, scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    my $time = shift ;
    my $dbh  = $self -> dbh ;
    my $SQL = sprintf "SELECT count(*) as res FROM %s WHERE %s = ?"
      , $name, $TS::TIME, $time ;
    printf "${SQL} ; [%s]\n", $time if optd ;
    $SQL .= "\n" ;
    my $sth = $dbh -> prepare ( $SQL ) or confess "can't prepare $SQL" ;
    $sth -> execute ( $time ) ;
    my $row = $sth -> fetchrow_hashref or confess "can't fetchrow $SQL" ;
    my $res = $row -> {res} ; $sth -> finish ;
    $res ;
  }

sub select_all
  { A_is 2, scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    my $dbh  = $self -> dbh ;
    my $res  = [] ;
    my $SQL = sprintf "SELECT * FROM %s ORDER by %s"
      , $name, $TS::TIME ;
    unless ( $self -> has_tab ( $name ) )
      { printf "no table $name\n" ; return [] ; }
    printf "${SQL}\n" if optd ;
    my $sth = $dbh -> prepare ( $SQL ) or confess "can't prepare $SQL" ;
    $sth -> execute () ;
    while ( my $row = $sth -> fetchrow_hashref )
      { push @$res, $row }
    $res ;
  }

sub check
  { my $self = shift ;
    my $res  = 1 ;
    for my $name ( sort @{ $self -> _tabs } )
      { unless ( $self -> has_col ( $name, $TIME ) )
          { printf "[err] no column $TIME in $name" ; $res = 0 ; }
      }
    $res ;
  }

sub save_hash
  { A_in [3,4], scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    my $hash = shift ;
    my $time = shift || $^T ;
    my @cols = () ;
    my @vals = () ;
    my $SQL  ;

    for my $atr ( sort keys %$hash )
      { my $val = $hash -> { $atr } ;
        if ( $self -> has_col ( $name, $atr ) )
          { push @cols, $atr ; push @vals, $val ; }
        else
          { printf "[warn] no $name.$atr ignore [%s]\n", ( $val || '' ) ; }
      }

    unless ( @cols ) { printf "[err] no valid attrs\n" ; return 0 ; }

    if ( $self -> has_row ( $name, $time ) )
      { my $ulst = join ',', map "$_ = ?", @cols ;
        $SQL = sprintf "UPDATE %s SET %s WHERE %s = %s"
          , $name, $ulst, $TS::TIME, $time ;
      }
    else
      { my $clst = join ',', @cols ;
        my $vlst = join ',', map '?', @cols ;
        $SQL = sprintf "INSERT INTO %s ( %s, %s ) VALUES ( %s, %s )"
          , $name, $TS::TIME, $clst, $time, $vlst ;
      }
    printf "${SQL} ; [%s]\n", join ',', map { $_ || '' ; } @vals ; # if optd ;
    $SQL .= "\n" ;
    my $sth = $self -> dbh -> prepare ( $SQL ) or confess "can't prep $SQL" ;
    $sth -> execute ( @vals ) ? $time : 0 ;
  }

sub insert_tups
  { A_is 4, scalar @_ ;
    my $self = shift ;
    my $name = shift ;
    my $nams = shift ;
    my $tups = shift ;
    my @cols = () ;
    my @idxs = () ;
    my $res  = 1 ; 

    unless ( grep $_ eq $TS::TIME, @$nams )
      { printf "[err] no $TS::TIME in tuples?\n" ; return 0 ; }

    my $idx  = 0 ;
    for my $nam ( @$nams )
      { if ( $self -> has_col ( $name, $nam ) )
          { push @cols, $nam ; push @idxs, $idx ; }
        else
          { print "[warn] no $name.$nam ; ignore\n" ; }
        $idx ++ ;
      }

    unless ( @cols ) { printf "[err] no valid attrs\n" ; return 0 ; }

    my $clst = join ',', @cols ;
    my $vlst = join ',', map '?', @cols ;
    my $SQL = sprintf "INSERT INTO %s ( %s ) VALUES ( %s )"
      , $name, $clst, $vlst ;

    printf "${SQL} ; \@tup[%s]\n", join ',', map { $_ ; } @idxs if optd ;
    $SQL .= "\n" ;
    my $dbh = $self -> dbh ;
    my $sth ;
    my $cnt = 0 ;
    $dbh -> begin_work or die $dbh -> errstr ;
    $sth = $dbh -> prepare ( $SQL ) or confess "can't prep $SQL" ;
    for my $tup ( @$tups )
      { my $r = ( $sth -> execute ( @$tup [ @idxs ] ) ? $res : 0 ) ;
        die "bad tup [@$tup]\n" unless $r ;
        $res &= $r ;
        $cnt ++ ;
      }
    $dbh -> commit or die $dbh -> errstr ;
    ( $res ? scalar @$tups : 0 ) ;
  }

# <!-- 2015-04-10 10:40:00 CEST / 1428655200 -->
# <row>
#   <v>3.5678548862e+04</v><v>2.3976067612e+04</v><v>4.8400726350e+04</v>
# </row>
sub read_rrd
  { A_is 2, scalar @_ ;
    my $self = shift ;
    my $file = shift ;
    my $nams = [ $TS::TIME ] ;
    my $tups = [] ;
    my $FILE = new IO::File "rrdtool dump $file|" ;
    die "[err] can't dump $file ($!)\n" unless defined $FILE ;
    while ( <$FILE> )
      { if ( m!<name>\s*(\S*)\s*</name>! )
          { push @$nams, $1 ; }
        elsif ( m!/\s+(\d+)\s+-->\s*<row><v>\s*(.*)\s*</v></row>! )
          { my $time = $1 ;
            my $vals =
              [ map { $_ eq 'NaN' ? undef : $_ } split m!</v><v>!, $2 ] ;
            if ( grep defined $_, @$vals )
              { unshift @$vals, $time ; push @$tups, $vals ; }
          }
      }
    close $FILE ;
    { nams => $nams , tups => $tups } ;
  }

1 ;