view release on metacpan or  search on metacpan

t/10-age-live.t  view on Meta::CPAN

my $optional = $schema->storage->cypher(
  $graph,
  q{
    MATCH (p:Person {name: 'Alice'})
    OPTIONAL MATCH (p)-[:KNOWS]->(lone:Person {name: 'NobodyHere'})
    RETURN p.name, lone.name
  },
  [qw(host guest)],
);
is(scalar @$optional, 1, 'OPTIONAL MATCH still returns the host row');
ok(!defined($optional->[0]{guest}) || $optional->[0]{guest} eq 'null',
  'OPTIONAL MATCH yields null for the missing branch');

# --- WITH + aggregation: count how many people each person knows ---
# Alice -> {Bob, Carol} = 2 outgoing; Bob -> Carol = 1; Carol -> 0.
# So WITH a, count(b) yields two groups (Alice=2, Bob=1).
my $degree = $schema->storage->cypher(
  $graph,
  q{
    MATCH (a:Person)-[:KNOWS]->(b:Person)
    WITH a, count(b) AS degree
    RETURN a.name, degree
    ORDER BY a.name
  },
  [qw(name degree)],
);
is(scalar @$degree, 2, 'two people have outgoing KNOWS edges (Alice and Bob)');
like($degree->[0]{degree}, qr/2/, 'Alice (sorted first) knows 2 people');
like($degree->[1]{degree}, qr/1/, 'Bob knows 1 person');

# --- variable-length path: who does Alice reach in 1..2 hops? ---
# Alice->Bob (1 hop), Alice->Carol (1 hop), Alice->Bob->Carol (2 hops).
# DISTINCT collapses Bob and Carol; with Dave added separately via MERGE above,
# Dave has no outgoing KNOWS, so he is not reachable from Alice.
my $reachable = $schema->storage->cypher(
  $graph,
  q{
    MATCH (a:Person {name: 'Alice'})-[:KNOWS*1..2]->(b:Person)
    RETURN DISTINCT b.name
  },
  ['name'],
);
my @reachable_names = sort map { my $n = $_->{name}; $n =~ s/^"|"$//g; $n } @$reachable;
is_deeply(\@reachable_names, [qw(Bob Carol)],
  'variable-length path [*1..2] from Alice reaches Bob and Carol');

# --- Edge properties in projection ---
# Use non-reserved column names — 'from' and 'to' are SQL keywords.
my $with_edge = $schema->storage->cypher(
  $graph,
  q{
    MATCH (a:Person {name: 'Alice'})-[r:KNOWS]->(b:Person)
    RETURN a.name, b.name, r.since
  },
  [qw(src dst since)],
);
is(scalar @$with_edge, 2, 'Alice has two KNOWS edges');
like($with_edge->[0]{since}, qr/^"?20\d\d"?$/, 'edge property since is a year');

# --- auto_decode: cypher() option returns structured Perl data ---
my $decoded = $schema->storage->cypher(
  $graph,
  q[ MATCH (p:Person {name: $name}) RETURN p.age, p.name ],
  [qw(age name)],
  { name => 'Alice' },
  { auto_decode => 1 },
);
is($decoded->[0]{name}, 'Alice',
  'auto_decode: string scalar has quotes stripped');
is($decoded->[0]{age}, 30,
  'auto_decode: integer scalar comes back as Perl number');

# --- auto_decode: vertex object decoded into hashref ---
my $vertex_rows = $schema->storage->cypher(
  $graph,
  q[ MATCH (p:Person {name: $name}) RETURN p ],
  ['p'],
  { name => 'Alice' },
  { auto_decode => 1 },
);
my $v = $vertex_rows->[0]{p};
is(ref($v), 'HASH', 'auto_decode: vertex decodes to hashref');
is($v->{label}, 'Person', 'auto_decode: vertex label preserved');
is_deeply(
  { name => 'Alice', age => 30 },
  $v->{properties},
  'auto_decode: vertex properties decoded into nested hashref'
);

# --- backward-compat: cypher() without auto_decode still returns strings ---
my $raw = $schema->storage->cypher(
  $graph,
  q[ MATCH (p:Person {name: $name}) RETURN p.age ],
  ['age'],
  { name => 'Alice' },
);
like($raw->[0]{age}, qr/^"?30"?$/,
  'cypher() without auto_decode still returns agtype strings');

# --- drop_graph (without cascade should fail if non-empty, in newer AGE) ---
# Skip the non-cascade case — depends on AGE version. Just drop with cascade.
lives_ok { $schema->storage->drop_graph($graph, 1) } 'drop_graph cascade lives';

my ($still_there) = $schema->storage->dbh->selectrow_array(
  'SELECT 1 FROM ag_catalog.ag_graph WHERE name = ?',
  undef, $graph,
);
ok(!$still_there, 'graph removed from ag_catalog.ag_graph');

done_testing;