##
## ... Physemp2/DB/Base.pm
##
package Physemp2::DB::Base;
use base qw/Maypole::Model::CDBI::Plain/;

use strict;

use Class::DBI::FromCGI;
use Class::DBI::AbstractSearch;
use Class::DBI::Plugin::AbstractCount;
use Class::DBI::Plugin::CountSearch;

use My::DBI;

my $db_options = { __PACKAGE__->_default_attributes() };

sub connection_key  { return 'physemp' };

sub db_Main {
  my ($class) = @_;
  my $dbh;

  ## My::DBI will put a good handle there in a mod_perl
  ## environment, so check that first
  $dbh = Apache->request()->pnotes('dbh')
    if $ENV{'MOD_PERL'} and not $Apache::ServerStarting;

  ## no handle, get one from My::DBI, and massage it.
  unless ($dbh) {
    $dbh = My::DBI->connect($class->connection_key(), $db_options);
    __PACKAGE__->_remember_handle('Main'); # so dbi_commit works
  }
  return $dbh;
}

## constants used by constraints methods
use constant _NO_YES => {'no' => {}, 'yes' => {}};

## constraint methods for all the subclasses 
sub date {
  my ($value, $self, $column_name, $changing) = @_;

  return ($value =~ /^ (-?\d{4}) \D? (\d{1,2}) \D? (\d{1,2}) $/x and $2 <= 12 and $3 <= 31);
}

sub int {
  my ($value, $self, $column_name, $changing) = @_;

  return '' unless DBI::looks_like_number($value);
  return '' unless $value == int($value);
  return '' unless $value >= -2147483648;
  return '' unless $value <= 2147483647;
  return 1;
}

sub length_10 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 10);
}

sub length_100 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 100);
}

sub length_127 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 127);
}

sub length_128 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 128);
}

sub length_15 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 15);
}

sub length_16 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 16);
}

sub length_16777215 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 16777215);
}

sub length_17 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 17);
}

sub length_18 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 18);
}

sub length_2 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 2);
}

sub length_20 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 20);
}

sub length_22 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 22);
}

sub length_255 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 255);
}

sub length_26 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 26);
}

sub length_3 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 3);
}

sub length_30 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 30);
}

sub length_32 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 32);
}

sub length_35 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 35);
}

sub length_4 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 4);
}

sub length_42 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 42);
}

sub length_50 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 50);
}

sub length_60 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 60);
}

sub length_64 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 64);
}

sub length_65535 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 65535);
}

sub length_80 {
  my ($value, $self, $column_name, $changing) = @_;

  return (length($value) <= 80);
}

sub no_yes {
  my ($value, $self, $column_name, $changing) = @_;

  return (exists _NO_YES->{lc($value)});
}

sub not_null {
  my ($value, $self, $column_name, $changing) = @_;

  return (defined $value);
}

sub number {
  my ($value, $self, $column_name, $changing) = @_;

  return '' unless DBI::looks_like_number($value);
  return 1;
}

sub small_int {
  my ($value, $self, $column_name, $changing) = @_;

  return '' unless DBI::looks_like_number($value);
  return '' unless $value == int($value);
  return '' unless $value >= -32768;
  return '' unless $value <= 32767;
  return 1;
}

sub time {
  my ($value, $self, $column_name, $changing) = @_;

  return ($value =~ /^ (\d{1,2}) \D? (\d{1,2}) \D? (\d{1,2}) $/x and $1 <= 24 and $2 <= 60 and $3 <= 62)
}

sub timestamp {
  my ($value, $self, $column_name, $changing) = @_;

  return ($value =~ /^ (\d{4}) \D? (\d{1,2}) \D? (\d{1,2}) (?:\D? (\d{1,2}) \D? (\d{1,2}) \D? (\d{1,2}) (?:\.\d*)? )? $/x
          and $2 <= 12 and $3 <= 31 and $4 <= 24 and $5 <= 60 and $6 <= 62);
}

sub tiny_int {
  my ($value, $self, $column_name, $changing) = @_;

  return '' unless DBI::looks_like_number($value);
  return '' unless $value == int($value);
  return '' unless $value >= -128;
  return '' unless $value <= 127;
  return 1;
}

sub unsigned_int {
  my ($value, $self, $column_name, $changing) = @_;

  return '' unless DBI::looks_like_number($value);
  return '' unless $value == int($value);
  return '' unless $value >= 0;
  return '' unless $value <= 4294967295;
  return 1;
}

sub unsigned_number {
  my ($value, $self, $column_name, $changing) = @_;

  return '' unless DBI::looks_like_number($value);
  return '' unless $value >= 0;
  return 1;
}

sub unsigned_tiny_int {
  my ($value, $self, $column_name, $changing) = @_;

  return '' unless DBI::looks_like_number($value);
  return '' unless $value == int($value);
  return '' unless $value >= 0;
  return '' unless $value <= 255;
  return 1;
}

1;
__END__