# Row.pm
package Rowlib::Row;

use strict;

use Carp;

use overload
    '""' => "as_string";

sub selectall {
    my $class = shift;
    my %params = @_;
    my ($by, $listby) = @params{qw(by listby)};

    my @rows = ();

    my $row_cursor = $class->new(mode=>'select', @_);

    while ($row_cursor->next) {
	push @rows, $row_cursor->clone;
    }

    # return a hashref if they wanted
    if (defined $by) {
	local $^W = 0; # allow to be indexed by a NULL without warning
	return { map {$_->get($by), $_} @rows }
    }

    # return a hashref *of arrays* if they wanted!
    if (defined $listby) {
	my %hash;
	for (@rows) {
	    no strict 'refs';
	    local $^W = 0; # allow to be indexed by a NULL without warning
	    push @{$hash{$_->get('vendor_id')}}, $_;
	}
	return \%hash;
    }

    # otherwise, they get a plain old aryref
    return \@rows;
}

# common abstract constructor
sub new {
    my $class = shift;
    my %params = @_;
    my ($db, $table, $pkey, $mode)
	= @params{qw(db table pkey mode)};

    my $self = bless {
	mode=>$mode,
	db=>$db,
	table=>$table,
	pkey=>$pkey,
	modified=>{},
	data=>undef,
	pkey_value=>undef,
	fields=>[],
	attr=>{}
    }, $class;

    return $mode eq 'select' ? $self->new_select(@_) : $self->new_insert(@_);

    return $self;
}

# clone a row object - use with caution!  This is used by the selectall (multi-)constructor
sub clone {
    my $self = shift;
    $self->ensure_started;
    my $class = ref $self;
    my ($mode, $db, $table, $pkey, $modified, $data, $pkey_value, $fields, $attr)
	= @$self{qw(mode db table pkey modified data pkey_value fields attr)};
    if (%$modified) { $self->fatal('clone Row: cannot clone a modified Row'); }
    my $clone = bless {
	mode=>$mode,
	db=>$db,
	table=>$table,
	pkey=>$pkey,
	modified=>{},
	data=>{%$data},
	pkey_value=>[@$pkey_value],
	fields=>[@$fields],
	attr=>{%$attr}
    }, $class;
}

sub save {
    my $self = shift;
    # insert if not already inserted
    if ($self->{insert}) { return $self->insert_new_row }
    # else we are updating
    my ($db, $table, $data, $pkey, $modified, $pkey_value) = @$self{qw(db table data pkey modified pkey_value)};
    my ($dbh, $debug) = @$db{qw(dbh debug)};
    # we update only fields that have changed
    my @fields = keys %$modified;
    return unless @fields; # don't update if nothing has changed

    %$modified = (); # make sure we only try once, even if it dies

    my ($SQL, $sth);
    $SQL = "UPDATE $table SET ". (join ', ', map {"$_=?"} @fields) .' WHERE '. (join ' AND ', map {"$_=?"} @$pkey);
    $self->message("update Row: $SQL (". nullify(@$data{@fields}, @$pkey_value). ")\n") if $debug;
    unless ($sth = $dbh->prepare($SQL) and $sth->execute(@$data{@fields}, @$pkey_value)) {
	$self->fatal("update Row(table=>'$table'): cannot update row : ". $dbh->errstr); }
}

# automatically write changes to database when the object is destroyed
sub DESTROY {
    my $self = shift;
    $self->save if $self->{db}{auto};
}

sub set {
    my $self = shift;
    $self->ensure_started;
    my ($data, $modified, $fields) = @$self{qw(data modified fields)};
    while (@_) {
	my ($k, $v) = (shift, shift);
	$data->{$k} = $v;
	$modified->{$k} = 1;
	# ensure that this field is in the list of fields
	push @$fields, $k unless grep { $_ eq $k } @$fields;
    }
}

sub get {
    my $self = shift;
    $self->ensure_started;
    my ($data) = @$self{qw(data)};
    return @$data{@_};
}

# backwards-compatible single get / set method:
sub data {
    my $self = shift;
    if (@_ == 1) {
	return $self->get(@_);
    } else {
	$self->set(@_);
    }
}

