DBIx-QuickORM

 view release on metacpan or  search on metacpan

lib/DBIx/QuickORM/Row.pm  view on Meta::CPAN

    my ($from, $field) = @_;

    croak "This row does not have a '$field' field" unless $self->has_field($field);

    return undef unless $from;
    return undef unless exists $from->{$field};
    my $val = $from->{$field};

    # A staged SQL literal (\'NOW()' or [\'expr ?', @binds]) is not table data;
    # it must pass through untouched. Deflating it would corrupt the literal.
    # This is deliberately narrow: a decoded JSON hashref/arrayref is data and
    # must still be deflated back to its stored form, so only literal shapes
    # pass through here.
    return $val if literal_write_value($val);

    return $val->qorm_deflate($self->conflate_args($field, $val))
        if blessed($val) && $val->can('qorm_deflate');

    if (my $type = $self->source->field_type($field)) {
        return $type->qorm_deflate($self->conflate_args($field, $val));
    }

lib/DBIx/QuickORM/Type/JSON.pm  view on Meta::CPAN

        elsif ($r eq 'ARRAY') { $val = [@$val] }
    }

    return $class->JSON->encode($val);
}

sub qorm_compare {
    my $class = shift;
    my ($a, $b) = @_;

    # First decode the json if it is not already decoded
    $a = $class->qorm_inflate($a);
    $b = $class->qorm_inflate($b);

    # Now encode it in canonical form so that identical structures produce identical strings.
    # Another option would be to use Test2::Compare...
    $a = $class->CJSON->encode($a);
    $b = $class->CJSON->encode($b);

    # Equality contract: true when the two values are the same.
    return $a eq $b;

t/AI/type_json.t  view on Meta::CPAN

use DBIx::QuickORM::Type::JSON;

my $C = 'DBIx::QuickORM::Type::JSON';

subtest affinity => sub {
    is($C->qorm_affinity, 'string', "JSON affinity is string");
};

subtest inflate => sub {
    my $ref = $C->qorm_inflate(class => $C, value => '{"a":1,"b":[2,3]}');
    is($ref, {a => 1, b => [2, 3]}, "decoded JSON object string into a Perl structure");

    is(
        $C->qorm_inflate(class => $C, value => '[1,2,3]'),
        [1, 2, 3],
        "decoded JSON array string",
    );

    is($C->qorm_inflate(class => $C, value => '"hello"'), 'hello', "decoded JSON string scalar");
    is($C->qorm_inflate(class => $C, value => '42'),      42,      "decoded JSON numeric scalar");

    is($C->qorm_inflate(class => $C, value => undef), undef, "undef inflates to undef");

    # An already-inflated ref passes straight through (the row layer can
    # re-run inflate on a value that is already a ref).
    my $already = {x => 1};
    is($C->qorm_inflate(class => $C, value => $already), $already, "ref value passes through unchanged");
};

subtest deflate => sub {

t/fork_safety.t  view on Meta::CPAN

}

subtest clean_stream => sub {
    my ($sth) = fork_handle(frames => [
        {result => 1},
        {row => {id => 1, name => 'a'}},
        {row => {id => 2, name => 'b'}},
        {done => 1},
    ]);

    is($sth->result, 1, "result frame decoded");
    is($sth->next, {id => 1, name => 'a'}, "first row");
    is($sth->next, {id => 2, name => 'b'}, "second row");
    is($sth->next, undef, "done frame ends the stream cleanly");
    ok($sth->done, "handle is finalized after a clean end");
};

subtest child_error_frame => sub {
    my ($sth) = fork_handle(frames => [
        {result => 1},
        {row => {id => 1}},
        {error => 'boom in the child'},
    ]);

    is($sth->result, 1, "result frame decoded");
    is($sth->next, {id => 1}, "row before the error");

    my $err = dies { $sth->next };
    like($err, qr/Forked query failed in the child process: boom in the child/, "child error surfaces with its message");
    ok($sth->done, "handle is finalized after a child error");
};

subtest error_before_result => sub {
    my ($sth) = fork_handle(frames => [
        {error => 'execute failed'},

t/fork_safety.t  view on Meta::CPAN

    ok($sth->done, "handle is finalized");
};

subtest truncated_stream => sub {
    # Child sends a result and one row, then exits without a terminal frame.
    my ($sth) = fork_handle(frames => [
        {result => 1},
        {row => {id => 1}},
    ]);

    is($sth->result, 1, "result frame decoded");
    is($sth->next, {id => 1}, "the row that did arrive");

    my $err = dies { $sth->next };
    like($err, qr/truncated|before the child signalled completion/i, "EOF with no terminal frame is reported as truncation");
    ok($sth->done, "handle is finalized after truncation");
};

subtest ownership_guard => sub {
    # A handle owned by a different process (as if inherited across a fork)
    # must not reap the child or release the owner's fork slot.

worktrees/audit-fixes-master/lib/DBIx/QuickORM/Row.pm  view on Meta::CPAN

    my ($from, $field) = @_;

    croak "This row does not have a '$field' field" unless $self->has_field($field);

    return undef unless $from;
    return undef unless exists $from->{$field};
    my $val = $from->{$field};

    # A staged SQL literal (\'NOW()' or [\'expr ?', @binds]) is not table data;
    # it must pass through untouched. Deflating it would corrupt the literal.
    # This is deliberately narrow: a decoded JSON hashref/arrayref is data and
    # must still be deflated back to its stored form, so only literal shapes
    # pass through here.
    return $val if literal_write_value($val);

    return $val->qorm_deflate($self->conflate_args($field, $val))
        if blessed($val) && $val->can('qorm_deflate');

    if (my $type = $self->source->field_type($field)) {
        return $type->qorm_deflate($self->conflate_args($field, $val));
    }

worktrees/audit-fixes-master/lib/DBIx/QuickORM/Type/JSON.pm  view on Meta::CPAN

        elsif ($r eq 'ARRAY') { $val = [@$val] }
    }

    return $class->JSON->encode($val);
}

sub qorm_compare {
    my $class = shift;
    my ($a, $b) = @_;

    # First decode the json if it is not already decoded
    $a = $class->qorm_inflate($a);
    $b = $class->qorm_inflate($b);

    # Now encode it in canonical form so that identical structures produce identical strings.
    # Another option would be to use Test2::Compare...
    $a = $class->CJSON->encode($a);
    $b = $class->CJSON->encode($b);

    # Equality contract: true when the two values are the same.
    return $a eq $b;

worktrees/audit-fixes-master/t/AI/type_json.t  view on Meta::CPAN

use DBIx::QuickORM::Type::JSON;

my $C = 'DBIx::QuickORM::Type::JSON';

subtest affinity => sub {
    is($C->qorm_affinity, 'string', "JSON affinity is string");
};

subtest inflate => sub {
    my $ref = $C->qorm_inflate(class => $C, value => '{"a":1,"b":[2,3]}');
    is($ref, {a => 1, b => [2, 3]}, "decoded JSON object string into a Perl structure");

    is(
        $C->qorm_inflate(class => $C, value => '[1,2,3]'),
        [1, 2, 3],
        "decoded JSON array string",
    );

    is($C->qorm_inflate(class => $C, value => '"hello"'), 'hello', "decoded JSON string scalar");
    is($C->qorm_inflate(class => $C, value => '42'),      42,      "decoded JSON numeric scalar");

    is($C->qorm_inflate(class => $C, value => undef), undef, "undef inflates to undef");

    # An already-inflated ref passes straight through (the row layer can
    # re-run inflate on a value that is already a ref).
    my $already = {x => 1};
    is($C->qorm_inflate(class => $C, value => $already), $already, "ref value passes through unchanged");
};

subtest deflate => sub {

worktrees/audit-fixes-master/t/fork_safety.t  view on Meta::CPAN

}

subtest clean_stream => sub {
    my ($sth) = fork_handle(frames => [
        {result => 1},
        {row => {id => 1, name => 'a'}},
        {row => {id => 2, name => 'b'}},
        {done => 1},
    ]);

    is($sth->result, 1, "result frame decoded");
    is($sth->next, {id => 1, name => 'a'}, "first row");
    is($sth->next, {id => 2, name => 'b'}, "second row");
    is($sth->next, undef, "done frame ends the stream cleanly");
    ok($sth->done, "handle is finalized after a clean end");
};

subtest child_error_frame => sub {
    my ($sth) = fork_handle(frames => [
        {result => 1},
        {row => {id => 1}},
        {error => 'boom in the child'},
    ]);

    is($sth->result, 1, "result frame decoded");
    is($sth->next, {id => 1}, "row before the error");

    my $err = dies { $sth->next };
    like($err, qr/Forked query failed in the child process: boom in the child/, "child error surfaces with its message");
    ok($sth->done, "handle is finalized after a child error");
};

subtest error_before_result => sub {
    my ($sth) = fork_handle(frames => [
        {error => 'execute failed'},

worktrees/audit-fixes-master/t/fork_safety.t  view on Meta::CPAN

    ok($sth->done, "handle is finalized");
};

subtest truncated_stream => sub {
    # Child sends a result and one row, then exits without a terminal frame.
    my ($sth) = fork_handle(frames => [
        {result => 1},
        {row => {id => 1}},
    ]);

    is($sth->result, 1, "result frame decoded");
    is($sth->next, {id => 1}, "the row that did arrive");

    my $err = dies { $sth->next };
    like($err, qr/truncated|before the child signalled completion/i, "EOF with no terminal frame is reported as truncation");
    ok($sth->done, "handle is finalized after truncation");
};

subtest ownership_guard => sub {
    # A handle owned by a different process (as if inherited across a fork)
    # must not reap the child or release the owner's fork slot.

worktrees/dbic-compat-native-features/lib/DBIx/QuickORM/Row.pm  view on Meta::CPAN

    my ($from, $field) = @_;

    croak "This row does not have a '$field' field" unless $self->has_field($field);

    return undef unless $from;
    return undef unless exists $from->{$field};
    my $val = $from->{$field};

    # A staged SQL literal (\'NOW()' or [\'expr ?', @binds]) is not table data;
    # it must pass through untouched. Deflating it would corrupt the literal.
    # This is deliberately narrow: a decoded JSON hashref/arrayref is data and
    # must still be deflated back to its stored form, so only literal shapes
    # pass through here.
    return $val if literal_write_value($val);

    return $val->qorm_deflate($self->conflate_args($field, $val))
        if blessed($val) && $val->can('qorm_deflate');

    if (my $type = $self->source->field_type($field)) {
        return $type->qorm_deflate($self->conflate_args($field, $val));
    }

worktrees/dbic-compat-native-features/lib/DBIx/QuickORM/Type/JSON.pm  view on Meta::CPAN

        else                  { die "Not sure what to do with $val" }
    }

    return $class->JSON->encode($val);
}

sub qorm_compare {
    my $class = shift;
    my ($a, $b) = @_;

    # First decode the json if it is not already decoded
    $a = $class->qorm_inflate($a);
    $b = $class->qorm_inflate($b);

    # Now encode it in canonical form so that identical structures produce identical strings.
    # Another option would be to use Test2::Compare...
    $a = $class->CJSON->encode($a);
    $b = $class->CJSON->encode($b);

    # Equality contract: true when the two values are the same.
    return $a eq $b;

worktrees/dbic-compat-native-features/t/AI/type_json.t  view on Meta::CPAN

use DBIx::QuickORM::Type::JSON;

my $C = 'DBIx::QuickORM::Type::JSON';

subtest affinity => sub {
    is($C->qorm_affinity, 'string', "JSON affinity is string");
};

subtest inflate => sub {
    my $ref = $C->qorm_inflate(class => $C, value => '{"a":1,"b":[2,3]}');
    is($ref, {a => 1, b => [2, 3]}, "decoded JSON object string into a Perl structure");

    is(
        $C->qorm_inflate(class => $C, value => '[1,2,3]'),
        [1, 2, 3],
        "decoded JSON array string",
    );

    is($C->qorm_inflate(class => $C, value => undef), undef, "undef inflates to undef");

    # An already-inflated ref passes straight through (the row layer can
    # re-run inflate on a value that is already a ref).
    my $already = {x => 1};
    is($C->qorm_inflate(class => $C, value => $already), $already, "ref value passes through unchanged");
};

worktrees/dbic-compat-native-features/t/fork_safety.t  view on Meta::CPAN

}

subtest clean_stream => sub {
    my ($sth) = fork_handle(frames => [
        {result => 1},
        {row => {id => 1, name => 'a'}},
        {row => {id => 2, name => 'b'}},
        {done => 1},
    ]);

    is($sth->result, 1, "result frame decoded");
    is($sth->next, {id => 1, name => 'a'}, "first row");
    is($sth->next, {id => 2, name => 'b'}, "second row");
    is($sth->next, undef, "done frame ends the stream cleanly");
    ok($sth->done, "handle is finalized after a clean end");
};

subtest child_error_frame => sub {
    my ($sth) = fork_handle(frames => [
        {result => 1},
        {row => {id => 1}},
        {error => 'boom in the child'},
    ]);

    is($sth->result, 1, "result frame decoded");
    is($sth->next, {id => 1}, "row before the error");

    my $err = dies { $sth->next };
    like($err, qr/Forked query failed in the child process: boom in the child/, "child error surfaces with its message");
    ok($sth->done, "handle is finalized after a child error");
};

subtest error_before_result => sub {
    my ($sth) = fork_handle(frames => [
        {error => 'execute failed'},

worktrees/dbic-compat-native-features/t/fork_safety.t  view on Meta::CPAN

    ok($sth->done, "handle is finalized");
};

subtest truncated_stream => sub {
    # Child sends a result and one row, then exits without a terminal frame.
    my ($sth) = fork_handle(frames => [
        {result => 1},
        {row => {id => 1}},
    ]);

    is($sth->result, 1, "result frame decoded");
    is($sth->next, {id => 1}, "the row that did arrive");

    my $err = dies { $sth->next };
    like($err, qr/truncated|before the child signalled completion/i, "EOF with no terminal frame is reported as truncation");
    ok($sth->done, "handle is finalized after truncation");
};

subtest ownership_guard => sub {
    # A handle owned by a different process (as if inherited across a fork)
    # must not reap the child or release the owner's fork slot.