#! /usr/bin/perl -w

use strict ;
use Carp ;
use csbase ;
use DBI ;
our $PRG = 'repocafe' ;
our $VER = '0.6' ;

$Carp::Verbose = 1 ;

our %TABLE_NAMES =
  ( repos  => [ 'Repos'        , 'repos' ]
  , guests => [ 'Guests'       , 'repo_guests' ]
  , rights => [ 'Rights'       , 'repo_rights' ]
  , groups => [ 'Groups'       , 'repo_groups' ]
  , gr_mem => [ 'GroupMembers' , 'repo_group_members' ]
  , stats  => [ 'Stats'        , 'repo_stats'  ]
  , xusers => [ 'Xusers'       , 'repo_xusers' ]
  ) ;

our $KW_LDAP = 'ldap' ; sub KW_LDAP { $KW_LDAP ; }
our $KW_CLAS = 'clas' ; sub KW_CLAS { $KW_CLAS ; }
our $KW_TREE = 'tree' ; sub KW_TREE { $KW_TREE ; }

package Base ; #####################################################

use base 'Exporter' ;
use Carp ;

our @ISA = qw(Exporter) ;
our @EXPORT = qw(mk_method mk_methods unref) ;

sub Version { "$PRG version $VER" ; }
sub version { "$PRG-$VER" ; }

sub unref  { my $self = shift ; ref $self or $self ; }
sub pref__ { my @x = @_ ; sprintf "%s\n", join "", map "  $_", @x ; }

sub inst
  { my $self = shift ;
    my @args = @_ ;
    my $res = bless {}, unref $self ;
    $res -> init ( @args ) ;
    $res ;
  }

sub _getset
  { my $self = shift ;
    my $attr = shift ;
    Carp::confess "self not ref ($self)" unless ref $self ;
    if ( @_ ) { $self -> { $attr } = shift ; }
    Carp::confess "no attr '$attr' ($self)" unless exists $self -> { $attr } ;
    $self -> { $attr } ;
  }

sub mk_method
  { my $self = shift ;
    my $attr = shift ;
    sprintf 'sub %s { my $self = shift ; $self -> _getset ( "%s",  @_ ) ; }'
      , $attr, $attr ;
  }

sub mk_methods
  { my $self = shift ;
    join "\n", map { Base -> mk_method ( $_ ) ; } @_ ;
  }

sub dmp
  { my $self  = shift ;
    my $depth = shift || 0 ;
    printf "self : %s\n", ref $self ;
    for my $key ( sort %$self )
      { printf "%s%s : %s\n" , ' ' x 2 * $depth , $key , $self -> { $key } ; }
  }

package Repocafe ; #################################################

our @ISA = qw(Base) ;

our %opt = ( v => 0 , d => 0 , q => 0 ) ;
sub _opt
  { my ( $key, $val ) = @_ ;
    unless ( exists $opt { $key } )
      { Carp::confess "unknown option '$key'\n" ; }
    elsif ( defined $val )
      { Carp::confess "_opt : bad arg ($val)" if $val eq 'Repocafe' ;
        $opt { $key } = $val ;
      }
    $opt { $key } ;
  }

sub verbose { _opt ( 'v', shift ) ; }
sub quiet   { _opt ( 'q', shift ) ; }
sub debug   { _opt ( 'd', shift ) ; }

sub set_opt
  { my %opts = @_ ;
    $opts{v} ||= $opts{d}  ;
    Repocafe::verbose ( $opts{v} ) ;
    Repocafe::quiet   ( $opts{q} ) ;
    Repocafe::debug   ( $opts{d} ) ;
  }

eval Base -> mk_methods
  ( qw(conf db repos guests rights groups gr_mem stats xusers) ) ;

sub new
  { my $self = shift ;
    my $path = shift ;
    my $_noc = shift ;
    my $cafe = bless {}, $self ;
    my $conf = $cafe -> get_config ( $path ) ;
    my $base = Repocafe::Db -> new ( $cafe ) ;
    $cafe -> db ( $base ) ;
    $cafe -> db_connect unless $_noc ;
    $cafe -> new_pack ( 'repos' ) ;
    $cafe -> new_pack ( 'rights' ) ;
    $cafe -> new_pack ( 'guests' ) ;
    $cafe -> new_pack ( 'groups' ) ;
    $cafe -> new_pack ( 'gr_mem' ) ;
    $cafe -> new_pack ( 'stats'  ) ;
    $cafe -> new_pack ( 'xusers' ) ;
    $cafe ;
  }

sub db_connect_as
  { my $self = shift ;
    my $conf = $self -> conf ;
    my $user = shift || $conf -> db_user ;
    my $pswd = shift || $conf -> db_pswd ;
    my $db_host = $conf -> db_host ;
    my $db_name = $conf -> db_name ;
    printf "db connect : host %s, db %s, user %s\n",
      $db_host, $db_name, $user if Repocafe::verbose ;
    my $dbh = DBI ->
      connect
        ( "dbi:Pg:dbname=$db_name;host=$db_host", $user, $pswd
        , { RaiseError => 1, AutoCommit => 1 }
        ) or die $DBI::errstr ;
    $self -> db -> set_dbh ( $dbh ) ;
  }

