DBIx::Recordset - Perl extension for DBI recordsets

 use DBIx::Recordset;

 # Setup a new object and select some recods...
 *set = DBIx::Recordset -> Search ({'!DataSource' => 'dbi:Oracle:....',
                                    '!Table'      => 'users',
                                    '$where'      => 'name = ? and age > ?',
                                    '$values'     => ['richter', 25] }) ;

 # Get the values of field foo ...
 print "First Records value of foo is $set[0]{foo}\n" ;
 print "Second Records value of foo is $set[1]{foo}\n" ;
 # Get the value of the field age of the current record ...
 print "Age is $set{age}\n" ;

 # Do another select with the already created object...
 $set -> Search ({name => 'bar'}) ;

 # Show the result...
 print "All users with name bar:\n" ;
 while ($rec = $set -> Next)
    {
    print $rec -> {age} ;
    }

 # Setup another object and insert a new record
 *set2 = DBIx::Recordset -> Insert ({'!DataSource' => 'dbi:Oracle:....',
                                     '!Table'      => 'users',
                                     'name'        => 'foo',
                                     'age'         => 25 }) ;

 


 # Update this record (change age from 25 to 99)...
 $set -> Update ({age => 99}, {name => 'foo'}) ; 

  Example

  '!Table'       => 'tab1, tab2',
  '!TabRelation' => 'tab1.id=tab2.id',
  'name'         => 'foo'

  This will generate the following SQL statement:

  SELECT * FROM tab1, tab2 WHERE name = 'foo' and tab1.id=tab2.id ;

  Example

  '!Table'   => 'tab1, tab2',
  '!TabJoin' => 'tab1 LEFT JOIN tab2 ON	(tab1.id=tab2.id)',
  'name'     => 'foo'

  This will generate the following SQL statement:

  SELECT * FROM tab1 LEFT JOIN tab2 ON	(tab1.id=tab2.id) WHERE name = 
