@voxgig/sdkgen 4.34.0 → 4.34.2

package/project/.sdk/tm/ocaml/sdk_types.ml

@@ -17,6 +17,8 @@
 
 open Voxgig_struct
 
+module OpMap = Map.Make (String)
+
 (* Branded SDK error. Raised as `Sdk_error_exc` on the throwing path; carried
  * as `sdk_error option` on the (value, err) pipeline return tuples. *)
 type sdk_error = {
@@ -68,6 +70,9 @@ and spec = {
   mutable sp_body : value;
   mutable sp_url : string;
   mutable sp_path : string;
+  (* The query parameters prepare_auth placed: the credential, which the
+   * request sends and the entity's match leaves out. *)
+  mutable sp_authquery : string list;
 }
 
 and response = {
@@ -77,6 +82,8 @@ and response = {
   mutable rs_json : value;        (* Func thunk or Noval *)
   mutable rs_body : value;
   mutable rs_err : sdk_error option;
+  (* Set by a transport that could not read a non-blank body as JSON. *)
+  mutable rs_unreadable : bool;
 }
 
 and result = {
@@ -208,6 +215,7 @@ and entity_obj = {
   mutable e_list : value -> value -> entity_obj list;
   mutable e_create : value -> value -> entity_obj;
   mutable e_update : value -> value -> entity_obj;
+  mutable e_patch : value -> value -> entity_obj;
   mutable e_remove : value -> value -> entity_obj;
   (* e_remove resolves to the entity, marked. The instance KEEPS the data it
    * held - a caller can still read what was deleted - but it is no longer a
@@ -232,7 +240,7 @@ and ctxspec = {
   mutable cs_options : value option;
   mutable cs_entity : entity_obj option;
   mutable cs_shared : value option;
-  mutable cs_opmap : (string, operation) Hashtbl.t option;
+  mutable cs_opmap : operation OpMap.t Atomic.t option;
   mutable cs_data : value option;
   mutable cs_reqdata : value option;
   mutable cs_match : value option;
@@ -255,7 +263,9 @@ and ctx = {
   mutable c_config : value;
   mutable c_entopts : value;
   mutable c_options : value;
-  mutable c_opmap : (string, operation) Hashtbl.t;
+  (* Shared by every context of one client, so by requests on other domains:
+   * a map replaced whole, never changed in place. *)
+  mutable c_opmap : operation OpMap.t Atomic.t;
   mutable c_response : response option;
   mutable c_result : result option;
   mutable c_spec : spec option;

package/project/.sdk/tm/ocaml/test/concurrency_test.ml

@@ -0,0 +1,148 @@
+(* Requests in flight at once on one client. Each resolves its operation
+ * through the cache the client's root context shares with every request, and
+ * registers and cleans secrets through the one registry the client holds.
+ *
+ * Threads take turns on one domain and switch when the runtime's tick lands,
+ * so each test runs long enough to be switched inside a resolution or a
+ * registration. *)
+
+open Voxgig_struct
+open Sdk_types
+open Testutil
+
+let rounds = 3
+let width = 8
+let ops = 4000
+let seeded = 600
+let added = 100
+let masked = "a [redacted] b [redacted] c"
+
+(* Runs body on width threads released together, and returns what they raised. *)
+let at_once (body : int -> unit) : string list =
+  let lock = Mutex.create () in
+  let ready = Condition.create () in
+  let waiting = ref 0 in
+  let raised = ref [] in
+  let run n =
+    Mutex.lock lock;
+    incr waiting;
+    if !waiting = width then Condition.broadcast ready
+    else while !waiting < width do Condition.wait ready lock done;
+    Mutex.unlock lock;
+    try body n
+    with e ->
+      Mutex.lock lock;
+      raised := fail_msg e :: !raised;
+      Mutex.unlock lock
+  in
+  List.iter Thread.join (List.init width (Thread.create run));
+  !raised
+
+let root_of (cl : sdk_client) : ctx =
+  match cl.cl_rootctx with Some c -> c | None -> failwith "no root context"
+
+let resolve (cl : sdk_client) (k : int) : operation =
+  let ctx = cl.cl_utility.u_make_context
+      { (Sdk_runtime.default_ctxspec ()) with cs_opname = Some ("op" ^ string_of_int k) }
+      cl.cl_rootctx in
+  ctx.c_op
+
+let () = test "concurrent resolutions share one cached operation" (fun () ->
+    for round = 1 to rounds do
+      let cl = Sdk_client.test () in
+      let got = Array.init width (fun _ -> Array.make ops None) in
+      let raised = at_once (fun n ->
+          for k = 0 to ops - 1 do got.(n).(k) <- Some (resolve cl k) done) in
+      check (Printf.sprintf "round %d raised: %s" round (String.concat "; " raised)) (raised = []);
+      for k = 0 to ops - 1 do
+        let cached = resolve cl k in
+        for n = 0 to width - 1 do
+          check (Printf.sprintf "round %d: op%d resolved to more than one Operation" round k)
+            (match got.(n).(k) with Some op -> op == cached | None -> false)
+        done
+      done
+    done)
+
+let clean_str (cl : sdk_client) (text : string) : string =
+  match cl.cl_utility.u_clean (root_of cl) (Str text) with Str s -> s | v -> stringify v
+
+(* A live client whose transport answers at once. *)
+let live_client () : sdk_client =
+  let fetch = Func (fun _ _ _ _ ->
+      Sdk_helpers.jo [
+        ("status", Num 200.); ("statusText", Str "OK"); ("headers", Sdk_helpers.jo []);
+        ("json", Sdk_helpers.json_thunk (Sdk_helpers.jo [("ok", Bool true)]))]) in
+  Sdk_client.make (Sdk_helpers.jo [
+      ("base", Str "http://concurrency.test/api");
+      ("allow", Sdk_helpers.jo [("op", Str "direct")]);
+      ("system", Sdk_helpers.jo [("fetch", fetch)])])
+
+(* Registers thread n's secrets, then counts the thread out of registering. *)
+let register_secrets (cl : sdk_client) (round : int) (n : int) (registering : int Atomic.t) : unit =
+  Fun.protect ~finally:(fun () -> Atomic.decr registering) (fun () ->
+      for k = 1 to added do
+        cl.cl_utility.u_clean_add (root_of cl) (Printf.sprintf "ADDED-SECRET-%d-%d-%d" round n k)
+      done)
+
+let every_secret_masked (cl : sdk_client) (round : int) : unit =
+  for n = 0 to width / 2 - 1 do
+    for k = 1 to added do
+      let secret = Printf.sprintf "ADDED-SECRET-%d-%d-%d" round n k in
+      check_str (Printf.sprintf "round %d: %s was registered but not masked" round secret)
+        (clean_str cl secret) "[redacted]"
+    done
+  done
+
+(* Secrets registered on some threads while others clean: every clean masks
+ * what was registered before it, the longer secret whole, and no
+ * registration is lost. *)
+let () = test "concurrent registration keeps every secret masked" (fun () ->
+    for round = 1 to rounds do
+      let cl = Sdk_client.test () in
+      let add v = cl.cl_utility.u_clean_add (root_of cl) v in
+      for k = 1 to seeded do add (Printf.sprintf "SEEDED-SECRET-%d-%d" round k) done;
+      let inner = Printf.sprintf "INNER-SECRET-%d" round in
+      add inner;
+      add ("OUTER-" ^ inner ^ "-TAIL");
+      let text = "a " ^ inner ^ " b OUTER-" ^ inner ^ "-TAIL c" in
+      check_str (Printf.sprintf "round %d" round) (clean_str cl text) masked;
+      let registering = Atomic.make (width / 2) in
+      let raised = at_once (fun n ->
+          if n < width / 2 then register_secrets cl round n registering
+          else
+            while 0 < Atomic.get registering do
+              let got = clean_str cl text in
+              if got <> masked then failwith ("cleaned to: " ^ got);
+              Thread.yield ()
+            done) in
+      check (Printf.sprintf "round %d raised: %s" round (String.concat "; " raised)) (raised = []);
+      every_secret_masked cl round
+    done)
+
+(* Requests on one client while secrets register on it: each request copies
+ * the client's options, the registry among them. *)
+let () = test "concurrent requests survive registration" (fun () ->
+    for round = 1 to rounds do
+      let cl = live_client () in
+      for k = 1 to seeded do
+        cl.cl_utility.u_clean_add (root_of cl) (Printf.sprintf "SEEDED-SECRET-%d-%d" round k)
+      done;
+      let registering = Atomic.make (width / 2) in
+      let raised = at_once (fun n ->
+          if n < width / 2 then register_secrets cl round n registering
+          else
+            while 0 < Atomic.get registering do
+              let res = Sdk_client.direct cl
+                  (Sdk_helpers.jo [("path", Str (Printf.sprintf "p%d" n))]) in
+              if Sdk_helpers.getp res "ok" <> Bool true then
+                failwith ("a request failed: " ^ stringify res);
+              Thread.yield ()
+            done) in
+      check (Printf.sprintf "round %d raised: %s" round (String.concat "; " raised)) (raised = []);
+      every_secret_masked cl round
+    done)
+
+let () =
+  List.iter (fun m -> print_endline ("FAIL " ^ m)) (List.rev !failures);
+  Printf.printf "concurrency_test: %d passed, %d failed\n" !npass !nfail;
+  if !nfail > 0 then exit 1

package/project/.sdk/tm/ocaml/test/harness.ml

@@ -117,7 +117,7 @@ let make_client ?(server : server option) ?(mode = "test") ?(base = "http://api.
 let feature (h : harness) (name : string) : feature option =
   List.find_opt (fun f -> f.f_name = name) h.h_client.cl_features
 
-let default_method op = match op with "create" -> "POST" | "update" -> "PATCH" | "remove" -> "DELETE" | _ -> "GET"
+let default_method op = match op with "create" -> "POST" | "update" | "patch" -> "PATCH" | "remove" -> "DELETE" | _ -> "GET"
 
 let build_url (sp : spec) : string =
   let q = match sp.sp_query with Map _ as m -> m | _ -> empty_map () in

package/project/.sdk/tm/ocaml/test/t_pipeline.ml

@@ -40,7 +40,8 @@ let make_factory (cl : sdk_client) (made : value list ref) : entity_obj =
     (* Ops resolve to the ENTITY (see Sdk_types); this fake never runs them. *)
     e_load = (fun _ _ -> failwith "unused"); e_list = (fun _ _ -> []);
     e_create = (fun _ _ -> failwith "unused");
-    e_update = (fun _ _ -> failwith "unused"); e_remove = (fun _ _ -> failwith "unused");
+    e_update = (fun _ _ -> failwith "unused"); e_patch = (fun _ _ -> failwith "unused");
+    e_remove = (fun _ _ -> failwith "unused");
     e_deleted = false; e_mark_deleted = (fun () -> ());
     e_stream = (fun _ _ _ -> Seq.empty);
   } in

package/project/.sdk/tm/perl/LICENSE

@@ -1,6 +1,6 @@
 MIT License
 
-Copyright (c) $$const.year$$ Voxgig
+Copyright (c) $$const.year$$ PROJECTPUBLISHER
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

package/project/.sdk/tm/perl/core/context.pm

@@ -113,7 +113,7 @@ sub resolve_op {
 
   my $opcfg = ProjectNameHelpers::gpath($self->{config}, "entity.$entname.op.$opname");
 
-  my $input = ($opname eq 'update' || $opname eq 'create') ? 'data' : 'match';
+  my $input = ($opname eq 'update' || $opname eq 'create' || $opname eq 'patch') ? 'data' : 'match';
 
   my $points = [];
   if (Voxgig::Struct::ismap($opcfg)) {

package/project/.sdk/tm/perl/core/response.pm

@@ -34,6 +34,8 @@ sub new {
     json_func   => $json_func,
     body        => ProjectNameHelpers::gp($resmap, 'body'),
     err         => ProjectNameHelpers::gp($resmap, 'err'),
+    # Set by a transport that could not read a non-blank body as JSON.
+    unreadable  => (ProjectNameHelpers::gp($resmap, 'unreadable') ? 1 : 0),
   }, $class;
 }
 

package/project/.sdk/tm/perl/core/spec.pm

@@ -27,6 +27,9 @@ sub new {
     body    => $specmap->{body},
     url     => $g->('url', ''),
     path    => $g->('path', ''),
+    # The query parameters prepare_auth placed: the credential, which the
+    # request sends and the entity's match leaves out.
+    authquery => $g->('authquery', []),
   }, $class;
 }
 

package/project/.sdk/tm/perl/feature/test_feature.pm

@@ -15,6 +15,17 @@ require(Cwd::abs_path("$__dir/base_feature.pm"));
 
 package ProjectNameTestFeature;
 
+# The key a list's response transform
+# ["`$EACH`", "body", { "`$MERGE`" => "`.<key>`" }] reads each item's record under.
+sub item_envelope_key {
+  my ($spec) = @_;
+  return undef unless ref($spec) eq 'ARRAY' && 3 == @$spec &&
+    '`$EACH`' eq ($spec->[0] // '') && 'body' eq ($spec->[1] // '') && ref($spec->[2]) eq 'HASH';
+  my $merge = $spec->[2]{'`$MERGE`'};
+  return undef unless defined $merge && !ref($merge) && $merge =~ /^`\.([^.`\$]+)`$/;
+  return $1;
+}
+
 our @ISA = ('ProjectNameBaseFeature');
 
 sub new {
@@ -65,6 +76,8 @@ sub init {
     return $data unless defined $fctx && defined $fctx->{point};
     my $tm = ProjectNameHelpers::gp($fctx->{point}, 'transform');
     my $spec = ProjectNameHelpers::gp($tm, 'res');
+    my $key = item_envelope_key($spec);
+    return [ map { +{ $key => $_ } } @$data ] if defined $key && ref($data) eq 'ARRAY';
     return $data unless defined $spec && !ref($spec);
     # Rebuild whatever nesting the transform unwraps. Multi-segment on purpose:
     # GraphQL ops unwrap `body.data.<field>`, not just one envelope property.
@@ -133,7 +146,7 @@ sub init {
       my $out = Voxgig::Struct::clone($found);
       return $respond->($fctx, 200, $out, undef);
     }
-    elsif ('update' eq $op->{name}) {
+    elsif ('update' eq $op->{name} || 'patch' eq $op->{name}) {
       # Match the existing entity by id only (or its alias). reqdata also
       # contains the new field values, which would otherwise cause select
       # to filter out the entity we want to update. When reqdata has no id,
@@ -158,7 +171,7 @@ sub init {
       return $respond->($fctx, 404, undef, { 'statusText' => 'Not found' })
         unless ProjectNameHelpers::rb_truthy($ent);
       if (Voxgig::Struct::ismap($ent) && Voxgig::Struct::ismap($fctx->{reqdata})) {
-        Voxgig::Struct::merge([$ent, $fctx->{reqdata}]);
+        Voxgig::Struct::merge([$ent, _record($fctx->{reqdata})]);
       }
       Voxgig::Struct::delprop($ent, '$KEY');
       my $out = Voxgig::Struct::clone($ent);
@@ -183,7 +196,7 @@ sub init {
         int(rand(0x10000)), int(rand(0x10000)),
         int(rand(0x10000)), int(rand(0x10000))) unless defined $id;
 
-      my $ent = Voxgig::Struct::clone($fctx->{reqdata});
+      my $ent = Voxgig::Struct::clone(_record($fctx->{reqdata}));
       if (Voxgig::Struct::ismap($ent)) {
         $ent->{id} = $id;
         $entmap->{"$id"} = $ent if defined $id && !ref $id;
@@ -214,6 +227,16 @@ sub init {
 # {min,max}), a budget of first-N failures ("failTimes" -> "failStatus"),
 # first-N connection errors ("errorTimes"), or a hard "offline" outage.
 # Counter-driven, so simulations are deterministic across a test.
+# The record the mock keeps: the request data without `$body`, which only the
+# wire carries.
+sub _record {
+  my ($reqdata) = @_;
+  return $reqdata unless ref $reqdata eq 'HASH';
+  my %out = %$reqdata;
+  delete $out{'$body'};
+  return \%out;
+}
+
 sub make_netsim {
   my ($self, $net, $inner) = @_;
   $self->{netcalls} = 0;

package/project/.sdk/tm/perl/feature/validate_feature.pm

@@ -206,6 +206,8 @@ sub _payload {
   # fields will never name it - and under `strict` every custom-action call
   # would be rejected for the one key that made it reachable.
   delete $out{'$action'};
+  # Nor is `$body`, the raw request body.
+  delete $out{'$body'};
 
   return \%out;
 }

package/project/.sdk/tm/perl/t/feature.t

@@ -30,7 +30,7 @@ sub has_feature {
 sub default_method {
   my ($opname) = @_;
   return 'POST' if 'create' eq $opname;
-  return 'PATCH' if 'update' eq $opname;
+  return 'PATCH' if 'update' eq $opname || 'patch' eq $opname;
   return 'DELETE' if 'remove' eq $opname;
   return 'GET';
 }

package/project/.sdk/tm/perl/t/feature_corpus.t

@@ -35,7 +35,7 @@ unless (defined $TEST_JSON && -e $TEST_JSON) {
 # without a listed feature still skips, not fails.
 
 # The standard operation names, in the order the runner prefers them.
-my @FEATURE_CORPUS_OPS = qw(load list create update remove);
+my @FEATURE_CORPUS_OPS = qw(load list create update patch remove);
 
 my $CORPUS = do {
   open my $fh, '<', $TEST_JSON or die "cannot read $TEST_JSON: $!";
@@ -101,10 +101,14 @@ sub scripted_fetcher {
 #
 # The plain constructor, not the test-mode one: the `test` feature is
 # transport: 'base' and REPLACES the transport, so a client in test mode
-# would shadow the script.
+# would shadow the script. The `test` OPTION installs no transport: it says
+# the client is not live, so a required server variable becomes test-<name>.
 sub build_client {
   my ($kase) = @_;
-  my $opts = { 'utility' => { 'fetcher' => scripted_fetcher($kase->{res}) } };
+  my $opts = {
+    'test' => { 'active' => 1 },
+    'utility' => { 'fetcher' => scripted_fetcher($kase->{res}) },
+  };
   $opts->{feature} = $kase->{feature} if defined $kase->{feature};
   return ProjectNameSDK->new($opts);
 }
@@ -281,6 +285,23 @@ sub record {
   return $client->{"_$name"};
 }
 
+# The first feature a case composes that this SDK does not generate, probed
+# as a section's own feature is. Such a case is skipped rather than failed.
+sub missing_feature {
+  my ($kase, $have) = @_;
+  my $spec = $kase->{feature};
+  my @names = ref $spec eq 'ARRAY' ? map { ref $_ eq 'HASH' ? $_->{name} : undef } @$spec
+    : ref $spec eq 'HASH' ? sort keys %$spec
+    : ();
+  for my $name (@names) {
+    next unless defined $name && !ref $name;
+    $have->{$name} //=
+      present(build_client({ feature => [ { name => $name, active => 1 } ] }), $name) ? 1 : 0;
+    return $name unless $have->{$name};
+  }
+  return undef;
+}
+
 
 my @ops = usable_ops(2);
 
@@ -292,6 +313,8 @@ ok(scalar(@ops) > 0,
   exit 0;
 };
 
+my %have;
+
 for my $name (sort keys %{ $CORPUS->{feature} || {} }) {
   my $section = ($CORPUS->{feature} || {})->{$name};
   next unless defined $section;
@@ -315,53 +338,69 @@ for my $name (sort keys %{ $CORPUS->{feature} || {} }) {
   my $ran = 0;
   for my $raw (@$cases) {
     my $need = tokens_used($raw);
-    next if $need > scalar(@ops);
+    if ($need > scalar(@ops)) {
+      diag(sprintf('skip "%s": needs %d operations, this SDK offers %d',
+        $raw->{name} // '', $need, scalar(@ops)));
+      next;
+    }
+
+    my $missing = missing_feature($raw, \%have);
+    if (defined $missing) {
+      diag(sprintf('skip "%s": needs the %s feature, which this SDK does not generate',
+        $raw->{name} // '', $missing));
+      next;
+    }
 
     my %tokens;
     for my $i (0 .. $need - 1) {
       $tokens{ '#OP' . ($i + 1) } = $ops[$i]{key};
     }
     my $kase = resolve($raw, \%tokens);
-
-    my $client = build_client($kase);
     my $label = $kase->{name} || '';
+    $ran++;
 
-    for my $step (@{ $kase->{op} || [] }) {
-      my $op = $by_key{ $step->{op} };
-      ok(defined $op, "$label: operation $step->{op} is known") or next;
-      my $ctrl = $step->{ctrl} || {};
-      my $wanterr = $step->{err};
-
-      my $ok = eval { invoke($client, $op, $ctrl); 1 };
-      my $err = $@;
-
-      if (!defined $wanterr) {
-        ok($ok, "$label: $step->{op} succeeded")
-          or diag("failed unexpectedly: $err");
-        next;
+    # Every failing case is reported, not only the first.
+    my $done = eval {
+      my $client = build_client($kase);
+
+      for my $step (@{ $kase->{op} || [] }) {
+        my $op = $by_key{ $step->{op} };
+        ok(defined $op, "$label: operation $step->{op} is known") or next;
+        my $ctrl = $step->{ctrl} || {};
+        my $wanterr = $step->{err};
+
+        my $ok = eval { invoke($client, $op, $ctrl); 1 };
+        my $err = $@;
+
+        if (!defined $wanterr) {
+          ok($ok, "$label: $step->{op} succeeded")
+            or diag("failed unexpectedly: $err");
+          next;
+        }
+
+        ok(!$ok, "$label: $step->{op} failed as expected") or next;
+
+        if (!ref $wanterr) {
+          # The CODE, not the message: make_error prefixes and humanises the
+          # text, so matching it would pass on any error mentioning the word.
+          my $code = (Scalar::Util::blessed($err) && $err->can('code'))
+            ? $err->code : undef;
+          is($code, $wanterr, "$label: error code");
+        }
       }
 
-      ok(!$ok, "$label: $step->{op} failed as expected") or next;
-
-      if (!ref $wanterr) {
-        # The CODE, not the message: make_error prefixes and humanises the
-        # text, so matching it would pass on any error mentioning the word.
-        my $code = (Scalar::Util::blessed($err) && $err->can('code'))
-          ? $err->code : undef;
-        is($code, $wanterr, "$label: error code");
-      }
-    }
-
-    subset(record($client, $name), $kase->{out}, "$label: _$name");
-    $ran++;
+      subset(record($client, $name), $kase->{out}, "$label: _$name");
+      1;
+    };
+    fail("$label: $@") unless $done;
   }
 
-  ok($ran > 0, "at least one feature.$name case ran");
   # Say how many ran. A partial run is legitimate (an SDK with one operation
   # skips the cases needing two) but it should be visible rather than
   # inferred from a green tick.
   diag(sprintf('feature.%s: ran %d of %d case(s) against %d operation(s)',
     $name, $ran, scalar(@$cases), scalar(@ops)));
+  ok($ran > 0, "at least one feature.$name case ran");
 }
 
 done_testing();

package/project/.sdk/tm/perl/t/runner.pm

@@ -167,4 +167,90 @@ sub live_delay_ms {
   return 500;
 }
 
+# A live check that did not pass, as main.kit.test.live.strict decides:
+# strict fails the test, lenient skips it with the same reason. The caller
+# leaves its block after either.
+sub live_miss {
+  my ($strict, $name, $reason) = @_;
+  if ($strict) {
+    Test::More::fail("$name: $reason");
+  }
+  else {
+    Test::More->builder->skip("$name: $reason");
+  }
+  return;
+}
+
+# An account holding no record for the test to read skips either way.
+sub live_empty {
+  my ($name, $reason) = @_;
+  Test::More->builder->skip("$name: $reason");
+  return;
+}
+
+# A live list response's records: the body, or the first list an envelope
+# holds.
+sub live_list {
+  my ($data) = @_;
+  return $data if ref $data eq 'ARRAY';
+  if (ref $data eq 'HASH') {
+    for my $k (sort keys %$data) {
+      return $data->{$k} if ref $data->{$k} eq 'ARRAY';
+    }
+  }
+  return undef;
+}
+
+# A live response for a message: the SDK's error, or else its status and
+# content type, never its body.
+sub live_describe {
+  my ($result) = @_;
+  return 'no response' unless ref $result eq 'HASH';
+  return '' . $result->{err} if defined $result->{err};
+  my $ctype;
+  for my $k (keys %{ $result->{headers} || {} }) {
+    $ctype = $result->{headers}{$k} if lc($k) eq 'content-type';
+  }
+  my $out = 'HTTP ' . ($result->{status} // 'none');
+  if (defined $ctype) {
+    my ($media) = split /;/, $ctype;
+    $media =~ s/^\s+|\s+$//g;
+    $out .= " $media";
+  }
+  return $out;
+}
+
+# The record a create-less flow reads live: the first its list returns, put
+# where the flow reads the fixture's existing records. False once the test
+# is settled and its block ends.
+sub live_existing {
+  my ($setup, $strict, $label, $name, $list) = @_;
+  my $found = eval { $list->() };
+  if (my $err = $@) {
+    live_miss($strict, $label, "Live list discovery failed: $err");
+    return 0;
+  }
+  if (ref $found ne 'ARRAY') {
+    live_miss($strict, $label, 'Live list discovery returned no list');
+    return 0;
+  }
+  if (!@$found) {
+    live_empty($label, "The account has no $name record to load");
+    return 0;
+  }
+  my $first = $found->[0];
+  my $record = (Scalar::Util::blessed($first) && $first->can('data_get'))
+    ? $first->data_get : $first;
+  $setup->{data}{existing}{$name} = { 'live01' => $record };
+  return 1;
+}
+
+# In a lenient live run a step that dies skips, observing the live API.
+sub live_observe {
+  my ($err, $setup, $strict, $label) = @_;
+  die $err if $strict || !$setup->{live};
+  Test::More->builder->skip("$label: live run, main.kit.test.live.strict is false: $err");
+  return;
+}
+
 1;

package/project/.sdk/tm/perl/t/server_variables.t

@@ -0,0 +1,39 @@
+#!perl
+# ProjectName SDK server variables
+#
+# A templated base URL takes each {name} from the `server` option. A missing
+# or empty value fails construction; test mode fills in test-<name>.
+
+use strict;
+use warnings;
+use Test::More;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use ProjectNameSDK;
+
+# A variable no API declares, so the API's own server defaults cannot fill it.
+my $base = 'https://api.example.test/bot{zzvar}';
+
+for my $server ({}, { 'zzvar' => '' }) {
+  my $client = eval { ProjectNameSDK->new({ 'base' => $base, 'server' => $server }) };
+  my $err = $@;
+  ok(!defined $client, 'construction fails without a value for zzvar');
+  is(ref $err ? $err->{code} : '', 'server_var_required', 'the error carries its code');
+  like("$err", qr/the server variable 'zzvar' is required/, 'the error names the variable');
+  like("$err", qr/\Q$base\E/, 'the error quotes the base URL');
+}
+
+my $filled = ProjectNameSDK->new({ 'base' => $base, 'server' => { 'zzvar' => 'T1' } });
+is($filled->options_map()->{base}, 'https://api.example.test/botT1',
+  'a server value fills the base');
+
+my $testmode = ProjectNameSDK->new({ 'base' => $base, 'test' => { 'active' => 1 } });
+is($testmode->options_map()->{base}, 'https://api.example.test/bottest-zzvar',
+  'the test option fills test-<name>');
+
+my $mock = ProjectNameSDK->test(undef, { 'base' => $base });
+is($mock->options_map()->{base}, 'https://api.example.test/bottest-zzvar',
+  'the test feature fills test-<name>');
+
+done_testing();