add 'original_uri' and 'retrieval_uri' to JSON::Schema::Modern::Document

This will allow us to implement the separation of retrieval URL from "$self"
in JSON::Schema::Modern::Document::OpenAPI and OpenAPI::Modern (to be added to
the OpenAPI Specification in v3.2).

see OAI/OpenAPI-Specification#4389

Author: karenetheridge

Changes

@@ -5,6 +5,9 @@ Revision history for JSON-Schema-Modern
             Schema schema files
           - documentation fixes for JSM and JSM::Document regarding handling
             of uris
+          - introduction of 'original_uri' for JSON::Schema::Modern::Document,
+            which document subclasses may wish to use for logic of their own
+            after changing the canonical uri of the document
 
 0.607     2025-04-01 19:35:50Z
           - now performing stricter email address validation for the 'email' and

lib/JSON/Schema/Modern/Document.pm

@@ -20,6 +20,7 @@ use Mojo::URL;
 use Carp 'croak';
 use List::Util 1.29 'pairs';
 use Ref::Util 0.100 'is_plain_hashref';
+use builtin::compat 'refaddr';
 use Safe::Isa 1.000008;
 use MooX::TypeTiny;
 use Types::Standard 1.016003 qw(InstanceOf HashRef Str Map Dict ArrayRef Enum ClassName Undef Slurpy Optional);
@@ -41,6 +42,14 @@ has canonical_uri => (
   coerce => sub { $_[0]->$_isa('Mojo::URL') ? $_[0] : Mojo::URL->new($_[0]) },
 );
 
+# this is also known as the retrieval uri in the OpenAPI::Modern specification
+has original_uri => (
+  is => 'rwp',
+  isa => (InstanceOf['Mojo::URL'])->where(q{not defined $_->fragment}),
+  init_arg => undef,
+);
+*retrieval_uri = \&original_uri;
+
 has metaschema_uri => (
   is => 'rwp',
   isa => (InstanceOf['Mojo::URL'])->where(q{not length $_->fragment}), # allow for .../draft-07/schema#
@@ -157,15 +166,14 @@ sub TO_JSON { shift->schema }
 
 # note that this is always called, even in subclasses
 sub BUILD ($self, $args) {
-  my $original_uri = $self->canonical_uri->clone;
+  # note! not a clone! Please don't change canonical_uri in-place.
+  $self->_set_original_uri($self->canonical_uri);
+
   my $state = $self->traverse(
     $self->evaluator // $self->_set_evaluator(JSON::Schema::Modern->new),
     $args->{specification_version} ? +{ $args->%{specification_version} } : (),
   );
 
-  # if the schema identified a canonical uri for itself, it overrides the initial value
-  $self->_set_canonical_uri($state->{initial_schema_uri}) if $state->{initial_schema_uri} ne $original_uri;
-
   if ($state->{errors}->@*) {
     $self->_set_errors($state->{errors});
     return;
@@ -180,7 +188,9 @@ sub BUILD ($self, $args) {
     ++$seen_root if $value->{path} eq '';
   }
 
-  $self->_add_resource($original_uri.'' => {
+  # we only index the original uri if nothing in the schema itself identified a root resource:
+  # otherwise the top of the document would be unreferenceable.
+  $self->_add_resource($self->original_uri.'' => {
       path => '',
       canonical_uri => $self->canonical_uri,
       specification_version => $state->{spec_version},
@@ -197,14 +207,23 @@ sub traverse ($self, $evaluator, $config_override = {}) {
   die 'wrong class - use JSON::Schema::Modern::Document::OpenAPI instead'
     if is_plain_hashref($self->schema) and exists $self->schema->{openapi};
 
+  my $original_uri = $self->original_uri;
+
   my $state = $evaluator->traverse($self->schema,
     {
-      initial_schema_uri => $self->canonical_uri->clone,
+      initial_schema_uri => $original_uri,
       $self->metaschema_uri ? ( metaschema_uri => $self->metaschema_uri ) : (),
       %$config_override,
     }
   );
 
+  die 'original_uri has changed' if $self->original_uri ne $original_uri
+    or refaddr($self->original_uri) != refaddr($original_uri);
+
+  # if the schema identified a canonical uri for itself via '$id', it overrides the initial value
+  # Note that subclasses of this class may choose to identify the canonical uri in a different way
+  $self->_set_canonical_uri($state->{initial_schema_uri}) if $state->{initial_schema_uri} ne $original_uri;
+
   return $state if $state->{errors}->@*;
 
   # we don't store the metaschema_uri in $state nor in resource_index, but we can figure it out
@@ -278,6 +297,8 @@ against this URI to determine the final value, which is then stored in this acce
 can be considered the canonical URI for the document as a whole, from which subsequent C<$ref>
 keywords are resolved.
 
+The original passed-in value is saved in L</original_uri>.
+
 =head2 metaschema_uri
 
 =for stopwords metaschema schemas
@@ -318,14 +339,28 @@ A L<JSON::Schema::Modern> object. Optional, unless custom metaschemas are used.
 
 =head1 METHODS
 
-=for Pod::Coverage FOREIGNBUILDARGS BUILDARGS BUILD FREEZE THAW traverse has_errors path_to_resource resource_pairs get_entity_at_location get_entity_locations
+=for Pod::Coverage FOREIGNBUILDARGS BUILDARGS BUILD FREEZE THAW traverse has_errors path_to_resource
+resource_pairs get_entity_at_location get_entity_locations retrieval_uri
 
 =head2 errors
 
 Returns a list of L<JSON::Schema::Modern::Error> objects that resulted when the schema document was
 originally parsed. (If a syntax error occurred, usually there will be just one error, as parse
 errors halt the parsing process.) Documents with errors cannot be used for evaluation.
 
+=head2 original_uri
+
+Returns the original value of L</canonical_uri> that was passed to the document constructor (which
+C<$id> keywords within the document would have been resolved against, if they were not already
+absolute). Some subclasses may make use of this value for resolving URIs when matching HTTP requests
+at runtime.
+
+This URI is B<not> added to the document's resource index, so if you want the document to be
+addressable at this location you must add it to the evaluator yourself with the two-argument form of
+L<JSON::Schema::Modern/add_document>.
+
+Read-only.
+
 =head2 resource_index
 
 An index of URIs to subschemas (JSON pointer to reach the location, and the canonical URI of that

t/document.t

@@ -36,6 +36,7 @@ subtest 'boolean document' => sub {
           %configs,
         },
       ],
+      original_uri => [ str('') ],
       canonical_uri => [ str('') ],
       _entities => [ { '' => 0 } ],
     ),
@@ -87,6 +88,7 @@ subtest 'object document' => sub {
           %configs,
         },
       ],
+      original_uri => [ str($_//'') ],
       canonical_uri => [ str($_//'') ],
       _entities => [ { '' => 0 } ],
     ),
@@ -108,6 +110,7 @@ subtest 'object document' => sub {
           %configs,
         },
       ],
+      original_uri => [ str('https://foo.com') ],
       canonical_uri => [ str('https://foo.com') ],
       _entities => [ { '' => 0 } ],
     ),
@@ -128,6 +131,7 @@ subtest 'object document' => sub {
           %configs,
         },
       ],
+      original_uri => [ str($_//'') ],
       canonical_uri => [ str('https://foo.com') ], # note canonical_uri has been overwritten
       _entities => [ { '' => 0 } ],
     ),
@@ -149,6 +153,7 @@ subtest 'object document' => sub {
           %configs,
         },
       ],
+      original_uri => [ str($_) ],
       canonical_uri => [ str('https://bar.com') ], # note canonical_uri has been overwritten
       _entities => [ { '' => 0 } ],
     ),
@@ -188,6 +193,7 @@ subtest 'object document' => sub {
           %configs,
         },
       ],
+      original_uri => [ str('https://foo.com') ],
       canonical_uri => [ str('https://foo.com') ],
       _entities => [ { '' => 0 } ],
     ),
@@ -224,6 +230,7 @@ subtest 'object document' => sub {
           %configs,
         },
       ),
+      original_uri => [ str('https://foo.com') ],
       canonical_uri => [ str('https://bar.com') ],
       _entities => [ { map +($_ => 0), '', '/allOf/0', '/allOf/1' } ],
     ),
@@ -245,6 +252,7 @@ subtest 'object document' => sub {
           %configs,
         },
       ],
