BEGIN {
- # helper routines, constructed as anon subs so autoclean nukes them
-
- use signatures;
-
- *argify = sub (@names) {
- map '_'.$_, @names;
- };
+ sub argify {
+ my @names = @_;
+ map '_' . $_, @names;
+ }
- *qualify_with = sub ($source, @names) {
- my $name = blessed($source) ? $source->name : $source;
- map join('.', $name, $_), @names;
- };
+ sub qualify_with {
+ my $source = shift;
+ my @names = @_;
+ my $name = blessed($source) ? $source->name : $source;
+ map join( '.', $name, $_ ), @names;
+ }
- *body_cols = sub ($source) {
- my %pk; @pk{$source->primary_columns} = ();
- map +{ %{$source->column_info($_)}, name => $_ },
+ sub body_cols {
+ my $source = shift;
+ my %pk;
+ @pk{ $source->primary_columns } = ();
+ map +{ %{ $source->column_info($_) }, name => $_ },
grep !exists $pk{$_}, $source->columns;
- };
+ }
- *pk_cols = sub ($source) {
- map +{ %{$source->column_info($_)}, name => $_ },
+ sub pk_cols {
+ my $source = shift;
+ map +{ %{ $source->column_info($_) }, name => $_ },
$source->primary_columns;
- };
+ }
- *names_of = sub (@cols) { map $_->{name}, @cols };
+ sub names_of { my @cols = @_; map $_->{name}, @cols }
- *function_body = sub {
- my ($name,$args,$body_parts) = @_;
- my $arglist = join(
- ', ',
- map "_${\$_->{name}} ${\uc($_->{data_type})}",
- @$args
- );
- my $body = join("\n", '', map " $_;", @$body_parts);
+ sub function_body {
+ my ( $name, $args, $body_parts ) = @_;
+ my $arglist =
+ join( ', ', map "_${\$_->{name}} ${\uc($_->{data_type})}", @$args );
+ my $body = join( "\n", '', map " $_;", @$body_parts );
return strip tt q{
CREATE OR REPLACE FUNCTION [% name %]
([% arglist %])
END;
$function$ LANGUAGE plpgsql;
};
- };
+ }
}
BEGIN {
- use signatures;
-
- *arg_hash = sub ($source) {
- map +($_ => \(argify $_)), names_of body_cols $source;
- };
+ sub arg_hash {
+ my $source = shift;
+ map +( $_ => \( argify $_) ), names_of body_cols $source;
+ }
- *rule_body = sub ($on, $to, $oldlist, $newlist) {
- my $arglist = join(', ',
- (qualify_with 'OLD', names_of @$oldlist),
- (qualify_with 'NEW', names_of @$newlist),
+ sub rule_body {
+ my ( $on, $to, $oldlist, $newlist ) = @_;
+ my $arglist = join( ', ',
+ ( qualify_with 'OLD', names_of @$oldlist ),
+ ( qualify_with 'NEW', names_of @$newlist ),
);
$to = $to->name if blessed($to);
return strip tt q{
SELECT [% to %]_[% on %]([% arglist %])
);
};
- };
+ }
}
method root_table () {