view release on metacpan or  search on metacpan

lib/Apache/SdnFw/lib/Core.pm  view on Meta::CPAN

		return;
	}
}

sub tt {

=head2 tt

 $s->tt($fname,$args,[$string])

$fname can be a path to a file, or a string reference, $args is a hash ref with
values of information that is passed to template toolkit.  $string can be a 
reference to a string variable, or to an array ref, in which case the results
are pushed into that array.  If $string is not defined, then the results are
appended to $s->{content}.

 $s->tt('object/template.tt', { s => $s, hash => \%hash });
 $s->tt('object/template.tt', { s => $s, list => \@list },\$output);
 $s->tt(\$template, { s => $s },\@output);

=cut

	my $s = shift;
	my $fname = shift;
	my $args = shift;
	my $string = shift;

	#my $agentfname;
	#if ($s->{agent}) {
	#	($fname = $agentfname) =~ s/([^\/]+\.tt)$/$s->{agent}\/$1/;
	#}

	$fname .= '.xml' if ($s->{api});

	if (defined $string) {
		if (ref $string eq 'ARRAY') {
			my $tmp;
			$s->{tt}->process($fname,$args,\$tmp) || croak $s->{tt}->error();
			push @{$string}, $tmp;
		} else {
			$s->{tt}->process($fname,$args,$string) || croak $s->{tt}->error();
		}
	} else {
		$s->{tt}->process($fname,$args) || croak $s->{tt}->error();
	}

}

=head2 update_and_log

 $s->update_and_log(
 	table => tablename,
	idfield => idfield,
	object => object,
	id => id,
	existing => \%hash,
	update => \%hash);

=cut 

sub update_and_log {
	my $s = shift;
	my %args = @_;

	croak "Missing table" unless($args{table});
	croak "Missing idfield" unless($args{idfield});
	croak "Missing object" unless($args{object});
	croak "Missing id" unless($args{id});
	croak "Missing existing" unless(defined($args{existing}));
	croak "Missing update" unless(defined($args{update}));

	#croak "<pre>".Data::Dumper->Dump([\%{$args{update}}])."</pre>";
	my %update;
	foreach my $k (keys %{$args{update}}) {
		if (exists($args{existing}{$k})) {
			my $object;
			if ($args{update}{$k} =~ m/^(.+):(\d*)$/) {
				$object = $1;
				$args{update}{$k} = $2;
			}

			if ($args{update}{$k} ne $args{existing}{$k}) {
				$update{$k} = $args{update}{$k};
				my $old = $args{existing}{$k};
				my $new = $update{$k};
				my $field = $k;
				if ($object) {
					$field = $object;
					$old = $s->db_q("SELECT name
						FROM ${object}s_v_keyval
						WHERE id=?
						",'scalar',
						v => [ $args{existing}{$k} ])
						if ($args{existing}{$k});

					$new = $s->db_q("SELECT name
						FROM ${object}s_v_keyval
						WHERE id=?
						",'scalar',
						v => [ $update{$k} ])
						if ($update{$k});
				}

				$s->log($args{object},$args{id},
					"$args{object} $field changed from [$old] to [$new]");
			}
		} else {
			croak "Existing data for $args{object} field $k not defined";
		}
	}

	#croak "<pre>".Data::Dumper->Dump([\%update])."</pre>";
	if (keys %update) {
		$s->db_update_key($args{table},$args{idfield},$args{id},\%update);
	}
}

sub in_to_hash {

=head2 in_to_hash

lib/Apache/SdnFw/lib/Core.pm  view on Meta::CPAN

				croak "$hash{$kname} is not a valid email";
			}
		}
	}

	$hash{city} = $city if (defined($hash{city}) && $city);
	$hash{state} = $state if (defined($hash{state}) && $state);

	$s->{dbh}->begin_work;

	if ($s->{in}{$s->{o}{id}} =~ m/^\d+$/) {
		# save an existing record
		$s->db_update_key($s->{o}{table},$s->{o}{id},$s->{in}{$s->{o}{id}},\%hash);
	} else {
		# create a new record
		if (defined($s->{o}{create_session_extra})) {
			my $key = $s->{o}{create_session_extra};
			$hash{$key} = $s->{session_data}{$key};
		}
		$s->{in}{$s->{o}{id}} = $s->db_insert($s->{o}{table},\%hash,$s->{o}{id});
	}

	if ($s->{o}{relations}) {
		foreach my $ref (@{$s->{o}{relations}}) {
			my %existing = $s->db_q("
				SELECT $ref->{k}, $ref->{n} FROM $ref->{t}_v
				WHERE $s->{o}{id}=?",
				'keyval',
				v => [ $s->{in}{$s->{o}{id}} ]);
			# delete rows
			foreach my $id (keys %existing) {
				unless(defined($s->{in}{"$ref->{t}:$id"})) {
					$s->db_q("
						DELETE FROM $ref->{t}
						WHERE $s->{o}{id}=?
						AND $ref->{k}=?
						",undef,
						v => [ $s->{in}{$s->{o}{id}}, $id ]);
				}
			}
			# insert new rows
			foreach my $k (keys %{$s->{in}}) {
				if ($k =~ m/^$ref->{t}:(\S+)$/) {
					my $id = $1;
					unless(defined($existing{$id})) {
						$s->db_insert($ref->{t}, {
							$s->{o}{id} => $s->{in}{$s->{o}{id}},
							$ref->{k} => $id,
							});
					}
				}
			}
		}
	}

	$s->{dbh}->commit;

	$s->{redirect} = "$s->{ubase}/$s->{object}/display?$s->{o}{id}=$s->{in}{$s->{o}{id}}";
}

sub update_lookup_table {
	my $s = shift;
	my %args = @_;

	$args{in_regex} = $args{table} unless($args{in_regex});

	my %existing;
	my ($k1,$k2);
	if ($args{id} =~ m/^(.+):(.+)$/) {
		$k1 = $1;
		$k2 = $2;
		%existing = $s->db_q("
			SELECT $args{k}, $args{k} 
			FROM $args{table}
			WHERE $k1=?
			AND $k2=?
			",'keyval',
			v => [ $s->{in}{$k1}, $s->{in}{$k2} ]);
	} else {
		%existing = $s->db_q("
			SELECT $args{k}, $args{k} 
			FROM $args{table}
			WHERE $args{id}=?
			",'keyval',
			v => [ $s->{in}{$args{id}} ]);
	}

	# delete rows
	foreach my $id (keys %existing) {
		unless(defined($s->{in}{"$args{in_regex}:$id"})) {
			if ($k1) {
				$s->db_q("
					DELETE FROM $args{table}
					WHERE $args{k}=?
					AND $k1=?
					AND $k2=?
					",undef,
					v => [ $id, $s->{in}{$k1}, $s->{in}{$k2} ]);
			} else {
				$s->db_q("
					DELETE FROM $args{table}
					WHERE $args{k}=?
					AND $args{id}=?
					",undef,
					v => [ $id, $s->{in}{$args{id}} ]);
			}
		}
	}
	# insert new rows
	foreach my $k (keys %{$s->{in}}) {
		if ($k =~ m/^$args{in_regex}:(\S+)$/) {
			my $id = $1;
			unless(defined($existing{$id})) {
				if ($k1) {
					$s->db_insert($args{table}, {
						$args{k} => $id,
						$k1 => $s->{in}{$k1},
						$k2 => $s->{in}{$k2},
						});
				} else {
					$s->db_insert($args{table}, {