view release on metacpan or  search on metacpan

lib/App/Netdisco/Util/Web.pm  view on Meta::CPAN

package App::Netdisco::Util::Web;

use strict;
use warnings;

use Dancer ':syntax';
use Dancer::Plugin::DBIC 'schema';

use Time::Piece;
use Time::Seconds;
use HTML::Entities ();
use URI ();
use URI::QueryParam ();

use base 'Exporter';
our @EXPORT = ();
our @EXPORT_OK = qw/
  sort_port sort_modules
  interval_to_daterange
  sql_match
  request_is_device
  request_is_api
  request_is_api_report
  request_is_api_search
  device_display_name
  page_title
  pane_chrome
  pane_history_header
  escape_for_script_context
  escape_results_token
/;
our %EXPORT_TAGS = (all => \@EXPORT_OK);

=head1 NAME

App::Netdisco::Util::Web

=head1 DESCRIPTION

A set of helper subroutines to support parts of the Netdisco application.

There are no default exports, however the C<:all> tag will export all
subroutines.

=head1 EXPORT_OK

=head2 request_is_device

Client has requested device content under C<.../device> or C<.../device/ports>.

=cut

sub request_is_device {
  return (
    index(request->path, uri_for('/device')->path) == 0
      or
    index(request->path, uri_for('/ajax/content/device/details')->path) == 0
      or
    index(request->path, uri_for('/ajax/content/device/ports')->path) == 0
  );
}

=head2 request_is_api

Client has requested JSON format data and an endpoint under C</api>.

=cut

sub request_is_api {
  # /api/ paths are always API endpoints regardless of Accept header
  return 1 if index(request->path, uri_for('/api/')->path) == 0;
  # for other paths, require Accept: json and a return_url pointing to /api/
  return ((request->accept and request->accept =~ m/(?:json|javascript)/)
    and param('return_url')
    and index(param('return_url'), uri_for('/api/')->path) == 0);
}

=head2 request_is_api_report

Same as C<request_is_api> but also requires path to start "C</api/v1/report/...>".

=cut

sub request_is_api_report {
  return (request_is_api and (
    index(request->path, uri_for('/api/v1/report/')->path) == 0
      or
    (param('return_url')
    and index(param('return_url'), uri_for('/api/v1/report/')->path) == 0)
  ));

lib/App/Netdisco/Util/Web.pm  view on Meta::CPAN

  # between the tab asked for and the tab of the page htmx is leaving
  my $leaving_tab = $leaving ? $leaving->query_param('tab') : undef;

  return ('HX-Push-Url' => $url)
    if defined $leaving_tab and $leaving_tab ne $tab;

  return ('HX-Replace-Url' => $url);
}

# htmx sends the address bar contents with every request it makes
sub _htmx_current_url {
  my $current = request->env->{'HTTP_HX_CURRENT_URL'} or return undef;
  return URI->new($current);
}

=head2 pane_chrome( $page, $tab )

The chrome around the C<$tab> pane of C<$page> that changes with the tab: the
CSV download link, and on the device page the sidebar reset link. Returned as
C<hx-swap-oob> markup for the same response that carries the pane, so that one
answer paints the pane and everything around it.

Returns the empty string where the page shell carries neither, which is also
what an unregistered tag gets. That is not tidiness: htmx drops an out-of-band
element naming an id the page does not have, and says nothing at all about it,
so C<netdisco.js> reports the shortfall as a script error.

The sidebar itself is deliberately absent. Whether a tab has one is declared by
the sidebar templates, both by which of them exist on an include path that
site-local plugins extend and by two of them reporting that they carry only
hidden fields, so no route can answer it without duplicating template text.

=cut

sub pane_chrome {
  my ($page, $tab) = @_;
  my $config = _tab_config($page, $tab) or return '';

  return join '', _csv_download_link($page, $tab, $config),
                  _sidebar_reset_link($page, $tab);
}

# The device and search shells render the anchor for every tab and show or hide
# it per tab; the report and admin shells render it only where the tab offers a
# download, and give the job queue and the port log a different set of controls
# in the same corner.
sub _csv_download_link {
  my ($page, $tab, $config) = @_;

  if ($page eq 'report' or $page eq 'admin') {
    return '' unless $config->{'provides_csv'};
    return '' if $tab eq 'portlog' or $tab eq 'jobqueue';
  }

  my $query = request->env->{'QUERY_STRING'} || '';
  my $href = uri_for("/ajax/content/$page/$tab")->path
    . (length $query ? ('?'. $query) : '');

  return _oob_anchor('nd_csv-download', $href,
    ($config->{'provides_csv'} ? '' : ' hidden'),
    ' download="'. _escape_attr("netdisco-$page-$tab.csv") .'"',
    '<i id="nd_csv-download-icon" class="text-info far fa-file-lines fa-lg"'
    .' rel="tooltip" data-bs-placement="left" data-bs-title="Download as CSV"></i>');
}

# the fields each device tab offers, in the order the sidebar renders them, so
# that the reset address reads the way it did when the browser built it
my %RESET_FIELDS = (
  ports  => [qw/q f partial invert/],
  netmap => [qw/q/],
);

# only the device page has a reset anchor, and only for the two tabs whose
# sidebar has anything to reset. Nothing is emitted for the others, which is
# what the shell does today: the anchor keeps the address it last had, behind a
# sidebar those tabs hide anyway.
sub _sidebar_reset_link {
  my ($page, $tab) = @_;
  return '' unless $page eq 'device';

  my $fields = $RESET_FIELDS{ $tab } or return '';

  my $uri = URI->new( uri_for('/device')->path );
  $uri->query_form(tab => $tab, reset => 'on', firstsearch => 'on',
    map  {; ($_ => scalar param($_)) }
    grep {; defined scalar param($_) } @$fields);

  return _oob_anchor('nd_sidebar-reset-link', $uri->as_string, '', '',
    '<i class="nd_sidebar-reset fas fa-arrow-rotate-left"'
    .' rel="tooltip" data-bs-placement="left" data-bs-title="Reset to Defaults"'
    .' data-bs-container="body"></i>');
}

sub _oob_anchor {
  my ($id, $href, $hidden, $extra, $content) = @_;

  return '<a id="'. $id .'" hx-swap-oob="true"'. $hidden
    .' href="'. _escape_attr($href) .'"'. $extra .'>'. $content .'</a>';
}

sub _escape_attr {
  return HTML::Entities::encode_entities(shift, q{<>&"'});
}

=head2 escape_for_script_context( $json )

Makes a JSON string safe to embed as a JavaScript literal inside an HTML
C<< <script> >> element, which is how the report and search templates ship
their result sets. Returns anything that is not a defined plain scalar
unchanged, so a resultset or an arrayref passed to a CSV or API template is
left alone.

=cut

sub escape_for_script_context {
  my $json = shift;
  return $json if (not defined $json) or ref $json;

  # Inside a script element the HTML parser ends the element at "</" and
  # changes state at "<!--" and "<script", none of which it stops doing just
  # because the sequence sits inside a JavaScript string. Escaping every "<"
  # covers all three. Both JSON.parse and the JavaScript parser read the
  # escape back as "<", so the data the page receives is unchanged.
  $json =~ s/</\\u003C/g;

  # Not an HTML concern. This JSON is emitted as JavaScript source rather than
  # parsed from a string, and these two characters are line terminators there.
  $json =~ s/\x{2028}/\\u2028/g;
  $json =~ s/\x{2029}/\\u2029/g;

  return $json;
}

=head2 escape_results_token( $tokens )

Applies C<escape_for_script_context> to the C<results> token of a template
token hash, in place, and returns the hash.

Only when the key is already there. The API serializer chooses between
emitting C<results> alone and walking the whole token hash on C<exists
$tokens-E<gt>{results}>, and a handler that renders without that token, as
node search does, needs the second. Assigning unconditionally would
autovivify the key and silently move such a handler onto the first branch.

=cut

sub escape_results_token {
  my $tokens = shift;
  return $tokens unless (ref {} eq ref $tokens) and exists $tokens->{results};

  $tokens->{results} = escape_for_script_context( $tokens->{results} );
  return $tokens;
}

1;