File Coverage

blib/lib/Querylet.pm

Criterion	Covered	Total	%
statement	49	53	92.4
branch	2	2	100.0
condition	2	2	100.0
subroutine	22	24	91.6
pod	21	21	100.0
total	96	102	94.1

use strict;
use warnings;
package Querylet;
{
  $Querylet::VERSION = '0.401';
}
use Filter::Simple;
# ABSTRACT: simplified queries for the non-programmer




sub init { <<'END_CODE'
use strict;
use warnings;
use Querylet::Query;
my $q ||= new Querylet::Query;
END_CODE
}


sub set_dbh    { shift; <<"END_CODE"
use DBI;
my \$dbh = DBI->connect(q|$_[0]|);
\$q->set_dbh(\$dbh);
END_CODE
}


sub set_query  { shift; "\$q->set_query(q{$_[0]});\n"; }


sub bind_next_param { shift; <<"END_CODE"
{
  my \$input = \$q->{input};
  \$q->bind_more($_[0]);
}
END_CODE
}


sub set_query_vars { shift; <<"END_CODE"
{
  my \$input = \$q->{input};
  \$q->set_query_vars({$_[0]});
}
END_CODE
}


sub set_option  { shift;
  my ($option, $value) = @_;
  $value =~ s/(^\s+|\s+$)//g;
  "\$q->option(q{$option}, q{$value});\n"
}


sub input { shift; "\$q->input(q{$_[0]});\n"; }


sub set_input_type { shift; "\$q->input_type(q{$_[0]});\n"; }


sub set_output_filename { shift; "\$q->output_filename(q{$_[0]});\n"; }


sub set_output_method { shift; "\$q->write_type(q{$_[0]});\n"; }


sub set_output_type { shift; "\$q->output_type(q{$_[0]});\n"; }


sub munge_rows { shift; <<"END_CODE";
foreach my \$row (\@{\$q->results}) {
  $_[0]
}
END_CODE
}


sub delete_rows { shift; <<"END_CODE";
my \@new_results;
for my \$row (\@{\$q->results}) {
  push \@new_results, \$row unless ($_[0]);
}
\$q->set_results([\@new_results]);
END_CODE
}


sub munge_col  { shift; <<"END_CODE";
foreach my \$row (\@{\$q->results}) {
  foreach my \$value (\$row->{$_[0]}) {
    $_[1]
  }
}
END_CODE
}


sub add_col  { shift; <<"END_CODE";
if (exists \$q->results->[0]->{$_[0]}) {
  warn "column $_[0] already exists; ignoring directive\n";
} else {
  push \@{\$q->columns}, '$_[0]';
  foreach my \$row (\@{\$q->results}) {
    for my \$value (\$row->{$_[0]}) {
      $_[1]
    }
  }
}
END_CODE
}


sub delete_col  { shift; <<"END_CODE";
\$q->set_columns( [ grep { \$_ ne "$_[0]" } \@{\$q->columns} ] );
foreach my \$row (\@{\$q->results}) {
  delete \$row->{$_[0]};
}
END_CODE
}


sub delete_cols { my $class = shift; qq|
for my \$column (\@{\$q->columns}) {
  my \@values;
  push \@values, \$_->{\$column} for \@{\$q->results};
  if ($_[0]) {
| .   $class->delete_col('$column') . qq|
  }
}
|

}


sub column_headers { my $class = shift; "\$q->set_headers({ $_[0] });" }


sub munge_values { shift; <<"END_CODE";
foreach my \$row (\@{\$q->results}) {
  foreach my \$value (values \%\$row) {
    $_[0]
  }
}
END_CODE
}


sub output { shift; <<'END_CODE'
$q->write_output;
END_CODE
}


my %ran;

sub once {
  my ($id, $text) = @_;
  return q{} if $ran{$id}++;
  return $text || '';
}

my $to_next = qr/(?=^\S|\Z)/sm;

FILTER {
  my ($class) = @_;

  s/\r//g;
  s/\A/"\n" . once('init',init)/egms;

  s/^ database:\s*([^\n]+)
   /  $class->set_dbh($1)
   /egmsx;

  s/^ query:\s*(.+?)
      $to_next
   /  $class->set_query($1)
   /egmsx;

  s/^ query\s+parameter:\s*(.+?)
      $to_next
   /  $class->bind_next_param($1);
   /egmsx;

  s/^ munge\s+query:\s*(.+?)
      $to_next
   /  $class->set_query_vars($1);
   /egmsx;

  s/^ set\s+option\s+([\/A-Za-z0-9_]+):\s*(.+?)
      $to_next
   /  $class->set_option($1,$2);
   /egmsx;

  s/^ input:\s*([^\n]+)
   /  $class->input($1)
   /egmsx;

  s/^ input\s+type:\s+(\w+)$
   /  $class->set_input_type($1);
   /egmsx;

  s/^ munge\s+rows:\s*(.+?)
      $to_next
   /  $class->munge_rows($1);
   /egmsx;

  s/^ delete\s+rows\s+where:\s*(.+?)
      $to_next
   /  $class->delete_rows($1);
   /egmsx;

  s/^ munge\s+all\s+values:\s*(.+?)
      $to_next
   /  $class->munge_values($1);
   /egmsx;

  s/^ munge\s+column\s+(\w+):\s*(.+?)
      $to_next
   /  $class->munge_col($1, $2);
   /egmsx;

  s/^ add\s+column\s+(\w+):\s*(.+?)
      $to_next
   /  $class->add_col($1, $2);
   /egmsx;

  s/^ delete\s+column\s+(\w+)$
   /  $class->delete_col($1);
   /egmsx;

  s/^ delete\s+columns\s+where:\s*(.+?)
      $to_next
   /  $class->delete_cols($1);
   /egmsx;

  s/^ column\s+headers?:\s*(.+?)
      $to_next
   /  $class->column_headers($1);
   /egmsx;

  s/^ output\s+format:\s+(\w+)$
   /  $class->set_output_type($1);
   /egmsx;

  s/^ output\s+method:\s+(\w+)$
   /  $class->set_output_method($1);
   /egmsx;

  s/^ output\s+file:\s+([_.A-Za-z0-9]+)$
   /  $class->set_output_filename($1);
   /egmsx;

  s/^ no\s+output$
   /  once('output', q{})
   /egmsx;

  s/\Z
   /once('output',output)
   /egmsx;
}


"I do endeavor to give satisfaction, sir.";

__END__