CGI-Lazy

 view release on metacpan or  search on metacpan

lib/CGI/Lazy/DB/RecordSet.pm  view on Meta::CPAN

#--------------------------------------------------------------------
sub select { 
	my $self = shift;
	my @bindvars = @_;

	my ($query, @wherebinds)  = $self->createSelect;

	if (@wherebinds) {
		unshift @bindvars, $_ for @wherebinds;
	}

	my @data;
	my $sth;
	
	my ($pkg, $file, $line) = caller;

	eval {
		$sth = $self->db->dbh->prepare($query);
		$sth->execute(@bindvars);
#		$self->q->util->debug->edump($query, @bindvars);
	};

	if ($@) {
		$self->q->errorHandler->dbError($pkg, $file, $line, $query);
	} else {

		while (my @record = $sth->fetchrow_array) {
			my @fieldlist = keys %{$self->fieldlist};
		
			my $record = {};
			tie (%$record, 'Tie::IxHash');

			for (0..$#fieldlist) {
				next if	$self->passwd($fieldlist[$_]);
				$record->{$fieldlist[$_]} = $record[$_];
			}

			push @data, $record;
		}
	}

	$self->{_data} = \@data; 

	#$self->q->util->debug->edump(\@data);
	return $self->{_data};
}

#-------------------------------------------------------------------------------
sub table {
	my $self = shift;
	my $value = shift;

	if ($value) {
		return $self->{_table} = $value;
	} else {
		return $self->{_table};
	}
}

#-------------------------------------------------------------------------------
sub update {
	my $self = shift;
	my $data = shift;
	my $vars = shift;

	my $table = $self->table;
	my $primarykey = $self->primarykey;
	my $defaults = $self->updatedefaults;
	my $additional = $self->updateadditional;

	foreach my $ID (keys %$data) {
		my @updates;
		my @binds;

		if (%$vars) {
			foreach (keys %$vars) {
				if ($vars->{$_}->{value}) {
					$data->{$ID}->{$_} = ref $vars->{$_}->{value} ? ${$vars->{$_}->{value}} : $vars->{$_}->{value};
#					$self->q->util->debug->edump("var: ".$vars->{$_}->{value}." -- ".${$vars->{$_}->{value}});
				}
			}
		}

		if ($defaults) {
			foreach my $field (keys %$defaults) {
				if ($defaults->{$field}->{value}) { #static quanities
					$data->{$ID}->{$field} = $defaults->{$field}->{value};
					if ($vars->{$field}->{handle}) {
						${$vars->{$field}->{handle}} = $defaults->{$field}->{value};
					}
				} else { #values pulled from queries and such
					my $result = $self->db->getarray(@{$defaults->{$field}->{sql}});

					if (defined $result->[1] || defined $result->[0]->[1]) { #we got more than a single value, better warn
						$self->q->errorHandler->dbReturnedMoreThanSingleValue;
					}

					my $value = $result->[0]->[0];
					$data->{$ID}->{$field} = $value;

					if ($vars->{$field}->{handle}) {
						${$vars->{$field}->{handle}} = $value;
					}
				}
			}
		}


		foreach (keys %{$data->{$ID}}) {
			my $field = $self->verify($_);

			if ($field) {
				unless ($self->displayOnly($field) || $self->readOnly($field)) {
					if ($vars->{$field}->{handle}) {
						${$vars->{$field}->{handle}} = $data->{$ID}->{$field};

					}

					if ($field eq $self->primarykey) {
						${$self->primarykeyhandle} = $data->{$ID}->{$field};

lib/CGI/Lazy/DB/RecordSet.pm  view on Meta::CPAN

						push @updates,  "$field = ".$self->fieldlist->{$field}->{writefunc};

					} elsif ($self->passwd($field)) {
						if ($self->q->authn) {
							if ($data->{$ID}->{$field}) {
								push @updates,  "$field = ?";
							}
						}
					} else {
						push @updates,  "$field = ?";
					}
				}
			}
		}

		if (@{$self->checkboxes}) {
			foreach (@{$self->checkboxes}) {
				next if exists $data->{$ID}->{$_};

				if ($vars->{$_}->{handle}) {
					${$vars->{$_}->{handle}} = '';
				}

				push @updates,  "$_ = ?";
				push @binds, '';

			}
		}

		my $updateclause = join ',', @updates;

		my $query = "update $table set $updateclause where $primarykey = ?";

#		$self->q->util->debug->edump($query, join ',', @binds. " key: $ID");
	       
		$self->db->do($query, @binds, $ID);

		${$self->primarykeyhandle} = $ID;

		if ($additional) { #addional queries run on insert
			foreach my $field (keys %$additional) {
				my $result = $self->db->getarray($additional->{$field}->{sql});

				if (defined $result->[1] || defined $result->[0]->[1]) { #we got more than a single value, better warn
					$self->q->errorHandler->dbReturnedMoreThanSingleValue;
				}

				my $value = $result->[0]->[0];

				if ($additional->{$field}->{handle}) {
					${$additional->{$field}->{handle}} = $value ;
				}
			}
		}
	}


}

#----------------------------------------------------------------------
sub updateadditional {
	my $self = shift;

	return $self->{_updateadditional};
}

#----------------------------------------------------------------------
sub updatedefaults {
	my $self = shift;

	return $self->{_updatedefaults};
}

#-----------------------------------------------------------------------------
sub validator {
	my $self = shift;
	my $field = shift;

	if (exists $self->fieldlist->{$field}) {
		return $self->fieldlist->{$field}->{validator};
	} else {
		return;
	}

}

#----------------------------------------------------------------------------------------
sub verify {
	my $self = shift;
	my $value = shift;

	$value =~ /^([\w\d\-\.]+)$/; #letters, numbers, underscores, dots, and dashes only please.
	my $field = $1;

	if (exists $self->fieldlist->{$field}) { #fieldname has to be in recordset
		if ($field =~ /\./) {		 #if there's a . in the fieldname
			my $table = $self->table;
			if ($field =~ /^$table/) { #the first part has to be the recordset's table
				return $field;
			} else {		# its a joined field, no modification allowed
				return;
			}
		}
		return $field;
	}

	return;
}

#-----------------------------------------------------------------------------
sub visibleFieldLabels {
	my $self = shift;

	my @visibleFieldLabels;
	foreach my $field (keys %{$self->{_fieldlist}}) {
		unless ($self->fieldlist->{$field}->{hidden}) {
			push @visibleFieldLabels, $self->fieldlist->{$field}->{label} ? $self->fieldlist->{$field}->{label} : $self->fieldlist->{$field}->{name};
		}
	}

	return wantarray ? @visibleFieldLabels : \@visibleFieldLabels;

}

#-----------------------------------------------------------------------------
sub visibleFields {
	my $self = shift;



( run in 1.974 second using v1.01-cache-2.11-cpan-13bb782fe5a )