sub db_connect
  { my $self = shift ;
    my $conf = $self -> conf ;
    $self -> db_connect_as ( $conf -> db_user, $conf -> db_pswd ) ;
  }

sub new_pack
  { my $self = shift ;
    my $name = shift ;
    my $pack = $self -> pack_name  ( $name ) ;
    my $tnam = $self -> table_name ( $name ) ;
    $self -> $name ( $pack -> inst ( $self, $tnam ) ) ;
  }

sub config_list
  { my $self = shift ;
    my $home = ( getpwuid $< ) [ 7 ] or die "can get homedir '$<' ($!)" ;
      ( "$PRG.conf", "$home/.$PRG.conf", "/etc/$PRG.conf" ) ;
  }

sub find_config
  { my $self = shift ;
    my $arg = shift ;
    my @LIST = $arg ? ( $arg ) : Repocafe -> config_list ;
    for my $conf ( @LIST ) { return $conf if -f $conf ; }
    die sprintf "can't find a config file :\n  %s\n" , join "\n  ", @LIST ;
  }

sub get_config
  { my $self = shift ;
    my $path = shift ;
    my $file = $self -> find_config ( $path ) ; # or die
    $self -> conf ( Repocafe::Conf -> new ( $self, $file ) ) ;
  }

sub pack_name
  { my $self = shift ;
    my $name = shift ;
    my $tnam = $TABLE_NAMES { $name } ;
    Carp::croak "can't find name for pack ($name)" unless defined $tnam ;
    'Repocafe::' . $tnam -> [ 0 ] ;
  }

sub table_name
  { my $self = shift ;
    my $name = shift ;
    my $tnam = $TABLE_NAMES { $name } ;
    Carp::croak "can't find name for table ($name)" unless defined $tnam ;
    $self -> conf -> db_pref . $tnam -> [ 1 ] ;
  }

sub lookups
  { my $self = shift ;
    my $uids = {} ; for ( @_ ) { $uids -> { $_ } ++ ; }
    my $res  = [] ;
    for my $uclas ( @{ $self -> conf -> clas_list } )
      { for my $user ( @{ $uclas -> lookups ( keys %$uids ) } )
          { push @$res, $user ; delete $uids -> { $user -> login } ; }
      }
    $res ;
  }

package Repocafe::Conf ; ###########################################

our @ISA = qw(Base) ;

our %CNF_defaults =
  ( db_pref           => ''
  , db_owner          => ''
  , db_opswd          => ''
  , file_access       => 'svnaccessfile'
  , file_guests       => 'guestusers'
  , file_log          => 'repocafe_log'
  , cmd_perl          => '/usr/bin/perl'
  , cmd_svnadmin      => '/usr/bin/svnadmin'
  , cmd_svnlook       => '/usr/bin/svnlook'
  , cmd_commit_email  => '/usr/bin/perl commit-email.pl'
  , top_rules_usage   => ''
  , aux_rules_usage   => ''
  , top_statistics    => ''
  , aux_statistics    => ''
  , create_guests     => ''
  , viewvc            => 1
  , mail_from_admin   => ''
  , mail_from_noreply => ''
  , $KW_LDAP => {}
  , $KW_CLAS => []
  , $KW_TREE => {}
  ) ;

our @REQ_KEYS =
  qw(organisation dir_admin dir_data dir_www
     www_user www_group www_server www_contact www_secret
     db_host db_name db_user db_pswd admin_user admin_group
    ) ;

our %CNF_KEYS ;
for ( @REQ_KEYS, keys %CNF_defaults ) { $CNF_KEYS { $_ } ++ ; }

eval Base -> mk_methods
  ( keys %CNF_KEYS, qw(root cafe ldaps clases clas_list trees) ) ;

sub new
  { my $self = shift ;
    my $cafe = shift ;
    my $file = shift ;
    my $res = bless { %CNF_defaults }, $self ;
    $res -> root ( $file ) ;
    $res -> cafe ( $cafe ) ;
    $res -> get_conf () ;
  }

sub _split
  { my $str = shift ; map { $_ eq 'EMPTY' ? '' : $_ } split ' ', $str ; }

