baergaj // pullingshots // andrew@pullingshots.ca

Taming a Thousand Pound Gorilla

Andrew Baerg // Perl Dancer 2015

The Problem

• Code that needed to be tested was in IC pages
• Poor development and test environment
• Tests were not being run

The Plan

• Move [query] and [data] out of html templates
• Migrate Tag->query and Tag->data to DBIx
• Inject data into templates in a more modern way
• Run usertag code in a repl
• Write tests on usertag code

My::Schema::Result::Userdb

__PACKAGE__->has_many(
    transactions => 'My::Schema::Result::Transaction', 'username'
);

My::Schema::Result::Transaction

__PACKAGE__->belongs_to(
    customer => 'My::Schema::Result::Userdb', 'username', 
    { 'is_foreign_key_constraint' => 0, }, 
);

My::Schema::ResultSet::Transaction;

sub complete {
  my ($self) = @_;
  
  return $self->search(
    {
      'me.status' => { '-in' => ['shipped','imported','complete'] },
      'me.deleted' => { '!=' => 1 },
    }, {},
  );
}

UserTag/ActionMap:

$Scratch->{orders} = [
  $Sub->get_schema()
    ->resultset('Userdb')
      ->find('ABT3K')
        ->transactions
          ->complete
            ->hri
];

OR

$Scratch->{orders} = My::Orders->new(
  schema => $Sub->get_schema(),
  customer => 'ABT3K',
  pending => 1,
)->list;


Page:

<ul>
[foreach arrayref=`$Scratch->{orders}` prefix="order"]

<li>[order-param order_number]: [order-param order_date]</li>

[/foreach]
</ul>

DBIC_TRACE=1 re.pl (Devel::REPL)

main(0)> [ $schema->resultset('Userdb')->find('ABT3K')->transactions->complete->hri ]->[0]

SELECT me.code, me.store_id, me.order_number, me.session, me.username, me.shipmode ...
  FROM transactions me 
WHERE me.deleted != '1' AND me.status IN ( 'shipped', 'imported', 'complete' )
  AND me.username = 'ABT3K'
$HASH1 = {
           address1  => '67 Coventry View NE',
           address2  => '',

...

DBIx::Class::Fixtures

Config:

{
  "sets": [
    {
      "class": "Userdb",
      "ids": ["ABT3K"],
      "fetch": [
        {
          "rel": "transactions",
          "quantity": "all",
        },
      ],
    },
  ],
}


Create Fixtures:

$fixtures->dump({ config => $config, schema => $schema, directory => "t/fixtures/" });

use Test::More;

...

$fixtures->populate({
    no_deploy => 1,
    schema => $test_schema,
    directory => './t/fixtures/',
  });

use Test::UserTag; # Load UserTag files into $Tag

my $orders = eval($Tag->{'orders'};

eval {
    $orders->({ customer => 'ABT3K', pending => 1 });
};

is ($Scratch->{orders}->[0]->{order_number}, '12345', 'got pending order number');

baergaj // pullingshots // andrew@pullingshots.ca

Thank you!

Andrew Baerg // Perl Dancer 2015