From 1f45a87c9817567c2f5f5df60ffaedafd2e364eb Mon Sep 17 00:00:00 2001 From: Christian Walde Date: Mon, 11 May 2015 17:03:33 +0200 Subject: [PATCH 1/3] prevent debug calls with expensive arguments if debugging is not enabled 15-05-11@16:58:43 (ribasushi) just optimize for "minimal logical diff", and ignore the urge to "strive for elegance" --- lib/SQL/Translator.pm | 4 ++-- lib/SQL/Translator/Producer/Diagram.pm | 6 +++--- lib/SQL/Translator/Producer/GraphViz.pm | 2 +- lib/SQL/Translator/Producer/TTSchema.pm | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index 1f0c636d0..1cbfcee16 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -148,7 +148,7 @@ has filters => ( next; } else { - __PACKAGE__->debug("Adding $filt filter. Args:".Dumper(\@args)."\n"); + __PACKAGE__->debug("Adding $filt filter. Args:".Dumper(\@args)."\n") if __PACKAGE__->debugging; $filt = _load_sub("$filt\::filter", "SQL::Translator::Filter") || throw(__PACKAGE__->error); push @filters, [$filt,@args]; @@ -361,7 +361,7 @@ sub translate { return $self->error($msg); } } - $self->debug("Schema =\n", Dumper($self->schema), "\n"); + $self->debug("Schema =\n", Dumper($self->schema), "\n") if $self->debugging;; # Validate the schema if asked to. if ($self->validate) { diff --git a/lib/SQL/Translator/Producer/Diagram.pm b/lib/SQL/Translator/Producer/Diagram.pm index f415390e0..a12556b37 100644 --- a/lib/SQL/Translator/Producer/Diagram.pm +++ b/lib/SQL/Translator/Producer/Diagram.pm @@ -67,8 +67,8 @@ sub produce { my $schema = $t->schema; my $args = $t->producer_args; local $DEBUG = $t->debug; - debug("Schema =\n", Dumper( $schema )); - debug("Producer args =\n", Dumper( $args )); + debug("Schema =\n", Dumper( $schema )) if $DEBUG; + debug("Producer args =\n", Dumper( $args )) if $DEBUG; my $out_file = $args->{'out_file'} || ''; my $output_type = $args->{'output_type'} || 'png'; @@ -176,7 +176,7 @@ sub produce { debug("Processing table '$table_name'"); my @fields = $table->get_fields; - debug("Fields = ", join(', ', map { $_->name } @fields)); + debug("Fields = ", join(', ', map { $_->name } @fields)) if $DEBUG; my ( @fld_desc, $max_name, $max_desc ); for my $f ( @fields ) { diff --git a/lib/SQL/Translator/Producer/GraphViz.pm b/lib/SQL/Translator/Producer/GraphViz.pm index f17a9d320..3b8ef59d3 100644 --- a/lib/SQL/Translator/Producer/GraphViz.pm +++ b/lib/SQL/Translator/Producer/GraphViz.pm @@ -520,7 +520,7 @@ sub produce { debug("Processing table '$table_name'"); - debug("Fields = ", join(', ', map { $_->name } @fields)); + debug("Fields = ", join(', ', map { $_->name } @fields)) if $DEBUG; for my $f ( @fields ) { my $name = $f->name or next; diff --git a/lib/SQL/Translator/Producer/TTSchema.pm b/lib/SQL/Translator/Producer/TTSchema.pm index 5885d3b06..36f62b6ab 100644 --- a/lib/SQL/Translator/Producer/TTSchema.pm +++ b/lib/SQL/Translator/Producer/TTSchema.pm @@ -138,7 +138,7 @@ sub produce { my %tt_conf = exists $args->{tt_conf} ? %{$args->{tt_conf}} : (); # sqlt passes the producer args for _all_ producers in, so we use this # grep hack to test for the old usage. - debug(Dumper(\%tt_conf)); + debug(Dumper(\%tt_conf)) if $DEBUG; if ( grep /^[A-Z_]+$/, keys %$args ) { warn "Template config directly in the producer args is deprecated." ." Please use 'tt_conf' instead.\n"; From 281b9028c6e47f89cf77831afe73632ee878ca7d Mon Sep 17 00:00:00 2001 From: Christian Walde Date: Mon, 11 May 2015 17:34:33 +0200 Subject: [PATCH 2/3] speed up add_field on large tables by ignoring field names unless needed Getting the names of fields is only needed when adding a field with a pre-determined order value. For all other cases that is wasted time. --- lib/SQL/Translator/Schema/Table.pm | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index 789b9a160..0fd59c7c5 100644 --- a/lib/SQL/Translator/Schema/Table.pm +++ b/lib/SQL/Translator/Schema/Table.pm @@ -303,22 +303,24 @@ sub add_field { $self->error( $field_class->error ); } - my $existing_order = { map { $_->order => $_->name } $self->get_fields }; + my @fields = $self->get_fields; # supplied order, possible unordered assembly if ( $field->order ) { - if($existing_order->{$field->order}) { + my %existing_order = map { $_->order => $_->name } @fields; + if($existing_order{$field->order}) { croak sprintf "Requested order '%d' for column '%s' conflicts with already existing column '%s'", $field->order, $field->name, - $existing_order->{$field->order}, + $existing_order{$field->order}, ; } } else { - my $last_field_no = max(keys %$existing_order) || 0; - if ( $last_field_no != scalar keys %$existing_order ) { + my @orders = map { $_->order } @fields; + my $last_field_no = max(@orders) || 0; + if ( $last_field_no != @orders ) { croak sprintf "Table '%s' field order incomplete - unable to auto-determine order for newly added field", $self->name, From 2d934a7b6959368123e64c12cc236d329248dbf6 Mon Sep 17 00:00:00 2001 From: Christian Walde Date: Mon, 11 May 2015 17:38:15 +0200 Subject: [PATCH 3/3] speed up add_field on large tables by getting fields unsorted The code that determines/checks the value of order for the new field needs all existing fields, but does not depend on their order at all, thus switching from get_fields to _fields speeds things up a bit. --- lib/SQL/Translator/Schema/Table.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index 0fd59c7c5..a73b6b69c 100644 --- a/lib/SQL/Translator/Schema/Table.pm +++ b/lib/SQL/Translator/Schema/Table.pm @@ -303,7 +303,7 @@ sub add_field { $self->error( $field_class->error ); } - my @fields = $self->get_fields; + my @fields = values %{ $self->_fields }; # supplied order, possible unordered assembly if ( $field->order ) {