+      original_uri => [ str('https://my-base.com') ],
       canonical_uri => [ str('https://my-base.com/relative') ],
       _entities => [ { '' => 0 } ],
     ),
@@ -275,6 +283,8 @@ subtest 'object document' => sub {
           %configs,
         },
       ),
+      original_uri => [ str('') ],
+      canonical_uri => [ str('') ],
       _entities => [ { map +($_ => 0), '', '/$defs/foo' } ],
     ),
     'relative uri for inner $id',
@@ -303,6 +313,8 @@ subtest 'object document' => sub {
           %configs,
         },
       ),
+      original_uri => [ str('') ],
+      canonical_uri => [ str('') ],
       _entities => [ { map +($_ => 0), '', '/$defs/foo' } ],
     ),
     'no root $id; absolute uri with path in subschema resource',
@@ -328,6 +340,8 @@ subtest 'object document' => sub {
           },
         },
       ],
+      original_uri => [ str('') ],
+      canonical_uri => [ str('') ],
     ),
     'no root $id or canonical_uri provided; anchor is indexed at the root',
   );
@@ -353,6 +367,8 @@ subtest 'object document' => sub {
           },
         },
       ],
+      original_uri => [ str('https://example.com') ],
+      canonical_uri => [ str('https://example.com') ],
     ),
     'canonical_uri provided; empty uri not added as a referenceable uri when an anchor exists',
   );
@@ -378,6 +394,8 @@ subtest 'object document' => sub {
           },
         },
       ],
+      original_uri => [ str('') ],
+      canonical_uri => [ str('https://my-base.com') ],
     ),
     'absolute uri provided at root; adjacent anchor has the same canonical uri',
   );
@@ -407,6 +425,8 @@ subtest 'object document' => sub {
           },
         },
       ],
+      original_uri => [ str('') ],
+      canonical_uri => [ str('https://my-base.com') ],
     ),
     'absolute uri provided at root; anchor lower down has its own canonical uri',
   );
@@ -981,7 +1001,7 @@ subtest 'custom metaschema_uri' => sub {
   memory_cycle_ok($js, 'no leaks in the evaluator object');
 };
 
-subtest 'multiple uris used for resolution and identification' => sub {
+subtest 'multiple uris used for resolution and identification, and original_uri' => sub {
   my $js = JSON::Schema::Modern->new;
   my $doc = $js->add_document(
     'https://example.com/api/' => JSON::Schema::Modern::Document->new(
@@ -999,6 +1019,7 @@ subtest 'multiple uris used for resolution and identification' => sub {
   cmp_deeply(
     $doc,
     listmethods(
+      original_uri => [ str('staging/') ],
       canonical_uri => [ str('staging/alpha.json') ],
       resource_index => unordered_pairs(
         'staging/alpha.json' => {