view release on metacpan or  search on metacpan

lib/Developer/Dashboard/Web/App.pm  view on Meta::CPAN

      );
    my $script_html = $hide_indicators ? q{} : <<'HTML';
<script>
(function() {
  function renderTopStatus(items) {
    return (items || []).map(function(row) {
      return '<span id="status-' + row.prog + '">' + row.status + row.alias + '</span> ';
    }).join('');
  }
  function updateTopStatus(payload) {
    if (!payload || !payload.array) return;
    var top = document.getElementById('status-on-top');
    if (top) top.innerHTML = renderTopStatus(payload.array);
  }
  setInterval(function() {
    fetch('/system/status', { headers: { 'Accept': 'application/json' } })
      .then(function(res) { return res.json(); })
      .then(updateTopStatus)
      .catch(function() {});
  }, 5000);
  function pad(value) {
    return String(value).padStart(2, '0');
  }
  function updateDateTime() {
    var node = document.getElementById('status-datetime');
    if (!node) return;
    var now = new Date();
    node.textContent = now.getFullYear() + '-' +
      pad(now.getMonth() + 1) + '-' +
      pad(now.getDate()) + ' ' +
      pad(now.getHours()) + ':' +
      pad(now.getMinutes()) + ':' +
      pad(now.getSeconds());
  }
  updateDateTime();
  setInterval(updateDateTime, 1000);
})();
</script>
HTML
    return sprintf <<'HTML', $share_html, $nav_html, $right_html, $script_html;
<div class="dd-top-chrome" style="display:flex;justify-content:space-between;gap:16px;align-items:flex-start;margin-bottom:16px;padding-bottom:12px;border-bottom:1px solid #ddd3c2">
  <div>
    %s
    %s
  </div>
  %s
</div>
%s
HTML
}

# _top_context_html($page)
# Builds the old-style top-right user, host, and date context line for browser chrome.
# Input: page document object.
# Output: HTML snippet string.
sub _top_context_html {
    my ( $self, $page ) = @_;
    my $ctx = $page->{meta}{request_context} || {};
    my $user = (
        ( $ctx->{tier} || '' ) eq 'helper' && ( $ctx->{username} || '' ) ne ''
    ) ? $ctx->{username} : ( $ENV{USER} || eval { getpwuid($<) } || 'user' );
    my $host = $ctx->{host} || '';
    $host =~ s/^https?:\/\///;
    $host =~ s/\/.*$//;
    my ( $host_only, $port ) = split /:/, $host, 2;
    my $machine_ip = $self->_machine_ip || $host_only || $ctx->{remote_addr} || '127.0.0.1';
    my $host_href = 'http://' . $machine_ip . ( defined $port && $port ne '' ? ':' . $port : '' );
    my $now = strftime '%Y-%m-%d %H:%M:%S', localtime;
    return sprintf q{<span class="user-name-and-icon">&#128129;&#127996; %s</span> <span id="status-server">&#128187; <a href="%s">%s</a></span> &#128467; <span id="status-datetime">%s</span><br>},
      _escape_html($user),
      _escape_html($host_href),
      _escape_html($machine_ip),
      _escape_html($now);
}

# _machine_ip()
# Discovers the preferred machine IPv4 address, preferring VPN-style interfaces before other global addresses.
# Input: none.
# Output: IPv4 address string or undef when unavailable.
sub _machine_ip {
    my ($self) = @_;
    my @candidates = $self->_ip_candidates;
    return $candidates[0] if @candidates;
    return;
}

# _ip_candidates()
# Collects candidate machine IPv4 addresses from system network interfaces.
# Input: none.
# Output: ordered list of IPv4 address strings.
sub _ip_candidates {
    my ($self) = @_;
    my @pairs = $self->_ip_interface_pairs;
    my @vpn;
    my @preferred;
    my @other;
    for my $pair (@pairs) {
        push @other, $pair->{ip};
        push @vpn, $pair->{ip} if $pair->{iface} =~ /^(?:tun|tap|ppp|utun|wg|vpn)/i;
        push @preferred, $pair->{ip} if $pair->{iface} =~ /^(?:eth|en|wlan|wl)/i;
    }
    my %seen;
    return grep { !$seen{$_}++ } ( @vpn, @preferred, @other );
}

# _ip_interface_pairs()
# Reads active global IPv4 interface/address pairs from the host system.
# Input: none.
# Output: list of hashes with iface and ip keys.
sub _ip_interface_pairs {
    my ($self) = @_;
    my @pairs = $self->_ip_pairs_from_ip;
    return @pairs if @pairs;
    @pairs = $self->_ip_pairs_from_ipconfig;
    return @pairs if @pairs;
    return $self->_ip_pairs_from_ifconfig;
}

# _ip_pairs_from_ip()
# Reads IPv4 interface/address pairs using the `ip` command when available.
# Input: none.