# set and get attributes - useful for subclasses and users to store non-persistent data
sub set_attr {
    my $self = shift;
    $self->ensure_started;
    my ($attr, $data) = @$self{qw(attr data)};
    unless (defined $data) { $self->next }
    while (@_) {
	my ($k, $v) = (shift, shift);
	$attr->{$k} = $v;
    }
}

sub get_attr {
    my $self = shift;
    $self->ensure_started;
    my ($attr) = @$self{qw(attr)};
    return @$attr{@_};
}

sub as_string {
    my $self = shift;
    $self->ensure_started;
    my ($data, $fields) = @$self{qw(data fields)};
    return (join ' ', map {"$_:". (defined $$data{$_} ? $$data{$_} : 'NULL')} @$fields)."\n";
}

sub abort {
    my $self = shift;
    %{$self->{modified}} = ();
}

sub new_select {
    my $self = shift;

    my %params = @_;
    my ($db, $table, $pkey, $where, $fields, $order, $key, $value, $data)
	= (@$self{qw(db table pkey)}, @params{qw(where fields order key value data)});
    my ($dbh, $debug) = @$db{qw(dbh debug)};

    my $using_all_fields = not defined $fields;
    $fields = [] if $using_all_fields;

    $self->{fields} = $fields;

    if (defined $data) {
	if (defined $where or defined $key or defined $value) {
	    $self->fatal("select Row: cannot specify 'data' and another type of key"); }
	$key = [keys %$data]; $value = [values %$data];
    }
    if (not (defined $key or defined $where) and defined $value) {
        # no key or where, but value => key=pkey implicitly
        $key = $pkey;
    }
    if (defined $key) {
	unless (ref $key) { $key = [$key] }
	$where = join ' AND ', map {"$_=?"} @$key;
    }

    $value = [] unless $value or exists $params{value}; 
        # the second clause allows selecting for value == NULL (undef)
    $value = [$value] unless ref $value;
    $where = defined $where ? " WHERE $where" : '';
    $order = defined $order ? " ORDER BY $order" : '';

    # what fields to select?
    my $select;
    if ($using_all_fields) {
	$select = "*";
    } else {
	# ensure that the primary key is in the list of fields
	my %select_fields = map {$_, 1} @$fields;
	for my $pkey_part (reverse @$pkey) {
	    unshift @$fields, $pkey_part
		unless grep {$_ eq $pkey_part} @$fields;
	}
	$select = join ', ', @$fields;
    }
    
    # NOTE: POSTGRESQL is happy to bind NULLs (undefs) in a select - but other DBI/DBMS may not be...
    my $SQL = "SELECT $select FROM $table".$where.$order;
    $self->message("select Row: $SQL (". nullify(@$value). ")\n") if $debug;
    unless ($SQL =~ tr/?// == @$value) { $self->fatal("select Row(table=>'$table'): wrong number of values passed"); }

    my $sth;
    unless ($sth = $dbh->prepare($SQL) and $sth->execute(@$value)) {
	$self->fatal("select Row(table=>'$table'): cannot select : ". $dbh->errstr); }
    
    $self->{sth} = $sth;

    return $self;
}

sub next {
    my $self = shift;
    return ($self->{mode} eq 'select') ?
	$self->next_select(@_) :
        $self->next_insert(@_);
}

# next fetches the next row from the query
sub next_select {
    my $self = shift;
    my ($sth, $pkey, $fields) = @$self{qw(sth pkey fields)};

    if (defined $self->{data} and $self->{data} eq 'DEAD') {
	$self->fatal("next Row: cannot call next; you were already told there are no more rows");
    }

    $self->save if defined $self->{data};

    my $data = $sth->fetchrow_hashref;

    unless (@$fields) {
	# find out _order_ of fields in the table
	@$fields = @{$sth->{NAME}};
    }

    if (defined $data) {
	$self->{data} = {%$data};
	# store the primary key value now, to avoid loss of identity if the pkey is changed
	$self->{pkey_value} = [@$data{@$pkey}];
	return 1;
    } else {
	$self->{data} = 'DEAD';
	return 0;
    }
}

sub new_insert {
    my $self = shift;
    my %params = @_;

    my ($db, $table, $pkey, $data, $seq)
	= (@$self{qw(db table pkey)}, @params{qw(data seq)});

    if (defined $data) {
	$self->next(%$data); # get ready to insert the first row
    } else {
	#$self->{data} = {}; # data was not supplied with the insert, so we wait for a call to next
    }

    return $self;
}

# next creates a new row (with optional data supplied in the parameters)
sub next_insert {
    my $self = shift;

    $self->save if defined $self->{data};

    my %data = @_;
    $self->{data} = \%data;
    @{$self->{fields}} = keys %data;

    $self->{insert} = 1;
}

# don't use this method directly - use save instead
sub insert_new_row {
    my $self = shift;
    my ($db, $table, $seq, $pkey, $data, $insert) = @$self{qw(db table seq pkey data insert)};
    my ($dbh, $debug) = @$db{qw(dbh debug)};

    $self->{modified} = {}; #
    $self->{insert} = 0;    # make sure we only try once, even if it dies

    # was the pkey value specified in $data?
    my $pkey_in_data = 1; for my $pkey_part (@$pkey) { $pkey_in_data &&= exists $data->{$pkey_part} }
    my ($SQL, $sth);
    unless ($pkey_in_data) {
	# no - so we need to read a sequence to get it!
	if (scalar(@$pkey) > 1) { # we can't get a _composite_ primary key in this way, so die
	    $self->fatal("insert Row(table=>'$table'): composite primary key (@$pkey) values not specified"); }
	my $k = $pkey->[0];
	$seq = "seq_$k" unless defined $seq;
	$SQL = "SELECT nextval ('$seq')";
	$self->message("insert Row: $SQL\n") if $debug;
	my $pkey_value = $dbh->selectrow_array($SQL);
	unless (defined $pkey_value) { $self->fatal("cannot SELECT nextval ('$seq') : ". $dbh->errstr); }
	$data->{$k} = $pkey_value;
    }
    my @fields = keys %$data;
    $SQL = "INSERT INTO $table (" .(join ', ', @fields). ') values ('. (join ', ', ('?')x(scalar(@fields))) .")";
    $self->message("insert Row: $SQL (". nullify(@$data{@fields}). ")\n") if $debug;
    unless ($sth = $dbh->prepare($SQL) and $sth->execute(@$data{@fields})) {
	$self->fatal("insert Row(table=>'$table'): cannot insert row : ". $dbh->errstr); }
    # store the primary key value now, to avoid loss of identity if the pkey is changed
    $self->{pkey_value} = [@$data{@$pkey}];
}

# display undef as NULL
sub nullify {
    return join ', ', map {defined $_ ? $_ : 'NULL'} @_;
}

# how useful is this?
sub delete {
    my $self = shift;
    $self->ensure_started;
    # if not already inserted, simply don't insert it
    if ($self->{insert}) { $self->{insert} = 0; return }
    # else we must delete it
    my ($db, $table, $data, $pkey, $modified, $pkey_value) = @$self{qw(db table data pkey modified pkey_value)};
    my ($dbh, $debug) = @$db{qw(dbh debug)};

    %$modified = (); # make sure we only try once, even if it dies

    my ($SQL, $sth);
    $SQL = "DELETE FROM $table WHERE ". (join ' AND ', map {"$_=?"} @$pkey);
    $self->message("delete Row: $SQL (". nullify(@$pkey_value). ")\n") if $debug;
    unless ($sth = $dbh->prepare($SQL) and $sth->execute(@$pkey_value)) {
	$self->fatal("delete Row(table=>'$table'): cannot delete row : ". $dbh->errstr); }
}

# debug messages
sub message {
    my $self = shift;
    my $message = shift;
    if ($self->{db}{debug} eq 'html') {
	print "<LI>$message";
    } else {
	print STDERR $message;
    }
}

# fatal errors
sub fatal {
    my $self = shift;
    my $message = shift;
    croak $message;
}

sub ensure_started {
    # this makes sure that next has been called once before any row access operation can take place -
    # next is not called on construction for select rows, because it may be desirable to use a
    # while ($row->next) { } style loop for cycling through the rows
    my $self = shift;
    $self->next unless ref $self->{data};
        # we use ref to test this, because undef means 'not started', and 'DEAD' means 'have finished' (in which case
        # next will croak)
    if ($self->{data} eq 'DEAD') {
	$self->fatal("Row: cannot access Row, there are no more rows");
    }
}

1
