view release on metacpan or  search on metacpan

t/25backcompat.t  view on Meta::CPAN

sub _rel_condition {
    my ($from, $to) = @_;

    return +{
        QuuxBaz => q{'foreign.baz_num' => 'self.baz_id'},
        BarFoo  => q{'foreign.fooid'   => 'self.foo_id'},
        BazStationsvisited => q{'foreign.id' => 'self.stations_visited_id'},
        StationsvisitedQuux => q{'foreign.quuxid' => 'self.quuxs_id'},
        RoutechangeQuux => q{'foreign.quuxid' => 'self.QuuxsId'},
    }->{_rel_key($from, $to)};
}

sub class_content_contains {
    my ($schema, $class, $substr, $test_name) = @_;

    my $file = $schema->loader->get_dump_filename($class);
    my $code = slurp_file $file;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    contains $code, $substr, $test_name;
}

sub contains {
    my ($haystack, $needle, $test_name) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    like $haystack, qr/\Q$needle\E/, $test_name;
}

sub add_custom_content {
    my ($schema, $rels, $opts) = @_;

    while (my ($from, $to) = each %$rels) {
        my $relname    = $opts->{rel_name_map}{_rel_key($from, $to)} || _relname($to);
        my $from_class = _qualify_class($from, $opts->{result_namespace});
        my $to_class   = _qualify_class($to,   $opts->{result_namespace});
        my $condition  = _rel_condition($from, $to);

        my $content = <<"EOF";
package ${from_class};
sub b_method { 'dongs' }

__PACKAGE__->has_one('$relname', '$to_class',
{ $condition });

1;
EOF

        _write_custom_content($schema, $from_class, $content);
    }
}

sub _write_custom_content {
    my ($schema, $class, $content) = @_;

    my $pm = $schema->loader->get_dump_filename($class);
    {
        local ($^I, @ARGV) = ('.bak', $pm);
        while (<>) {
            if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
                print;
                print $content;
            }
            else {
                print;
            }
        }
        close ARGV;
        unlink "${pm}.bak" or die $^E;
    }
}

sub result_count {
    my $path = shift || '';

    my $dir = result_dir($path);

    my $file_count =()= glob "$dir/*";

    return $file_count;
}

sub result_files {
    my $path = shift || '';

    my $dir = result_dir($path);

    return glob "$dir/*";
}

sub schema_files { result_files(@_) }

sub result_dir {
    my $path = shift || '';

    (my $dir = "$DUMP_DIR/$SCHEMA_CLASS/$path") =~ s{::}{/}g;
    $dir =~ s{/+\z}{};

    return $dir;
}

sub schema_dir { result_dir(@_) }

# vim:et sts=4 sw=4 tw=0: