New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Keyword.pm in branches/UKMO/r5936_restart_datestamp/NEMOGCM/EXTERNAL/fcm/lib/Fcm – NEMO

source: branches/UKMO/r5936_restart_datestamp/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword.pm @ 7114

Last change on this file since 7114 was 7114, checked in by jcastill, 7 years ago

Changes as in UKMO/restart_datestamp@6336

File size: 12.1 KB
Line 
1# ------------------------------------------------------------------------------
2# (C) Crown copyright Met Office. All rights reserved.
3# For further details please refer to the file COPYRIGHT.txt
4# which you should have received as part of this distribution.
5# ------------------------------------------------------------------------------
6use strict;
7use warnings;
8
9package Fcm::Keyword;
10
11use Carp qw{croak};
12use Fcm::Config;
13use Fcm::Exception;
14use Fcm::Keyword::Config;
15use Fcm::Keyword::Exception;
16use URI;
17
18my $ENTRIES;
19
20my $PREFIX_OF_LOCATION_KEYWORD = 'fcm';
21my $PATTERN_OF_RESERVED_REVISION_KEYWORDS
22    = qr{\A (?:\d+|HEAD|BASE|COMMITTED|PREV|\{[^\}]+\}) \z}ixms;
23
24################################################################################
25# Returns the Fcm::Keyword::Entries object for storing the location entries
26sub get_entries {
27    my ($reset) = @_;
28    if ($reset || !$ENTRIES) {
29        $ENTRIES = Fcm::Keyword::Config::get_entries('LOCATION_ENTRIES');
30    }
31    return $ENTRIES;
32}
33
34################################################################################
35# Returns a list of Fcm::Keyword::Entry::Location objects matching $in_loc
36sub get_location_entries_for {
37    my ($in_loc) = @_;
38    my ($loc, $rev, @entry_trail_refs) = _parse_loc($in_loc);
39    return (map {$_->[0]} @entry_trail_refs);
40}
41
42################################################################################
43# Returns the prefix of location keyword (with or without the delimiter).
44sub get_prefix_of_location_keyword {
45    my ($with_delimiter) = @_;
46    return $PREFIX_OF_LOCATION_KEYWORD . ($with_delimiter ? ':' : '');
47}
48
49################################################################################
50# Expands (the keywords in) the specfied location (and REV), and returns them
51sub expand {
52    my ($in_loc, $in_rev) = @_;
53    my ($loc, $rev) = _expand($in_loc, $in_rev);
54    return _unparse_loc($loc, $rev, $in_rev);
55}
56
57################################################################################
58# Returns the corresponding browser URL for the input VC location
59sub get_browser_url {
60    my ($in_loc, $in_rev) = @_;
61
62    my ($loc, $rev, @entry_trail_refs) = _expand($in_loc, $in_rev);
63    if (!@entry_trail_refs) {
64        croak(Fcm::Keyword::Exception->new({message => sprintf(
65            "%s: cannot be mapped to a browser URL", $in_loc,
66        )}));
67    }
68
69    my @entries = map {$_->[0]} @entry_trail_refs;
70    my $location_component_pattern
71        = _get_browser_url_setting(\@entries, 'location_component_pattern');
72    my $browser_url_template
73        = _get_browser_url_setting(\@entries, 'browser_url_template');
74    my $browser_rev_template
75        = _get_browser_url_setting(\@entries, 'browser_rev_template');
76
77    if (
78           $location_component_pattern
79        && $browser_url_template
80        && $browser_rev_template
81    ) {
82        my $uri = URI->new($loc);
83        my $sps = $uri->opaque();
84        my @matches = $sps =~ $location_component_pattern;
85        if (@matches) {
86            my $result = $browser_url_template;
87            for my $field_number (1 .. @matches) {
88                my $match = $matches[$field_number - 1];
89                $result =~ s/\{ $field_number \}/$match/xms;
90            }
91            my $rev_field = scalar(@matches) + 1;
92            if ($rev) {
93                my $rev_string = $browser_rev_template;
94                $rev_string =~ s/\{1\}/$rev/xms;
95                $result =~ s/\{ $rev_field \}/$rev_string/xms;
96            }
97            else {
98                $result =~ s/\{ $rev_field \}//xms;
99            }
100            return $result;
101        }
102    }
103    else {
104        croak(Fcm::Keyword::Exception->new({message => sprintf(
105            "%s: mapping templates not defined correctly", $in_loc,
106        )}));
107    }
108}
109
110################################################################################
111# Returns a browser URL setting, helper function for get_browser_url()
112sub _get_browser_url_setting {
113    my ($entries_ref, $setting) = @_;
114    my $getter = "get_$setting";
115    for my $entry (@{$entries_ref}) {
116        my $setting = $entry->$getter();
117        if ($setting) {
118            return $setting;
119        }
120    }
121    my $config = Fcm::Config->instance();
122    return $config->setting('URL_BROWSER_MAPPING_DEFAULT', uc($setting));
123}
124
125################################################################################
126# Un-expands the specfied location (and REV) to keywords, and returns them
127sub unexpand {
128    my ($in_loc, $in_rev) = @_;
129    my ($loc, $rev, @entry_trail_refs) = _parse_loc($in_loc, $in_rev);
130    if (@entry_trail_refs) {
131        my ($entry, $trail) = @{$entry_trail_refs[0]};
132        if ($rev) {
133            GET_REV_KEY:
134            for my $entry_trail_ref (@entry_trail_refs) {
135                my ($e, $t) = @{$entry_trail_ref};
136                my $rev_key
137                    = $e->get_revision_entries()->get_entry_by_value($rev);
138                if ($rev_key) {
139                    $rev = $rev_key->get_key();
140                    last GET_REV_KEY;
141                }
142            }
143        }
144        $loc = get_prefix_of_location_keyword(1) . $entry->get_key() . $trail;
145        return _unparse_loc($loc, $rev, $in_rev);
146    }
147    return _unparse_loc($in_loc, $in_rev, $in_rev);
148}
149
150################################################################################
151# Expands (the keywords in) the specfied location (and REV), and returns them
152sub _expand {
153    my ($in_loc, $in_rev) = @_;
154    my ($loc, $rev, @entry_trail_refs) = _parse_loc($in_loc, $in_rev);
155    if (@entry_trail_refs) {
156        my ($entry, $trail) = @{$entry_trail_refs[0]};
157        $loc = $entry->get_value() . $trail;
158        if ($rev && $rev !~ $PATTERN_OF_RESERVED_REVISION_KEYWORDS) {
159            my $r;
160            GET_REV:
161            for my $entry_trail_ref (@entry_trail_refs) {
162                my ($e, $t) = @{$entry_trail_ref};
163                $r = $e->get_revision_entries()->get_entry_by_key($rev);
164                if ($r) {
165                    $rev = $r->get_value();
166                    last GET_REV;
167                }
168            }
169            if (!$r) {
170                croak(Fcm::Keyword::Exception->new({message => sprintf(
171                    "%s: %s: unknown revision keyword",
172                    $loc, $rev,
173                )}));
174            }
175        }
176    }
177    return ($loc, $rev, @entry_trail_refs);
178}
179
180################################################################################
181# Parses $in_loc (and $in_rev)
182sub _parse_loc {
183    my ($in_loc, $in_rev) = @_;
184    if (!$in_loc) {
185        croak(Fcm::Exception->new({
186            message => 'internal error: $in_loc not defined',
187        }));
188    }
189    if ($in_loc) {
190        if (!defined($in_rev)) {
191            my ($loc, $rev) = $in_loc =~ qr{\A (.+) \@ ([^/\@]+) \z}xms;
192            if ($loc && $rev) {
193                return ($loc, $rev, _get_loc_entry($loc));
194            }
195            else {
196                return ($in_loc, $in_rev, _get_loc_entry($in_loc));
197            }
198        }
199        return ($in_loc, $in_rev, _get_loc_entry($in_loc));
200    }
201    return;
202}
203
204################################################################################
205# Returns a list of keyword entries/trailing path pairs for the input location
206sub _get_loc_entry {
207    my ($loc) = @_;
208    if ($loc) {
209        my $uri = URI->new($loc);
210        if (
211               $uri->scheme()
212            && $uri->scheme() eq get_prefix_of_location_keyword()
213        ) {
214            my ($key, $trail) = $uri->opaque() =~ qr{\A ([^/\@]+) (.*) \z}xms;
215            my $entry = get_entries()->get_entry_by_key($key);
216            if (!$entry || !$entry->get_value()) {
217                die(Fcm::Keyword::Exception->new({message => sprintf(
218                    "%s: unknown FCM location keyword", $loc,
219                )}));
220            }
221            $loc = $entry->get_value() . ($trail ? $trail : q{});
222        }
223        my @entry_trail_pairs = ();
224        my $lead = $loc;
225        GET_ENTRY:
226        while ($lead) {
227            my $entry = get_entries()->get_entry_by_value($lead);
228            if ($entry) {
229                my $trail = substr($loc, length($lead));
230                push @entry_trail_pairs, [$entry, $trail];
231            }
232            if (!($lead =~ s{/+ [^/]* \z}{}xms)) {
233                last GET_ENTRY;
234            }
235        }
236        if (@entry_trail_pairs) {
237            return @entry_trail_pairs;
238        }
239        else {
240            return;
241        }
242    }
243    return;
244}
245
246################################################################################
247# If $in_rev, returns (LOC, REV). Otherwise, returns LOC@REV
248sub _unparse_loc {
249    my ($loc, $rev, $in_rev) = @_;
250    if (!$loc) {
251        return;
252    }
253    return ($in_rev ? ($loc, $rev) : join(q{@}, $loc, ($rev ? $rev : ())));
254}
255
2561;
257__END__
258
259=head1 NAME
260
261Fcm::Keyword
262
263=head1 SYNOPSIS
264
265    use Fcm::Keyword;
266
267    $loc = Fcm::Keyword::expand('fcm:namespace/path@rev-keyword');
268    $loc = Fcm::Keyword::unexpand('svn://host/namespace/path@1234');
269
270    ($loc, $rev) = Fcm::Keyword::expand('fcm:namespace/path', 'rev-keyword');
271    ($loc, $rev) = Fcm::Keyword::unexpand('svn://host/namespace/path', 1234);
272
273    $loc = Fcm::Keyword::get_browser_url('fcm:namespace/path');
274    $loc = Fcm::Keyword::get_browser_url('svn://host/namespace/path');
275
276    $loc = Fcm::Keyword::get_browser_url('fcm:namespace/path@1234');
277    $loc = Fcm::Keyword::get_browser_url('svn://host/namespace/path@1234');
278
279    $loc = Fcm::Keyword::get_browser_url('fcm:namespace/path', 1234);
280    $loc = Fcm::Keyword::get_browser_url('svn://host/namespace/path', 1234);
281
282    $entries = Fcm::Keyword::get_entries();
283
284=head1 DESCRIPTION
285
286This module contains utilities to expand and unexpand FCM location and revision
287keywords.
288
289=head1 FUNCTIONS
290
291=over 4
292
293=item expand($loc)
294
295Expands FCM keywords in $loc and returns the result.
296
297If $loc is a I<fcm> scheme URI, the leading part (before any "/" or "@"
298characters) of the URI opaque is the namespace of a FCM location keyword. This
299is expanded into the actual value. Optionally, $loc can be suffixed with a peg
300revision (an "@" followed by any characters). If a peg revision is a FCM
301revision keyword, it is expanded into the actual revision.
302
303=item expand($loc,$rev)
304
305Same as C<expand($loc)>, but $loc should not contain a peg revision. Returns a
306list containing the expanded version of $loc and $rev.
307
308=item get_browser_url($loc)
309
310Given a repository $loc in a known keyword namespace, returns the corresponding
311URL for the code browser.
312
313Optionally, $loc can be suffixed with a peg revision (an "@" followed by any
314characters).
315
316=item get_browser_url($loc,$rev)
317
318Same as get_browser_url($loc), but the revision should be specified using $rev
319but not pegged with $loc.
320
321=item get_entries([$reset])
322
323Returns the L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object for storing
324location keyword entries. If $reset if true, reloads the entries.
325
326=item get_location_entries_for($loc)
327
328Returns a list of L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>
329objects matching $loc.
330
331=item get_prefix_of_location_keyword($with_delimiter)
332
333Returns the prefix of a FCM location keyword, (currently "fcm"). If
334$with_delimiter is specified and is true, returns the prefix with the delimiter,
335(currently "fcm:").
336
337=item unexpand($loc)
338
339Does the opposite of expand($loc). Returns the FCM location keyword equivalence
340of $loc. If the $loc can be mapped using 2 or more namespaces, the namespace
341that results in the longest substitution is used. Optionally, $loc can be
342suffixed with a peg revision (an "@" followed by any characters). If a peg
343revision is a known revision, it is turned into its corresponding revision
344keyword.
345
346=item unexpand($loc,$rev)
347
348Same as unexpand($loc), but $loc should not contain a peg revision. Returns a
349list containing the unexpanded version of $loc and $rev
350
351=back
352
353=head1 DIAGNOSTICS
354
355=over 4
356
357=item L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>
358
359Functions in this module may die() with this exception when it fails to expand
360a keyword.
361
362=back
363
364=head1 SEE ALSO
365
366L<Fcm::Keyword::Config|Fcm::Keyword::Config>,
367L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
368L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
369L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>,
370L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>
371
372=head1 COPYRIGHT
373
374E<169> Crown copyright Met Office. All rights reserved.
375
376=cut
Note: See TracBrowser for help on using the repository browser.