sub get_conf
  { my $self = shift ;
    my $FILE = ( @_ ? shift : $self -> root ) ;
    my $cafe = $self -> cafe ;
    my $err  = '' ;

    if ( grep $_ eq $FILE,  @{ $self -> {_include} } )
      { die "already included : '$FILE'" ; }
    else
      { push @{ $self -> {_include} }, $FILE ; }

    open FILE, $FILE or die "can't open '$FILE' ($!)" ;
    my $CONF = join "\n", grep /./, <FILE> ;
    close FILE ;

    $CONF =~ s/\t/ /g ;           # replace tabs
    $CONF =~ s/^[+ ]+// ;         # delete leading space, plus
    $CONF =~ s/\n\n\s+/ /g ;      # glue continuation lines
    $CONF =~ s/\n\n\+\s+//g ;     # glue concatenation lines
    $CONF =~ s/\n\n\./\n/g ;      # glue concatenation lines

    chop $CONF ;
    print "--$CONF--\n" if Repocafe::debug () ;
    for ( grep ! /^#/, split /\n\n/, $CONF )
      { my ($key,$val) = split ' ', $_, 2 ;
        $val = '' unless defined $val ;
        $val = '' if $val eq 'EMPTY' ;
        print "conf '$FILE' : key '$key', val '$val'\n" if Repocafe::debug () ;
        if ( exists $CNF_KEYS { $key } )
          { my $ref = exists $self -> { $key } && ref ( $self -> $key ) ;
            if ( $ref and $ref eq 'ARRAY' )
              { push @{ $self -> $key }, [ _split $val ] ; }
            elsif ( $ref and $ref eq 'HASH' )
              { my ( $k, @v ) = _split $val ;
                $self -> $key -> { $k } = [ @v ] ;
              }
            else
              { $self -> $key ( $val ) ; }
          }
        elsif ( $key eq 'show' )
          { $self -> show_conf if Repocafe::verbose () ; }
        elsif ( $key eq 'no_viewvc' )
          { $self -> viewvc ( 0 ) ; }
        elsif ( $key eq 'exit' )
          { die 'exit per config directive' ; }
        elsif ( $key eq 'include' )
          { $self -> get_conf ( $val ) ; }
        elsif ( $key eq 'env' )
          { my ( $x, $y ) = split ' ' , $val ;
            $ENV { $x } = $y ;
            printf "config : setenv '%s'\n   '%s'\n", $x, $y
              if Repocafe::verbose () ;
          }
        else
          { $self -> show_conf ;
            die "unknown keyword '$key' (value '$val')\n" ;
          }
      }

    my $ldaps = {} ;
    for my $tag ( keys %{ $self -> { $KW_LDAP } } )
      { my $row = $self -> ldap -> { $tag } ;
        my $cnt = @$row ;
        $err .= "- wrong number of fields ($cnt) for ldap $tag\n"
          unless 2 <= $cnt and $cnt <= 3 ;
        my $val =
          { tag  => $tag
          , serv => $row -> [ 0 ]
          , base => $row -> [ 1 ]
          , dscr => ( $row -> [ 2 ] || $tag )
          } ;
        $val -> { dscr } =~ s/_/ /g ;
        my $ldap = Repocafe::Ldap -> new ;
        $ldaps -> { $tag } = $ldap -> init ( $val ) ;
      }
    $self -> ldaps ( $ldaps ) ;

    my @clas_list = () ;
    for my $row ( @{ $self -> { $KW_CLAS } } )
      { my $val = {} ;
        my $clas = $row -> [ 0 ] ;
        my $uclas ;
        if ( $row -> [ 1 ] eq 'table' )
          { my $cnt = @$row ;
            $err .= "- clas ($clas) : wrong number of fields ($cnt)\n"
              unless 6 <= $cnt and $cnt <= 7 ;
            $val =
              { clas  => $row -> [ 0 ]
              , typ   => $row -> [ 1 ]
              , table => $row -> [ 2 ]
              , login => $row -> [ 3 ]
              , paswd => $row -> [ 4 ]
              , cname => $row -> [ 5 ]
              , dscr  => $row -> [ 6 ]
              } ;
            $uclas = Repocafe::Clas::Table -> new ;
          }
        elsif ( $row -> [ 1 ] eq 'ldap' )
          { my $cnt = @$row ;
            my $tag = $row -> [ 2 ] ;
            $err .= "- clas ($clas) : wrong number of fields ($cnt)\n"
              unless 4 <= $cnt and $cnt <= 5 ;
            $err .= "- clas ($clas) : ldap ($tag) not found\n"
              unless exists $ldaps -> { $tag } ;
            $val =
              { clas => $row -> [ 0 ]
              , typ  => $row -> [ 1 ]
              , tag  => $row -> [ 2 ]
              , pat  => $row -> [ 3 ]
              , dscr => $row -> [ 4 ]
              , ldap => $ldaps -> { $tag }
              } ;
            $uclas = Repocafe::Clas::Ldap -> new ;
          }
        $val -> { dscr } ||= $clas ;
        $val -> { dscr } =~ s/_/ /g ;
        $val -> { cafe } = $cafe ;
        push @clas_list, $uclas -> init ( $val ) ;
      }
    $self -> clas_list ( [ @clas_list ] ) ;
    my %clases = () ;
    for my $uclas ( @clas_list )
      { $clases { $uclas -> clas } = $uclas ; }
    $self -> clases ( %clases ) ;

    my $trees = $self -> { $KW_TREE } ;
    for my $path ( keys %$trees )
      { my $row = $trees -> { $path } ;
        my @creas = split /,/, ( $row -> [ 1 ] || '' ) ;
        for my $crea ( sort @creas )
          { $err .= "- tree ($path) : clas ($crea) not found\n"
              unless exists $clases { $crea } ;
          }
        my $val =
          { pref => $row -> [ 0 ]
          , crea => [ @creas ]
          } ;
        $trees -> { $path } = $val ;
      }

    my $create_guests = $self -> create_guests ;
    my $new_crg = {} ;
    for my $clas ( split ' ', $create_guests )
      { $new_crg -> { $clas } ++ ; }
    $self -> create_guests ( $new_crg ) ;

    $self -> { mail_from_admin    } ||= $self -> { www_contact } ;
    $self -> { mail_from_noreply  } ||=
      sprintf '%s@%s', 'svn-no-reply'
        , ( $self -> { www_server } || 'no-host' ) ;

### checks

    my $tag = 'config error' ;
    for my $key ( @REQ_KEYS )
      { $err .= "- missing config for '$key'\n" 
          unless exists $self -> { $key } ;
      }

{   my $key = $KW_CLAS ;
    if ( exists $self -> { $key } and 0 == @{ $self -> { $key } } )
      { $err .= "- missing config line(s) '$key'\n" }
    $key = $KW_TREE ;
    if ( exists $self -> { $key } and 0 == keys %{ $self -> { $key } } )
      { $err .= "- missing config line(s) '$key'\n" }
}

    for my $clas ( sort keys %{ $self -> { create_guests } } )
      { $err .= "- create_guests : clas ($clas) not found\n"
          unless exists $clases { $clas } ;
      }

    my $pref = $self -> db_pref ;
    $err .= "- database prefix ($pref) should be all lowercase\n"
      if $pref ne lc $pref ;
    $err .= "- database prefix ($pref) should be alpha-numeric\n"
      if $pref and $pref !~ /^[a-z]\w*$/ ;
    
    die sprintf "config errors in root: %s\n%s", $self -> root, $err if $err ;
    $self ;
  }

sub show_conf
  { my $self = shift ;
    print "vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv\n" ;
    for my $key ( sort keys %$self )
      { next if $key =~ m/^_/ ;
        my $val = $self -> { $key } ;
        print "$key = '$val'\n" ;
        if ( ref $val eq 'ARRAY' and scalar @$val )
          { printf "  %s\n", join "\n  ", @$val ; }
        elsif ( ref $val eq 'HASH' and scalar keys %$val )
          { for my $k ( sort keys %$val )
              { printf "  %s = %s\n", $k, $val -> { $k } ; }
          }
      }
    printf "included '%s'\n"
      , join "', '", @{ $self -> {_include} } ;
    print "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n" ;
  }

sub dir_repos { my $self = shift ; $self -> dir_data . '/repos' ; }

package Repocafe::Db ; #############################################

our @ISA = qw(Base) ;

# eval Base -> mk_methods ( qw(dbh) ) ;

sub new
  { my $self = shift ;
    my $cafe = shift ;
    my $conf = $cafe -> conf ;
    my $scheme  = $conf -> dir_admin . '/lib/scheme.dat' ;
    my $table_names = [ map { $_ -> [ 1 ] } values %TABLE_NAMES ] ;
    my $CSBASE = CSBASE -> new
      ( $scheme, $conf -> db_pref, $table_names ) ;
    die $CSBASE unless ref $CSBASE ;
    CSBASE -> set_opt ( 'n' ) ;
    $CSBASE ;
  }

package Repocafe::Table ; ##########################################

eval Base -> mk_methods ( qw(CAFE TAB) ) ;

sub init
  { my $self = shift ;
    my $cafe = shift ;
    my $tabl = shift ;
    $self -> CAFE ( $cafe ) ;
    $self -> TAB
      ( ref $tabl
      ? $tabl
      : $cafe -> db -> tabbyname ( $tabl )
      ) ;
    $self ;
  }

sub dbh
  { my $self = shift ;
    $self -> TAB -> base -> dbh ;
  }

sub get_data
  { my $self = shift ;
    my $qwe  = shift ;
    die "no table defined ($self)" unless defined $self -> { TAB } ;
    $self -> TAB -> get_data ( $qwe ) ;
  }

sub get_rec
  { my $self = shift ;
    my $qwe  = shift ;
    die "no table defined" unless defined $self -> { TAB } ;
    $self -> TAB -> get_rec ( $qwe ) ;
  }

sub dmp
  { my $self = shift ;
    my $sep = shift || '' ;
    my $res = '' ;
    for my $key ( sort keys %$self )
      { my $val = $self -> { $key } ;
        $res .= sprintf "%skey '%s' (%s)\n", $sep, $key, $val unless ref $val ;
      }
    $res . "\n" ;
  }

package Repocafe::Repos ; ##########################################

our @ISA       = qw(Base Repocafe::Table Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;

eval Base -> mk_methods ( qw(id side ownr name dscr publ lock rights) ) ;

sub new
  { my $self = shift ;
    my $rec  = shift ;
    my $cafe = $self -> CAFE ;
    my $tabl = $self -> TAB ;
    bless $rec, unref $self ;
    $rec -> init ( $cafe, $tabl ) ;
    my $rights = $cafe -> rights -> get_by_rid ( $rec -> { id } ) ;
    $rec -> rights ( $rights ) ;
    $rec ;
  }

sub get_by_qwe
  { my $self = shift ;
    my $qwe  = shift ;
    my $res = [] ;
    $qwe = ( $qwe ? "WHERE $qwe" : '' ) ;
    my $row = $self -> get_data ( $qwe ) ;
    if ( defined $row )
      { for my $key ( keys %$row )
          { push @$res, $self -> new ( $row -> { $key } ) ; }
      }
    $res ;
  }

sub get_by_id
  { my $self = shift ;
    my $rid  = shift ;
    my $qwe = "id = '$rid'" ;
    my $res = $self -> get_by_qwe ( $qwe ) ;
    if ( ( my $cnt = scalar @$res ) != 1 )
      { die "cnt ($cnt) for $qwe" ; }
    pop @$res ;
  }

sub PAT
  { '^(staff|student|sci|edu|project)\.(g_)?[A-Za-z][-\w]*\.[A-Za-z][-\w]*$' ;
  }

sub repo_name
  { my $self = shift ;
    my $ownr = $self -> ownr ;
    my $side = $self -> side ;
    my $name = $self -> name ;

    my $conf = $self -> CAFE -> conf ;
    my $pref = $conf -> tree -> { $side } { pref } ;
    $pref .= ( $pref ? '.' : '' ) . '%n' ;
    $pref =~ s/%p/$side/g ;
    $pref =~ s/%o/$ownr/g ;
    $pref =~ s/%n/$name/g ;
    $pref ;
  }

sub path
  { my $self = shift ;
    my $conf = $self -> CAFE -> conf ;
    sprintf "%s/%s", $conf -> dir_repos, $self -> repo_name ;
  }

sub version
  { my $self = shift ;
    my $path = $self -> path ;
    my $CMD = "/usr/bin/svnlook youngest $path" ;
    open CMD, "$CMD|" or return undef ;
    my $res = <CMD> ;
    close CMD ;
    chomp $res ;
    $res ;
  }

sub size
  { my $self = shift ;
    my $path = $self -> path ;
    my $CMD = "/usr/bin/du -sk $path" ;
    open CMD, "$CMD|" or return undef ;
    my $res = ( split ' ', <CMD> ) [ 0 ] ;
    close CMD ;
    $res ;
  }

sub dmp
  { my $self = shift ;
    my $sep = shift || '' ;
    my $res = $self -> Repocafe::Table::dmp () ;
    my $rrs = $self -> rights ;
    for my $pid ( keys %$rrs )
      { my $rr = $rrs -> { $pid } ;
        $res .= sprintf "%s", $rr -> dmp ( "rr $sep" ) ;
      }
    $res ;
  }

sub watchers ()
  { my $self = shift ;
    my $cafe = $self -> CAFE ;
    my $rrs  = $self -> rights ;
    my @pids = () ;
    my @res  = () ;

    for my $rr ( values %$rrs )
      { push @pids, $rr -> pid if $rr -> wat eq 'TRUE' ; }

    my $res = $cafe -> lookups ( @pids ) ;
    map { $_ -> email } @$res ;
  }


package Repocafe::Rights ; #########################################

our @ISA       = qw(Base Repocafe::Table Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;
our $VERSION   = 1.00 ;

eval Base -> mk_methods ( qw(id pid rid mod man wat) ) ;

sub dmp
  { my $self = shift ;
    my $sep  = shift || '' ;
    $self -> Repocafe::Table::dmp ( "  $sep" ) ;
  }

sub new
  { my $self = shift ;
    my $rec  = shift ;
    my $cafe = $self -> CAFE ;
    my $tabl = $self -> TAB  ;
    my $res = bless $rec, unref $self ;
    $rec -> init ( $cafe, $tabl ) ;
    $res ;
  }

sub get_by_rid
  { my $self = shift ;
    my $rid  = shift ;
    my $res = {} ;
    my $qwe = "WHERE rid = $rid" ;
    my $row = $self -> get_data ( $qwe ) ;
    for my $key ( keys %$row )
      { my $rr = $self -> new ( $row -> { $key } ) ;
        my $pid = $rr -> pid ;
        $res -> { $rr -> pid } = $rr ;
      }
    $res ;
  }

package Repocafe::Groups ; #########################################

our @ISA       = qw(Base Repocafe::Table Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;
our $VERSION   = 1.00 ;

eval Base -> mk_methods ( qw(gid name ownr creat members) ) ;

sub dmp
  { my $self = shift ;
    my $sep  = shift || '' ;
    my $res = $self -> Repocafe::Table::dmp () ;
    my $mems = $self -> members ;
    for my $pid ( keys %$mems )
      { my $mem = $mems -> { $pid } ;
        $res .= sprintf "%s", $mem -> dmp ( "mem $sep" ) ;
      }
    $res ;
  }

sub new
  { my $self = shift ;
    my $rec  = shift ;
    my $res = bless {}, unref $self ;
    for my $fld ( sort keys %$rec )
      { $res -> $fld ( $rec -> { $fld } ) ; }
    my $members = $self -> CAFE -> gr_mem -> get_by_gid ( $res -> { gid } ) ;
    $res -> members ( $members ) ;
    $res ;
  }

sub get_by_qwe
  { my $self = shift ;
    my $qwe  = shift ;
    my $res = [] ;
    $qwe = ( $qwe ? "WHERE $qwe" : '' ) ;
    my $row = $self -> get_data ( $qwe ) ;
    if ( defined $row )
      { for my $key ( keys %$row )
          { push @$res, $self -> new ( $row -> { $key } ) ; }
      }
    $res ;
  }


package Repocafe::GroupMembers ; ###################################

our @ISA       = qw(Base Repocafe::Table Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;
our $VERSION   = 1.00 ;

eval Base -> mk_methods ( qw(id pid gid mem man) ) ;

sub dmp
  { my $self = shift ;
    my $sep  = shift || '' ;
    $self -> Repocafe::Table::dmp ( "  $sep" ) ;
  }

sub new
  { my $self = shift ;
    my $rec  = shift ;
    my $res = bless {}, unref $self ;
    for my $fld ( sort keys %$rec )
      { $res -> $fld ( $rec -> { $fld } ) ; }
    $res ;
  }

sub get_by_qwe
  { my $self = shift ;
    my $qwe  = shift ;
    my $recs = $self -> get_data ( $qwe ) ;
    my $res  = [] ;
    for my $key ( keys %$recs )
      { my $mem = $self -> new ( $recs -> { $key } ) ;
        push @$res, $mem ;
      }
    $res ;
  }

sub get_by_gid
  { my $self = shift ;
    my $gid  = shift ;
    my $res = {} ;
    my $qwe = "WHERE gid = $gid" ;
    my $mems = $self -> get_by_qwe ( $qwe ) ;
    for my $mem ( @$mems )
      { my $pid = $mem -> pid ;
        $res -> { $pid } = $mem ;
      }
    $res ;
  }


package Repocafe::Stats ; ##########################################

our @ISA       = qw(Base Repocafe::Table Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;

eval Base -> mk_methods ( qw(id rid) ) ;

sub dmp
  { my $self = shift ;
    my $sep  = shift || '' ;
    $self -> Repocafe::Table::dmp ( "  $sep" ) ;
  }

sub new
  { my $self = shift ;
    my $rec  = shift ;
    my $res = bless {}, $self ;
    for my $fld ( sort keys %$rec )
      { $res -> $fld -> ( $rec -> { $fld } ) ; }
    $res ;
  }

sub get_by_rid
  { my $self = shift ;
    my $rid  = shift ;
    my $res = {} ;
    my $qwe = "WHERE rid = $rid" ;
    my $row = $self -> get_data ( $qwe ) ;
    for my $key ( keys %$row )
      { my $rr = $self -> new ( $row -> { $key } ) ;
        $res -> { $rr -> pid } = $rr ;
      }
    $res ;
  }

sub _get_dates_times
  { my $self = shift ;
    my $what = shift ; # date or time
    my @res = () ;
    my $dbh = $self -> dbh ;
    my $qwe = "SELECT distinct $what FROM repo_stats ORDER BY ?" ;
    my $sth = $dbh -> prepare ( $qwe ) ;
    $sth -> execute ( $what ) ;
    while ( my $rec = $sth -> fetchrow_hashref )
      { push @res, $rec -> { $what } ; }
    @res ;
  }

sub get_dates { my $self = shift ; $self -> _get_dates_times ( 'date' ) ; }
sub get_times { my $self = shift ; $self -> _get_dates_times ( 'time' ) ; }

sub get_all_stats
  { my $self = shift ;
    my $res = [] ;
    my $dbh = $self -> dbh ;
    my $qwe = "SELECT * FROM repo_stats ORDER BY rid, time" ;
    my $sth = $dbh -> prepare ( $qwe ) ;
    $sth -> execute () ;
    while ( my $rec = $sth -> fetchrow_hashref ) { push @$res, $rec ; }
    $res ;
  }

sub get_upd_stats
  { my $self = shift ;
    my $then = shift ;
    my $res = {} ;
    my $dbh = $self -> TAB -> dbh ;
    my $qwe = <<QWE ;
SELECT * FROM repo_stats
WHERE ( rid, time ) IN
  ( SELECT rid, max(time) AS time
    FROM repo_stats
    WHERE time > ?
    GROUP by rid
    HAVING count (*) > 1
  )
order by rid, time ;
QWE
    printf "%s(%s)\n", $qwe, $then ;
    my $sth = $dbh -> prepare ( $qwe ) ;
    $sth -> execute ( $then ) ;
    while ( my $rec = $sth -> fetchrow_hashref )
      { my $rid = $rec -> { rid } ;
        $res -> { $rid } = $rec ;
      }
    $res ;
  }

sub delete_last
  { my $self  = shift ;
    my $DAYS  = shift ;
    my $opt_f = shift ;
    my $dbh   = $self -> dbh ;
    my $qwe   = <<QWE ;
SELECT *
FROM repo_stats
ORDER BY rid, time DESC ;
QWE
    printf "%s\n", $qwe ;
    my $sth = $dbh -> prepare ( $qwe ) ;
    $sth -> execute () ;
    my %tab = () ;

    while ( my $rec = $sth -> fetchrow_hashref )
      { my $rid = $rec -> { rid } ;
        if ( ! exists $tab { $rid } )
          { $tab { $rid } = [ $rec ] ; }
        elsif ( @{ $tab { $rid } } < 2 )
          { push @{ $tab { $rid } }, $rec ; }
        else
          { next ; }
        my $date = $rec -> { date } ;
        my $time = $rec -> { time } ;
      }

    my $sql = "DELETE FROM repo_stats WHERE id = ? " ;
    $sth = $dbh -> prepare ( $sql ) ;

    for my $rid ( sort { $a <=> $b } keys %tab )
      { my $ary = $tab { $rid } ;
        if ( @$ary == 2 )
          { my $last = $ary -> [ 0 ] ;
            my $frst = $ary -> [ 1 ] ;
            my $tim_last = $last -> { time } ;
            my $tim_frst = $frst -> { time } ;
            my $diff_days = int
              ( ( $tim_last - $tim_frst ) / ( 24 * 60 * 60 ) + 0.5 ) ;
            printf "DIFF %4d %s\n", $rid, $diff_days ;
            if ( $diff_days < $DAYS )
              { my $id   = $last -> { id   } ;
                my $date = $last -> { date } ;
                my $time = $last -> { time } ;
                printf "DELETE %4d %3d %s %s\n", $id, $rid, $date, $time ;
                if ( $opt_f )
                  { $sth -> execute ( $id ) or die "$DBI::errstr\n" ; }
              }
          }
      }
    $sth -> finish ;
  }

package Repocafe::User ; ########################################

our @ISA       = qw(Base Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;

eval Base -> mk_methods ( qw(login email name clas) ) ;

sub dmp
  { my $self = shift ;
    for my $key ( sort keys %$self )
      { printf "%s -> %s\n", $key, $self -> $key ; }
  }

sub new
  { my $self = shift ;
    my $res = bless {}, unref $self ;
    $res -> init_user ( @_ ) ;
    $res ;
  }

sub init_user
  { my $self  = shift ;
    Carp::croak "init_user : bad args (@_)" unless @_ == 4 ;
    $self -> login ( shift ) ;
    $self -> email ( shift ) ;
    $self -> name  ( shift ) ;
    $self -> clas  ( shift ) ;
    $self ;
  }

package Repocafe::Guests ; ##################################################

our @ISA       = qw(Base Repocafe::Table Repocafe::User Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;

eval Base -> mk_methods ( qw(login email name passwd) ) ;

sub dmp
  { my $self = shift ;
    my $sep  = shift || '' ;
    $self -> Repocafe::Table::dmp () ;
  }

sub new
  { my $self = shift ;
    my $rec  = shift ;
    my $res  = bless {}, unref $self ;
    $res -> init ( $self -> CAFE, $self -> TAB ) ;
    $res -> init_user
      ( $rec -> { login }
      , $rec -> { email }
      , $rec -> { name  }
      , 'guests'
      ) ;
    $res -> passwd ( $rec -> { passwd } ) ;
    $res ;
  }

sub get_by_qwe
  { my $self = shift ;
    my $qwe  = shift ;
    my $data = $self -> get_data ( $qwe ) ;
    my $res = {} ;
    for my $key ( keys %$data )
      { my $user = $self -> new ( $data -> { $key } ) ;
        $res -> { $user -> login } = $user ;
      }
    $res ;
  }

sub get_by_rid
  { my $self = shift ;
    my $rid  = shift ;
    my $cafe = $self -> CAFE ;
    my $pref = $cafe -> conf -> db_pref ;
    my $qwe = <<QWE ;
WHERE login in
  ( SELECT pid FROM ${pref}repo_rights
    WHERE pid LIKE 'g_%' and rid = $rid AND wat = 'TRUE'
  )
QWE
    $self -> get_by_qwe ( $qwe ) ;
  }

sub try_by_login
  { my $self  = shift ;
    my $login = shift ;
    my $qwe = "WHERE login = '$login'" ;
    my $recs = $self -> get_data ( $qwe ) ;
    return undef unless scalar keys %$recs ;
    my $rec = ( values %$recs ) [ 0 ] ;
    $self -> new ( $rec ) ;
  }

sub lookups
  { my $self = shift ;
    my @uids = @_ ;
    my $res  = [] ;

    my $guests = $self -> get_by_qwe ( '' ) ;
    for my $uid ( sort @uids )
      { print "trying uid ($uid) as guest ...\n" if Repocafe::debug () ;
        if ( exists $guests -> { $uid } )
          { push @$res, $guests -> { $uid } ;
            print "  found uid ($uid) as guest ...\n" if Repocafe::debug () ;
          }
      }
    $res ;
  }

### class methods ##########################################

sub file_out
  { use DB_File ;

    my $self = shift ;
    my $out  = shift ;
    my $txt  = "$out.txt" ;
    my $db   = "$out.db" ;
    my $tmp  = "$txt.$$" ;
    my $tdb  = "$db.$$" ;
    my @guests = () ;
    my %tmp ;
    for my $rec ( values %{ $self -> get_data ( '' ) } )
      { push @guests, $self -> new ( $rec ) ; }

    my @abc = 'a' .. 'z' ;

    tie %tmp , "DB_File" , $tdb , O_RDWR|O_CREAT , 0644 , $DB_HASH
      or die "can't tie" ;
    open TMP, ">$tmp" or die "can't write $tmp ($!)" ;
    for my $guest ( sort { $a -> login cmp $b -> login } @guests )
      { my $seed = @abc [ int rand @abc ] . @abc [ int rand @abc ] ;
        my $cryp = crypt $guest -> passwd, $seed ;
        $tmp { $guest -> login } = $cryp ;
        printf TMP "%s:%s\n" , $guest -> login , $cryp ;
      }
    untie %tmp ;
    close TMP ;
    rename $tmp, $txt or die "can't rename $tmp, $txt ($!)" ;
    rename $tdb, $db  or die "can't rename $tdb, $db  ($!)" ;
  }

package Repocafe::Xusers ; #########################################

our @ISA       = qw(Base Repocafe::Table Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;

eval Base -> mk_methods ( qw(id pid) ) ;

sub dmp
  { my $self = shift ;
    my $sep  = shift || '' ;
    $self -> Repocafe::Table::dmp () ;
  }

sub new
  { my $self = shift ;
    my $rec  = shift ;
    bless $rec, unref $self ;
  }

sub get_by_qwe
  { my $self = shift ;
    my $qwe  = shift || '' ;
    my $res  = {} ;
    my $recs = $self -> get_data ( $qwe ) ;
    for my $key ( keys %$recs )
      { my $xuser = $self -> new ( $recs -> { $key } ) ;
        $res -> { $xuser -> pid } = $xuser ;
      }
    $res ;
  }

package Repocafe::Ldap ; ###########################################

use Net::LDAP ;

our @ISA       = qw(Base Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;

eval Base -> mk_methods ( qw(tag serv base dscr) ) ;

sub new { my $self = shift ; bless {}, $self ; }

sub init
  { my $self = shift ;
    my $rec  = shift ;
    my $serv = $rec -> { serv } ;

    $self -> tag  ( $rec -> { tag  } ) ;
    $self -> serv ( $rec -> { serv } ) ;
    $self -> base ( $rec -> { base } ) ;
    $self -> dscr ( $rec -> { dscr } ) ;

    $self ;
  }

sub lookups
  { my $self = shift ;
    my $clas = shift ;
    my $pat  = shift ;
    my @uids = @_ ;
    my $res  = [] ;

    my $serv = $self -> serv ;
    my $base = $self -> base ;

    my $ldap = Net::LDAP -> new ( $serv )
      or Carp::croak "can't make Net::LDAP ($serv)" ;
    my $mesg = $ldap -> bind ;
    my $errr = $mesg -> error ;
    warn "can't bind to $serv ($errr)" if $mesg -> code ;

    for my $uid ( sort @uids )
      { print "trying uid ($uid) on serv $serv pat ($pat) ...\n"
          if Repocafe::debug () ;

        $mesg = $ldap -> search
          ( base   => $base
          , filter => "uid=$uid"
          , attrs  => [ qw(cn mail) ]
          ) ;
        next if $mesg -> code ;
        for my $entry ( $mesg -> entries )
          { my $dn = lc $entry -> dn ;
            if ( $dn =~ /$pat/i )
              { my $mail = $entry -> get_value ( 'mail' ) ;
                my $cn   = $entry -> get_value ( 'cn'   ) ;
                my $user = Repocafe::User -> new ( $uid, $mail, $cn, $clas ) ;
                push @$res, $user ;
                print "  found uid ($uid) pat ($pat) ...\n"
                  if Repocafe::debug () ;
                last ;
              }
          }
      }
    $ldap -> unbind () ;
    $res ;
  }

package Repocafe::Clas ; ###########################################

our @ISA       = qw(Base Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;

eval Base -> mk_methods ( qw(clas typ dscr cafe) ) ;

sub new { my $self = shift ; bless {}, $self ; }

sub init_clas
  { my $self = shift ;
    my $rec  = shift ;
    $self -> clas ( $rec -> { clas } ) ;
    $self -> typ  ( $rec -> { typ  } ) ;
    $self -> dscr ( $rec -> { dscr } ) ;
    $self -> cafe ( $rec -> { cafe  } ) ;
    $self ;
  }

package Repocafe::Clas::Table ; ####################################

our @ISA       = qw(Base Repocafe::Clas Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;

eval Base -> mk_methods ( qw(table login paswd cname) ) ;

sub new { my $self = shift ; bless {}, $self ; }

sub init
  { my $self = shift ;
    my $rec  = shift ;
    $self -> table ( $rec -> { table } ) ;
    $self -> login ( $rec -> { login } ) ;
    $self -> paswd ( $rec -> { paswd } ) ;
    $self -> cname ( $rec -> { cname } ) ;
    $self -> init_clas ( $rec ) ;
  }

sub lookups
  { my $self = shift ;
    my @uids = @_ ;
    $self -> cafe -> guests -> lookups ( @uids ) ;
  }

package Repocafe::Clas::Ldap ; #####################################

our @ISA       = qw(Base Repocafe::Clas Exporter) ;
our @EXPORT    = qw() ;
our @EXPORT_OK = qw() ;

eval Base -> mk_methods ( qw(tag pat ldap) ) ;

sub new { my $self = shift ; bless {}, $self ; }

sub init
  { my $self = shift ;
    my $rec  = shift ;
    $self -> tag  ( $rec -> { tag  } ) ;
    $self -> pat  ( $rec -> { pat  } ) ;
    $self -> ldap ( $rec -> { ldap } ) ;
    $self -> init_clas ( $rec ) ;
  }

sub lookups
  { my $self = shift ;
    my @uids = @_ ;
    $self -> ldap -> lookups ( $self -> clas, $self -> pat, @uids ) ;
  }

1 ;