File Coverage

blib/lib/Pinwheel/Fixtures.pm

Criterion	Covered	Total	%
statement	136	137	99.2
branch	24	24	100.0
condition	12	12	100.0
subroutine	22	22	100.0
pod	5	5	100.0
total	199	200	99.5

package Pinwheel::Fixtures;

use strict;
use warnings;

use FindBin qw($Bin);
use File::Slurp;
use POSIX qw(strftime);
use YAML::Tiny;

use Pinwheel::Context;
use Pinwheel::Database qw(without_foreign_keys);
use Pinwheel::View::ERB;

our @ISA = qw(Exporter);
our @EXPORT = qw(fixtures scenario identify);
our @EXPORT_OK = qw(insert_fixtures empty_tables);


our $fixtures_path = "$Bin/../fixtures";
our $last_caller = '';
our $helpers;
my %ids;


sub fixtures
{
    my (@names) = @_;
    my ($caller) = caller();

    without_foreign_keys {
        if ($caller ne $last_caller) {
            empty_tables();
            $last_caller = $caller;
        }
        foreach my $table (@names) {
            insert_fixtures(_load_yaml("$fixtures_path/$table.yml"), $table);
        }
    };

    # For doctest niceness, otherwise the result is that of the commit
    return;
}

# See http://code.google.com/p/fixture-scenarios/
sub scenario
{
    my ($name, %opts) = @_;
    my (@dirs, $path);

    $last_caller = caller();
    $path = $fixtures_path;
    if (!exists($opts{'root'}) || $opts{'root'}) {
        push @dirs, $path;
    }
    foreach (split('/', $name)) {
        $path .= '/' . $_;
        push @dirs, $path;
    }

    without_foreign_keys {
        empty_tables();
        foreach $path (@dirs) {
            foreach (glob("$path/*.yml")) {
                /\/([^\/]+)\.yml$/;
                insert_fixtures(_load_yaml($_), $1);
            }
        }
    };

    # For doctest niceness, otherwise the result is that of the commit
    return;
}

sub empty_tables
{
    foreach my $table (Pinwheel::Database::tables()) {
        my $sth = Pinwheel::Database::prepare("DELETE FROM $table");
        $sth->execute();
    }
}

sub insert_fixtures
{
    my ($fixtures, $table) = @_;
    my ($sth, $info, %defaults, @keys);
    my ($label, $row, @fields, $columns, $values);

    $info = Pinwheel::Database::describe($table);
    foreach (keys %$info) {
        if ($_ =~ /^(?:cre|upd)ated_(?:at|on)$/) {
            # created_at/on and updated_at/on default to the current time
            $defaults{$_} = strftime('%Y-%m-%d %H:%M:%S', gmtime());
        } elsif ($_ =~ /_id$/ && $info->{$_}{type} =~ /^int\b/) {
            # Foreign keys can be supplied as labels
            push @keys, $_;
        }
    }

    $sth = {};
    while (($label, $row) = each(%$fixtures)) {
        $row = {%defaults, %$row};

        # If no id, generate one by hashing the label
        if (exists($info->{id}) && !exists($row->{id})) {
            $row->{id} = identify($label);
        }
        # Convert foreign keys supplied as labels
        foreach (@keys) {
            if ($row->{$_} && $row->{$_} =~ /[^0-9]/) {
                $row->{$_} = identify($row->{$_});
            }
        }

        @fields = keys %$row;
        $columns = join(', ', map { "`$_`" } @fields);
        unless ($sth->{$columns}) {
            $values = join(', ', ('?') x scalar(@fields));
            $sth->{$columns} = Pinwheel::Database::prepare(
                "REPLACE INTO $table ($columns) VALUES ($values)"
            );
        }
        $sth->{$columns}->execute(@{$row}{@fields});
    }
}

sub _load_yaml
{
    my ($filename) = @_;
    my ($data, $tmpl);

    $data = read_file($filename, binmode => ':raw');
    if ($data =~ /<%/) {
        _prepare_helpers() unless $helpers;
        $tmpl = Pinwheel::View::ERB::parse_template($data, $filename);
        $data = $tmpl->({}, {}, $helpers);
    }
    return YAML::Tiny->read_string($data)->[0];
}

sub _prepare_helpers
{
    my ($pkg, $fns);

    $fns = {};
    $pkg = \%Pinwheel::Helpers::Fixtures::;
    foreach (@{$pkg->{'EXPORT_OK'}}) {
        $fns->{$_} = \&{$pkg->{$_}} if $pkg->{$_};
    }

    $helpers = $fns;
}


sub identify
{
    my ($s) = @_;

    $ids{$s} = _hash($s) if !exists($ids{$s});
    return $ids{$s};
}


# Implementation of http://burtleburtle.net/bob/hash/evahash.html
sub _hash
{
    use integer;
    my ($s) = @_;
    my ($length, $a, $b, $c, $i, $j, @k);

    $length = length($s);
    $s .= "\0\0\0\0\0\0\0\0\0\0\0\0";
    @k = unpack('V' x (length($s) >> 2), $s);

    $i = 0;
    $j = ($length >> 2) - 3;
    $a = $b = 0x9e3779b9;
    $c = 0;
    while ($i <= $j) {
        $a += $k[$i++];
        $b += $k[$i++];
        $c += $k[$i++];
        ($a, $b, $c) = _mix($a, $b, $c);
    }

    $a += $k[$i++];
    $b += $k[$i++];
    $c += $length + ($k[$i++] << 8);
    ($a, $b, $c) = _mix($a, $b, $c);

    if ($c & 0x80000000) {
        $c = 0x80000000 - ($c & 0x7fffffff);
    } else {
        $c &= 0x7fffffff;
    }

    return $c;
}

sub _mix
{
    use integer;
    my ($a, $b, $c) = @_;

    $a = ($a - $b - $c) ^ (($c >> 13) & 0x0007ffff);
    $b = ($b - $c - $a) ^  ($a <<  8);
    $c = ($c - $a - $b) ^ (($b >> 13) & 0x0007ffff);
    $a = ($a - $b - $c) ^ (($c >> 12) & 0x000fffff);
    $b = ($b - $c - $a) ^  ($a << 16);
    $c = ($c - $a - $b) ^ (($b >>  5) & 0x07ffffff);
    $a = ($a - $b - $c) ^ (($c >>  3) & 0x1fffffff);
    $b = ($b - $c - $a) ^  ($a << 10);
    $c = ($c - $a - $b) ^ (($b >> 15) & 0x0001ffff);

    return ($a, $b, $c);
}


1;

__DATA__