'foo' ;

 


 Example:

     '!Filter'   => 
	{
	DBI::SQL_DATE     => 
	    [ 
		sub { shift =~ /(\d\d)\.(\d\d)\.(\d\d)/ ; "19$3$2$1"},
		sub { shift =~ /\d\d(\d\d)(\d\d)(\d\d)/ ; "$3.$2.$1"}
	    ],

	'datefield' =>
	    [ 
		sub { shift =~ /(\d\d)\.(\d\d)\.(\d\d)/ ; "19$3$2$1"},
		sub { shift =~ /\d\d(\d\d)(\d\d)(\d\d)/ ; "$3.$2.$1"}
	    ],

	}

 The following example prefetches all record with id < 7:

 tie %dbhash, 'DBIx::Recordset::Hash', {'!DataSource'   =>  $DSN,
                                        '!Username'     =>  $User,
                                        '!Password'     =>  $Password,
                                        '!Table'        =>  'foo',
                                        '!PreFetch'     =>  {
                                                             '*id' => '<',
                                                             'id' => 7
                                                            },
                                        '!PrimKey'      =>  'id'} ;

 The following example prefetches all records:

 tie %dbhash, 'DBIx::Recordset::Hash', {'!DataSource'   =>  $DSN,
                                        '!Username'     =>  $User,
                                        '!Password'     =>  $Password,
                                        '!Table'        =>  'bar',
                                        '!PreFetch'     =>  '*',
                                        '!PrimKey'      =>  'id'} ;

 The following example sets up a hash, that, when more then one record with the same id is
 found, the field C<sum> is added and the first record is returned, where the C<sum> field
 contains the sum of B<all> found records:

 tie %dbhash, 'DBIx::Recordset::Hash', {'!DataSource'   =>  $DSN,
                                        '!Username'     =>  $User,
                                        '!Password'     =>  $Password,
                                        '!Table'        =>  'bar',
                                        '!MergeFunc'    =>  sub { my ($a, $b) = @_ ; $a->{sum} += $b->{sum} ; },
                                        '!PrimKey'      =>  'id'} ;

 Example:

 *set = DBIx::Recordset -> Search ({'!DataSource' => 'dbi:Oracle:....',
                                    '!Table'      => 'users',
                                    '$where'      => 'name = ? and age > ?',
                                    '$values'     => ['richter', 25] }) ;

  Example:

  'name' => [ 'mouse', 'cat'] will expand to name='mouse' or name='cat'

 Example:
 'name' => "mouse\tcat" will expand to name='mouse' or name='cat'

 NOTE: The above example can also be written as 'name' => [ 'mouse', 'cat']

 Example:
 'value' => 9, '*value' => '>' expand to value > 9

  Example:

    $set -> Search  ({id          => [5,    7   ],
                     '*id'        => ['>=', '<='],
                     '$valueconj' => 'and'})  ;

  This will expanded to "id >= 5 and id <= 7"

  Example:

    $set -> Search  ({id          => 5,
                     '$expr'      => 
                        {
                        'name'  => 'Richter',
                        'country' => 'de',
                        '$conj'   => 'or'
                        }
                      }) ;

    This will expand to

        (name = 'Richter' or country = 'de') and id = 5

  #now you can update an existing record by assigning new values
  #Note: if possible, specify a PrimKey for update to work faster
  $set[0]{'name'} = 'zyx' ;

  # or insert a new record by setting up an new array row
  $set[9]{'name'} = 'foo' ;
  $set[9]{'id'}   = 10 ;

  # if you don't know the index of a new row you can obtain
  # one by using Add
  my $i = $set -> Add () ;
  $set[$i]{'name'} = 'more foo' ;
  $set[$i]{'id'}   = 11 ;

  # or add an empty record via Add and assign the values to the current
  # record
  $set -> Add () ;
  $set{'name'} = 'more foo' ;
  $set{'id'}   = 11 ;

  # or insert the data directly via Add
  $set -> Add ({'name' => 'even more foo',
		'id'   => 12}) ;

  # NOTE: up to this point, NO data is actually written to the db!

  # we are done with that object,  Undef will flush all data to the db
  DBIx::Recordset::Undef ('set') ;

  table name
  name	    char (30),
  street_id  integer

  table street
  id	    integer,
  street    char (30),
  city      char (30)

  *set = DBIx::Recordset -> Search ({'!DataSource' => 'dbi:drv:db',
		     '!Table'	   => 'name, street',
		     '!TabRelation'=> 'name.street_id = street.id'}) ;

  *set = DBIx::Recordset -> Search ({
            '!DataSource' => 'dbi:drv:db',
	    '!Table'   => 'name, street',
	    '!TabJoin' => 'name LEFT JOIN street ON (name.street_id=street.id)'}) ;

  *set = DBIx::Recordset -> Search ({'!DataSource' => 'dbi:drv:db',
		     '!Table'	   => 'name',
		     '!Links'	   => {
			'-street'  => {
			    '!Table' => 'street',
			    '!LinkedField' => 'id',
			    '!MainField'   => 'street_id'
			    }
			}
		    }) ;

  $set{name} to access the name field
  $set{-street}{street} to access the first street (as long as the
				    current record of the subobject isn't
				    modified)

  $set{-street}[0]{street}	first street
  $set{-street}[1]{street}	second street
  $set{-street}[2]{street}	third street

  $set[2]{-street}[1]{street} to access the second street of the
				    third name

  *set = DBIx::Recordset -> Search ({'!DataSource' => 'dbi:drv:db',
		     '!Table'	   => 'name',
		     '!LinkName'   => 1,
		     '!Links'	   => {
			'-street'  => {
			    '!Table' => 'street',
			    '!LinkedField' => 'id',
			    '!MainField'   => 'street_id',
			    '!NameField'   => 'street'
			    }
			}
		    }) ;

  name  street_id  street

  name  street_id  street  city

  name  street_id  STREET_ID

  name  street_id

  *set = DBIx::Recordset -> Search ({'!DataSource' => 'dbi:drv:db',
				     '!Table'	   => 'name') ;

  $db = DBIx::Database -> new ({'!DataSource'   =>  $DSN,
		                '!Username'     =>  $User,
				'!Password'     =>  $Password,
                                '!KeepOpen'     => 1}) ;

   *set = DBIx::Recordset -> Search ({'!DataSource'   =>  $db,
			              '!Table'        =>  'foo',
				     })  ;

  %DBDefault = 

    (
    '!Grant' => 
        [
        'select', 
        'insert',
        'update',
        'delete',
        ],
    )
     ;




  @DBSchema = (

    {
    '!Table' => 'language',
    '!Fields' => 
        [
        'id'            => 'char (2)',
        'directory'     => 'varchar(40)',
        'name'          => 'varchar(40)',
        'europe'        => 'bool', 
        ],
    '!PrimKey' => 'id',
    '!Default' =>
        {
        'europe'    => 1,
        },
    '!Init' =>
        [
        {'id' => 'de', 'directory' => 'html_49', 'name' => 'deutsch'},
        {'id' => 'en', 'directory' => 'html_76', 'name' => 'english'},
        {'id' => 'fr', 'directory' => 'html_31', 'name' => 'french'},
        ],
   '!Index' =>
        [
        'directory' => '',
        ]

    },

  );

 Example:

    # open the log file
    open LOG, ">test.log" or die "Cannot open test.log" ; 

    # assign filehandle
    *DBIx::Recordset::LOG = \*LOG ; 

    # set debugging level
    $DBIx::Recordset::Debug = 2 ; 

    # now you can create a new DBIx::Recordset object

 *set = DBIx::Recordset-> Setup ({'!DataSource'  =>  "dbi:$Driver:$DB",
			                        '!Table'	  =>  "$Table",
			                        '!Fields'	  =>  "a, b, c"}) ;

 $set -> Search (\%fdat) ;

 *set = DBIx::Recordset-> Setup ({'!DataSource'  =>  "dbi:$Driver:$DB",
                    			    '!Table'	  =>  "$Table"}) ;

 $set -> Select () ;

 SELECT * from <table> ;




 $set -> Select ({'id'=>2}) ;
 is the same as
 $set1 -> Select ('id=2') ;

 SELECT * from <table> WHERE id = 2 ;




 $set -> Search({ '$fields' => 'id, balance AS paid - total ' }) ;

 SELECT id, balance AS paid - total FROM <table>




 $set -> Select ({name => "Second Name\tFirst Name"}) ;

 SELECT * from <table> WHERE name = 'Second Name' or name = 'First Name' ;




 $set1 -> Select ({value => "9991 9992\t9993",
    		       '$valuesplit' => ' |\t'}) ;

 SELECT * from <table> WHERE value = 9991 or value = 9992 or value = 9993 ;




 $set -> Select ({'+name&value' => "9992"}) ;

 SELECT * from <table> WHERE name = '9992' or value = 9992 ;




 $set -> Select ({'+name&value' => "Second Name\t9991"}) ;

 SELECT * from <table> WHERE (name = 'Second Name' or name = '9991) or
			    (value = 0 or value = 9991) ;




 $set -> Search ({id => 1,name => 'First Name',addon => 'Is'}) ;

 SELECT * from <table> WHERE id = 1 and name = 'First Name' and addon = 'Is' ;




 $set1 -> Search ({'$start'=>0,'$max'=>2, '$order'=>'id'})  or die "not ok 
($DBI::errstr)" ;

 SELECT * from <table> ORDER BY id ;
 B<Note:> Because of the B<start> and B<max> only records 0,1 will be returned




 $set1 -> Search ({'$start'=>0,'$max'=>2, '$next'=>1, '$order'=>'id'})  or die "not ok 
($DBI::errstr)" ;

 SELECT * from <table> ORDER BY id ;
 B<Note:> Because of the B<start>, B<max> and B<next> only records 2,3 will be 
returned




 $set1 -> Search ({'$start'=>2,'$max'=>1, '$prev'=>1, '$order'=>'id'})  or die "not ok 
($DBI::errstr)" ;

 SELECT * from <table> ORDER BY id ;
 B<Note:> Because of the B<start>, B<max> and B<prev> only records 0,1,2 will be 
returned




 $set1 -> Search ({'$start'=>5,'$max'=>5, '$next'=>1, '$order'=>'id'})  or die "not ok 
($DBI::errstr)" ;

 SELECT * from <table> ORDER BY id ;
 B<Note:> Because of the B<start>, B<max> and B<next> only records 5-9 will be 
returned




 *set6 = DBIx::Recordset -> Search ({  '!DataSource'   =>  "dbi:$Driver:$DB",
				                        '!Table'	    =>	"t1, t2",
				                        '!TabRelation'  =>
	"t1.value=t2.value",
                                        '!Fields'       =>  'id, name, text',
                                        'id'            =>  "2\t4" }) or die "not ok 
($DBI::errstr)" ;

 SELECT id, name, text FROM t1, t2 WHERE (id=2 or id=4) and t1.value=t2.value ;




 $set6 -> Search ({'name'            =>  "Fourth Name" }) or die "not ok 
($DBI::errstr)" ;
 SELECT id, name, text FROM t1, t2 WHERE (name = 'Fourth Name') and 
t1.value=t2.value 
;







 $set6 -> Search ({'id'            =>  3,
                  '$operator'     =>  '<' }) or die "not ok ($DBI::errstr)" ;

 SELECT id, name, text FROM t1, t2 WHERE (id < 3) and t1.value=t2.value ;




 $set6 -> Search ({'id'            =>  4,
                  'name'          =>  'Second Name',
                  '*id'           =>  '<',
                  '*name'         =>  '<>' }) or die "not ok ($DBI::errstr)" ;

 SELECT id, name, text FROM t1, t2 WHERE (id<4 and name <> 'Second Name') and 
t1.value=t2.value ;




 $set6 -> Search ({'id'            =>  2,
                  'name'          =>  'Fourth Name',
                  '*id'           =>  '<',
                  '*name'         =>  '=',
                  '$conj'         =>  'or' }) or die "not ok ($DBI::errstr)" ;

 SELECT id, name, text FROM t1, t2 WHERE (id<2 or name='Fourth Name') and 
t1.value=t2.value ;




 $set6 -> Search ({'+id|addon'     =>  "7\tit",
                  'name'          =>  'Fourth Name',
                  '*id'           =>  '<',
                  '*addon'        =>  '=',
                  '*name'         =>  '<>',
                  '$conj'         =>  'and' }) or die "not ok ($DBI::errstr)" ;

 SELECT id, name, text FROM t1, t2 WHERE (t1.value=t2.value) and (  ((name <> 
Fourth 
Name)) and (  (  id < 7  or  addon = 7)  or  (  id < 0  or  addon = 0)))




 $set6 -> Search ({'+id|addon'     =>  "6\tit",
                  'name'          =>  'Fourth Name',
                  '*id'           =>  '>',
                  '*addon'        =>  '<>',
                  '*name'         =>  '=',
                  '$compconj'     =>  'and',
                  '$conj'         =>  'or' }) or die "not ok ($DBI::errstr)" ;




 SELECT id, name, text FROM t1, t2 WHERE (t1.value=t2.value) and (  ((name = 
Fourth 
Name)) or (  (  id > 6 and addon <> 6)  or  (  id > 0 and addon <> 0))) ;




 *set7 = DBIx::Recordset -> Search ({  '!DataSource'   =>  "dbi:$Driver:$DB",
                                    '!Table'        =>  "t1, t2",
                                    '!TabRelation'  =>  "t1.id=t2.id",
                                    '!Fields'       =>  'name, typ'}) or die "not ok 
($DBI::errstr)" ;

 SELECT name, typ FROM t1, t2 WHERE t1.id=t2.id ;




 %h = ('id'    => 22,
      'name2' => 'sqlinsert id 22',
      'value2'=> 1022) ;




 *set9 = DBIx::Recordset -> Insert ({%h,
                                    ('!DataSource'   =>  "dbi:$Driver:$DB",
                                     '!Table'        =>  "$Table[1]")}) or die "not ok 
($DBI::errstr)" ;

 INSERT INTO <table> (id, name2, value2) VALUES (22, 'sqlinsert id 22', 1022) ;




 %h = ('id'    => 22,
      'name2' => 'sqlinsert id 22u',
      'value2'=> 2022) ;




 $set9 -> Update (\%h, 'id=22') or die "not ok ($DBI::errstr)" ;

 UPDATE <table> WHERE id=22 SET id=22, name2='sqlinsert id 22u', value2=2022 ;




 %h = ('id'    => 21,
      'name2' => 'sqlinsert id 21u',
      'value2'=> 2021) ;

 *set10 = DBIx::Recordset -> Update ({%h,
                                    ('!DataSource'   =>  "dbi:$Driver:$DB",
                                     '!Table'        =>  "$Table[1]",
                                     '!PrimKey'      =>  'id')}) or die "not ok 
($DBI::errstr)" ;

 UPDATE <table> WHERE id=21 SET name2='sqlinsert id 21u', value2=2021 ;




 %h = ('id'    => 21,
      'name2' => 'Ready for delete 21u',
      'value2'=> 202331) ;




 *set11 = DBIx::Recordset -> Delete ({%h,
                                    ('!DataSource'   =>  "dbi:$Driver:$DB",
                                     '!Table'        =>  "$Table[1]",
                                     '!PrimKey'      =>  'id')}) or die "not ok 
($DBI::errstr)" ;

 DELETE FROM <table> WHERE id = 21 ;







 *set12 = DBIx::Recordset -> Execute ({'id'  => 20,
                                   '*id' => '<',
                                   '!DataSource'   =>  "dbi:$Driver:$DB",
                                   '!Table'        =>  "$Table[1]",
                                   '!PrimKey'      =>  'id'}) or die "not ok 
($DBI::errstr)" ;

 SELECT * FROM <table> WHERE id<20 ;




 *set13 = DBIx::Recordset -> Execute ({'=search' => 'ok',
                    'name'  => 'Fourth Name',
                    '!DataSource'   =>  "dbi:$Driver:$DB",
                    '!Table'        =>  "$Table[0]",
                    '!PrimKey'      =>  'id'}) or die "not ok ($DBI::errstr)" ;

 SELECT * FROM <table>  WHERE   ((name = Fourth Name))




 $set12 -> Execute ({'=insert' => 'ok',
                    'id'     => 31,
                    'name2'  => 'insert by exec',
                    'value2'  => 3031,
 # Execute should ignore the following params, since it is already setup
                    '!DataSource'   =>  "dbi:$Driver:$DB",
                    '!Table'        =>  "quztr",
                    '!PrimKey'      =>  'id99'}) or die "not ok ($DBI::errstr)" ;

 SELECT * FROM <table> ;




 $set12 -> Execute ({'=update' => 'ok',
                    'id'     => 31,
                    'name2'  => 'update by exec'}) or die "not ok ($DBI::errstr)" ;

 UPDATE <table> SET name2=update by exec,id=31 WHERE id=31 ;




 $set12 -> Execute ({'=insert' => 'ok',
                    'id'     => 32,
                    'name2'  => 'insert/upd by exec',
                    'value2'  => 3032}) or die "not ok ($DBI::errstr)" ;




 INSERT INTO <table> (name2,id,value2) VALUES (insert/upd by exec,32,3032) ;




 $set12 -> Execute ({'=delete' => 'ok',
                    'id'     => 32,
                    'name2'  => 'ins/update by exec',
                    'value2'  => 3032}) or die "not ok ($DBI::errstr)" ;

 DELETE FROM <table> WHERE id=32 ;

###################################################################################
#
#   DBIx::Recordset - Copyright (c) 1997-2001 Gerald Richter / ECOS
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#
#   THIS IS BETA SOFTWARE!
#
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
#   $Id: Recordset.pm,v 1.106 2002/10/15 14:11:19 richter Exp $
#
###################################################################################



package DBIx::Recordset ;

use strict 'vars' ;
use Carp ;
use Data::Dumper;

use DBIx::Database ;
use DBIx::Compat ;
use Text::ParseWords ;

use vars 
    qw(
    $VERSION
    @ISA
    @EXPORT
    @EXPORT_OK

    $self
    @self
    %self
    
    $newself

    $Debug 

    $fld
    @fld 

    %Compat

    $id
    $numOpen

    %Data
    %Metadata

    %unaryoperators
    
    $LastErr
    $LastErrstr

    $PreserveCase
    $FetchsizeWarn
    );

use DBI ;

require Exporter;

@ISA       = qw(Exporter DBIx::Database::Base);

$VERSION = '0.26';


$PreserveCase = 0 ;
$FetchsizeWarn = 2 ;

$id = 1 ;
$numOpen = 0 ;

$Debug = 0 ;     # Disable debugging output

# Write Modes

use constant wmNONE   => 0 ;
use constant wmINSERT => 1 ;
use constant wmUPDATE => 2 ;
use constant wmDELETE => 4 ;
use constant wmCLEAR  => 8 ;
use constant wmALL    => 15 ;

# required Filters 

use constant rqINSERT => 1 ;
use constant rqUPDATE => 2 ;

# OnDelete actions

use constant odDELETE => 1 ;
use constant odCLEAR  => 2 ;


%unaryoperators = (
    'is null' => 1,
    'is not null' => 1
	) ;


# Get filehandle of logfile
if (defined ($INC{'Embperl.pm'}))
    {
    tie *LOG, 'Embperl::Log' ;
    }
elsif (defined ($INC{'HTML/Embperl.pm'}))
    {
    tie *LOG, 'HTML::Embperl::Log' ;
    }
else
    {
    *LOG = \*STDOUT ; 
    }


## ----------------------------------------------------------------------------
##
## SetupDBConnection
##
## $data_source  = Driver/DB/Host
##                  or recordset from which the data_source and dbhdl should be taken (optional)
## $table        = table (multiple tables must be comma separated)
## $username     = Username (optional)
## $password     = Password (optional) 
## \%attr        = Attributes (optional) 
##


sub SetupDBConnection($$$;$$\%)

    {
    my ($self, $data_source,  $table, $username, $password, $attr, $autolink) = @_ ;

    if ($table =~ /^\"/)
        {
        $self->{'*Table'}      = $table ;
        }
    else
        {
        $self->{'*Table'}      = $PreserveCase?$table:lc ($table) ;
        }

    $self->{'*MainTable'}  = $PreserveCase?$table:lc ($table) ;
    $self->{'*Id'}         = $id++ ;

    if (!($data_source =~ /^dbi\:/i)) 
        {
        my $metakey    = "-DATABASE//$data_source"  ;
        $data_source = $DBIx::Recordset::Metadata{$metakey} if (exists $DBIx::Recordset::Metadata{$metakey}) ;
        }

    if (ref ($data_source) eq 'DBIx::Recordset')
        { # copy from another recordset
        $self->{'*Driver'}     = $data_source->{'*Driver'} ;   
        $self->{'*DataSource'} = $data_source->{'*DataSource'} ;
        $self->{'*Username'}   = $data_source->{'*Username'} ; 
        $self->{'*DBHdl'}      = $data_source->{'*DBHdl'} ;    
        $self->{'*DBIAttr'}    = $data_source->{'*DBIAttr'} ;
        $self->{'*MainHdl'}    = 0 ;
        $self->{'*TableFilter'}= $data_source->{'*TableFilter'} ;
	$self->{'*Query'}      = $data_source->{'*Query'} ;
        }
    elsif (ref ($data_source) eq 'DBIx::Database')
        { # copy from database object
        $self->{'*DataSource'} = $data_source->{'*DataSource'} ;
        $self->{'*Username'}   = $data_source->{'*Username'} ; 
        $self->{'*DBIAttr'}    = $data_source->{'*DBIAttr'} ;
        $self->{'*TableFilter'}= $data_source->{'*TableFilter'} ;
        $self->{'*DBHdl'}      = $data_source->{'*DBHdl'} ;    
        $self->{'*Driver'}     = $data_source->{'*Driver'} ;   
        $self->{'*DoOnConnect'} = $data_source->{'*DoOnConnect'} ;
        }
     elsif (ref ($data_source) and eval { $data_source->isa('DBI::db') } )
         { # copy from database handle
         $self->{'*Driver'}     = $data_source->{'Driver'}->{'Name'} ;
         $self->{'*DataSource'} = $data_source->{'Name'} ;
         # DBI does not save user name
         $self->{'*Username'}   = undef ;
         $self->{'*DBHdl'}      = $data_source ;
         # XXX no idea how to fetch attr hash other than handle itself
         $self->{'*DBIAttr'}    = {} ;
         $self->{'*MainHdl'}    = 0 ;
         }
    else
        {
        $self->{'*DataSource'} = $data_source ;
        $self->{'*Username'}   = $username ;
        $self->{'*DBIAttr'}    = $attr ;
        $self->{'*DBHdl'}      = undef ;
        }

    
    my $hdl ;

    if (!defined ($self->{'*DBHdl'}))
        {
        $hdl = $self->{'*DBHdl'}  = DBI->connect($self->{'*DataSource'}, $self->{'*Username'}, $password, $self->{'*DBIAttr'}) or return undef ;

        $LastErr    = $self->{'*LastErr'}	= $DBI::err ;
        $LastErrstr = $self->{'*LastErrstr'}    = $DBI::errstr ;
    
        $self->{'*MainHdl'}    = 1 ;
        $self->{'*Driver'}     = $hdl->{Driver}->{Name} ;
	if ($self->{'*Driver'} eq 'Proxy')
	    {
            $self->{'*DataSource'} =~ /dsn\s*=\s*dbi:(.*?):/i ;
	    $self->{'*Driver'} = $1 ;
	    print LOG "DB:  Found DBD::Proxy, take compability entrys for driver $self->{'*Driver'}\n" if ($self->{'*Debug'} > 1) ;
	    }

        $numOpen++ ;

        print LOG "DB:  Successfull connect to $self->{'*DataSource'} (id=$self->{'*Id'}, numOpen = $numOpen)\n" if ($self->{'*Debug'} > 1) ;

        my $cmd ;
        if ($hdl && ($cmd = $self -> {'*DoOnConnect'}))
            {
            $self -> DoOnConnect ($cmd) ;
            }
        }
    else
        {
        $LastErr    = $self->{'*LastErr'}	= undef ;
        $LastErrstr = $self->{'*LastErrstr'}    = undef ;
    
        $hdl = $self->{'*DBHdl'} ;
        print LOG "DB:  Use already open dbh for $self->{'*DataSource'} (id=$self->{'*Id'}, numOpen = $numOpen)\n" if ($self->{'*Debug'} > 1) ;
        }
            
    

    my $meta = $self -> QueryMetaData ($self->{'*Table'}) ;
    my $metakey    = "$self->{'*DataSource'}//" . $self->{'*Table'} ;
    
    $self->{'*NullOperator'}  = DBIx::Compat::GetItem ($self->{'*Driver'}, 'NullOperator') ;
    $self->{'*HasInOperator'} = DBIx::Compat::GetItem ($self->{'*Driver'}, 'HasInOperator') ;

    $meta or $self -> savecroak ("No meta data available for $self->{'*Table'}") ;

    $self->{'*Table4Field'} = $meta->{'*Table4Field'} ;
    $self->{'*Type4Field'}  = $meta->{'*Type4Field'} ;
    #$self->{'*MainFields'} = $meta->{'*MainFields'} ;
    $self->{'*FullNames'}= $meta->{'*FullNames'} ;
    $self->{'*Names'}    = $meta->{'*Names'} ;
    $self->{'*Types'}    = $meta->{'*Types'} ;
    $self->{'*Quote'}    = $meta->{'*Quote'} ;
    $self->{'*Numeric'}  = $meta->{'*Numeric'} ;
    $self->{'*NumericTypes'}  = $meta->{'*NumericTypes'} ;
    $self->{'*Links'}    = $meta->{'*Links'} ;
    $self->{'*PrimKey'}  = $meta->{'!PrimKey'} ;


    return $hdl ;
    }


## ----------------------------------------------------------------------------
##
## TIEARRAY
##
## tie an array to the object, object must be aready blessed
##
## tie @self, 'DBIx::Recordset', $self ;
##


sub TIEARRAY
    {
    my ($class, $arg) = @_ ;
    my $rs ;    
    
    if (ref ($arg) eq 'HASH')
        {
        $rs = DBIx::Recordset -> SetupObject ($arg) or return undef ;
        }
    elsif (ref ($arg) eq 'DBIx::Recordset')
        {
        $rs = $arg ;
        }
    else
        {
        croak ("Need DBIx::Recordset or setup parameter") ;
        }

    
    return $rs ;
    }


sub STORESIZE
    
    {
    my ($self, $size) = @_ ;

    $self -> ReleaseRecords if ($size == 0) ;
    }


## ----------------------------------------------------------------------------
##
## New
##
## creates an new recordset object and ties an array and an hash to it
##
## returns a typeglob which contains:
## scalar:  ref to new object
## array:   array tied to object
## hash:    hash tied to object
##
## $data_source  = Driver/DB/Host
## $table        = table (multiple tables must be comma separated)
## $username     = Username (optional)
## $password     = Password (optional) 
## \%attr        = Attributes (optional) 
##


sub New
    {
    my ($class, $data_source,  $table, $username, $password, $attr) = @_ ;
    
    my $self = {'*Debug' => $Debug} ;

    bless ($self, $class) ;

    my $rc = $self->SetupDBConnection ($data_source,  $table, $username, $password, $attr) ;
    
    $self->{'*Placeholders'}= $DBIx::Compat::Compat{$self->{'*Driver'}}{Placeholders} ;
    $self->{'*Placeholders'}= $DBIx::Compat::Compat{'*'}{Placeholders} if (!defined ($self->{'*Placeholders'})) ;    
    $self->{'*Placeholders'}= 0 if ($self->{'*Placeholders'} < 10) ; # only full support for placeholders works

    if ($self->{'*Debug'} > 0)
        {
        print LOG "DB:  ERROR open DB $data_source ($DBI::errstr)\n" if (!defined ($rc)) ;

        my $n = '' ;
        $n = ' NOT' if (!$self->{'*Placeholders'}) ;
        print LOG "DB:  New Recordset driver=$self->{'*Driver'}  placeholders$n supported\n" if ($self->{'*Debug'} > 2)
        }

    return defined($rc)?$self:undef ;
    }

## ----------------------------------------------------------------------------
##
## SetupMemberVar
##
## setup a member config variable checking
## 1.) given parameter
## 2.) TableAttr
## 3.) default
##


sub SetupMemberVar
    {
    my ($self, $name, $param, $default) = @_ ;

    my $pn = "!$name" ;
    my $sn = "\*$name" ;
    my $attr ;

    if (exists $param -> {$pn})
	{
	$self -> {$sn} = $param -> {$pn} ;
	}
    elsif (defined ($attr = $self -> TableAttr ($pn)))
	{
	$self -> {$sn} = $attr ;
	}
    else
	{
	$self -> {$sn} ||= $default ;
	}
    print LOG "DB:  Setup: $pn = " . (defined ($self->{$sn})?$self->{$sn}:'<undef>') . "\n" if ($self -> {'*Debug'} > 2) ;
    }


## ----------------------------------------------------------------------------
##
## Setup
##
## creates an new recordset object and ties an array and an hash to it
##
## Same as New, but parameters passed as hash:
##
## !DataSource  = Driver/DB/Host
##                or a Recordset object from which to take the DataSource, DBIAttrs and username
## !Username    = username
## !Password    = password
## !DBIAttr     = reference to a hash which is passed to the DBI connect method
##
## !Table       = Tablename, muliply tables are comma separated
## !Fields      = fields which should be return by a query
## !Order	= order for any query
## !TabRelation = condition which describes the relation
##                between the given tables
## !TabJoin     = JOIN to use in table part of select statement
## !PrimKey     = name of primary key
## !StoreAll	= store all fetched data
## !LinkName    = query !NameField field(s) instead of !MainField for links
##		    0 = off
##		    1 = select additional fields
##		    2 = build name in uppercase of !MainField
##		    3 = replace !MainField with content of !NameField
##
## !Default     = hash with default record data
## !IgnoreEmpty = 1 ignore undef values, 2 ignore empty strings
##
## !WriteMode   = 1 => allow insert (wmINSERT)
##                2 => allow update (wmUPDATE)
##		  4 => allow delete (wmDELETE)
##                8 => allow delete all (wmCLEAR)
##		    default = 7
## !TableFilter = prefix which tables should be used
##


sub SetupObject

    {
    my ($class, $parm) = @_ ;

    my $self = New ($class, $$parm{'!DataSource'}, $$parm{'!Table'}, $$parm{'!Username'}, $$parm{'!Password'}, $$parm{'!DBIAttr'}) or return undef ; 


    HTML::Embperl::RegisterCleanup (sub { $self -> Disconnect }) if (defined (&HTML::Embperl::RegisterCleanup)) ;

    $self -> SetupMemberVar ('Debug', $parm, $Debug) ;
    $self -> SetupMemberVar ('Fields', $parm) ;
    $self -> SetupMemberVar ('TabRelation', $parm) ;
    $self -> SetupMemberVar ('TabJoin', $parm) ;
    $self -> SetupMemberVar ('PrimKey', $parm) ;
    $self -> SetupMemberVar ('Serial', $parm) ;
    $self -> SetupMemberVar ('Sequence', $parm) ;
    $self -> SetupMemberVar ('SeqClass', $parm) ;
    $self -> SetupMemberVar ('StoreAll', $parm) ;
    $self -> SetupMemberVar ('Default', $parm) ;
    $self -> SetupMemberVar ('IgnoreEmpty', $parm, 0) ;
    $self -> SetupMemberVar ('WriteMode', $parm, 7) ;
    $self -> SetupMemberVar ('TieRow', $parm, 1) ;
    $self -> SetupMemberVar ('LongNames', $parm, 0) ;
    $self -> SetupMemberVar ('KeepFirst', $parm, 0) ;
    $self -> SetupMemberVar ('LinkName', $parm, 0) ;
    $self -> SetupMemberVar ('NameField', $parm) ;
    $self -> SetupMemberVar ('Order', $parm) ;
    $self -> SetupMemberVar ('TableFilter', $parm) ;
    $self -> SetupMemberVar ('DoOnConnect', $parm) ;
    $self -> SetupMemberVar ('Query', $parm) ;

    if ($self -> {'*Serial'}) 
        {
        $self->{'*PrimKey'}     = $self -> {'*Serial'} if (!$parm->{'!PrimKey'}) ;
        $self->{'*Sequence'}    ||= "$self->{'*Table'}_seq" ;
    
        if ($self->{'*SeqClass'})
            {
            my @seqparm = split (/\s*,\s*/, $self->{'*SeqClass'}) ;

            my $class = shift @seqparm ;
            if (!defined (&{"$class\:\:new"}))
                {
                my $fn = $class ;
                $fn =~ s/::/\//g ;
                $fn .= '.pm' ;
                require $fn ;
                }
            $self->{'*SeqObj'} = $class -> new ($self -> {'*DBHdl'}, @seqparm) ; 
            }
        else
            {                        
            $self->{'*GetSerialPreInsert'} = DBIx::Compat::GetItem ($self -> {'*Driver'}, 'GetSerialPreInsert')  ;
            $self->{'*GetSerialPostInsert'} = DBIx::Compat::GetItem ($self -> {'*Driver'}, 'GetSerialPostInsert')  ;
            }
        }

    $Data{$self->{'*Id'}}   = [] ;
    $self->{'*FetchStart'}  = 0 ;
    $self->{'*LastSerial'}  = undef ;
    $self->{'*FetchMax'}    = undef ;
    $self->{'*EOD'}         = undef ;
    $self->{'*CurrRow'}     = 0 ;
    $self->{'*Stats'} = {} ;
    $self->{'*CurrRecStack'} = [] ;

    $self->{'*LinkSet'} = {} ;
    $LastErr	= $self->{'*LastErr'}	    = undef ;
    $LastErrstr = $self->{'*LastErrstr'}    = undef ;

    my $ofunc = $self->{'*OutputFunctions'} = {} ;
    my $ifunc = $self->{'*InputFunctions'}  = {} ;
    my $irfunc_insert = $self->{'*InputFunctionsRequiredOnInsert'}  = [] ;
    my $irfunc_update = $self->{'*InputFunctionsRequiredOnUpdate'}  = [] ;
    my $names = $self->{'*Names'} ;
    my $types = $self->{'*Types'} ;
    my $key ;
    my $value ;
    my $conversion ;
    my $dbg = ($self -> {'*Debug'} > 2) ;

    foreach $conversion (($self -> TableAttr ('!Filter'), $$parm{'!Filter'}))  
	{
	if ($conversion)
	    {
	    foreach $key (sort keys %$conversion)
		{
		$value = $conversion -> {$key} ;
		if ($key =~ /^-?\d*$/)
		    { # numeric -> SQL_TYPE
		    my $i = 0 ;
		    my $name ;
		    foreach (@$types)
			{
			if ($_ == $key) 
			    {
			    $name = $names -> [$i] ;
			    if ($value -> [0] || $ifunc -> {$name}) 
                                {
                                local $^W = 0 ;
                                $ifunc -> {$name} = $value -> [0] ;
		                print LOG "DB:  Apply input Filter to $name (type=$_)\n" if ($dbg) ;
		                push @$irfunc_insert, $name if ($value -> [2] & rqINSERT) ;
		                print LOG "DB:  Apply required INSERT Filter to $name (type=$_)\n" if ($dbg && $value -> [2] & rqINSERT) ;
		                push @$irfunc_update, $name if ($value -> [2] & rqUPDATE) ;
		                print LOG "DB:  Apply required UPDATE Filter to $name (type=$_)\n" if ($dbg && $value -> [2] & rqUPDATE) ;
                                }
			    $ofunc -> {$name} = $value -> [1] if ($value -> [1] || $ofunc -> {$name}) ;
			    print LOG "DB:  Apply output Filter to $name  (type=$_)\n" if ($dbg && ($value -> [1] || $ofunc -> {$name})) ;
                            }
			$i++ ;
			}
		    }
		else
		    {    	    
		    if ($value -> [0] || $ifunc -> {$key}) 
                        {
                        local $^W = 0 ;
                        $ifunc -> {$key} = $value -> [0] ;
		        print LOG "DB:  Apply input Filter to $key\n" if ($dbg) ;
		        push @$irfunc_insert, $key if ($value -> [2] & rqINSERT) ;
		        print LOG "DB:  Apply required INSERT Filter to $key\n" if ($dbg && $value -> [2] & rqINSERT) ;
		        push @$irfunc_update, $key if ($value -> [2] & rqUPDATE) ;
	                print LOG "DB:  Apply required UPDATE Filter to $key\n" if ($dbg && $value -> [2] & rqUPDATE) ;
                        }
    		    $ofunc -> {$key} = $value -> [1] if ($value -> [1] || $ofunc -> {$key}) ;
		    print LOG "DB:  Apply output Filter to $key\n" if ($dbg && ($value -> [1] || $ofunc -> {$key})) ;
		    }
		}
	    }
	}

    delete $self->{'*OutputFunctions'} if (keys (%$ofunc) == 0) ;
    delete $self->{'*InputFunctionsRequiredOnInsert'} if ($#$irfunc_insert == -1) ;
    delete $self->{'*InputFunctionsRequiredOnUpdate'} if ($#$irfunc_update == -1) ;
    	

    my $links =  $$parm{'!Links'} ;
    if (defined ($links))
        {
        my $k ;
        my $v ;
        while (($k, $v) = each (%$links))
            {
            $v -> {'!LinkedField'} = $v -> {'!MainField'} if (defined ($v) && !defined ($v -> {'!LinkedField'})) ;
            $v -> {'!MainField'}   = $v -> {'!LinkedField'} if (defined ($v) && !defined ($v -> {'!MainField'})) ;
            }
        $self->{'*Links'} = $links ;
        }

    if ($self->{'*LinkName'})
        {
        ($self->{'*Fields'}, $self->{'*Table'}, $self->{'*TabJoin'}, $self->{'*TabRelation'}, $self->{'*ReplaceFields'}) = 
               $self -> BuildFields ($self->{'*Fields'}, $self->{'*Table'}, $self->{'*TabRelation'}) ;
        }

    return $self ;
    }


sub Setup

    {
    my ($class, $parm) = @_ ;

    local *self ;
    
    $self = SetupObject ($class, $parm) or return undef ;

    tie @self, $class, $self ;
    if ($parm -> {'!HashAsRowKey'})
	{
	tie %self, "$class\:\:Hash", $self ;
	}
    else
	{
	tie %self, "$class\:\:CurrRow", $self ;
	}

    return *self ;
    }


## ----------------------------------------------------------------------------
##
## ReleaseRecords ...
##
## Release all records, write data if necessary
##

sub ReleaseRecords

    {
    $_[0] -> {'*LastKey'} = undef ;
    $_[0] -> Flush (1) ;
    #delete $Data{$_[0] -> {'*Id'}}  ;
    $Data{$_[0] -> {'*Id'}} = [] ;
    }



## ----------------------------------------------------------------------------
##
## undef and untie the object
##

sub Undef

    {
    my ($objname) = @_ ;

    if (!($objname =~ /\:\:/))
        {
        my ($c) = caller () ;
        $objname = "$c\:\:$objname" ;
        } 
    
    print LOG "DB:  Undef $objname\n" if (defined (${$objname}) && (${$objname}->{'*Debug'} > 1 || $Debug > 1)) ; 
    
    
    if (defined (${$objname}) && ref (${$objname}) && UNIVERSAL::isa (${$objname}, 'DBIx::Recordset')) 
        {
        # Cleanup rows and write them if necessary
        ${$objname} -> ReleaseRecords () ;
        ${$objname} -> Disconnect () ;
        }

    if (defined (%{$objname}))
        {
        my $obj = tied (%{$objname}) ;
        $obj -> {'*Recordset'} = undef if ($obj) ;
        $obj = undef ;
        }

    #${$objname} = undef ;
    untie %{$objname} ;
    undef ${$objname} if (defined (${$objname}) && ref (${$objname})) ;
    untie @{$objname} ;
    }


## ----------------------------------------------------------------------------
##
## disconnect from database
##

sub Disconnect ($)
    {
    my ($self) = @_ ;

    if (defined ($self->{'*StHdl'})) 
        {
        $self->{'*StHdl'} -> finish () ;
        print LOG "DB:  Call DBI finish (id=$self->{'*Id'}, Last = $self->{'*LastSQLStatement'})\n" if ($self->{'*Debug'} > 3) ;
        undef $self->{'*StHdl'} ;
        }

    $self -> ReleaseRecords () ;

    if (defined ($self->{'*DBHdl'}) && $self->{'*MainHdl'})
        {
        $numOpen-- ;
        print LOG "DB:  Call DBI disconnect (id=$self->{'*Id'}, numOpen = $numOpen)\n" if ($self->{'*Debug'} > 3) ;
        $self->{'*DBHdl'} -> disconnect () ;
        undef $self->{'*DBHdl'} ;
        }


    print LOG "DB:  Disconnect (id=$self->{'*Id'}, numOpen = $numOpen)\n" if ($self->{'*Debug'} > 1) ;
    }


## ----------------------------------------------------------------------------
##
## do some cleanup 
##

sub DESTROY ($)
    {
    my ($self) = @_ ;
    my $orgerr = $@ ;
    local $@ ;

    eval 
	{ 
	$self -> Disconnect () ;

	delete $Data{$self -> {'*Id'}}  ;

	    {
	    local $^W = 0 ;
	    print LOG "DB:  DESTROY (id=$self->{'*Id'}, numOpen = $numOpen)\n" if ($self->{'*Debug'} > 2) ;
	    }
	} ;
    $self -> savecroak ($@) if (!$orgerr && $@) ;
    warn $@ if ($orgerr && $@) ;
    }



## ----------------------------------------------------------------------------
##
## begin transaction
##

sub Begin 

    {
    my ($self) = @_ ;

    # 'begin' method is unhandled by DBI
    ## ??  $self->{'*DBHdl'} -> func('begin') unless $self->{'*DBHdl'}->{'AutoCommit'};
    }

## ----------------------------------------------------------------------------
##
## commit transaction
##

sub Commit 

    {
    my ($self) = @_ ;

    $self -> Flush ;
    $self->{'*DBHdl'} -> commit unless $self->{'*DBHdl'}->{'AutoCommit'} ;
    }

## ----------------------------------------------------------------------------
##
## rollback transaction
##

sub Rollback

    {
    my ($self) = @_ ;

    $self -> ReleaseRecords ;

    $self->{'*DBHdl'} -> rollback unless $self->{'*DBHdl'}->{'AutoCommit'} ;
    }

## ----------------------------------------------------------------------------
##
## store something in the array
##

sub STORE 

    {
    my ($self, $fetch, $value) = @_ ;

    $fetch += $self->{'*FetchStart'} ;
    #$max    = $self->{'*FetchMax'} ;
    print LOG "DB:  STORE \[$fetch\] = " . (defined ($value)?$value:'<undef>') . "\n"  if ($self->{'*Debug'} > 3) ;
    if ($self->{'*Debug'} > 2 && ref ($value) eq 'HASH')
        {
        my $k ;
        my $v ;
        while (($k, $v) = each (%$value))
            {
            print LOG "<$k>=<$v> " ;
            }
        print LOG "\n" ;
        }        
    my $r ;
    my $rec ;
    $value ||= {} ;
    if (keys %$value)
        {
        my %rowdata ;
        $r = tie %rowdata, 'DBIx::Recordset::Row', $self ;
        %rowdata = %$value ;
        $rec = $Data{$self->{'*Id'}}[$fetch] = \%rowdata ;
        }
    else
        {
        local $^W = 0 ;

        $r = tie %$value, 'DBIx::Recordset::Row', $self, $value ;
        $rec = $Data{$self->{'*Id'}}[$fetch] = $value ;
	my $dirty = $r->{'*dirty'} ; # preserve dirty state  
        %$value = %{$self -> {'*Default'}} if (exists ($self -> {'*Default'})) ;
	$r->{'*dirty'}   = $dirty
        }
    $r -> {'*new'} = 1 ;

    #$self->{'*LastRow'} = $fetch ;
    #$self->{'*LastKey'} = $r -> FETCH ($self -> {'*PrimKey'}) ;

    return $rec ;
    } 

## ----------------------------------------------------------------------------
##
## Add
##
## Add a new record
##

sub Add
    
    {
    my ($self, $data) = @_ ;

    my $num = $#{$Data{$self->{'*Id'}}} + 1 ;

    $self -> STORE ($num, $data) if ($data) ;
    
    $self -> {'*CurrRow'} = $num + 1 ;
    $self -> {'*LastRow'} = $num ;
    
    return $num ;
    }


## ----------------------------------------------------------------------------
##
## StHdl
##
## return DBI statement handle of last select
##

sub StHdl ($)

    {
    return $_[0] -> {'*StHdl'} ;
    }


## ----------------------------------------------------------------------------
##
## TableName
##
## return name of table
##

sub TableName ($)

    {
    return $_[0] -> {'*Table'} ;
    }

## ----------------------------------------------------------------------------
##
## TableNameWithoutFilter
##
## return name of table. If a !TabFilter was specified, and the table start with 
## that filter text, it is removed from the front of the name
##

sub TableNameWithoutFilter ($)

    {
    my $tab = $_[0] -> {'*Table'} ;

    return $1 if ($tab =~ /^$_[0]->{'*TableFilter'}(.*?)$/) ;
    return $tab ;
    }

## ----------------------------------------------------------------------------
##
## PrimKey
##
## return name of primary key
##

sub PrimKey ($)

    {
    return $_[0] -> {'*PrimKey'} ;
    }


## ----------------------------------------------------------------------------
##
## TableFilter
##
## return table filter
##

sub TableFilter ($)

    {
    return $_[0] -> {'*TableFilter'} ;
    }


## ----------------------------------------------------------------------------
##
## AllNames
##
## return reference to array of all names in all tables
##

sub AllNames

    {
    return $_[0] -> {'*Names'} ;
    }

## ----------------------------------------------------------------------------
##
## AllTypes
##
## return reference to array of all types in all tables
##

sub AllTypes

    {
    return $_[0] -> {'*Types'} ;
    }


## ----------------------------------------------------------------------------
##
## Names
##
## return reference to array of names of the last query
##

sub Names

    {
    my $self = shift ;
    if ($self -> {'*LinkName'} < 2)
        {
        return $self->{'*SelectFields'} ;
        }
    else
        {
        my $names = $self->{'*SelectFields'};
        my $repl = $self -> {'*ReplaceFields'} ;
        my @newnames  ;
        my $i  ;
        for ($i = 0; $i <= $#$repl; $i++)
            {
            #print LOG "### Names $i = $names->[$i]\n" ;
            push @newnames, $names -> [$i] ; 
            }
        return \@newnames ;
        }
    }


## ----------------------------------------------------------------------------
##
## Types
##
## return reference to array of types of the last query
##

sub Types

    {
    my $sth = $_[0] -> {'*StHdl'} ;
    return undef if (!$sth) ;
    return $sth -> FETCH('TYPE') ;
    }


## ----------------------------------------------------------------------------
##
## Link
##
## if linkname if undef returns reference to an hash of all links
## else returns reference to that link
##

sub Link

    {
    my ($self, $linkname) = @_ ;

    my $links = $self -> {'*Links'} ;
    return undef if (!defined ($links)) ;
    return $links if (!defined ($linkname)) ;
    return $links -> {$linkname}  ;
    }

## ----------------------------------------------------------------------------
##
## Link4Field
##
## returns the Linkname for that field, if any
##

sub Link4Field

    {
    my ($self, $field) = @_ ;

    my $links = $self -> {'*Links'} ;
    return undef if (!defined ($field)) ;

    my $tab4f = $self -> {'*Table4Field'} ;

    if (!exists ($self -> {'*MainFields'}))
        {
        my $k ;
        my $v ;

        my $mf = {} ;
        my $f ;
        while (($k, $v) = each (%$links))
            {
            $f = $v -> {'!MainField'} ;
            $mf -> {$f} = $k ;
            $mf -> {"$tab4f->{$f}.$f"} = $k ;
            print LOG "DB:  Field $v->{'!MainField'} has link $k\n" ;
            }
        $self -> {'*MainFields'} = $mf ;
        }

    return $self -> {'*MainFields'} -> {$field} ;
    }

## ----------------------------------------------------------------------------
##
## Links
##
## return reference to an hash of links
##

sub Links

    {
    return $_[0] -> {'*Links'} ;
    }

## ----------------------------------------------------------------------------
##
## TableAttr
##
## get and/or set an unser defined attribute of that table
##
## $key   = key
## $value = new value (optional)
## $table = Name of table(s) (optional)
##

sub TableAttr

    {
    my ($self, $key, $value, $table) = @_ ;

   $table ||= $self -> {'*MainTable'} ;

    my $meta ;
    my $metakey    = "$self->{'*DataSource'}//" . ($PreserveCase?$table:lc ($table)) ; ;
    
    if (!defined ($meta = $DBIx::Recordset::Metadata{$metakey})) 
        {
        $self -> savecroak ("Unknown table $table in $self->{'*DataSource'}") ;
        }

    # set new value if wanted
    return $meta -> {$key} = $value if (defined ($value)) ;

    # only return value
    return $meta -> {$key} if (exists ($meta -> {$key})) ;

    # check if there is a default value
    $metakey    = "$self->{'*DataSource'}//*" ;
    
    return undef if (!defined ($meta = $DBIx::Recordset::Metadata{$metakey})) ;

    return $meta -> {$key} ;
    }

## ----------------------------------------------------------------------------
##
## Stats
##
## return statistics
##

sub Stats

    {
    return $_[0] -> {'*Stats'} ;
    }


## ----------------------------------------------------------------------------
##
## StartRecordNo
##
## return the record no which will be returned for index 0
##

sub StartRecordNo

    {
    return $_[0] -> {'*StartRecordNo'} ;
    }

## ----------------------------------------------------------------------------
##
## LastSQLStatement
##
## return the last executed SQL Statement
##

sub LastSQLStatement

    {
    return $_[0] -> {'*LastSQLStatement'} ;
    }

## ----------------------------------------------------------------------------
##
## LastSerial
##
## return the last value of the field defined with !Serial
##

sub LastSerial

    {
    return $_[0] -> {'*LastSerial'} ;
    }


## ----------------------------------------------------------------------------
##
## LastError
##
## returns the last error message and code (code only in array context)
##

sub LastError

    {
    my $self = shift ;

    if (ref $self)
	{
	if (wantarray)
	    {
	    return ($self -> {'*LastErrstr'}, $self -> {'*LastErr'}) ;
	    }
	else
	    {
	    return $self -> {'*LastErrstr'} ;
	    }
	}
    else
	{
	if (wantarray)
	    {
	    return ($LastErrstr, $LastErr) ;
	    }
	else
	    {
	    return $LastErrstr ;
	    }
	}
    }


## ----------------------------------------------------------------------------
##
## SQL Insert ...
##
## $fields = comma separated list of fields to insert
## $vals   = comma separated list of values to insert
## \@bind_values = values which should be insert for placeholders
## \@bind_types  = data types of bind_values
##

sub SQLInsert ($$$$)

    {
    my ($self, $fields, $vals, $bind_values, $bind_types) = @_ ;
  
    $self -> savecroak ("Insert disabled for table $self->{'*Table'}") if (!($self->{'*WriteMode'} & wmINSERT)) ;
      
    $self->{'*Stats'}{insert}++ ;

    if (defined ($bind_values))
        {
        return $self->do ("INSERT INTO $self->{'*Table'} ($fields) VALUES ($vals)", undef, $bind_values, $bind_types) ;
        }
    else
        {
        return $self->do ("INSERT INTO $self->{'*Table'} ($fields) VALUES ($vals)") ;
        }
    }

## ----------------------------------------------------------------------------
##
## SQL Update ...
##
## $data = komma separated list of fields=value to update
## $where = SQL Where condition
## \@bind_values = values which should be insert for placeholders
## \@bind_types  = data types of bind_values
##
##

sub SQLUpdate ($$$$)

    {
    my ($self, $data, $where, $bind_values, $bind_types) = @_ ;
    
    $self -> savecroak ("Update disabled for table $self->{'*Table'}") if (!($self->{'*WriteMode'} & wmUPDATE)) ;

    $self->{'*Stats'}{update}++ ;

    if (defined ($bind_values))
        {
        return $self->do ("UPDATE $self->{'*Table'} SET $data WHERE $where", undef, $bind_values, $bind_types) ;
        }
    else
        {
        return $self->do ("UPDATE $self->{'*Table'} SET $data WHERE $where") ;
        }
    }

## ----------------------------------------------------------------------------
##
## SQL Delete ...
##
## $where = SQL Where condition
## \@bind_values = values which should be insert for placeholders
## \@bind_types  = data types of bind_values
##
##

sub SQLDelete ($$$)

    {
    my ($self, $where, $bind_values, $bind_types) = @_ ;
    
    $self -> savecroak ("Delete disabled for table $self->{'*Table'}") if (!($self->{'*WriteMode'} & wmDELETE)) ;
    $self -> savecroak ("Clear (Delete all) disabled for table $self->{'*Table'}") if (!$where && !($self->{'*WriteMode'} & wmCLEAR)) ;

    $self->{'*Stats'}{'delete'}++ ;

    if (defined ($bind_values))
        {
        return $self->do ("DELETE FROM $self->{'*Table'} " . ($where?"WHERE $where":''), undef, $bind_values, $bind_types) ;
        }
    else
        {
        return $self->do ("DELETE FROM $self->{'*Table'} " . ($where?"WHERE $where":'')) ;
        }
    }




## ----------------------------------------------------------------------------
##
## SQL Select
##
## Does an SQL Select of the form
##
##  SELECT $fields FROM <table> WHERE $expr ORDERBY $order
##
## $expr    = SQL Where condition (optional, defaults to no condition)
## $fields  = fields to select (optional, default to *)
## $order   = fields for sql order by or undef for no sorting (optional, defaults to no order) 
## $group   = fields for sql group by or undef (optional, defaults to no grouping) 
## $append  = append that string to the select statemtn for other options (optional) 
## \@bind_values = values which should be inserted for placeholders
## \@bind_types  = data types of bind_values
##

sub SQLSelect ($;$$$$$$$)
    {
    my ($self, $expr, $fields, $order, $group, $append, $bind_values, $bind_types, $makesql, ) = @_ ;

    my $sth ;  # statement handle
    my $where ; # where or nothing
    my $orderby ; # order by or nothing
    my $groupby ; # group by or nothing
    my $rc  ;        #
    my $table ;

    if (defined ($self->{'*StHdl'})) 
        {
        $self->{'*StHdl'} -> finish () ;
        print LOG "DB:  Call DBI finish (id=$self->{'*Id'}, Last = $self->{'*LastSQLStatement'})\n" if ($self->{'*Debug'} > 3) ;
        }
    undef $self->{'*StHdl'} ;
    $self->ReleaseRecords ;
    undef $self->{'*LastKey'} ;
    $self->{'*FetchStart'} = 0 ;
    $self->{'*StartRecordNo'} = 0 ;
    $self->{'*FetchMax'} = undef ;
    $self->{'*EOD'} = undef ;
    $self->{'*SelectFields'} = undef ;
    $self->{'*LastRecord'} = undef ;

    $order  ||= '' ;
    $expr   ||= '' ;
    $group  ||= '' ;
    $append ||= '' ;
    $orderby  = $order?'ORDER BY':'' ;
    $groupby  = $group?'GROUP BY':'' ;
    $where    = $expr?'WHERE':'' ;
    $fields ||= '*';
    $table    = $self->{'*TabJoin'} || $self->{'*Table'} ;

    my $statement;
    if ($self->{'*Query'}) {
       $statement = $self->{'*Query'} . " " . $append;
    } else {
       $statement = "SELECT $fields FROM $table $where $expr $groupby $group $orderby $order $append" ;
    }



    if ($self->{'*Debug'} > 1)
        { 
        my $bv = $bind_values || [] ;
        my $bt = $bind_types || [] ;
        print LOG "DB:  '$statement' bind_values=<@$bv> bind_types=<@$bt>\n" ;
        }

    $self -> {'*LastSQLStatement'} = $statement ;

    return $statement if $makesql;

    $self->{'*Stats'}{'select'}++ ;

    $sth = $self->{'*DBHdl'} -> prepare ($statement) ;

    if (defined ($sth))
        {
        my @x ;
        my $ni = 0 ;
        
        my $Numeric = $self->{'*NumericTypes'} ;
        local $^W = 0 ; # avoid warnings
        for (my $i = 0 ; $i < @$bind_values; $i++)
            {
            #print LOG "bind $i  bv=<$bind_values->[$i]>  bvcnv=" . ($Numeric -> {$bind_types -> [$i]}?$bind_values -> [$i]+0:$bind_values -> [$i]) . "  bt=$bind_types->[$i]  n=$Numeric->{$bind_types->[$i]}\n" ;
            $bind_values -> [$i] += 0 if (defined ($bind_values -> [$i]) && defined ($bind_types -> [$i]) && $Numeric -> {$bind_types -> [$i]}) ;
            #my $bti = $bind_types -> [$i]+0 ;
            #$sth -> bind_param ($i+1, $bind_values -> [$i], {TYPE => $bti}) ;
            #$sth -> bind_param ($i+1, $bind_values -> [$i], $bind_types -> [$i] == DBI::SQL_CHAR()?DBI::SQL_CHAR():undef) ;
	    my $bt = $bind_types -> [$i] ;
            $sth -> bind_param ($i+1, $bind_values -> [$i], (defined ($bt) && $bt <= DBI::SQL_CHAR())?{TYPE => $bt}:undef ) ;
            }
        $rc = $sth -> execute  ;
	$self->{'*SelectedRows'} = $sth->rows;
	}
        
    $LastErr	= $self->{'*LastErr'}	    = $DBI::err ;
    $LastErrstr = $self->{'*LastErrstr'}    = $DBI::errstr ;
    
    my $names ;
    if ($rc)
    	{
	$names = $sth -> FETCH (($PreserveCase?'NAME':'NAME_lc')) ;
    	$self->{'*NumFields'} = $#{$names} + 1 ;
	}
    else
    	{
	print LOG "DB:  ERROR $DBI::errstr\n"  if ($self->{'*Debug'}) ;
	print LOG "DB:  in '$statement' bind_values=<@$bind_values> bind_types=<@$bind_types>\n" if ($self->{'*Debug'} == 1) ;
    
    	$self->{'*NumFields'} = 0 ;
	
	undef $sth ;
	}

    $self->{'*CurrRow'} = 0 ;
    $self->{'*LastRow'} = 0 ;
    $self->{'*StHdl'}   = $sth ;

    my @ofunca  ;
    my $ofunc  = $self -> {'*OutputFunctions'} ;

    if ($ofunc && $names)
	{
	my $i = 0 ;

	foreach (@$names)
	    {
	    $ofunca [$i++] = $ofunc -> {$_} ;
	    }
	}

    $self -> {'*OutputFuncArray'} = \@ofunca ;
    

	
    if ($self->{'*LongNames'})
        {
        if ($fields eq '*')
	    {
	    $self->{'*SelectFields'} = $self->{'*FullNames'} ;
	    }
        else
            {
            my $tab4f  = $self -> {'*Table4Field'} ;
            #my @allfields = map { (/\./)?$_:"$tab4f->{$_}.$_" } split (/\s*,\s*/, $fields) ;
            my @allfields = map { (/\./)?$_:"$tab4f->{$_}.$_" } quotewords ('\s*,\s*', 0, $fields) ;
            shift @allfields if (lc($allfields[0]) eq 'distinct') ;
            $self->{'*SelectFields'} = \@allfields ;
            }
        }
    else
	{
	$self->{'*SelectFields'} = $names ;
	}


    return $rc ;
    }

## ----------------------------------------------------------------------------
##
## FECTHSIZE - returns the number of rows form the last SQLSelect
##
## WARNING: Not all DBD drivers returns the correct number of rows
## so we issue a warning/error message when this function is used
##



sub FETCHSIZE 

    {
    my ($self) = @_;

    die "FETCHSIZE may not supported by your DBD driver, set \$FetchsizeWarn to zero if you are sure it works. Read about \$FetchsizeWarn in the docs!"  if ($FetchsizeWarn == 2) ;
    warn "FETCHSIZE may not supported by your DBD driver, set \$FetchsizeWarn to zero if you are sure it works. Read about \$FetchsizeWarn in the docs!"  if ($FetchsizeWarn == 1) ;
        
    my $sel = $self->{'*SelectedRows'} ;
    return $sel if (!defined ($self->{'*FetchMax'})) ;

    my $max = $self->{'*FetchMax'} - $self->{'*FetchStart'} + 1 ;
    return $max<$sel?$max:$sel ;
    }   


## ----------------------------------------------------------------------------
##
## Fetch the data from a previous SQL Select
##
## $fetch     = Row to fetch
## 
## fetchs the nth row and return a ref to an hash containing the entire row data
##


sub FETCH  
    {
    my ($self, $fetch) = @_ ;

    print LOG "DB:  FETCH \[$fetch\]\n"  if ($self->{'*Debug'} > 3) ;

    $fetch += $self->{'*FetchStart'} ;

    return $self->{'*LastRecord'} if (defined ($self->{'*LastRecordFetch'}) && $fetch == $self->{'*LastRecordFetch'} && $self->{'*LastRecord'}) ; 

    my $max ;
    my $key ;
    my $dat ;                           # row data

    
    $max    = $self->{'*FetchMax'} ;

    my $row = $self->{'*CurrRow'} ;     # row next to fetch from db
    my $sth = $self->{'*StHdl'} ;       # statement handle
    my $data = $Data{$self->{'*Id'}} ;  # data storage (Data is stored in a seperate hash to avoid circular references)

    if ($row <= $fetch && !$self->{'*EOD'} && defined ($sth))
        {

        # successfull select has happend before ?
        return undef if (!defined ($sth)) ;
        return undef if (defined ($max) && $row > $max) ;
        
        my $fld = $self->{'*SelectFields'} ;
        my $arr  ;
        my $i  ;

	if ($self -> {'*StoreAll'})
	    {
	    while ($row < $fetch)
		{
    	        if (!($arr = $sth -> fetchrow_arrayref ()))
		    {
		    $self->{'*EOD'} = 1 ;
		    $sth -> finish ;
                    print LOG "DB:  Call DBI finish (id=$self->{'*Id'}, LastRow = $row, Last = $self->{'*LastSQLStatement'})\n" if ($self->{'*Debug'} > 3) ;
                    undef $self->{'*StHdl'} ;
		    last ;
		    }
                
                $i = 0 ;
                $data->[$row] = [ @$arr ] ;
		$row++ ;

                last if (defined ($max) && $row > $max) ;
		}
	    }
	else
	    {
	    while ($row < $fetch)
		{
    	        if (!$sth -> fetchrow_arrayref ())
		    {
		    $self->{'*EOD'} = 1 ;
		    $sth -> finish ;
                    print LOG "DB:  Call DBI finish (id=$self->{'*Id'}, Last = $self->{'*LastSQLStatement'})\n" if ($self->{'*Debug'} > 3) ;
                    undef $self->{'*StHdl'} ;
		    last ;
		    }
		$row++ ;
                last if (defined ($max) && $row > $max) ;
		}
	    }


        $self->{'*LastRow'}   = $row ;
        if ($row == $fetch && !$self->{'*EOD'})
    	    {
            
    	    $arr = $sth -> fetchrow_arrayref () ;
            
            if ($arr)
                {
                $row++ ;
                $dat = {} ;
                if ($self -> {'*TieRow'})
		    {
		    my $obj = tie %$dat, 'DBIx::Recordset::Row', $self, $fld, $arr ;
		    $self->{'*LastKey'} = $obj -> FETCH ($self -> {'*PrimKey'}) ;
		    }
		else
		    {
		    @$dat{@$fld} = @$arr ;
                

		    my $nf = $self -> {'*NameField'} || $self -> TableAttr ('!NameField') ;
		    if ($nf)
			{
			if (!ref $nf)
			    {
			    $dat -> {'!Name'} = $dat -> {uc($nf)} || $dat -> {$nf} ;
			    }
			else
			    {    
			    $dat -> {'!Name'} = join (' ', map { $dat -> {uc ($_)} || $dat -> {$_} } @$nf) ;
			    }
			}

                    $self->{'*LastKey'} = $dat -> {$self -> {'*PrimKey'}} if ($self -> {'*PrimKey'}) ;
		    }
            
                $data -> [$fetch] = $dat ;
                }
            else
                {
                $dat = $data -> [$fetch] = undef ;
                #print LOG "new dat undef\n"  ;
    	        $self->{'*EOD'} = 1 ;
		$sth -> finish ;
                print LOG "DB:  Call DBI finish (id=$self->{'*Id'}, Last = $self->{'*LastSQLStatement'})\n" if ($self->{'*Debug'} > 3) ;
                undef $self->{'*StHdl'} ;
                }
            }
        $self->{'*CurrRow'} = $row ;
        }
    else
        {
	my $obj ;

        $dat = $data -> [$fetch] if (!defined ($max) || $fetch <= $max);
	if (ref $dat eq 'ARRAY')
	    { # just an Array so tie it now
	    my $arr = $dat ;	
            $dat = {} ;
            $obj = tie %$dat, 'DBIx::Recordset::Row', $self, $self->{'*SelectFields'} , $arr ;
            $data -> [$fetch] = $dat ;
	    $self->{'*LastRow'} = $fetch ;
            $self->{'*LastKey'} = $obj -> FETCH ($self -> {'*PrimKey'}) ;
	    }
	else
	    {
	    #my $v ;
	    #my $k ;
	    #print LOG "old dat\n" ; #  = $dat  ref = " . ref ($dat) . " tied = " . ref (tied(%$dat)) . " fetch = $fetch\n"  ;
	    #while (($k, $v) = each (%$dat))
	    #        {
	    #        print "$k = $v\n" ;
	    #        }


	    my $obj = tied(%$dat) if ($dat) ;
	    $self->{'*LastRow'} = $fetch ;
	    $self->{'*LastKey'} = $obj?($obj -> FETCH ($self -> {'*PrimKey'})):undef ;
	    }
        }


        if ($row == $fetch + 1 && !$self->{'*EOD'})
            {
            # check if there are more records, if not close the statement handle
    	    my $arr ;
            
            $arr = $sth -> fetchrow_arrayref () if ($sth) ;
            my $orgrow = $row ;

            if ($arr)
                {
                $data->[$row] = [ @$arr ] ;
		$row++ ;
                $self->{'*CurrRow'} = $row ;
                }
            if ((defined ($max) && $orgrow > $max) || !$arr)
		{
		$self->{'*EOD'} = 1 ;
		$sth -> finish if ($sth) ;
                print LOG "DB:  Call DBI finish (id=$self->{'*Id'}, LastRow = $row, Last = $self->{'*LastSQLStatement'})\n" if ($self->{'*Debug'} > 3) ;
                undef $self->{'*StHdl'} ;
		}
            }

    $self->{'*LastRecord'} = $dat ;
    $self->{'*LastRecordFetch'} = $fetch ;

    print LOG 'DB:  FETCH return ' . (defined ($dat)?$dat:'<undef>') . "\n"  if ($self->{'*Debug'} > 3) ;
    return $dat ;
    }


## ----------------------------------------------------------------------------
## 
## Reset ...
##
## position the record pointer before the first row, just as same as after Search
##

sub Reset ($)
    {
    my $self = shift ;

    $self->{'*LastRecord'} = undef ;
    $self ->{'*LastRow'}   = 0 ;
    }

## ----------------------------------------------------------------------------
## 
## First ...
##
## position the record pointer to the first row and return it
##

sub First ($;$)

    {
    my ($self, $new) = @_ ;
    my $rec = $self -> FETCH (0) ;
    return $rec if (defined ($rec) || !$new) ;
    # create new record 
    return $self -> {'*LastRecord'} = $self -> STORE (0) ;
    }


## ----------------------------------------------------------------------------
## 
## Last ...
##
## position the record pointer to the last row
## DOES NOT WORK!!
##
##

sub Last ($)
    {
    $_[0] -> FETCH (0x7fffffff) ; # maxmimun postiv integer
    return undef if ($_[0] -> {'*LastRow'} == 0) ;
    return $_[0] -> Prev ;
    }


## ----------------------------------------------------------------------------
## 
## Next ...
##
## position the record pointer to the next row and return it
##

sub Next ($;$)
    {
    my ($self, $new) = @_ ;
    my $lr   =  $self -> {'*LastRow'} ;

    $lr -= $self -> {'*FetchStart'} ;
    $lr = 0 if ($lr < 0) ;
    $lr++ if (defined ($self -> {'*LastRecord'})) ;

    ##$lr++ if ($_[0] ->{'*CurrRow'} > 0 || $_[0] ->{'*EOD'}) ; 
    my $rec = $self -> FETCH ($lr) ;
    return $rec if (defined ($rec) || !$new) ;

    # create new record 
    return $self -> {'*LastRecord'} = $self -> STORE ($lr) ;
    }


## ----------------------------------------------------------------------------
## 
## Prev ...
##
## position the record pointer to the previous row and return it
##

sub Prev ($)
    {
    $_[0] -> {'*LastRow'} = 0 if (($_[0] -> {'*LastRow'})-- == 0) ;
    return $_[0] -> FETCH ($_[0] ->{'*LastRow'} - $_[0] -> {'*FetchStart'}) ;
    }


## ----------------------------------------------------------------------------
##
## Fetch the data from current row
##


sub Curr ($;$)
    {
    my ($self, $new) = @_ ;

    my $lr ;
    return $lr if ($lr = $self->{'*LastRecord'}) ; 

    my $n = $self ->{'*LastRow'} - $self -> {'*FetchStart'} ;
    my $rec = $self -> FETCH ($n) ;
    return $rec if (defined ($rec) || !$new) ;

    # create new record 
    return $self -> STORE ($n) ;
    }

## ----------------------------------------------------------------------------
## 
## BuildFields ...
##

sub BuildFields

    {
    my ($self, $fields, $table, $tabrel) = @_ ;


    my @fields ;
    my $tab4f  = $self -> {'*Table4Field'} ;
    my $fnames = $self -> {'*FullNames'} ;
    my $debug  = $self -> {'*Debug'} ;
    my $drv    = $self->{'*Driver'} ;
    my %tables ;
    my %fields ;
    my %tabrel ;
    my @replace ;
    my $linkname ;
    my $link ;
    my $nf ;
    my $fn ;
    my @allfields ;
    my @orderedfields ;
    my $i ;
    my $n ;
    my $m ;
    my %namefields ;

    my $leftjoin = DBIx::Compat::GetItem ($drv, 'SupportSQLJoin') ;
    my $numtabs = 99 ;
    
    local $^W = 0 ;

    $numtabs = 2 if (DBIx::Compat::GetItem ($drv, 'SQLJoinOnly2Tabs')) ;


    #%tables = map { $_ => 1 } split (/\s*,\s*/, $table) ;
    %tables = map { $_ => 1 } quotewords ('\s*,\s*', 0, $table) ;
    $numtabs -= keys %tables ;

    #print LOG "###--> numtabs = $numtabs\n" ;
    if (defined ($fields) && !($fields =~ /^\s*\*\s*$/))
        {
        #@allfields = map { (/\./)?$_:"$tab4f->{$_}.$_" } split (/\s*,\s*/, $fields) ;
#        @allfields = map { (/\./)?$_:"$tab4f->{$_}.$_" } quotewords ('\s*,\s*', 0, $fields) ;
	@allfields = map { (/\./ || !$tab4f->{$_})?$_:"$tab4f->{$_}.$_" } quotewords ('\s*,\s*', 0, $fields) ;
        #print LOG "###allfields = @allfields\n" ;
	}
    else
        {
        @allfields = @$fnames ;
        }

    $nf = $self -> {'*NameField'} || $self -> TableAttr ('!NameField') ;
    if ($nf)
	{
	if (ref ($nf) eq 'ARRAY')
	    {
	    %namefields = map { ($fn = "$tab4f->{$_}\.$_") => 1 } @$nf ;
	    }
	else
	    {
	    %namefields = ( "$tab4f->{$nf}.$nf" => 1 ) ;
	    }

	@orderedfields = keys %namefields ;
	foreach $fn (@allfields)
	    {
	    push @orderedfields, $fn if (!$namefields{$fn}) ;
	    }
	}
    else
	{
	@orderedfields = @allfields ;
	}

    $i = 0 ;
    %fields = map { $_ => $i++ } @orderedfields ;

    $n = $#orderedfields ;
    $m = $n + 1;
    for ($i = 0; $i <=$n; $i++)
        {
        #print LOG "###loop numtabs = $numtabs\n" ;
	$fn = $orderedfields[$i] ;
        $replace[$i] = [$i] ;
        next if ($numtabs <= 0) ;
        next if (!($linkname = $self -> Link4Field ($fn))) ;
        next if (!($link = $self -> Link ($linkname))) ;
            # does not work with another Datasource or with an link to the table itself
        next if ($link -> {'!DataSource'} || $link -> {'!Table'} eq $self -> {'!Table'}) ; 

        $nf = $link->{'!NameField'} || $self -> TableAttr ('!NameField', undef, $link->{'!Table'}) ;

        if (!$link -> {'!LinkedBy'} && $nf)
            {
            $replace[$i] = [] ;
            if (ref $nf)
                {
                foreach (@$nf)
                    { 
                    if (!exists $fields{"$link->{'!Table'}.$_"})
                        {
                        push @orderedfields, "$link->{'!Table'}.$_" ;
                        push @allfields, "$link->{'!Table'}.$_" ;
                        $fields{"$link->{'!Table'}.$_"} = $m ; 
                        push @{$replace[$i]}, $m ;

                        print LOG "[$$] DB:  Add to $self->{'*Table'} linked name field $link->{'!Table'}.$_ (i=$i, n=$n, m=$m)\n" if ($debug > 2) ;            
                        $m++ ;
                        }
                    }
                }
            else
                {
                if (!exists $fields{"$link->{'!Table'}.$nf"})
                    {
                    push @orderedfields, "$link->{'!Table'}.$nf" ;
                    push @allfields, "$link->{'!Table'}.$nf" ;
                    $fields{"$link->{'!Table'}.$nf"} = $m ; 
                    push @{$replace[$i]}, $m ;

                    print LOG "[$$] DB:  Add to $self->{'*Table'} linked name field $link->{'!Table'}.$nf (i=$i, n=$n, m=$m)\n" if ($debug > 2) ;            
                    $m++ ;
                    }
                }

            $numtabs-- if (!exists $tables{$link->{'!Table'}}) ;
	    $tables{$link->{'!Table'}} = "$fn = $link->{'!Table'}.$link->{'!LinkedField'}" ;
            }
        elsif ($debug > 2 && !$link -> {'!LinkedBy'})
            { print LOG "[$$] DB:  No name, so do not add to $self->{'*Table'} linked name field $link->{'!Table'}.$fn\n" ;}            
        }

    #my $rfields = join (',', @allfields) ;
    my $rfields = join (',', @orderedfields) ;
    my $rtables = join (',', keys %tables) ;

    delete $tables{$table} ;
    my $rtabrel ;
    
    if ($leftjoin == 1)
      {
	  my @tabs = keys %tables ;
	  $rtabrel = ('(' x scalar(@tabs)) . $table . ' ' . join (' ', map { "LEFT JOIN $_ on $tables{$_})" } @tabs) ;
      } 
    elsif ($leftjoin == 2)	
      {
	  my $v ;

	  $tabrel = ($tabrel?"$tabrel and ":'') . join (' and ', map { $v = $tables{$_} ; $v =~ s/=/*=/ ; $v } keys %tables) ;
      } 
    elsif ($leftjoin == 3) 
      {
	  my $v ;

	  $tabrel = ($tabrel?"$tabrel and ":'') . join (' and ', map { "$tables{$_} (+)" } keys %tables) ;
      } 
    elsif ($leftjoin == 4)
      {
	  my @tabs = keys %tables ;
	  $rtabrel = $table . ' ' . join ' ', map { "LEFT JOIN $_ on $tables{$_}" } @tabs ;
      }
    else 
      {
	  my $v ;

	  $rtabrel = $table . ',' . join (',', map { "OUTER $_ " } keys %tables) ;
	  $tabrel = ($tabrel?"$tabrel and ":'') . join (' and ', values %tables) ;
      }

    return ($rfields, $rtables, $rtabrel, $tabrel, \@replace) ;
    }


## ----------------------------------------------------------------------------
## 
## BuildWhere ...
##
## \%where/$where   = hash of which the SQL Where condition is build
##                    or SQL Where condition as text
## \@bind_values    = returns the bind_value array for placeholder supported
## \@bind_types     = returns the bind_type  array for placeholder supported
##
##
## Builds the WHERE condition for SELECT, UPDATE, DELETE 
## upon the data which is given in the hash \%where or string $where
##
##      Key                 Value
##      <fieldname>         Value for field (automatily quote if necessary)
##      '<fieldname>        Value for field (always quote)
##      #<fieldname>        Value for field (never quote, convert to number)
##      \<fieldname>        Value for field (leave value as it is)
##      +<field>|<field>..  Value for fields (value must be in one/all fields
##                          depending on $compconj
##      $compconj           'or' or 'and' (default is 'or') 
##
##      $valuesplit         regex for spliting a field value in mulitply value
##                          per default one of the values must match the field
##                          could be changed via $valueconj
##      $valueconj          'or' or 'and' (default is 'or') 
##
##      $conj               'or' or 'and' (default is 'and') conjunction between
##                          fields
##
##      $operator           Default operator
##      *<fieldname>        Operator for the named field
##
##	$primkey	    primary key
##
##	$where		    where as string
##

sub BuildWhere ($$$$)

    {
    my ($self, $where, $xbind_values, $bind_types, $sub) = @_ ;
    
    
    my $expr = '' ;
    my $primkey ;
    my $Quote = $self->{'*Quote'} ;
    my $Debug = $self->{'*Debug'} ;
    my $ignore       = $self->{'*IgnoreEmpty'} ;
    my $nullop       = $self->{'*NullOperator'} ;
    my $hasIn        = $self->{'*HasInOperator'} ;
    my $linkname     = $self->{'*LinkName'} ;
    my $tab4f        = $self->{'*Table4Field'} ;
    my $type4f       = $self->{'*Type4Field'} ;
    my $ifunc        = $self->{'*InputFunctions'} ;
    my $bind_values  = ref ($xbind_values) eq 'ARRAY'?$xbind_values:$$xbind_values ;
    
    if (!ref($where))
        { # We have the where as string
        $expr = $where ;
        if ($Debug > 2) { print LOG "DB:  Literal where -> $expr\n" ; }
        }
    elsif (exists $where -> {'$where'})
        { # We have the where as string
        $expr = $where -> {'$where'} ;
        if (exists $where -> {'$values'})
            {
            if (ref ($xbind_values) eq 'ARRAY')
                {
                push @$xbind_values, @{$where -> {'$values'}} ;
                }
            else
                {
                $$xbind_values = $where -> {'$values'} ;
                }
            }
        if ($Debug > 2) { print LOG "DB:  Literal where -> $expr\n" ; }
        }
    elsif (defined ($primkey = $self->{'*PrimKey'}) && defined ($where -> {$primkey}) && 
           (!defined ($where -> {"\*$primkey"}) || $where -> {"\*$primkey"} eq '=') &&
           !ref ($where -> {$primkey}))
        { # simplify where when ask for <primkey> = ?
        my $oper = $$where{"\*$primkey"} || '=' ;

        my $pkey = $primkey ;
        $pkey = "$tab4f->{$primkey}.$primkey" if ($linkname && !($primkey =~ /\./)) ;

        # any input conversion ?
	my $val = $where -> {$primkey} ;
	my $if  = $ifunc -> {$primkey} ; 
	$val = &{$if} ($val) if ($if) ;

        $expr = "$pkey$oper ? "; push @$bind_values, $val ; push @$bind_types, $type4f -> {$primkey} ;
        if ($Debug > 2) { print LOG "DB:  Primary Key $primkey found -> $expr\n" ; }
        }
    else
        {         
        my $key ;
        my $lkey ;
        my $val ;

        my @mvals ;
    
        my $field ;
        my @fields ;

        my $econj ;
        my $vconj ;
        my $fconj ;
    
        my $vexp  ;
        my $fieldexp  ;

        my $type ;
        my $oper = $$where{'$operator'} || '=' ;
        my $op ;

        my $mvalsplit = $$where{'$valuesplit'} || "\t" ;

        my $lexpr = '' ;
        my $multcnt ;
	my $uright ;
        
	$econj = '' ;
    
 
        while (($key, $val) = each (%$where))
            {
            my @multtypes ;
            my @multval ;
            my $if ;

            $type  = substr ($key, 0, 1) || ' ' ;
            $val = undef if ($ignore > 1 && defined ($val) && $val eq '') ;

            if ($Debug > 2) { print LOG "DB:  SelectWhere <$key>=<" . (defined ($val)?$val:'<undef>') ."> type = $type\n" ; }

            $vexp  = '' ;
            if (substr ($key, 0, 5) eq '$expr')
                {
                $vexp = $self -> BuildWhere ($val, $bind_values, $bind_types, 1) if ($val) ;
                }
            else
                {
                if (($type =~ /^(\w|\\|\+|\'|\#|\s)$/) && !($ignore && !defined ($val)))
                    {
                    if ($type eq '+')
                        { # composite field
                
                        if ($Debug > 3) { print LOG "DB:  Composite Field $key\n" ; }

                        $fconj    = '' ;
                        $fieldexp = '' ;
                        @fields   = split (/\&|\|/, substr ($key, 1)) ;

                        $multcnt = 0 ;
                        foreach $field (@fields)
                            {
                            if ($Debug > 3) { print LOG "DB:  Composite Field processing $field\n" ; }

                            if (!defined ($$Quote{$PreserveCase?$field:lc ($field)}))
                                {
                                if ($Debug > 2) { print LOG "DB:  Ignore non existing Composite Field $field\n" ; }
                                next ;
                                } # ignore no existent field

                            $op = $$where{"*$field"} || $oper ;

                            $field = "$tab4f->{$field}.$field" if ($linkname && !($field =~ /\./)) ;

                            if (($uright = $unaryoperators{lc($op)}))
			        {
    			        if ($uright == 1)
				    { $fieldexp = "$fieldexp $fconj $field $op" }
			        else
				    { $fieldexp = "$fieldexp $fconj $op $field" }
			        }
                            elsif ($type eq '\\') 
                                { $fieldexp = "$fieldexp $fconj $field $op $val" ; }
                            elsif (defined ($val)) 
                                { 
                                $fieldexp = "$fieldexp $fconj $field $op ?" ;
                                push @multtypes, $type4f -> {$field} ; 
                                $multcnt++ ;
                                }
                            elsif ($op eq '<>')
                                { $fieldexp = "$fieldexp $fconj $field $nullop not NULL" ; }
                            else
                                { $fieldexp = "$fieldexp $fconj $field $nullop NULL" ; }

                        
                            $fconj ||= $$where{'$compconj'} || ' or ' ; 

                            if ($Debug > 3) { print LOG "DB:  Composite Field get $fieldexp\n" ; }

                            }
                        if ($fieldexp eq '')
                            { next ; } # ignore no existent field

                        }
                    else
                        { # single field
                        $multcnt = 0 ;
                        # any input conversion ?
		        $if  = $ifunc -> {$PreserveCase?$key:lc ($key)} ; 
		        ## see bvelow ## $val = &{$if} ($val) if ($if && !ref($val)) ;

                        if ($type eq '\\' || $type eq '#' || $type eq "'")
                            { # remove leading backslash, # or '
                            $key = substr ($key, 1) ;
                            }

                        $lkey = $PreserveCase?$key:lc ($key) ;

                    	        
		        if ($type eq "'")
                            {
                            $$Quote{$lkey} = 1 ;
                            }
                        elsif ($type eq '#')
                            {
                            $$Quote{$lkey} = 0 ;
                            }

		        
		        {
		        local $^W = 0 ; # avoid warnings

		        #$val += 0 if ($$Quote{$lkey}) ; # convert value to a number if necessary
		        }

                        if (!defined ($$Quote{$lkey}) && $type ne '\\')
                            {
                            if ($Debug > 3) { print LOG "DB:  Ignore Single Field $key\n" ; }
                            next ; # ignore no existent field
                            } 

                        if ($Debug > 3) { print LOG "DB:  Single Field $key\n" ; }

                        $op = $$where{"*$key"} || $oper ;

                        $key = "$tab4f->{$lkey}.$key" if ($linkname && $type ne '\\' && !($key =~ /\./)) ;

                        if (($uright = $unaryoperators{lc($op)}))
			    {
			    if ($uright == 1)
			        { $fieldexp = "$key $op" }
			    else
			        { $fieldexp = "$op $key" }
			    }
                        elsif ($type eq '\\') 
                            { $fieldexp = "$key $op $val" ; }
                        elsif (defined ($val)) 
                            { 
                            $fieldexp = "$key $op ?" ; 
                            push @multtypes, $type4f -> {$lkey} ;
                            $multcnt++ ;
                            }
                        elsif ($op eq '<>')
                            { $fieldexp = "$key $nullop not NULL" ; }
                        else
                            { $fieldexp = "$key $nullop NULL" ; }

                    
                        if ($Debug > 3) { print LOG "DB:  Single Field gives $fieldexp\n" ; }
                        }
    
                    my @multop ;
                    @multop = @$op if (ref ($op) eq 'ARRAY') ;


                    if (!defined ($val))
                        { @mvals = (undef) }
                    elsif ($val eq '')
                        { @mvals = ('') }
                    else
                        { 
                        if (ref ($val) eq 'ARRAY')
                            { 
                            if ($if) 
                                { @mvals = map { &{$if} ($_) } @$val } 
                            else
                                { @mvals = @$val ; }
                            }
                        else
                            {   
                            if ($if) 
                                { @mvals = map { &{$if} ($_) } split (/$mvalsplit/, $val) ; } 
                            else
                                { @mvals = split (/$mvalsplit/, $val) ; }
                            }
                        }
                    $vconj = '' ;
                    my $i ;

                    if ($hasIn && @mvals > 1 && !@multop && $op eq '=' && !$$where{'$valueconj'} && $type ne '+')
                        {
                        my $j = 0 ;
                        $vexp = "$key IN (" ;
                        foreach $val (@mvals)
                            {
                            $i = $multcnt ;
                            push @$bind_values, $val while ($i-- > 0) ;
                            push @$bind_types, @multtypes ;
                            $vexp .= $j++?',?':'?' ;
                            }                
                        $vexp .= ')' ;
                        }
                    else
                        {
                        foreach $val (@mvals)
                            {
                            $i = $multcnt ;
                            push @$bind_values, $val while ($i-- > 0) ;
                            push @$bind_types, @multtypes ;
                            if (@multop)
                                { $vexp = "$vexp $vconj ($key " . (shift @multop) . ' ?)' ; }
                            else
                                { $vexp = "$vexp $vconj ($fieldexp)" ; }
                            $vconj ||= $$where{'$valueconj'} || ' or ' ; 
                            }                
                    
                        }
                    }
                }

            if ($vexp)
                {
                if ($Debug > 3) { local $^W = 0 ; print LOG "DB:  Key $key gives $vexp bind_values = <@$bind_values> bind_types=<@$bind_types>\n" ; }

                $expr = "$expr $econj ($vexp)"  ;
        
                $econj ||= $$where{'$conj'} || ' and ' ; 
                }

            if ($Debug > 3 && $lexpr ne $expr) { $lexpr = $expr ; print LOG "DB:  expr is $expr\n" ; }
            }
        }


    # Now we add the Table relations, if any

    my $tabrel = $self->{'*TabRelation'} ;

    if ($tabrel && !$sub)
        {
        if ($expr)
            {
            $expr = "($tabrel) and ($expr)" ;
            }
        else
            {
            $expr = $tabrel ;
            }
        }
    
    return $expr ;
    }


## ----------------------------------------------------------------------------
##
## Dirty - see if there is at least one dirty row
##
##

sub Dirty
    {
    my $self = shift;
    my $data = $Data{ $self->{'*Id'} };
    
    return undef unless ( ref($data) eq 'ARRAY');
    
    foreach my $rowdata (@$data) 
        {
        print LOG "DIRTY: rowref " . (defined ($rowdata)?$rowdata:'<undef>') . "\n" if $self->{'*Debug'} > 4;
        next unless ((ref($rowdata) eq 'HASH')
                      and eval { tied(%$rowdata)->isa('DBIx::Recordset::Row') } );
        return 1 if tied(%$rowdata)->Dirty ;
        };
    return 0;	# clean
    }

 
## ----------------------------------------------------------------------------
##
## Fush ...
##
## Write all dirty rows to the database
##

sub Flush

    {
    my $self    = shift ;
    
    return if ($self -> {'*InFlush'}) ; # avoid endless recursion
    
    my $release = shift ;
    my $dat ;
    my $obj ;
    my $dbg = $self->{'*Debug'} ;
    my $id   = $self->{'*Id'} ;
    my $data = $Data{$id} ;
    my $rc = 1 ;

    print LOG "DB:  FLUSH Recordset id = $id  $self \n" if ($dbg > 2) ;

    $self -> {'*InFlush'} = 1 ;
    $self -> {'*UndefKey'} = undef ; # invalidate record for undef hashkey
    $self->{'*LastRecord'} = undef ; 
    $self->{'*LastRecordFetch'} = undef ; 
    if (defined ($self->{'*StHdl'})) 
        {
        $self->{'*StHdl'} -> finish () ;
        print LOG "DB:  Call DBI finish (id=$self->{'*Id'}, Last = $self->{'*LastSQLStatement'})\n" if ($self->{'*Debug'} > 3) ;
        undef $self->{'*StHdl'} ;
        }


    eval
        {    
        my $err ;
        
        foreach $dat (@$data)
	    {
            $obj = (ref ($dat) eq 'HASH')?tied (%$dat):undef ;
            if (defined ($obj)) 
                {
                # isolate row update errors
                eval 
                    {
                    local $SIG{__DIE__};
                    $obj -> Flush ();
                    } or $rc = undef ;

                $err ||= $@ ;
                $obj -> {'*Recordset'} = undef if ($release) ;
                }
	    }
        die $err if ($err) ;
        } ;

    $self -> {'*InFlush'} = 0 ;

    $self -> savecroak ($@) if ($@) ;

    return $rc ;
    }




## ----------------------------------------------------------------------------
##
## Insert ...
##
## \%data = hash of fields for new record
##

sub Insert ($\%)

    {
    my ($self, $data) = @_ ;

    local *newself ;
    if (!ref ($self)) 
        {
        *newself = Setup ($self, $data) ;
        ($self = $newself) or return undef ;
        }

    my @bind_values ;
    my @bind_types ;
    my @qvals ;
    my @keys ;
    my $key ;
    my $val ;
    my $q ;

    my $type4f = $self->{'*Type4Field'} ;
    my $Quote = $self->{'*Quote'} ;
    my $ifunc = $self->{'*InputFunctions'} ;
    my $irfunc = $self->{'*InputFunctionsRequiredOnInsert'} ;
    my $insertserial ;

    if ($self -> {'*GetSerialPreInsert'})
        {
        my $val = $data -> {$self -> {'*Serial'}} ;
        $val = $$val if (ref ($val) eq 'SCALAR') ;
        if (!defined ($val)) 
            { 
            $data -> {$self -> {'*Serial'}} = &{$self -> {'*GetSerialPreInsert'}} ($self -> {'*DBHdl'},
                                                                           $self -> {'*Table'}, 
                                                                           $self -> {'*Sequence'}) ;
            $insertserial = $self -> {'*Serial'} ;
            }
        $self -> {'*LastSerial'} = $data -> {$self -> {'*Serial'}} ;
        }
    elsif ($self -> {'*SeqObj'})
        {
        my $val = $data -> {$self -> {'*Serial'}} ;
        $val = $$val if (ref ($val) eq 'SCALAR') ;
        if (!defined ($val)) 
            { 
            $data -> {$self -> {'*Serial'}} = $self -> {'*SeqObj'} -> NextVal ($self -> {'*Sequence'}) ;
            $insertserial = $self -> {'*Serial'} ;
            }
        $self -> {'*LastSerial'} = $data -> {$self -> {'*Serial'}} ;
        }


    while (($key, $val) = each (%$data))
        {
        $val = $$val if (ref ($val) eq 'SCALAR') ;
        # any input conversion ?
	my $if = $ifunc -> {$key} ;
	$val = &{$if} ($val, 'insert', $data) if ($if) ;
	next if (!defined ($val)) ; # skip NULL values
	if ($key =~ /^\\(.*?)$/)
	    {
            push @qvals, $val ;
            push @keys, $1 ;
            }
	elsif (defined ($$Quote{$PreserveCase?$key:lc ($key)}))
            {
            push @bind_values ,$val ;
            push @qvals, '?' ;
            push @keys, $key ;
            push @bind_types, $type4f -> {$PreserveCase?$key:lc ($key)} ;
            }
        }

    if (@qvals == 1 && $insertserial && exists ($data -> {$insertserial}))
        { # if the serial is the only value remove if and make no insert
        @qvals = () ;
        }    

    if ($#qvals > -1)
        {
        foreach $key (@$irfunc)
            {
            next if (exists ($data -> {$key})) ; # input function alread applied
	    my $if = $ifunc -> {$key} ;
	    $val = &{$if} (undef, 'insert', $data) if ($if) ;
	    next if (!defined ($val)) ; # skip NULL values
	    if ($key =~ /^\\(.*?)$/)
		{
                push @qvals, $val ;
                push @keys, $1 ;
                }
	    elsif (defined ($$Quote{$PreserveCase?$key:lc ($key)}))
                {
                push @bind_values ,$val ;
                push @qvals, '?' ;
                push @keys, $key ;
                push @bind_types, $type4f -> {$PreserveCase?$key:lc ($key)} ;
                }
            }
        }
    
    my $rc  ;

    if ($#qvals > -1)
        {
        my $valstr = join (',', @qvals) ;
        my $keystr = join (',', @keys) ;

        $rc = $self->SQLInsert ($keystr, $valstr, \@bind_values, \@bind_types) ;

        $self -> {'*LastSerial'} = &{$self -> {'*GetSerialPostInsert'}} ($self -> {'*DBHdl'},
                                                                           $self -> {'*Table'}, 
                                                                           $self -> {'*Sequence'}) if ($self -> {'*GetSerialPostInsert'}) ; 

        }
    else
        {
        $self -> {'*LastSerial'} = undef ;
        }                

    return $newself?*newself:$rc ;
    }

## ----------------------------------------------------------------------------
##
## Update ...
##
## \%data = hash of fields for new record
## $where/\%where = SQL Where condition
##
##

sub Update ($\%$)

    {
    my ($self, $data, $where) = @_ ;
    
    local *newself ;
    if (!ref ($self)) 
        {
        *newself = Setup ($self, $data) ;
        ($self = $newself) or return undef ;
        }

    my $expr  ;
    my @bind_values ;
    my @bind_types ;
    my $key ;
    my $val ;
    my @vals ;
    my $q ;

    my $type4f = $self->{'*Type4Field'} ;
    my $primkey ;
    my $Quote = $self->{'*Quote'} ;
    my $ifunc = $self->{'*InputFunctions'} ;
    my $irfunc = $self->{'*InputFunctionsRequiredOnUpdate'} ;
    my $dbg = $self -> {'*Debug'} > 2 ;
        
    if ($irfunc)
        {
        map { $data -> {$_} = undef if (!exists ($data -> {$_})) } @$irfunc ;
        }
       
    
    if (defined ($primkey = $self->{'*PrimKey'}))
	{
        $val = $data -> {$primkey} ;
	$val = $$val if (ref ($val) eq 'SCALAR') ;
	#print LOG "1 primkey = $primkey d=$data->{$primkey} w=" . ($where?$where->{$primkey}:'<undef>') . " v=$val\n" ;
	if (defined ($val) && !$where)
	    {
	    $where = {$primkey => $val} ;
	    }
	elsif (ref ($where) eq 'HASH' && $val eq $where -> {$primkey})
	    {
	    delete $data -> {$primkey} ;
	    }
	else
	    {
	    $primkey = '' ;
	    }
	}
    else
	{
	$primkey = '' ;
	}

    #print LOG "2 primkey = $primkey d=$data->{$primkey} w=" . ($where?$where->{$primkey}:'<undef>') . " v=$val\n" ;
    my $datacnt = 0 ; 

    while (($key, $val) = each (%$data))
        {
        next if ($key eq $primkey) ;
        $val = $$val if (ref ($val) eq 'SCALAR') ;
        # any input conversion ?
        my $if = $ifunc -> {$key} ;
        print LOG "DB:  UPDATE: $key = " . (defined ($val)?$val:'<undef>') . " " . ($if?"input filter = $if":'') . "\n" if ($dbg) ;
       $val = &{$if} ($val, 'update', $data, $where) if ($if) ;
       if ($key =~ /^\\(.*?)$/)
            {
            push @vals, "$1=$val" ;
            $datacnt++ ;
            }
        elsif (defined ($$Quote{$PreserveCase?$key:lc ($key)}))
            { 
            push @vals, "$key=?" ;
            push @bind_values, $val ;
            push @bind_types, $type4f -> {$PreserveCase?$key:lc ($key)} ;
            $datacnt++ ;
            }
        }

    my $rc = '' ;
    if ($datacnt)
        {
	my $valstr = join (',', @vals) ;

	if (defined ($where))
	    { $expr = $self->BuildWhere ($where, \@bind_values, \@bind_types) ; }
	else
	    { $expr = $self->BuildWhere ($data, \@bind_values, \@bind_types) ; }


	$rc = $self->SQLUpdate ($valstr, $expr, \@bind_values, \@bind_types) ;
	}

    return $newself?*newself:$rc ;
    }



## ----------------------------------------------------------------------------
##
## UpdateInsert ...
##
## First try an update, if this fail insert an new record
##
## \%data = hash of fields for record
##

sub UpdateInsert ($\%)

    {
    my ($self, $fdat) = @_ ;

    my $rc ;

    local *newself ;
    if (!ref ($self)) 
        {
        *newself = Setup ($self, $fdat) ;
        ($self = $newself) or return undef ;
        }

    $rc = $self -> Update ($fdat) ;
    print LOG "DB:  UpdateInsert update returns: $rc  affected rows: $DBI::rows\n" if ($self->{'*Debug'} > 2) ;
    
    if (!$rc || $DBI::rows <= 0)
        {
        $rc = $self -> Insert ($fdat) ;
        }
    return $newself?*newself:$rc ;
    }




## ----------------------------------------------------------------------------
##
## Delete ...
##
## $where/\%where = SQL Where condition
##
##

sub Delete ($$)

    {
    my ($self, $where) = @_ ;
    
    local *newself ;
    if (!ref ($self)) 
        {
        *newself = Setup ($self, $where) ;
        ($self = $newself) or return undef ;
        }

    my @bind_values ;
    my @bind_types ;
    my $expr = $self->BuildWhere ($where,\@bind_values,\@bind_types) ;

    $self->{'*LastKey'} = undef ;

    my $rc = $self->SQLDelete ($expr, \@bind_values, \@bind_types) ;
    return $newself?*newself:$rc ;
    }

## ----------------------------------------------------------------------------
##
## DeleteWithLinks ...
##
## $where/\%where = SQL Where condition
##
##

sub DeleteWithLinks ($$;$)

    {
    my ($self, $where, $seen) = @_ ;

    $seen = {} if (ref ($seen) ne 'HASH') ;

    local *newself ;
    if (!ref ($self)) 
        {
        *newself = Setup ($self, $where) ;
        ($self = $newself) or return undef ;
        }

    $self -> savecroak ("Delete disabled for table $self->{'*Table'}") if (!($self->{'*WriteMode'} & wmDELETE)) ;
    
    my @bind_values ;
    my @bind_types ;
    my $expr = $self->BuildWhere ($where,\@bind_values,\@bind_types) ;

    my $clear_disabled_diag =
      "(!$expr && !($self->{'*WriteMode'} & wmCLEAR))";
    $self -> savecroak ("Clear (Delete all) disabled for table $self->{'*Table'}: $clear_disabled_diag") if (!$expr && !($self->{'*WriteMode'} & wmCLEAR)) ;

    my $links = $self -> {'*Links'} ;

    my $k ;
    my $link ;
    my $od ;
    my $selected = 0 ;

    foreach $k (keys %$links)
        {
        $link = $links -> {$k} ;
        if ($od = $link -> {'!OnDelete'})
            {
            if (!$selected)
                {
                my $rc = $self->SQLSelect ($expr, '*', undef, undef, undef, \@bind_values, \@bind_types) ;
                $selected = 1 ;
                }
            
            $self -> Reset ;
            my $lf = $link -> {'!LinkedField'} ;
            my $rec ;
            while ($rec = $self -> Next)
                {
	        my $setup = {%$link} ;
	        my $mv ;
	        if (exists ($rec -> {$link -> {'!MainField'}}))
		    { 
		    $mv = $rec -> {$link -> {'!MainField'}} ;
		    }
	        else
		    { 
		    $mv = $rec -> {"$link->{'!MainTable'}.$link->{'!MainField'}"} ;
		    }
                $setup -> {'!DataSource'} = $self if (!defined ($link -> {'!DataSource'})) ;
                print LOG "DB:  DeleteLinks  link = $k  Setup New Recordset for table $link->{'!Table'}, $lf = " . (defined ($mv)?$mv:'<undef>') . "\n" if ($self->{'*Debug'} > 1) ;
                my $updset = DBIx::Recordset -> Setup ($setup) ;

                if ($od & odDELETE)
                    {
                    my $seenkey = "$link->{'!Table'}::$lf::$mv" ;
                    if (!$seen -> {$seenkey})
                        {
                        $seen -> {$seenkey} = 1 ; # avoid endless recursion
                        $$updset -> DeleteWithLinks ({$lf => $mv}, $seen) ;
                        }
                    else
                        {
                        print LOG "DB:  DeleteLinks  detected recursion, do not follow link (key=$seenkey)\n" if ($self->{'*Debug'} > 1) ;
                        }
                    }
                elsif ($od & odCLEAR)
                    {
                    $$updset -> Update ({$lf => undef}, {$lf => $mv}) ;
                    }
                }
            }
        }

    $self->{'*LastKey'} = undef ;

    my $rc = $self->SQLDelete ($expr, \@bind_values, \@bind_types) ;
    return $newself?*newself:$rc ;
    }


## ----------------------------------------------------------------------------
##
## Select
##
## Does an SQL Select of the form
##
##  SELECT $fields FROM <table> WHERE $expr ORDERBY $order
##
## $where/%where = SQL Where condition (optional, defaults to no condition)
## $fields       = fields to select (optional, default to *)
## $order        = fields for sql order by or undef for no sorting (optional, defaults to no order) 
## $group        = fields for sql group by or undef (optional, defaults to no grouping) 
## $append       = append that string to the select statemtn for other options (optional) 
##


sub Select (;$$$$$)
    {
    my ($self, $where, $fields, $order, $group, $append, $makesql) = @_ ;

    local *newself ;
    if (!ref ($self)) 
        {
        *newself = Setup ($self, $where) ;
        ($self = $newself) or return undef ;
        }

    my $bind_values = [] ;
    my @bind_types ;
    my $expr = $self->BuildWhere ($where, \$bind_values, \@bind_types) ;

    my $rc = $self->SQLSelect ($expr, $self->{'*Fields'} || $fields, $self->{'*Order'} || $order, $group, $append, $bind_values, \@bind_types, $makesql, ) ;
    return $newself?*newself:$rc ;
    }


## ----------------------------------------------------------------------------
##
## Search data
##
## \%fdat   = hash of form data
##      
##   Special keys in hash:
##      $start: first row to fetch 
##      $max:   maximum number of rows to fetch
##	$next:	next n records
##	$prev:	previous n records
##	$order: fieldname(s) for ordering (could also contain USING)
##      $group: fields for sql group by or undef (optional, defaults to no grouping) 
##      $append:append that string to the select statemtn for other options (optional) 
##      $fields:fieldnams(s) to retrieve    
##



sub Search ($\%)

    {
    my ($self, $fdat) = @_ ;

    local *newself ;
    if (!ref ($self)) 
        {
        *newself = Setup ($self, $fdat) ;
        ($self = $newself) or return undef;
        }

    my $Quote = $self->{'*Quote'} ;

    my $start = $$fdat{'$start'} || 0 ;
    my $max   = $$fdat{'$max'} ;

    $start = 0 if (defined ($$fdat{'$first'}) || (defined ($start) && $start < 0)) ;
    $max   = 1 if (defined ($max) && $max < 1) ;

    if (defined ($$fdat{'$prev'}))
        {
        $start -= $max ; 
        if ($start < 0) { $start = 0 ; }
        }
    elsif (defined ($$fdat{'$next'}))
        { $start += $max ; }
    elsif (defined ($$fdat{'$goto'}))
        { 
	$start = $$fdat{'$gotorow'} - 1 ;
        if ($start < 0) { $start = 0 ; }
	}

    my $startrecno = $start ;
    my $append = '' ;
    if (defined ($max) && !$$fdat{'$last'})
        {
        my $LimitOffset = DBIx::Compat::GetItem ($self->{'*Driver'}, 'LimitOffset')  ;
        if ($LimitOffset) 
            {
            $append = &{$LimitOffset}($start,$$fdat{'$last'}?0:$max+1);
            $start = 0 if ($append) ;
            }
        }

    my $rc ;
    
    {
    local $^W = 0 ;
    $rc = $self->Select($fdat, $$fdat{'$fields'}, $$fdat{'$order'}, $$fdat{'$group'}, "$$fdat{'$append'} $append", $fdat->{'$makesql'} ) ; 
    }

    if ($rc && $$fdat{'$last'})
	{ # read all until last row
	my $storeall = $self->{'*StoreAll'} ;
	$self->{'*StoreAll'} = 1 ;
	$self -> FETCH (0x7ffffff) ;
	$startrecno = $start = $self->{'*LastRow'} - ($max || 1) ;
	$self->{'*StoreAll'} = $storeall ;
	}

    $self->{'*StartRecordNo'} = $startrecno ;
    $self->{'*FetchStart'} = $start ;
    $self->{'*FetchMax'}   = $start + $max - 1 if (defined ($max)) ;


    return $newself?*newself:$rc ;
    }




## ----------------------------------------------------------------------------
##
## Execute
##
##
## \%fdat   = hash of form data
##
##      =search  = search data
##      =update  = update record(s)
##      =insert  = insert record
##      =delete  = delete record(s)
##      =empty   = setup empty object
##


sub Execute ($\%)

    {
    my ($self, $fdat) = @_ ;

    local *newself ;
    if (!ref ($self)) 
        {
        *newself = Setup ($self, $fdat) ;
        ($self = $newself)  or return undef ;
        }


    if ($self->{'*Debug'} > 2)
         { print LOG 'DB:  Execute ' . ($$fdat{'=search'}?'=search ':'') .
                ($$fdat{'=update'}?'=update ':'') . ($$fdat{'=insert'}?'=insert ':'') .
                ($$fdat{'=empty'}?'=empty':'') . ($$fdat{'=delete'}?'=delete':'') . "\n" ; }

    my $rc = '-' ;
    if (defined ($$fdat{'=search'})) 
        {
        $rc = $self -> Search ($fdat) 
        }
    else
        {
        my $serial ;
        #$rc = $self -> UpdateInsert ($fdat) if (defined ($$fdat{'=update'}) && defined ($$fdat{'=insert'}) && !defined($rc)) ;
        $rc = $self -> Update ($fdat) if (defined ($$fdat{'=update'}) && $rc eq  '-') ;
        if (defined ($$fdat{'=insert'}) && $rc eq  '-') 
             {
             $rc = $self -> Insert ($fdat) ;
             if (defined ($rc) && $self -> {'*LastSerial'}) 
                {
                $serial = $self -> {'*LastSerial'} ;
                $rc = $self -> Search ({$self->{'*Serial'} => $serial}) ;
                return $newself?*newself:$rc ;
                }
             }
        $rc = $self -> DeleteWithLinks ($fdat) if (defined ($$fdat{'=delete'}) && $rc eq  '-') ;
        $rc = $self -> Search ($fdat) if (!defined ($$fdat{'=empty'}) && defined ($rc)) ;
        $rc = 1 if (defined ($$fdat{'=empty'}) && $rc eq  '-') ;
        }
                
    return $newself?*newself:$rc ;
    }

## ----------------------------------------------------------------------------
##
## PushCurrRec
##

sub PushCurrRec

    {
    my ($self) = @_ ;

    # Save Current Record
    my $sp = $self->{'*CurrRecStack'} ;
    push @$sp, $self->{'*LastRow'} ;
    push @$sp, $self->{'*LastKey'} ;
    push @$sp, $self->{'*FetchMax'} ;
    }



## ----------------------------------------------------------------------------
##
## PopCurrRec
##

sub PopCurrRec

    {
    my ($self) = @_ ;

    #Restore pointers
    my $sp = $self->{'*CurrRecStack'} ;
    $self->{'*FetchMax'} = pop @$sp  ;
    $self->{'*LastKey'}  = pop @$sp  ;
    $self->{'*LastRow'}  = pop @$sp  ;
    }

## ----------------------------------------------------------------------------
##
## MoreRecords
##

sub MoreRecords

    {
    my ($self, $ignoremax) = @_ ;

    $self -> PushCurrRec ;
    $self->{'*FetchMax'} = undef if ($ignoremax) ;

    my $more = $self -> Next () ;

    $self -> PopCurrRec ;

    return $more ; # && (ref $more) && keys (%$more) > 0 ;
    }


## ----------------------------------------------------------------------------
##
## PrevNextForm
##
##
##  $textprev   = Text for previous button
##  $textnext   = Text for next button
##  \%fdat      = fields/values for select where
##
##


sub PrevNextForm

    {
    my ($self, $textprev, $textnext, $fdat) = @_ ;

  
    my $param = $textprev ;
    my $textfirst ;
    my $textlast ;
    my $textgoto ;
    
    if (ref $textprev eq 'HASH')
	{
	$fdat = $textnext ;
	$textprev  = $param -> {'-prev'} ;  
	$textnext  = $param -> {'-next'} ;  
	$textfirst = $param -> {'-first'} ;  
	$textlast  = $param -> {'-last'} ;
	$textgoto  = $param -> {'-goto'} ;
	}
	  
  
  
    my $more  = $self -> MoreRecords (1) ;
    my $start = $self -> {'*StartRecordNo'} ;
    my $max   = $self -> {'*FetchMax'} - $self -> {'*FetchStart'} + 1 ;

    
    my $esc = '' ;
    $esc = '\\' if ((defined ($HTML::Embperl::escmode) && ($HTML::Embperl::escmode & 1)) || (defined ($Embperl::escmode) && ($Embperl::escmode & 1))) ;
    my $buttons = "$esc<form method=$esc\"POST$esc\"$esc>$esc<input type=$esc\"hidden$esc\" name=$esc\"\$start$esc\" value=$esc\"$start$esc\"$esc>\n$esc<input type=$esc\"hidden$esc\" name=$esc\"\$max$esc\" value=$esc\"$max$esc\"$esc>\n" ;
    my $k ;
    my $v ;

    if ($fdat)
        {
        while (($k, $v) = each (%$fdat))
            {
            if (substr ($k, 0, 1) eq '\\')
        	    {
        	    $k = '\\' . $k ;
        	    }
            if ($k ne '$start' && $k ne '$max' && $k ne '$prev' && $k ne '$next' && $k ne '$goto' && $k ne '$gotorow'
	         && $k ne '$first' && $k ne '$last')
        	    {
	            $buttons .= "$esc<input type=$esc\"hidden$esc\" name=$esc\"" . $k . "$esc\" value=$esc\"$v$esc\"$esc>\n" ;
		    }
            }
        }

    if ($start > 0 && $textfirst)
        {
        $buttons .= "$esc<input type=$esc\"submit$esc\" name=$esc\"\$first$esc\" value=$esc\"$textfirst$esc\"$esc> " ;
        }
    if ($start > 0 && $textprev)
        {
        $buttons .= "$esc<input type=$esc\"submit$esc\" name=$esc\"\$prev$esc\" value=$esc\"$textprev$esc\"$esc> " ;
        }
    if ($textgoto)
        {
        $buttons .= "$esc<input type=$esc\"text$esc\" size=6 name=$esc\"\$gotorow$esc\"$esc>" ;
        $buttons .= "$esc<input type=$esc\"submit$esc\" name=$esc\"\$goto$esc\" value=$esc\"$textgoto$esc\"$esc> " ;
        }
    if ($more > 0 && $textnext)
        {
        $buttons .= "$esc<input type=$esc\"submit$esc\" name=$esc\"\$next$esc\" value=$esc\"$textnext$esc\"$esc> " ;
        }
    if ($more > 0 && $textlast)
        {
        $buttons .= "$esc<input type=$esc\"submit$esc\" name=$esc\"\$last$esc\" value=$esc\"$textlast$esc\"$esc>" ;
        }
    $buttons .= "$esc</form$esc>" ;

    return $buttons ;    
    }




##########################################################################################

1;

package DBIx::Recordset::CurrRow ;


use Carp ;

## ----------------------------------------------------------------------------
##
## TIEHASH
##
## tie an hash to the object, object must be aready blessed
##
## tie %self, 'DBIx::Recordset::CurrRow', $self ;
##

sub TIEHASH
    {
    my ($class, $arg) = @_ ;
    my $rs ;    
    
    if (ref ($arg) eq 'HASH')
        {
        $rs = DBIx::Recordset -> SetupObject ($arg) or return undef ;
        }
    elsif (ref ($arg) eq 'DBIx::Recordset')
        {
        $rs = $arg ;
        }
    else
        {
        croak ("Need DBIx::Recordset or setup parameter") ;
        }


    my $self = {'*Recordset' => $rs} ;

    bless ($self, $class) ;
    
    return $self ;
    }




## ----------------------------------------------------------------------------
##
## Fetch the data from a previous SQL Select
##
## $fetch     = Column to fetch
## 
##


sub FETCH ()
    {
#    if (wantarray)
#        {
#        my @result ;
#        my $rs = $_[0] -> {'*Recordset'} ;
#        $rs -> PushCurrRec ;
#        my $rec = $rs -> First () ;
#        while ($rec)
#            {
##            push @result, tied (%$rec) -> FETCH ($_[1]) ;
#            push @result, $rec -> {$_[1]} ;
#            $rec = $rs -> Next () ;
#            }
#        $rs -> PopCurrRec ;
#        return @result ;
#        }
#    else
        {
        my $rec = $_[0] -> {'*Recordset'} -> Curr ;
	if (defined ($rec))
	    {
            my $obj ;
	    return $obj -> FETCH ($_[1]) if ($obj = tied (%$rec)) ;
            return $rec -> {$_[1]}  ;
	    }
        return undef ;
        }
    }


## ----------------------------------------------------------------------------

sub STORE ()
    {
    if (ref $_[2] eq 'ARRAY')
        { # array
        my ($self, $key, $dat) = @_ ;
        my $rs = $self -> {'*Recordset'} ;
        $rs -> PushCurrRec ;
        my $rec = $rs -> First (1) ;
        my $i = 0 ;
        while ($rec)
            {
            tied (%$rec) -> STORE ($key, $$dat[$i++]) ;
            last if ($i > $#$dat) ;
            $rec = $rs -> Next (1) ;
            }
        $rs -> PopCurrRec ;
        }
    else
        {
        tied (%{$_[0] -> {'*Recordset'} -> Curr (1)}) -> STORE ($_[1], $_[2]) ;
        }
    }


## ----------------------------------------------------------------------------

sub FIRSTKEY 
    {
    my $rec = $_[0] -> {'*Recordset'} -> Curr ;
    my $obj = tied (%{$rec}) ;

    return tied (%{$rec}) -> FIRSTKEY if ($obj) ;
    
    my $k = keys %$rec ;
    return each %$rec ;
    }


## ----------------------------------------------------------------------------

sub NEXTKEY 
    {
    my $rec = $_[0] -> {'*Recordset'} -> Curr ;
    my $obj = tied (%{$rec}) ;

    return tied (%{$rec}) -> NEXTKEY if ($obj) ; 
    return each %$rec ;
    }

## ----------------------------------------------------------------------------

sub EXISTS
    {
    return exists ($_[0] -> {'*Recordset'} -> Curr -> {$_[1]}) ;
    }

## ----------------------------------------------------------------------------

sub DELETE
    {
    carp ("Cannot DELETE a field from a database record") ;
    }
                
## ----------------------------------------------------------------------------

sub CLEAR ($)

    {
    #carp ("Cannot DELETE all fields from a database record") ;
    } 

## ----------------------------------------------------------------------------

sub DESTROY

    {
    my $self = shift ;
    my $orgerr = $@ ;
    local $@ ;

    eval 
	{ 

	$self -> {'*Recordset'} -> ReleaseRecords () if (defined ($self -> {'*Recordset'})) ;
    
	    {
	    local $^W = 0 ;
	    print DBIx::Recordset::LOG "DB:  ::CurrRow::DESTROY\n" if ($self -> {'*Recordset'} -> {'*Debug'} > 3) ;
	    }
	} ;
    $self -> savecroak ($@) if (!$orgerr && $@) ;
    warn $@ if ($orgerr && $@) ;
    }

##########################################################################################

package DBIx::Recordset::Hash ;

use Carp ;


## ----------------------------------------------------------------------------
##
## PreFetch
##
## Prefetch data
##
##

sub PreFetch
    
    {
    my ($self, $rs) = @_ ;
    my $where = $self -> {'*PreFetch'} ;
    my %keyhash ;
    my $rec ;
    my $merge = $self -> {'*MergeFunc'}  ;
    my $pk ;

    $rs -> Search ($where eq '*'?undef:$where) or return undef ;
    my $primkey = $rs -> {'*PrimKey'} or $rs -> savecroak ('Need !PrimKey') ;
    while ($rec = $rs -> Next)
        {
        $pk = $rec -> {$primkey} ;
        if ($merge && exists ($keyhash{$pk}))
            {
            if (tied (%{$keyhash{$pk}}))
                {
                my %data = %{$keyhash{$pk}} ;
                $keyhash{$pk} = \%data ;
                }

            &$merge ($keyhash{$pk}, $rec) ;
            }
        else
            {
            $keyhash{$pk} = $rec ;
            }
        }
    $self -> {'*KeyHash'} = \%keyhash ;
    $self -> {'*ExpiresTime'} = time + $self -> {'*Expires'} if ($self -> {'*Expires'} > 0) ;
    }

## ----------------------------------------------------------------------------
##
## PreFetchIfExpires
##
## Prefetch data
##
##

sub PreFetchIfExpires
    
  {

      my ($self, $rs) = @_ ;

      my $prefetch;

      if (ref ($self -> {'*Expires'}) eq 'CODE') {
	  $prefetch =  $self -> {'*Expires'}->($self);
      } elsif (defined ($self -> {'*ExpiresTime'})) {
	  $prefetch =  $self -> {'*ExpiresTime'} < time
      }

      $self -> PreFetch ($rs) if $prefetch;
    
  }

## ----------------------------------------------------------------------------
##
## TIEHASH
##
## tie an hash to the object, object must be aready blessed
##
## tie %self, 'DBIx::Recordset::Hash', $self ;
##

sub TIEHASH
    {
    my ($class, $arg) = @_ ;
    my $rs ;    
    my $keyhash ;

    my $self ;

    if (ref ($arg) eq 'HASH')
        {
        $self = 
                {
                '*Expires'   => $arg -> {'!Expires'},
                '*PreFetch'  => $arg -> {'!PreFetch'},
                '*MergeFunc' => $arg -> {'!MergeFunc'},
                } ;

        $rs = DBIx::Recordset -> SetupObject ($arg) or return undef ;
        }
    elsif (ref ($arg) eq 'DBIx::Recordset')
        {
        $rs = $arg ;
        $self = {} ;
        }
    else
        {
        croak ("Need DBIx::Recordset or setup parameter") ;
        }


    $self -> {'*Recordset'} = $rs ;

    bless ($self, $class) ;
 
    $self -> PreFetch ($rs) if ($self -> {'*PreFetch'}) ;

    return $self ;
    }


## ----------------------------------------------------------------------------
##
## Fetch the data from a previous SQL Select
##
## $fetch     = PrimKey for Row to fetch
## 
##


sub FETCH 
    {
    my ($self, $fetch) = @_ ;
    my $rs    = $self->{'*Recordset'} ;  

    return $rs-> {'*UndefKey'} if (!defined ($fetch)) ;  # undef could be used as key for autoincrement values
    
    my $h ;

    if ($self -> {'*PreFetch'}) 
        {
        $self -> PreFetchIfExpires ($rs) ;

        $h = $self -> {'*KeyHash'} -> {$fetch} ;
        }
    else
        {    
        print DBIx::Recordset::LOG "DB:  Hash::FETCH \{" . (defined ($fetch)?$fetch:'<undef>') ."\}\n"  if ($rs->{'*Debug'} > 3) ;

        if (!defined ($rs->{'*LastKey'}) || $fetch ne $rs->{'*LastKey'})
            {
            $rs->SQLSelect ("$rs->{'*PrimKey'} = ?", undef, undef, undef, undef, [$fetch], [$rs->{'*Type4Field'}{$rs->{'*PrimKey'}}]) or return undef ; 
    
            $h = $rs -> FETCH (0) ;
            my $merge = $self -> {'*MergeFunc'}  ;
            $self -> {'*LastMergeRec'} = undef ;
            if ($merge && $rs -> MoreRecords)
                {
                my %data = %$h ;
                my $rec ;
                my $i = 1 ;
                while ($rec = $rs -> FETCH($i++))
                    {
                    &$merge (\%data, $rec) ;
                    }
                $self -> {'*LastMergeRec'} = $h = \%data ;
                }
            }
        else
            {
            if ($self -> {'*LastMergeRec'})
                { $h = $self -> {'*LastMergeRec'} }
            else
                { $h = $rs -> Curr ; }
            }
        }

    print DBIx::Recordset::LOG "DB:  Hash::FETCH return " . (defined ($h)?$h:'<undef>') . "\n" if ($rs->{'*Debug'} > 3) ;
  
    return $h ;
    }

## ----------------------------------------------------------------------------
##
## store something in the hash
##
## $key     = PrimKey for Row to fetch
## $value   = Hashref with row data
##

sub STORE

    {
    my ($self, $key, $value) = @_ ;
    my $rs    = $self -> {'*Recordset'} ;  

    print DBIx::Recordset::LOG "DB:  ::Hash::STORE \{" . (defined ($key)?$key:'<undef>') . "\} = " . (defined ($value)?$value:'<undef>') . "\n" if ($rs->{'*Debug'} > 3) ;

    $rs -> savecroak ("Hash::STORE need hashref as value") if (!ref ($value) eq 'HASH') ;

    #$rs -> savecroak ("Hash::STORE doesn't work with !PreFetch") if ($self -> {'*PreFetch'}) ;
    return if ($self -> {'*PreFetch'}) ;

    my %dat = %$value ;                 # save values, if any
    $dat{$rs -> {'*PrimKey'}} = $key ;  # setup primary key value
    %$value = () ;                      # clear out data in tied hash
    my $r = tie %$value, 'DBIx::Recordset::Row', $rs, \%dat, undef, 1 ;
    
    #$r -> STORE ($rs -> {'*PrimKey'}, $key) ;
    #$r -> {'*new'}   = 1 ;
    
    # setup recordset
    $rs-> ReleaseRecords ;
    $DBIx::Recordset::Data{$rs-> {'*Id'}}[0] = $value ;
    $rs-> {'*UndefKey'} = defined($key)?undef:$value ;
    $rs-> {'*LastKey'} = $key ;
    $rs-> {'*CurrRow'} = 1 ;
    $rs-> {'*LastRow'} = 0 ;
    } 

## ----------------------------------------------------------------------------

sub FIRSTKEY 
    {
    my $self  = shift ;

    my $rs    = $self->{'*Recordset'} ;  
    my $primkey = $rs->{'*PrimKey'}  ;


    if ($self -> {'*PreFetch'}) 
        {
        $self -> PreFetchIfExpires ($rs) ;
        
        my $keyhash = $self -> {'*KeyHash'} ;
        my $foo = keys %$keyhash ; # reset iterator

        return each %$keyhash ;
        }

    $rs->SQLSelect () or return undef ; 

    my $dat = $rs -> First (0) or return undef ;
    my $key = $dat -> {$rs->{'*PrimKey'}} ;
    
    if ($rs->{'*Debug'} > 3) 
        {
        print DBIx::Recordset::LOG "DB:  Hash::FIRSTKEY \{" . (defined ($key)?$key:'<undef>') . "\}\n" ;
        }        

    return $key ;
    }

## ----------------------------------------------------------------------------

sub NEXTKEY 
    {
    my $self  = shift ;
    my $rs    = $self->{'*Recordset'} ;  

    if ($self -> {'*PreFetch'}) 
        {
        ##$self -> PreFetchIfExpires ($rs) ;
        
        my $keyhash = $self -> {'*KeyHash'} ;
        return each %$keyhash ;
        }

    my $dat   = $rs -> Next () or return undef ;
    my $key   = $dat -> {$rs->{'*PrimKey'}} ;

    if ($rs->{'*Debug'} > 3) 
        {
        print DBIx::Recordset::LOG "DB:  Hash::NEXTKEY \{" . (defined ($key)?$key:'<undef>') . "\}\n" ;
        }        

    return $key ;
    }

## ----------------------------------------------------------------------------

sub EXISTS
    {
    my ($self, $key)  = @_ ;

    if ($self -> {'*PreFetch'}) 
        {
        my $rs    = $self->{'*Recordset'} ;  
        $self -> PreFetchIfExpires ($rs) ;
        
        my $keyhash = $self -> {'*KeyHash'} ;
        return exists ($keyhash -> {$key}) ;
        }

    return defined ($self -> FETCH ($key)) ;
    }

## ----------------------------------------------------------------------------

sub DELETE
    {
    my ($self, $key) = @_ ;
    my $rs    = $self -> {'*Recordset'} ;  
    
    $rs->{'*LastKey'} = undef ;
    
    $rs->SQLDelete ("$rs->{'*PrimKey'} = ?", [$key], [$rs->{'*Type4Field'}{$rs->{'*PrimKey'}}]) or return undef ; 

    return 1 ;
    }
                
## ----------------------------------------------------------------------------

sub CLEAR 

    {
    my ($self, $key) = @_ ;
    my $rs    = $self -> {'*Recordset'} ;  

    $rs->SQLDelete ('') or return undef ; 
    } 

## ----------------------------------------------------------------------------
##
## Dirty  - see if there are unsaved changes
##

sub Dirty { return $_[0]->{'*Recordset'}->Dirty() }
 
## ----------------------------------------------------------------------------

sub Flush

    {
    $_[0]->{'*Recordset'} -> Flush () ;
    }

## ----------------------------------------------------------------------------

sub DESTROY

    {
    my $self = shift ;
    my $orgerr = $@ ;
    local $@ ;

    eval 
	{ 

	$self -> {'*Recordset'} -> ReleaseRecords ()  if (defined ($self -> {'*Recordset'})) ;

	    {
	    local $^W = 0 ;
	    print DBIx::Recordset::LOG "DB:  ::Hash::DESTROY\n" if ($self -> {'*Recordset'} -> {'*Debug'} > 3) ;
	    }
	} ;
    $self -> savecroak ($@) if (!$orgerr && $@) ;
    warn $@ if ($orgerr && $@) ;
    }

##########################################################################################

package DBIx::Recordset::Access ;

use overload 'bool' => sub { 1 }, '%{}' => \&gethash, '@{}' => \&getarray ; #, '${}' => \&getscalar ;

sub new 
    {
    my $class = shift;
    my $arg   = shift ;
    bless $arg, $class;
    }


sub gethash 
    {
    my $self = shift ;
    return \%$$self ;
    }

sub getarray
    {
    my $self = shift ;
    return \@$$self ;
    }

sub getscalar
    {
    my $self = shift ;
    return \$$$self ;
    }

##########################################################################################

package DBIx::Recordset::Row ;

use Carp ;

sub TIEHASH  

    {
    my ($class, $rs, $names, $dat, $new) = @_ ;

    my $self = {'*Recordset' => $rs} ;
    my $data = $self -> {'*data'} = {} ;
    my $upd  = $self -> {'*upd'}  = {} ;

    bless ($self, $class) ;
 
    if (ref ($names) eq 'HASH')
        {
        my $v ;
        my $k ;

        if ($new)
            {
            my $dirty = 0 ;
            $self->{'*new'}     = 1 ;                  # mark it as new record
            
            my $lk ;
            while (($k, $v) = each (%$names))
                {
                $lk = $DBIx::Recordset::PreserveCase?$k:lc ($k) ;
                # store the value and remeber it for later update
                $upd ->{$lk} = \($data->{$lk} = $v) ;
                $dirty = 1 ;
                }
            $self->{'*dirty'}   = $dirty ;             # mark it as dirty only if data exists
            }
        else
            {
            while (($k, $v) = each (%$names))
                {
                $data -> {$DBIx::Recordset::PreserveCase?$k:lc ($k)} = $v ;
                }
            }
        }
    else
        {
        my $i = 0 ;
	my $of ;
        my $ofunc    = $rs -> {'*OutputFuncArray'} || [] ;
	my $linkname = $rs -> {'*LinkName'} ;
        if ($rs -> {'*KeepFirst'})
            {
            $i = -1 ;
	    %$data = () ;
            if ($dat)
                {
                foreach my $k (@$dat)
                    {
                    $i++ ;
                    my $hkey = ($DBIx::Recordset::PreserveCase?$$names[$i]:lc($$names[$i])) ;

                    #warn "hkey = $hkey data = $k\n" ;
                    $data -> {$hkey} = ($ofunc->[$i]?(&{$ofunc->[$i]}($k)):$k) if (!exists $data -> {$hkey}) ;
                    }
                }
            }
	elsif ($linkname < 2)
            {    
            $i = -1 ;
	    %$data = map { $i++ ; ($DBIx::Recordset::PreserveCase?$$names[$i]:lc($$names[$i])) => ($ofunc->[$i]?(&{$ofunc->[$i]}($_)):$_) } @$dat if ($dat) ;
            }
        elsif ($linkname < 3)
            {
            my $r ;
            my $repl = $rs -> {'*ReplaceFields'} ;
            my $n ;
                
            foreach $r (@$repl)
                {
                $n = $DBIx::Recordset::PreserveCase?$names -> [$i]:lc ($names -> [$i]) ;
                $of = $ofunc -> [$i] ;
		$data -> {$n} = ($of?(&{$of}($dat->[$i])):$dat->[$i]) ;
                $data -> {uc($n)} = join (' ', map ({ ($ofunc->[$_]?(&{$ofunc->[$_]}($dat->[$_])):$dat->[$_])} @$r)) if ($#$r > 0 || $r -> [0] != $i) ;
                $i++ ;
                }
            }
        else
            {
            my $r ;
            my $repl = $rs -> {'*ReplaceFields'} ;
                
            foreach $r (@$repl)
                {
                $data -> {($DBIx::Recordset::PreserveCase?$$names[$i]:lc($$names[$i]))} = join (' ', map ({ ($ofunc->[$_]?(&{$ofunc->[$_]}($dat->[$_])):$dat->[$_])} @$r)) ;
		#print LOG "###repl $r -> $data->{$$names[$i]}\n" ;
                $i++ ;
                }
            }
        
        $self -> {'*Recordset'} = $rs ; 
        }

    if (!$new)
        {
        my $pk = $rs -> {'*PrimKey'} ;

        if ($pk && exists ($data -> {$pk})) 
            {
            $self -> {'*PrimKeyOrgValue'} = $data -> {$pk} ;
            }
        else
            {
            # save whole record for usage as key in later update
            %{$self -> {'*org'}} = %$data ;

            $self -> {'*PrimKeyOrgValue'} = $self -> {'*org'} ;
            }
        }


    return $self ;
    }

## ----------------------------------------------------------------------------

sub STORE
    {
    my ($self, $key, $value)  = @_ ;
    my $rs  = $self -> {'*Recordset'} ;  
    my $dat = $self -> {'*data'} ;
    
    local $^W = 0 ;

    print DBIx::Recordset::LOG "DB:  Row::STORE $key = $value\n" if ($rs->{'*Debug'} > 3) ;
    # any changes?
    if ($dat -> {$key} ne $value || defined ($dat -> {$key}) != defined($value))
	{
	# store the value and remeber it for later update
	$self -> {'*upd'}{$key} = \($dat -> {$_[1]} = $value) ;
	$self -> {'*dirty'}   = 1 ;                  # mark row dirty
	}
    }

## ----------------------------------------------------------------------------

sub FETCH
    {
    my ($self, $key) = @_ ;
    return undef if (!$key) ;
    my $rs   = $self -> {'*Recordset'} ;  
    my $data = $self -> {'*data'}{$key} ;
    my $link ;
    if (!defined($data))
        {
        if ($key eq '!Name')
            {
            my $nf = $rs -> {'*NameField'} || $rs -> TableAttr ('!NameField') ;
            if (!ref $nf)
                {
                return $self -> {'*data'}{$key} = $self -> {'*data'}{uc($nf)} || $self -> {'*data'}{$nf} ;
                }
            
            return $self -> {'*data'}{$key} = join (' ', map { $self -> {'*data'}{uc ($_)} || $self -> {'*data'}{$_} } @$nf) ;
            }
        elsif (defined ($link = $rs -> {'*Links'}{$key}))
            {
            my $lf = $link -> {'!LinkedField'} ;
            my $dat = $self -> {'*data'} ;
	    my $mv ;
	    if (exists ($dat -> {$link -> {'!MainField'}}))
		{ 
		$mv = $dat -> {$link -> {'!MainField'}} ;
		}
	    else
		{ 
		$mv = $dat -> {"$link->{'!MainTable'}.$link->{'!MainField'}"} ;
		}
            if ($link -> {'!UseHash'})
                {
                my $linkset = $rs -> {'*LinkSet'}{$key} ;
                if (!$linkset)
                    {
	            my $setup = {%$link} ;
                    $setup -> {'!PrimKey'} = $lf ;
                    $setup -> {'!DataSource'} = $rs if (!defined ($link -> {'!DataSource'})) ;
                    my %linkset ;
                    print DBIx::Recordset::LOG "DB:  Row::FETCH $key = Setup New Recordset for table $link->{'!Table'}, $lf = " . (defined ($mv)?$mv:'<undef>') . "\n" if ($rs->{'*Debug'} > 3) ;
                    $rs -> {'*LinkSet'}{$key} = $linkset = tie %linkset, 'DBIx::Recordset::Hash', $setup ;
                    }
                $data = $linkset -> FETCH ($mv) ;            
                }
            else
                {
                my $linkkey = "$key-$lf-$mv" ;
                my $linkset = $rs -> {'*LinkSet'}{$linkkey} ;
                if (!$linkset)
                    {
	            my $setup = {%$link} ;
                    $setup -> {$lf} = $mv ;
                    $setup -> {'!Default'} = { $lf => $mv } ;
                    $setup -> {'!DataSource'} = $rs if (!defined ($link -> {'!DataSource'})) ;
                    print DBIx::Recordset::LOG "DB:  Row::FETCH $key = Setup New Recordset for table $link->{'!Table'}, $lf = " . (defined ($mv)?$mv:'<undef>') . "\n" if ($rs->{'*Debug'} > 3) ;

                    $linkset = DBIx::Recordset -> Search ($setup) ;
                    $data = $self -> {'*data'}{$key} = DBIx::Recordset::Access -> new(\$linkset) ;

                    if ($link -> {'!Cache'})
                        {
                        $rs -> {'*LinkSet'}{$linkkey} = $linkset ;
                        }
                    }
                else
                    {
                    $$linkset -> Reset ;
                    $data = DBIx::Recordset::Access -> new(\$linkset) ;
                    }
                }

            my $of = $rs -> {'*OutputFunctions'}{$key} ;
	    $data = &{$of}($data) if ($of) ;	    
            }
        }

    if ($rs && $rs->{'*Debug'} > 3) { local $^W=0;print DBIx::Recordset::LOG "DB:  Row::FETCH " . (defined ($key)?$key:'<undef>') . " = <" . (defined ($data)?$data:'<undef>') . ">\n" } ;
    
    return $data ;
    }

## ----------------------------------------------------------------------------

sub FIRSTKEY
    {
    my ($self) = @_ ;
    my $a = scalar keys %{$self -> {'*data'}};
    
    return each %{$self -> {'*data'}} ;
    }

## ----------------------------------------------------------------------------

sub NEXTKEY
    {
    return each %{$_[0] -> {'*data'}} ;
    }

## ----------------------------------------------------------------------------

sub EXISTS
    {
    exists ($_[0]->{'*data'}{$_[1]}) ;
    }


## ----------------------------------------------------------------------------

sub DELETE
    {
    carp ("Cannot DELETE a field from a database record") ;
    }
                
## ----------------------------------------------------------------------------

sub CLEAR ($)

    {
    #carp ("Cannot DELETE all fields from a database record") ;
    } 

## ----------------------------------------------------------------------------
##
## report the cleanless of the row
##

sub Dirty { return $_[0]->{'*dirty'} }

## ----------------------------------------------------------------------------
##
## Flush data to database if row is dirty
##


sub Flush

    {
    my $self = shift ;
    my $rs    = $self -> {'*Recordset'} ;  
    
    return 1 if (!$rs) ;

    if ($self -> {'*dirty'}) 
        {
        my $rc ;
        print DBIx::Recordset::LOG "DB:  Row::Flush id=$rs->{'*Id'} $self\n" if ($rs->{'*Debug'} > 3) ;

        my $dat = $self -> {'*upd'} ;
        if ($self -> {'*new'})
            {
            $rc = $rs -> Insert ($dat)  ;
            }
        else
            {
            my $pko ;
            my $pk = $rs -> {'*PrimKey'} ;
            $dat->{$pk} = \($self -> {'*data'}{$pk}) if ($pk && !exists ($dat->{$pk})) ;
            #carp ("Need primary key to update record") if (!exists($self -> {"=$pk"})) ;
            if (!exists($self -> {'*PrimKeyOrgValue'})) 
                {
                $rc = $rs -> Update ($dat)  ;
                }
            elsif (ref ($pko = $self -> {'*PrimKeyOrgValue'}) eq 'HASH')
                {
                $rc = $rs -> Update ($dat, $pko)  ;
                }
            else
                {
                $rc = $rs -> Update ($dat, {$pk => $pko} )  ;
                }
            if ($rc != 1 && $rc ne '')
                { # must excatly be one row!
                print DBIx::Recordset::LOG "DB:  ERROR: Row Update has updated $rc rows instead of one ($rs->{'*LastSQLStatement'})\n" if ($rs->{'*Debug'}) ;
                #$rs -> savecroak ("DB:  ERROR: Row Update has updated $rc rows instead of one ($rs->{'*LastSQLStatement'})") ;            
                }	      
            }
        

        delete $self -> {'*new'} ;
        delete $self -> {'*dirty'} ;
        $self -> {'*upd'} = {} ;
        }

    my $k ;
    my $v ;
    my $lrs ;
    my $rname ;
    # "each" is not reentrant !!!!!!!!!!!!!!
    #while (($k, $v) = each (%{$rs -> {'*Links'}}))
    foreach $k (keys %{$rs -> {'*Links'}})
        { # Flush linked tables
        
        if ($lrs = $self->{'*data'}{$k})
            {
            $rname = '' ;
            $rname = eval {ref ($$lrs)} || '' ;
            ${$lrs} -> Flush () if ($rname eq 'DBIx::Recordset') ; #if (defined ($lrs) && ref ($lrs) && defined ($$lrs) && ) ;
            }
        }

    return 1 ;
    }



## ----------------------------------------------------------------------------

sub DESTROY

    {
    my $self = shift ;
    my $orgerr = $@ ;
    local $@ ;

    eval 
	{ 
    
	    {
	    local $^W = 0 ;
	    print DBIx::Recordset::LOG "DB:  Row::DESTROY\n" if ($DBIx::Recordset::Debug > 2 || $self -> {'*Recordset'} -> {'*Debug'} > 3) ;
	    }

	$self -> Flush () ;
	} ;
    if (!$orgerr && $@)
        {
        Carp::croak $@ ;
        }
    elsif ($orgerr && $@)   
        {
        warn $@  ;
        }
    }


################################################################################

1;
__END__