Perlbug::Object - Object handler for Perlbug database

	my $o_obj 	= Perlbug::Object->new(\%init); # see L<new()>

	$o_obj 		= $o_obj->read($oid);		# data

	my $name   	= $o_obj->data('name'); 	# Bug

	# ALL bugids (optionally) constrained by sql 'where' clause
	my @ids         = $o_obj->ids($where);	# where

	# Relation ids
	my @patchids	= $o_obj->rel_ids('patch');	# relids 

	print = $o_obj->format('h');		

	my @rellies 	= $o_obj->relations('to');	# patch, message, note, test, user, 

	my $o_patch     = $o_obj->relation('patch');	# handler

	my @pids	= $o_patch->ids($o_obj);	# or

	my @pids     	= $o_obj->relation_ids('patch');# ids

# Perlbug object attribute handler
# (C) 2000 Richard Foley RFI perlbug@rfi.net
# $Id: Object.pm,v 1.53 2002/02/01 08:36:45 richardf Exp $
#

package Perlbug::Object;
use strict;
use vars(qw($VERSION @ISA $AUTOLOAD));
@ISA = qw(Perlbug::Format); 
$VERSION = do { my @r = (q$Revision: 1.53 $ =~ /\d+/go); sprintf "%d."."%02d" x $#r, @r }; 
$|=1;

use Carp;
use CGI;
use Data::Dumper;
use Perlbug::Format; 
# use Perlbug::Template; 
my $o_Perlbug_Base = '';
%Perlbug::Object::Data = (); # ?
%Perlbug::Object::Data = (
	'relation'	=> {
		'from'	=> [],
		'to'	=> [],
	},
	'type'		=> {
		'field'	=> 'VARCHAR',
	},
);

sub new { # table, key
    my $proto = shift;
    my $class = ref($proto) || $proto; 
	$o_Perlbug_Base = (ref($_[0])) ? shift : Perlbug::Base->new;
	my %input  = @_;

	my $name = ucfirst($input{'name'});
	my $key  = lc($name);
	unless ($key =~ /\w+/o) {
		$o_Perlbug_Base->error("Fatal error: no keyname($name) given!\n".Dumper(\%input)."\n");
	}

	my $self = { 												# eg:
		'_attr'	=> {			
			'float'		=> [],				# rel
			'from'		=> [],				# rel
			'hint'		=> "$name($key)",	# Bug(Child)...
		    'key'		=> $key,			# bug
		    'name'  	=> $name,			# Bug
			'match_oid'	=> '[\b\D]*(\d+)[\b\D]*',  		# default
		    'objectid'	=> '',				# 21, 200011122.003
			'primary_key'=> $key.'id',		# bugid
			'printed'	=> 0,				# i_cnt
			'prejudicial'=> 0,				# single only (ie; status, severity, etc.)?
			'sql_clean'	=> 1,				# clean sql on create, update, delete, etc.
		    'table' 	=> 'pb_'.$key,		# db_bug
			'track'		=> '1',				# usually
			'to'		=> [],				# rel
			'types'		=> [qw(from to)], 	# of rels
			%input,
		},  	
		'_data'			=> {}, 		 		# 'field' 	=> 'value' ...
		'_type'			=> {},				# 'field'	=> 'DATE|INTEGER|VARCHAR'...
		'_relation'		=> {},				# 'from' => [], 'to' => [qw(patch status ...)],
		'_flag'			=> {
			'assigned'	=> 0,				# flags
			'created'	=> 0,				#  -"- 
			'deleted'	=> 0,				#  -"- 
			'read'		=> 0,				#  -"- 
			'reset'		=> 0,				#  -"- 
			'stored'	=> 0,				#  -"-
			'tracked'	=> 0,				#  -"-
			'updated'	=> 0,				#  -"-
		},
	};

	$self = bless($self, $class);

	$self->data; $self->attr; $self->flag; # prime
	$self = $self->reinit; # inc. check()

	return $self;
}

sub init_data { # generic attr from db
	my $self  = shift;
	my $table = shift || $self->attr('table');

	$self->{'_data'} = {};
	$self->{'_type'} = {};

	# my $fields = "SELECT * FROM $table WHERE 1 = 0";
	my $fields = "SHOW fields FROM $table"; # Mysql specific?
	my @fields = $self->base->get_data($fields);
	FIELD:
	foreach my $f (@fields) { 
		next FIELD unless ref($f) eq 'HASH';
		my $field = $$f{'Field'};
		my $type  = 'VARCHAR'; # default
		$type = 'DATETIME' if $$f{'Type'} =~ /^DATE(TIME)*$/io;
		$type = 'INTEGER'  if $$f{'Type'} =~ /^(BIG|SMALL)*INT(EGER)*(\(\d+\))*/io;
		# $Perlbug::Object{'_data'}{$field} = '';
		# $Perlbug::Object{'_type'}{$field} = $type;
		$self->{'_data'}{$field} = ''; 		# init	
		$self->{'_type'}{$field} = $type; 	# init	
		# $self->_gen_field_handler($field);# don't call 
	}

	return $self;
}

sub init_types { # generic attr from db
	my $self  = shift;
	my @types = @_;
	my @rels  = ();
	
	$self->{'_relation'} = {}; # 
	foreach my $type (@types) { # float|from|to
		foreach my $targ ( $self->attr($type) ) { # patch change bug address user
			$self->{'_relation'}{$targ}{'type'} = $type;
			push(@rels, $targ);
		}
	}

	return @rels;
}

sub reinit { 
	my $self = shift; 
	my $oid = shift || ''; #  || $self->oid;

	$self->CREATED(0);
	$self->READ(0);
	$self->UPDATED(0);
	$self->DELETED(0); 
	$self->STORED(0);
	$self->TRACKED(0);
	$self->REINIT(1);

	my @fields = $self->init_data($self->attr('table'));
	my $i_ok   = $self->check();
	my @types  = $self->attr('types');
	my @rels   = $self->init_types(@types);

	$self->attr( { 'objectid', $oid} ); # explicit	
	$self->data( { $self->attr('primary_key'), $oid} );

	$self->debug(3, "object($oid) reinit(".$self->attr('key').") types(@types) rels(@rels)") if $Perlbug::DEBUG;

	return $self;
}

sub refresh_relations {
	my $self = shift;
	my @args = my @rels = @_;
	my $obj  = $self->key;

	my $rellies = join('|', my @rellies = $self->rels);
	@rels = grep(/($rellies)/, @args);
	$self->debug(2, ref($self).": args(@args) rellies($rellies) => rels(@rels)") if $Perlbug::DEBUG;

	$self->{'_relation'} = {};	

	REL:
	foreach my $rel (@rels) {
		next REL if $rel =~ /^$obj$/i; # no recurse
		my @rids  = $self->rel_ids($rel, '', 'refresh');		# if ids	
		# my @names = $self->rel_names($rel, '', 'refresh');	# 
		my @names = $self->object($rel)->id2name(\@rids);		# if names
		$self->{'_relation'}{$rel}{'count'} =  @rids;	
		$self->{'_relation'}{$rel}{'ids'}   = \@rids; 
		$self->{'_relation'}{$rel}{'names'} = \@names;	
	}
	$self->debug(3, 'relations: '.Dumper($self->{'_relation'})) if $Perlbug::DEBUG;

	return $self;
}

sub check {
	my $self  = shift;
	my $h_ref = shift || $self->_oref('attr');

	my $i_ok  = 1;

	CHECK:
	foreach my $key (keys %{$h_ref}) {
		unless ($key =~ /(debug|objectid)/io) {
			if ($$h_ref{$key} !~ /\w+/) {
				$i_ok = 0;
				$self->error(" is incomplete key($key) val($$h_ref{$key}): ".Dumper($h_ref));
			}
		}
	}

	return $i_ok;
}

sub REINIT {
	my $self = shift;
	my $i_flag = shift || ''; 

	$self->flag('reinit', $1) if $i_flag =~ /^(1|0)$/o;	

	$i_flag = $self->flag('reinit');

	return $i_flag;	
}

sub exists {
	my $self = shift;
	my $a_oids = shift || [ $self->oid ];
	my @IDS = ();

	if (ref($a_oids) ne 'ARRAY') {
		$self->error("requires array ref($a_oids) of oids!");
	} else {
		my $ids = join("', '", @{$a_oids});
		my $pri = $self->attr('primary_key');
		my $sql = "SELECT DISTINCT $pri FROM ".$self->attr('table'). 
				  # " WHERE $pri Like '_%' AND $pri IN ('$ids')"
				  " WHERE $pri IN ('$ids')"
		;
		@IDS = $self->base->get_list($sql);
	}

	return @IDS;
}

sub _exists {
	my $self = shift;
	my $a_ids = shift || [ $self->attr($self->identifier) ];
	my @IDS = ();

	if (ref($a_ids) ne 'ARRAY') {
		$self->error("requires array ref($a_ids) of ids!");
	} else {
		my $ids = join("', '", @{$a_ids});
		my $pri = $self->identifier;
		my $sql = "SELECT DISTINCT $pri FROM ".$self->attr('table'). 
				  # " WHERE $pri Like '_%' AND $pri IN ('$ids')"
				  " WHERE $pri IN ('$ids')"
		;
		@IDS = $self->base->get_list($sql);
	}

	return @IDS;
}

sub data_fields { my $self = shift; return $self->fields(@_); }

sub fields {
	my $self = shift;

	my @fields = keys %{$self->{'_data'}};

	return @fields;
}

sub str2ids {
	my $self = shift;
	my $str  = shift || '';
	my @ids  = ();

	if ($str !~	/\w+/) {
		$self->error("no string($str) given to inspect for ids!");
	} else {
		my $match = $self->attr('match_oid');
		# my %x = ($dmc =~ /\<(\w+)\>(\w+)?(?:)\<\/\1\>/gi)
		@ids = ($str =~ /$match/cgs);
		$self->debug(2, "str($str) match($match) -> ids(@ids)") if $Perlbug::DEBUG;
	}

	return @ids;
}

sub ok_ids {
	my $self = shift;
	my $a_ids = shift || '';
	my @ok = ();

	if (!ref($a_ids) eq 'ARRAY') {
		$self->error("expecting array_ref($a_ids) of object ids!");
	} else {
		my $ids = join('|', my @ids = @{$a_ids});
		if (!(scalar(@ids) >= 1)) {
			$self->debug(2, "no ids(@ids) given") if $Perlbug::DEBUG;
		} else {
			my @wids = map { ($_ =~ /\w+/o ? $_ : ()) } @ids;  
			if (!(scalar(@wids))) {
				$self->debug(2, "no word-like ids(@wids) given(@ids)") if $Perlbug::DEBUG;
			} else {
				my $i_ids = @wids;
				my $match = $self->attr('match_oid');
				my $i_oks = @ok = map { ($_ =~ /^$match$/ ? $_ : ()) } @wids;  
				if ($i_ids != $i_oks) {
					$self->debug(2, $self->key()." failed to match($match) object ids! given: $i_ids(@wids) => ok_ids: $i_oks(@ok)") if $Perlbug::DEBUG; 
				}
			}
		}
	}

	return @ok;
}

sub primary_key {
	my $self = shift;
	
	my $pri = $self->attr('primary_key');

	return $pri;
}

sub key {
	my $self = shift;
	my $in = shift || '';
	
	if ($in =~ /\w+/o) {
		$self->attr({'key', $in}); # explicit	
	}

	my $key = $self->attr('key');

	return $key;
}

sub objectid { my $self = shift; return $self->oid(@_); } # shortcut

sub oid {
	my $self = shift;
	my $in = shift || '';

	if ($self->ok_ids([$in])) { # are appropriate
		$self->attr( { 'objectid', $in } ); # explicit	
		$self->data( { $self->attr('primary_key'), $in } );
	}
	my $oid = $self->attr('objectid');

	return $oid;
}

sub id {
	my $self  = shift;
	my $h_ref = shift; #$o_cgi
	my @ids   = ();

	if (!(ref($h_ref))) {
		$self->error("requires some sort of data ref($h_ref)!");
	} else {
		my $obj = $self->key;
		my @vars = ('id', $obj.'id', $obj.'_id', $obj.'_ids');
		foreach my $var (@vars) {
			if (ref($h_ref) eq 'CGI') {
				push(@ids, $h_ref->param($var)) if $h_ref->param($var);
			} else {
				if (ref($h_ref) eq 'ARRAY') {
					push(@ids, @{$h_ref}) if scalar(@{$h_ref}) >= 1;
				} else {
					if (ref($$h_ref{$var}) eq 'ARRAY') {
						push(@ids, @{$$h_ref{$var}}) if scalar(@{$$h_ref{$var}}) >= 1;
					} else {
						push(@ids, $$h_ref{$var}) if $$h_ref{$var} =~ /.+/o;
					}
				}
			}
		}
		$self->debug(3, "ok id(@ids)from: ".Dumper($h_ref)) if $Perlbug::DEBUG;
	} 

	return @ids;
}

sub ids {
	my $self  = shift;
	my $input = shift || '';
	my $extra = shift || '';
	my $refresh = shift || '';
	my @ids   = ();
	
	my $prime = $self->attr('primary_key');
	my $table = $self->attr('table');
	my $sql   = "SELECT DISTINCT $prime FROM $table ";

	if (ref($input)) {				# OBJECT with ids, etc.
		$sql .= " WHERE $prime = '".$input->oid()."'";		
		$sql .= " AND $extra" if $extra;
	} elsif ($input =~ /\w+/o) { 	# SQL where clause
		$input =~ s/^\s*WHERE\s*//io;	
		$sql  .= " WHERE $input";	
	} 								# ALL
	$sql .= " ORDER BY name " if $self->identifier eq 'name';
	
	@ids = $self->base->get_list($sql, $refresh);
	$self->debug(3, "input($input) extra($extra) -> ids(@ids)") if $Perlbug::DEBUG;

	return @ids;
}

sub names {
	my $self = shift;
	my $input = shift || '';
	my $extra = shift || '';
	my @names = ();
	
	my $ident = $self->identifier;
	if ($self->identifier eq 'name') {
		my $sql = "SELECT DISTINCT name FROM ".$self->attr('table');
		if (ref($input)) {				# OBJECT with ids, etc.
			$sql .= ' WHERE '.$input->attr('primary_key')." = '".$input->oid()."'";		
			$sql .= " AND $extra" if $extra;
		} elsif ($input =~ /\w+/o) { 	# SQL where clause
			$input =~ s/^\s*WHERE\s*//io;	
			$sql  .= " WHERE $input";	
		}
		@names = $self->base->get_list($sql);
	}								# ALL
	$self->debug(3, "input($input) extra($extra) -> names(@names)") if $Perlbug::DEBUG;

	return @names;
}

sub col { 
	my $self = shift;
	my $col  = shift;
	my $input = shift || '';
	my @cols = ();
	
	if ($col !~ /\w+/) {
		$self->error("No column($col) given to retrieve!");
	} else {	
		my $sql = "SELECT DISTINCT $col FROM ".$self->attr('table');
		if (ref($input)) {				# OBJECT with ids, etc.
			$sql .= ' WHERE '.$input->attr('primary_key')." = '".$input->oid()."'";		
		} elsif ($input =~ /\w+/o) { 	# SQL where clause
			$input =~ s/^\s*WHERE\s*//io;	
			$sql  .= " WHERE $input";	
		} 		 						# ALL 
		@cols = $self->base->get_list($sql);
	}	

	$self->debug(3, "col($col), input($input) -> cols(@cols)") if $Perlbug::DEBUG;
	return @cols;
}

sub identifier {
	my $self = shift;
	
	my $ident = (grep(/^name$/i, $self->data_fields)) 
	# my $ident = (map { ($_ =~ /^name$/ ? 1 : 0) } $self->data_fields) 
		? 'name' 
		: $self->attr('primary_key');

	$self->debug(3, "ident($ident)") if $Perlbug::DEBUG;
	return $ident;
}

sub id2name {
	my $self    = shift;
	my $a_input = shift;
	my @output  = ();

	if (!ref($a_input)) {
		$self->debug(0, "no input ids given to convert($a_input)") if $Perlbug::DEBUG;
	} else {
		if ($self->identifier ne 'name') {
			$self->debug(3, "identifier ne 'name'!") if $Perlbug::DEBUG;
		} else {
			my @input = @{$a_input};
			if (scalar(@input) >= 1) {
				my $input = join("', '", @input);
				my $sql = 
					"SELECT DISTINCT name FROM ".$self->attr('table').
					" WHERE ".$self->attr('primary_key')." IN ('$input')";
				@output = $self->base->get_list($sql);
				$self->debug(3, "given(@input) -> sql($sql) -> output(@output)") if $Perlbug::DEBUG;
			}
		}
	}
	$self->debug(2, "given(@{$a_input}) output(@output)") if $Perlbug::DEBUG;

	return @output;
}

sub name2id {
	my $self = shift;
	my $a_input   = shift;
	my @output = ();
	if (!ref($a_input)) {
		$self->error("no input names given to convert($a_input)");
	} else {
		my @input = @{$a_input};
		if (scalar(@input) >= 1) {
			my $input = join("', '", @input);
			my $sql = 
				 "SELECT DISTINCT ".$self->attr('primary_key').
				  " FROM ".$self->attr('table')." WHERE ".$self->identifier." IN ('$input')";
			@output = $self->base->get_list($sql);
			$self->debug(3, "input(@input) -> sql($sql) -> output(@output)") if $Perlbug::DEBUG;
		}
	}
	return @output;
}

sub count {
	my $self 	= shift;
	my $input = shift || '';
	my $extra = shift || '';

	my $i_cnt 	= 0;
	
	my $sql = "SELECT COUNT(".$self->attr('primary_key').") FROM ".$self->attr('table');
	if (ref($input)) {				# OBJECT with ids, etc.
		$sql .= ' WHERE '.$input->attr('primary_key')." = '".$input->oid()."'";		
		$sql .= " AND $extra" if $extra;
	} elsif ($input =~ /\w+/o) { 	# SQL where clause
		$input =~ s/^\s*WHERE\s*//io;	
		$sql  .= " WHERE $input";	
	} 								# ALL

	($i_cnt) = $self->base->get_list($sql);
	$self->debug(3, "input($input) extra($extra) -> i_cnt($i_cnt)") if $Perlbug::DEBUG;

	return $i_cnt;
}

sub trim {
	my $self = shift;
	my $a_in = shift;
	my @trimmed = ();

	if (!ref($a_in) eq 'ARRAY') {
		$self->error("expecting array_ref($a_in) to trim!");
	} else {
		foreach my $arg (@{$a_in}) {
			$arg =~ s/^\s+//o;
			$arg =~ s/\s+$//o;
			push(@trimmed, $arg);
		}
	}

	return @trimmed;
}

sub keys_sorted_by_value {
	my $self = shift;
	my $h_in = shift;

	my @sort = ();

	if (ref($h_in) ne 'HASH') {
		$self->error("expecting hash_ref($h_in) to sort!");
	} else {
		my %in = %{$h_in};
		foreach my $arg (sort { $in{$a} cmp $in{$b} } keys %in) {
			push(@sort, $arg);
		}
	}

	return @sort;
}

# HTTP specific methods
# -----------------------------------------------------------------------------

sub link {
	my $self = shift;
	my $fmt  = shift || $self->base->current('format');
	my $aoid = shift || [];
	my $js   = shift || '';
	my $stat = (ref($aoid) eq 'ARRAY') ? join(', ', @{$aoid}) : '';
	
	my $targ = $self->key;

    my @link = $self->href($targ.'_id', $aoid, ucfirst($targ), $stat, $aoid, $js, $fmt);

	$self->debug(3, "targ($targ) oid($aoid) => link(@link)") if $Perlbug::DEBUG;

	return @link;
}

sub choice {
	my $self = shift;

	my $choice = ($self->attr('prejudicial') == 1) ? 'popup' : 'selector';

	$self->debug(3, "choice($choice)...") if $Perlbug::DEBUG;

	return $self->$choice(@_);
}

sub popup {
	my $self = shift;
	my $name = shift || $self->attr('name');
	my $sel  = shift || ''; # any?
	my $where= shift || ''; # sql
	($sel)   = @{$sel} if ref($sel) eq 'ARRAY';

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

	my %map = ('' => '',);
	%map = (%map, 'any' => 'any') if $sel eq 'any';
	my $pri = $self->attr('primary_key');
	# my $col = (grep(/^name$/i, $self->data_fields)) ? 'name' : $pri;
	my ($col) = map { ($_ =~ /^name$/o ? $_ : $pri ) } $self->data_fields ? 'name' : $pri;

	my @ids = $self->col("CONCAT($pri, ':', $col)", $where); 
	foreach my $id (@ids) {
		my ($pre, $post) = split(':', $id);
		$map{$pre} = $post;
	}

	my @sorted = $self->keys_sorted_by_value(\%map);

	# my $pointer = 'parent.perlbug.document.forms[0].';
	my $pop = $cgi->popup_menu(
		-'name' 	=> $name, 			# xxx_groupids
		-'values' 	=> \@sorted, # keys %map
		-'onChange'	=> 'pick(this);',
		-'default' 	=> $sel,	
		-'labels' 	=> \%map, 
		-'override' => 1,
		@_,
	);
	
	$self->debug(3, "name($name) selected($sel) pop($pop)") if $Perlbug::DEBUG;

	return $pop;
}

sub selector {
	my $self = shift;
	my $name = shift || $self->attr('name');
	my @selected = @_;

	my $cgi  = $self->base->cgi;
	@selected = @{$selected[0]} if ref($selected[0]) eq 'ARRAY';

	my %map = ();
	my $pri = $self->attr('primary_key');
	# my $col = (grep(/^name$/i, $self->data_fields)) ? 'name' : $pri;
	my ($col) = map { ($_ =~ /^name$/o ? $_ : $pri ) } $self->data_fields ? 'name' : $pri;

	my @ids = $self->col("CONCAT($pri, ':', $col)"); 
	foreach my $id (@ids) {
		my ($pre, $post) = split(':', $id);
		$map{$pre} = $post;
	}

	my @sorted = $self->keys_sorted_by_value(\%map);

	my $sel  = $cgi->scrolling_list(
		-'name' 	=> $name, 			# xxx_groupids
		-'values' 	=> \@sorted, # keys %map
		-'default' 	=> \@selected,	
		-'labels' 	=> \%map, 
		-'multiple' => 'true', 
		-'size' 	=> 3, 
		-'override' => 1,
		-'onChange'	=> 'pick(this);',
		@_,
	).'<br>'.join(', ', map { $map{$_} } @selected);
	
	$self->debug(3, "name($name) selected(@selected) => sel($sel)") if $Perlbug::DEBUG;

	return $sel;
}

sub text_area {
	my $self = shift;
	my $name = shift || $self->attr('name');
	my $val  = shift || '';

	($val)  = @{$val} if ref($val) eq 'ARRAY';
	my $cgi  = $self->base->cgi;

	my $txt  = $cgi->textarea(
		-'name' 	=> $name, 			# xxx_groupids
		-'value' 	=> $val,
		-'override' => 1,
		-'onChange'	=> 'pick(this);',
		-'rows'		=> 3,
		-'cols'		=> 25,
		@_, 							# etc. 
	);

	$self->debug(3, "name($name) val($val) => txta($txt)") if $Perlbug::DEBUG;

	return $txt;
}

sub text_field {
	my $self = shift;
	my $name = shift || $self->attr('name');
	my $val  = shift || '';

	($val)  = @{$val} if ref($val) eq 'ARRAY';
	my $cgi  = $self->base->cgi;

	my $txt  = $cgi->textfield(
		-'name' 	=> $name, 			# xxx_groupids
		-'value' 	=> $val,
		-'override' => 1,
		-'onChange'	=> 'pick(this);',
		-'size'		=> 12,
		-'maxlength'=> 12,
		@_, 							# etc. 
	);

	$self->debug(3, "name($name) val($val) => txtf($txt)") if $Perlbug::DEBUG;

	return $txt;
}

sub htmlify {
	my $self   = shift;
	my $h_data = $self->SUPER::htmlify(@_);

	if (ref($h_data) ne 'HASH') {
		$self->error("requires hashed data ref($h_data)!");
	} else {
		my $obj = $self->key;
		my $oid = $self->oid;
		$$h_data{'select'} = $self->base->cgi->checkbox(
			-'name'		=>"${obj}id", 
			-'checked' 	=> '', 
			-'value'	=> $oid, 
			-'label' 	=> '', 
			-'override' => 1
		);

		my $OPTIONAL = $self->base->help_ref('optional', 'Optional');
		my $TRANSFER = $self->base->help_ref('transfer', 'Transfer');
		my $transfer = '<td>&nbsp;</td><td>&nbsp;</td>';
		if (grep(/^$obj$/, $self->base->objects('mail'))) {
			$transfer = qq|<td><b>$TRANSFER type:</b>&nbsp;</td>|.
				'<td>'.
				$self->object('object')->popup("${oid}_transfer", $obj, 
				"UPPER(type) = 'MAIL' 
								AND name IN('message', 'note', 'patch', 'test') AND NAME != '$obj'", 
				# -'onChange'	=> "pick(this); return newcoms('read');",
			) . '</td>';
		}
		$$h_data{'options'} = qq|
				<table border=0>
						<tr>$transfer</tr>
						<tr>
								<td><b>$OPTIONAL information here:</b>&nbsp;</td>
								<td><input type="text" name="${oid}_opts" value="" size="30" 
								onChange="return pick(this);"></td>
						</tr>
				</table>
				|;
	}

	$self->debug(3, "$h_data => <pre>\n".Dumper($h_data)."</pre>\n") if $Perlbug::DEBUG;

	return $h_data;
}

sub form {
	my $self  = shift;
	my $o_cgi = shift; # ignored
	my $title = shift || 'form';
	my $obj   = $self->key;
	my $cgi   = $self->base->cgi;

	my $form = qq|<table border=1>\n|.
		q|<tr><th>&nbsp;</th><th><h3>|.ucfirst($obj).qq| $title</h3></th></tr>\n|;

	$self->reinit() unless $title =~ /^initial/io;

	my $h_data = $self->_oref('data');

	KEY:
	foreach my $key (sort keys %{$h_data}) {
		my $val = $$h_data{$key} || '';
		unless ($key eq 'userid') {
			if ($key =~ /^(created|modified|${obj}id)$/io) { 
				next KEY if $cgi->param('req') =~ /_initform$/io;
			}
		}
		$form .= qq|<tr><td><b>$key</b></td>|;
		if ($key =~ /body|header/io) {
			$form .= qq|<td><textarea name="$key" rows="3" cols="40">$val</textarea></td>|;
		} else {
			my $size = ($key =~ /(description|email_msgid|subject|(to|source)addr)/io) ? 'size="35"' : '';
			$form .= qq|<td><input type="text" name="$key" value="$val" $size></td>|;
		}
		$form .= qq|</tr>\n|;
	}

	$form .= qq|</table>\n|;

	$self->debug(3, "obj($obj) form($form)") if $Perlbug::DEBUG;

	return $form; 
}

sub search {
	my $self = shift;
	my $o_cgi = shift; # ignored
	my $obj  = $self->key;
	my $cgi  = $self->base->cgi;

	my $form = $self->form($cgi, 'search');

	my $FMT		 = $self->base->help_ref('format', 'Formatter');
	my $SHOWSQL  = $self->base->help_ref('show_sql', 'Show SQL');
	my $RESTRICT = $self->base->help_ref('restrict', 'Restrict returns to');
    my %format   = ( 'h' => 'Html list', 'H' => 'Html block', 'L' => 'Html lean', 'a' => 'Ascii list', 'A' => 'Ascii block', 'l' => 'Ascii lean',); 
	my $format   = $cgi->radio_group(-'name' => 'format',  -values => \%format, -'default' => 'h', -'override' => 1);
    my $sqlshow  = $cgi->radio_group(-'name' => 'sqlshow',	-'values' => ['Yes', 'No'], -'default' => 'No', -'override' => 1);
    my $restrict = $cgi->popup_menu(-'name' => 'trim',      -'values' => ['All', '5', '10', '25', '50', '100'],  -'default' => 10, -'override' => 1);

	$form .= qq|
				<table border=0>
				<tr><td>$FMT:     	</td><td>$format</td></tr> 
				<tr><td>$SHOWSQL: 	</td><td>$sqlshow</td></tr> 
				<tr><td>$RESTRICT:	</td><td>$restrict</td></tr> 
				</table>\n
				<input type=hidden name=req value="${obj}_query">\n
		|;

	$self->debug(3, "obj($obj) form($form)") if $Perlbug::DEBUG;

	return $form;
}

sub initform {
	my $self  = shift;
	my $o_cgi = shift; # ignored
	my $obj   = $self->key;
	my $cgi   = $self->base->cgi;

	$self->reinit;
	$self->data(
		$self->minimal_create_info({})	
	);

	my $form = $self->form($cgi, 'initialisation');

	my $optional = $self->base->help_ref('optional', 'Optional');
	$form .= qq|<hr>
				<b>$optional information here:</b>&nbsp;<input type="text" name="opts" value="" size="30">
		<hr>| if $self->isarel('bug'); # group (users)
	$form .= qq|
				<input type=hidden name=req value="${obj}_create">\n
				<input type=hidden name=format value="H">\n
				|;

	$self->debug(3, "obj($obj) form($form)") if $Perlbug::DEBUG;

	print $form; # <- !!!

	return (); 
}

# =============================================================================

sub x_gen_field_handler { # AUTOLOAD'd
    my $self  = shift;
    my $field = shift;
    # if (!(grep(/^$field$/, $self->data_fields))) { 
	if (map { ($_ =~ /^name$/o ? 1 : 0) } $self->data_fields) { 
		$self->error("can't gen_field_handler($field)!");
    } else {
		my $ref = ref($self);
		$self->debug(3, "setting($ref) field($field) handler...") if $Perlbug::DEBUG;
		my $code = qq|
						package $ref;
						sub $field {
								my \$self = shift;
								my \$val  = shift;
								if (defined(\$val)) {
										\$self->{'_data'}{'$field'} = \$val;
								}
								
								my \$ret = \$self->{'_data'}{'$field'};
								# print "returning $field data(\$ret) setting? val(\$val)\n";

								return \$ret;
						}		
				|;
		my $x = eval { $code }; 
		$self->error("Couldn't eval the($ref) field($field) handler: $@") if ($@);
    }
    $self;
}

{ $^W=0; eval ' 
sub base {
		my $self = shift;

		$o_Perlbug_Base = ref($o_Perlbug_Base) ? $o_Perlbug_Base : Perlbug::Base->new(@_);

		return $o_Perlbug_Base; 
} 
'; }

{ $^W=0; eval ' 
sub db {
		my $self = shift;

		return $self->base->db;
} 
'; }

sub _oref { # unsupported 
	my $self  = shift;
	my $key   = shift;
	my $h_ref = ''; # !

	my @refs = keys %{$self};
	# if (!grep(/^_$key$/, @refs)) { # sneaky :-]
	if (!(map { ($_ =~ /^_$key$/ ? 1 : 0) } @refs)) {
		$self->error("unknown key($key) requested! valid keys(@refs)");	
	} else {
		$h_ref = { %{$self->{"_$key"}} }; # copy
	}

	$self->debug(3, "key($key) => href: ".Dumper($h_ref)) if $Perlbug::DEBUG;
	
	return $h_ref;
}

sub relation_types { my $self = shift; return $self->rel_types(@_); } # wrapper for rel_types()

sub rel_types {
	my $self = shift;
	return $self->attr('types');
}

sub isarel {
	my $self = shift;
	my $rel  = shift;
	my $type = lc(shift) || '';

	# my $isa  = (grep(/^$rel$/, $self->rels($type))) ? 1 : 0;
	my $isa = map { ($_ =~ /^$rel$/ ? 1 : 0) } $self->rels($type);

	return $isa;
}

sub relations { my $self = shift; return $self->rels(@_); } # wrapper for rels()

sub rels { 
	my $self = shift;
	my $type = shift || ''; # float|from|to
	my @rels = ();
	if (defined($type) && $type =~ /\w+/o) {
		@rels = $self->attr($type); 
	} else {	
		@rels = map { $self->attr($_) } $self->rel_types;
	}
	$self->debug(3, "type($type) => rels(@rels)") if $Perlbug::DEBUG;

	return @rels;
}

sub relation { my $self = shift; return $self->rel(@_); } # wrapper for rel()

sub rel {
	my $self = shift;
	my $rel  = shift;
	my $o_rel = undef;
	if (!(defined($rel))) { 
		$self->error("No relation($rel) given to handle");
	} else {
		# if (!(grep(/^$rel$/, $self->relations))) {
		$rel =~ s/^.+?\W(\w+)$/$1/;
		if (!(map { ($_ =~ /^$rel$/ ? 1 : 0) } $self->rels)) { 
			$self->error("inappropriate relation($rel) requested from ".ref($self));
		} else {
			my $type = $self->{'_relation'}{$rel}{'type'};
			$o_rel  = $self->base->object($self->key.'->'.$rel, '', $type);
			my $oid = $self->oid;
			$o_rel->set_source($self->key, $self->oid);
			my $rid = $o_rel->oid;
		}
	}	
	$self->debug(3, "rjsf: Object::relation($rel): ".ref($self)." own_key(".$self->attr('key').") rel($rel) rel_key(".$o_rel->attr('key')." o_rel($o_rel)") if $Perlbug::DEBUG;
	return $o_rel;
}

sub relation_ids { my $self = shift; return $self->rel_ids(@_); } # wrapper for rel_ids()

sub rel_ids { # object 
	my $self = shift;
	my $rel  = shift;
	my $args = shift || '';
	my $refresh = shift || '';
	
	my @ids  = ();
	if (!defined($rel)) { 
		$self->error("Unable to get ids for non-existent ".ref($self)." relation($rel)");
	} else {
		my @rellies = $self->rels;
		# if (!(grep(/^$rel$/, @rellies))) {
		if (!(map { ($_ =~ /^$rel$/ ? 1 : 0) } $self->rels)) { 
			$self->error("inappropriate relation($rel) given for rel_ids from ".ref($self)." object ok(@rellies)");
		} else {
			my $o_rel = $self->relation($rel);
			@ids = $o_rel->ids($self, $args, $refresh);
			$self->debug(3, "rel($rel) args($args) -> ids(".@ids.')') if $Perlbug::DEBUG;
		}
	}	
	return @ids;
}

sub _rel_ids { my $self = shift; return $self->rel(@_, 'refresh'); } # wrapper for rel_ids()

sub relation_names { my $self = shift; return $self->rel_names(@_); } # wrapper for rel_names()

sub rel_names { # object 
	my $self = shift;
	my $rel  = shift;
	my $args = shift || '';

	my @names = ();

	my @ids = $self->rel_ids($rel, $args);
	if (scalar(@ids) >= 1) {
		@names = $self->object($rel)->id2name(\@ids) if @ids;
	}
	
	# $self->debug(3, "rel($rel), args($args) -> ids(@ids), names(@names)") if $Perlbug::DEBUG;
	return @names;
}

sub relate {
	my $self    = shift;
	my $h_ships = shift;
	my @rels    = ();

	if (ref($h_ships) ne 'HASH') {
		$self->debug(0, "requires relationships: ".Dumper($h_ships)) if $Perlbug::DEBUG;
	} else {
		my $oid = $self->oid;
		if ($oid !~ /\w+/) {
			$self->error("$self has no object id($oid) to relate with!");
		} else {
			my $obj = $self->key;
			if ($obj eq 'bug') {
				unless (ref($$h_ships{'status'}{'names'}) eq 'ARRAY') {
					my $i_has_status = $self->rel_ids('status');
					$$h_ships{'status'}{'names'} = ['open'] unless $i_has_status;
				}
			}
			my %track = ();
			$self->debug(1, 'oid: '.$self->oid.' relatable: '.Dumper($h_ships)) if $Perlbug::DEBUG;
			RELATE:
			foreach my $rel ($self->rels) {
				next RELATE unless $rel =~ /\w+/o;
				my $prej  = ($self->object($rel)->attr('prejudicial') == 1) ? 1 : 0;
				my $o_rel = $self->rel($rel);
				my $a_ids = $$h_ships{$rel}{'ids'} || [];
				my $call  = $prej ? 'store' : 'assign';
				if (ref($$h_ships{$rel}{'ids'})) {
					$o_rel->$call($a_ids);
					$track{$rel}{'ids'} = $o_rel->ASSIGNED.' <= ('.join(', ', @{$a_ids}).')';
				} 
				my $a_names = $$h_ships{$rel}{'names'} || [];
				if (ref($$h_ships{$rel}{'names'})) { 
					my $call  = $prej ? '_store' : '_assign';
					$o_rel->$call($a_names);
					$track{$rel}{'names'} = $o_rel->ASSIGNED.' <= ('.join(', ', @{$a_names}).')';
				}
				if (ref($track{$rel})) {
					push(@rels, $rel) if keys %{$track{$rel}} >= 1;
				}	
			}
			$self->debug(1, 'oid('.$self->oid.') related: '.Dumper(\%track)) if $Perlbug::DEBUG;
			$self->rtrack(\%track);
		}
	}

	return @rels;
}

sub appropriate {
	my $self    = shift;
	my $h_ships = shift;
	my @bugids  = ();

	if (ref($h_ships) ne 'HASH') {
		$self->debug(0, "requires relationships: ".Dumper($h_ships)) if $Perlbug::DEBUG;
	} else {
		@bugids   = (ref($$h_ships{'bug'}{'ids'}) eq 'ARRAY') 
			? @{$$h_ships{'bug'}{'ids'}}
			: ();
		if (scalar(@bugids) >= 1) {
			my $o_bug = $self->object('bug');
			foreach my $bugid (@bugids) {
				$o_bug->read($bugid)->relate($h_ships);
			}
		}
	}

	return @bugids;
}

sub read {
	my $self = shift;
	my $oid = shift || $self->oid;

	$self->reinit(''); # always want a fresh one
	if ($self->ok_ids([$oid]) != 1) {
		$self->debug(0, "$self requires a valid id($oid) to read against!") if $Perlbug::DEBUG;
	} else {
		my $pri	  = $self->attr('primary_key');
		my $table = $self->attr('table');
		my $sql = "SELECT * FROM $table WHERE $pri = '$oid'"; # SQL
		my ($h_data) = $self->base->get_data($sql);
		$h_data = '' unless $h_data;
		if (ref($h_data) ne 'HASH') {
			$self->debug(0, "failed to retrieve data($h_data) with $pri = '$oid' in table($table)") if $Perlbug::DEBUG;
		} else {
			$self->debug(2, $self->key." oid($oid)") if $Perlbug::DEBUG;
			# $DB::single=2;
			my $res = $self->data($h_data); 			# set
			my $xoid = $self->oid($oid);				# set
			# $self = $self->object($self->attr('key'), $self); # cache
			$self->READ(1) if $self->exists([$oid]); 	# catchy :)
		}
	}
	# print "Object::read($oid)...<pre>".Dumper($self)."</pre>\n";

	$self;
} 

sub READ {
	my $self = shift;
	my $i_flag = shift || ''; 

	$self->flag({'read', $1}) if $i_flag =~ /^(1|0)$/o;

	$i_flag = $self->flag('read');

	return $i_flag;	
}

sub _read {
	my $self = shift;
	my $name = shift || $self->data('name');

	my ($oid) = $self->name2id([$name]);

	return $self->read($oid);
}

sub column_type {
	my $self = shift;
	my $col  = lc(shift || '');
	my $type = 'VARCHAR';

	if (!($col =~ /^\w+$/o && grep(/^$col$/, keys %{$self->{'_type'}}))) {
		$self->error("can't define type for unrecognised column($col)");
	} else {
		$type = $self->{'_type'}{$col};
	}

	return $type;	
}

sub to_date {
	my $self = shift || '';
	return "'@_'";
}

sub prep {
	my $self = shift;
	my $control = uc(shift || '');
	my $h_data	= shift; 
	my $table 	= $self->attr('table');
	my $sql = '';
	
	if (ref($h_data) ne 'HASH') {
		$self->error("can't prep non-existing data hash ref($h_data)");
	} else {
		my $do = (($control eq 'INSERT') ? 'INSERT INTO' : 'UPDATE');
		my @args = (); 
		foreach my $key (keys %{$h_data}) {
			my $type = $self->column_type($key); # def = (VARCHAR|BLOB)
			my $val = $$h_data{$key};
			$self->debug(3, "key($key) type($type) val(".length($val).")") if $Perlbug::DEBUG;
			# $val =~ s/^\s+//o;		# front
			# $val =~ s/\s+$//o;		# back
			my $data = '';
			if ($type eq 'DATETIME') {
				$data = "$key = SYSDATE()";
				if (!($key =~ /modified/io || ($key =~ /created/io && $control eq 'INSERT'))) {
					$data = "$key = ".$self->to_date($val);
				}
			} elsif ($type eq 'INTEGER')  {
				$data = "$key = '$val'";
			} else { # default and handles all strings, requoting!
				$data = "$key = '".$self->base->db->quote($val)."'";
			}
			unless ($key =~ /^(header|body)$/i) {
				$self->debug(3, "Type($type) key($key) val($val) => data($data)") if $Perlbug::DEBUG;
			}
			push(@args, $data) if $data;
		}
		$sql = "$do $table SET ".join(', ', @args).(' ' x rand(10));
		$self->debug(2, "sql($sql)") if $Perlbug::DEBUG;
	}

	return $sql;
}

sub massage {
	my $self  = shift;
	my $o_cgi = shift;
	my $oid   = shift || '';
	my $obj   = $self->key;
	my %ret   = ();

	if (!(ref($o_cgi))) {
		$self->error("$obj requires cgi obj($o_cgi) to massage!");
	} else {
		$self->debug(2, "given: ".Dumper($o_cgi)) if $Perlbug::DEBUG;
		my $objid = $obj.'id';
		$ret{$objid} = [$self->id($o_cgi)];
		
		foreach my $key ($self->fields, '_opts') {
			my $oid_key = $oid.'_'.$key;
			my $val = $o_cgi->param($key) || $o_cgi->param($oid_key) || '';
			if ($val =~ /(.+)/) {
				if ($key =~ /^(created|modified)$/) {	
					$val = "TO_DATE($val)";
				}
				$ret{$key} = $val unless $ret{$val};
			}
		}
		$self->debug(2, "massaged: ".Dumper(\%ret)) if $Perlbug::DEBUG;

		if ($o_cgi->param('req') =~ /_create$/) {
			%ret = %{$self->minimal_create_info(\%ret)};
		}
	} 

	return \%ret;
}

sub minimal_create_info {
	my $self   = shift;
	my $h_data = shift;
	my %ret    = ();

	if (!(ref($h_data) eq 'HASH')) {
		$self->error("requires hash ref($h_data) minimally!");
	} else {
		$self->debug(2, "mci given: ".Dumper($h_data)) if $Perlbug::DEBUG;
		my $admin = $self->base->isadmin;
		if ($admin !~ /\w+/) {
			$self->error("shouldn't get here?"); # web create only for admins
		} else {
			%ret = %{$h_data};
			my $o_usr = $self->base->object('user')->read($admin);

			my $obj = $self->key;
			my $oid = $obj.'id';
			$ret{$oid} = $self->new_id($self->id($h_data)); # unless $ret{$oid} =~ /\w+/o;

			my $msgid	= $ret{'email_msgid'} 	|| $self->base->get_rand_msgid;
			my $from 	= $ret{'sourceaddr'} 	|| $o_usr->data('address');
			my ($to) 	= $ret{'toaddr'} 		|| $self->base->target('generic'); 
			my $subject	= $ret{'subject'}		|| 'no subject given'; 

			$ret{'header'} = qq|
								From: $from
								To: $to
								Message-ID: $msgid
								Subject: $subject

						|; $ret{'header'} =~ s/^\s+//gmos;
			$ret{'subject'} 	= $subject;
			$ret{'email_msgid'}	= $msgid;
			$ret{'sourceaddr'} 	= $from;
			$ret{'toaddr'}	= $to;
		}
		$self->debug(2, "mci return: ".Dumper(\%ret)) if $Perlbug::DEBUG;
	}

	return \%ret;
}

sub query {
	my $self   = shift;
	my $h_data = shift;
	my $cgi    = $self->base->cgi;
	my @ids    = ();

	if (ref($h_data) ne 'HASH') {
		$self->error("requires data hash ref($h_data) to query!");
	} else {
		my @sql = ();
		foreach my $key (sort $self->fields) {
			my $param = $$h_data{$key} || '';
			if (ref($param) eq 'ARRAY') {
				if (scalar(@{$param}) >= 1) {
					my $params = join("', '", @{$param});
					push(@sql, "$key IN ('$params')")
				}
			} elsif ($param =~ /(.+)/) {
				$param = "'$1'";
				my $cmp = $self->db->comp($param);
				if ($key =~ /^(created|modified)$/) {	
					$key = "TO_DAYS($key)";
					$cmp = '>='; 
					$param = "TO_DAYS($param)"; # nice and open via mysql
					# TO_DAYS(modified) >= TO_DAYS('TO_DATE(2001-01-10)')
				}
				push(@sql, "$key $cmp $param");
			}
		}
		my $sql = join(' AND ', @sql);
		$sql =~ s/\*/\%/g;
		my $sqls = $cgi->param('sqlshow') || '0';
		my $trim = $cgi->param('trim') || '25';
		if ($sqls eq 'Yes') {
			print "SQL(".$self->key."): $sql<hr>";
		}
		@ids = $self->ids($sql);
		$self->debug(1, "sql($sql) trim($trim) ids: ".@ids) if $Perlbug::DEBUG;
		if (!(scalar(@ids) >= 1)) {
			print 'no '.$self->key.' ids found<hr>';
		} else {
			print 'found '.@ids.' '.$self->key." ids with trim factor($trim)<hr>";
			my $o_rng = $self->object('range');
			$o_rng->create({
				'name'		=> $self->key,
				'rangeid'	=> $o_rng->new_id,
				'processid'	=> $$,
				'range'		=> $o_rng->rangeify(\@ids),
				# $o_rng->relation('bug')->assign(\@bids); # ouch!
			});
			$#ids = ($trim - 1) if scalar(@ids) > $trim;
			$self->base->{'_range'} = $o_rng->oid if $o_rng->CREATED; 
		}
	} 

	return @ids;
}

sub create {
	my $self = shift;
	my $h_data = shift || $self->_oref('data');
	my $flag   = shift || ''; # anything
	my $sqlclean = shift || '1';
	my ($table, $pri) = ($self->attr('table'), $self->attr('primary_key'));

	if (!(ref($h_data) eq 'HASH')) {
		$self->error("requires data hash ref($h_data) to store object data!");
	} else {
		my $oid = $$h_data{$pri} || '';
		if ($oid !~ /\w+/) {
			$self->error("requires an objectid($oid) to create record: ".Dumper($h_data));
		} else {
			if ($flag eq '' && $oid ne 'NULL' && $self->exists([$oid])) {	# relations (clunky) ...
				$self->error("can't create already existing $pri($oid) in $table");
			} else {					# INSERT
				$self->data($h_data);
				my $sql = $self->prep('insert', $self->_oref('data'));
				my $sth = $self->base->exec($sql);	# DOIT
				if (!$sth) {
					$self->error("Failed($oid) to create sql($sql)!");
				} else {	
					$oid = $self->insertid($sth, $oid); # 
					$self->debug(2, "sql($sql) -> insertid($oid)") if $Perlbug::DEBUG;
					if (!$oid) {
						$self->error("Failed to fetch new oid($oid) from sql($sql)");
					} else {
						$self->CREATED(1);
						$oid = $self->oid($oid); # if $oid =~ /\w+/ && $oid !~ '0';
						# $self->track($sql." -> oid($oid)"); rjsf !
					}
					$self->base->clean_cache('sql', 'force');
				}
			}
		}
	}

	return $self;
}

sub _create {
	my $self = shift;

	$self->attr('clean_sql', 0);
	$self->create(@_);
	$self->attr('clean_sql', 1);

	return $self;
}

sub CREATED {
	my $self = shift;
	my $i_flag = shift || ''; 

	$self->flag({'created', $1}) if $i_flag =~ /^(1|0)$/o;

	$i_flag = $self->flag('created');

	return $i_flag;	
}

sub store { # by id from hashref
	my $self = shift;
	my $h_data = shift || $self->_oref('data');
	my ($table, $pri) = ($self->attr('table'), $self->attr('primary_key'));

	if (!(ref($h_data) eq 'HASH')) {
		$self->error("requires data hash ref($h_data) to store object data!");
	} else {
		my $oid = $$h_data{$pri} || '';
		my $call = ($self->exists([$oid])) ? 'update' : 'create';
		$self = $self->$call($h_data);
		if (ref($self)) {
			$self->STORED(1);
		}
	}

	return $self;
}

sub STORED {
	my $self = shift;
	my $i_flag = shift || ''; 

	$self->flag({'stored', $1}) if $i_flag =~ /^(1|0)$/o;

	$i_flag = $self->flag('stored');

	return $i_flag;	
}

sub transfer { # webtransfer
	my $self   = shift;
	my $h_data = shift;
	my $oid    = shift;
	my $cgi    = $self->base->cgi;
	
	unless ($self->read($oid)->READ) {
		$self->error("can't read oid($oid) for transfer!");
	} else {
		my $transferid = $cgi->param($oid.'_transfer') || '';
		if ($transferid !~ /\w+/) {
			$self->error("require a transferid($transferid) for target object type!");
		} else { 
			my ($targ) = $self->object('object')->col('name', "objectid = '$transferid'"); 
			my $o_tgt = $self->object($targ);
			my $s_data = $self->_oref('data');
			my $pri = $o_tgt->attr('primary_key'); 
			$$s_data{$pri} = $o_tgt->new_id;
			my $i_created = $o_tgt->create($s_data)->CREATED; 
			if ($i_created != 1) {
				$self->error("failed to transfer oid($oid) data from ".ref($self)." -> to($targ)"); 
			} else {
				my $targoid = $o_tgt->oid;
				$self->debug(0, 'transferred '.ref($self)."($oid) -> target($targ) oid($targoid)") if $Perlbug::DEBUG;
				# my $t_ref = $self->href($targ.'_id', [$targoid], $targoid, 'click ', '', "return go('${targ}_id&${targ}_id=$targoid&commands=write');");
				my $t_ref = $self->href($targ.'_id', [$targoid], $targoid, 'click ', '', "return go('${targ}_id&${targ}_id=$targoid');");
				print "<h3>New $targ: $t_ref</h3>\n";
				my $opts = $cgi->param($oid.'_opts') || $cgi->param('_opts') || '';
				my $pars = join(' ', $opts);
				my %update = $self->base->parse_str($pars);
				# scan subject, etc.?

				my @curr = ();
				REL:
				foreach my $rel ($self->rels) {
					my @extant = $self->rel_ids($rel);
					$self->rel($rel)->delete([$oid]);
					next REL unless grep(/^$rel$/, $o_tgt->rels);
					push(@{$update{$rel}{'ids'}}, join(' ', @extant));
				}
				$o_tgt->relate(\%update);
				my $i_deleted = $self->delete([$self->oid]); # !
			}
		}
	}

	return ();
}

sub webupdate {
	my $self   = shift;
	my $h_data = shift;
	my $oid    = shift;
    my $cgi    = shift || $self->base->cgi();

	if (!(ref($h_data) eq 'HASH')) {
		$self->error("requires data hash ref($h_data) to update ".ref($self)." data via the web!");
	} else {
		if ($self->read($oid)->READ) {
			$self->debug(0, "oid: ".$self->oid) if $Perlbug::DEBUG;
			# my $pri = $self->attr('primary_key'); 
			# $$h_data{$pri} = $oid;
			# my $i_updated = $self->update($h_data)->UPDATED; # called separately
			# if ($i_updated == 1) {
				my $opts = $cgi->param($oid.'_opts') || $cgi->param('_opts') || '';
				my @curr = ();
				REL:
				foreach my $rel ($self->rels) {
					my @idents = ($self->object($rel)->identifier eq 'name') 
						? $self->id2name([$self->rel_ids($rel)]) 
						: $self->rel_ids($rel);
					push(@curr, join(' ', @idents));
					$self->debug(0, ref($self)."($oid) rel($rel) -> idents(@idents)") if $Perlbug::DEBUG;
				}
				my $pars = join(' ', $opts, @curr);
				my %cmds = $self->base->parse_str($pars);
				$self->relate(\%cmds);
			# }
		}
	}
	
	return $oid;
}