#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2016 -- leonerd@leonerd.org.uk

package Net::Prometheus;

use strict;
use warnings;

our $VERSION = '0.02';

use Carp;

use List::Util 1.29 qw( pairmap );

use Net::Prometheus::Gauge;
use Net::Prometheus::Counter;
use Net::Prometheus::Summary;

=head1 NAME

C<Net::Prometheus> - export monitoring metrics for F<prometheus>

=head1 SYNOPSIS

   use Net::Prometheus;

   my $client = Net::Prometheus->new;

   my $counter = $client->new_counter(
      name => "requests",
      help => "Number of received requests",
   );

   sub handle_request
   {
      $counter->inc;
      ...
   }

   use Plack::Builder;

   builder {
      mount "/metrics" => $client->psgi_app;
      ...
   }

=head1 DESCRIPTION

This module provides the ability for a program to collect monitoring metrics
and export them to the F<prometheus.io> monitoring server.

As C<prometheus> will expect to collect the metrics by making an HTTP request,
facilities are provided to yield a L<PSGI> application that the containing
program can embed in its own structure to provide the results, or the
application can generate a plain-text result directly and serve them by its
own means.

=cut

=head1 CONSTRUCTOR

=cut

=head2 new

   $prometheus = Net::Prometheus->new;

Returns a new C<Net::Prometheus> instance.

=cut

sub new
{
   my $class = shift;

   return bless {
      collectors => [],
   }, $class;
}

=head1 METHODS

=cut

=head2 register

=cut

sub register
{
   my $self = shift;
   my ( $collector ) = @_;

   # TODO: ban duplicate registration

   push @{ $self->{collectors} }, $collector;

   return $collector;
}

=head2 unregister

=cut

sub unregister
{
   my $self = shift;
   my ( $collector ) = @_;

   my $found;
   @{ $self->{collectors} } = grep {
      not( $_ == $collector and $found++ )
   } @{ $self->{collectors} };

   $found or
      croak "No such collector";
}

=head2 new_gauge

   $gauge = $prometheus->new_gauge( %args )

Constructs a new L<Net::Prometheus::Gauge> using the arguments given and
registers it with the exporter. The newly-constructed gauge is returned.

=cut

sub new_gauge
{
   my $self = shift;
   my %args = @_;

   return $self->register( Net::Prometheus::Gauge->new( %args ) );
}

=head2 new_counter

   $counter = $prometheus->new_counter( %args )

Constructs a new L<Net::Prometheus::Counter> using the arguments given and
registers it with the exporter. The newly-constructed counter is returned.

=cut

sub new_counter
{
   my $self = shift;
   my %args = @_;

   return $self->register( Net::Prometheus::Counter->new( %args ) );
}

=head2 new_summary

   $summary = $prometheus->new_summary( %args )

Constructs a new L<Net::Prometheus::Summary> using the arguments given
and registers it with the exporter. The newly-constructed summary is returned.

=cut

sub new_summary
{
   my $self = shift;
   my %args = @_;

   return $self->register( Net::Prometheus::Summary->new( %args ) );
}

=head2 render

   $str = $prometheus->render

Returns a string in the Prometheus text exposition format containing the
current values of all the registered metrics.

=cut

sub _render_label_value
{
   my ( $v ) = @_;

   $v =~ s/(["\\])/\\$1/g;
   $v =~ s/\n/\\n/g;

   return qq("$v");
}

sub _render_labels
{
   my ( $labels ) = @_;

   return "" if !scalar @$labels;

   return "{" .
      join( ",", pairmap { $a . "=" . _render_label_value( $b ) } @$labels ) .
      "}";
}

sub render
{
   my $self = shift;

   my $collectors = $self->{collectors};

   return join "", map {
      my $metricsamples = $_;

      my $fullname = $metricsamples->fullname;

      "# HELP $fullname " . $metricsamples->help . "\n",
      "# TYPE $fullname " . $metricsamples->type . "\n",
      map {
         my $sample = $_;
         sprintf "%s%s %s\n",
            $sample->varname,
            _render_labels( $sample->labels ),
            $sample->value
      } @{ $metricsamples->samples }
   } map { $_->collect } @$collectors;
}

=head2 psgi_app

   $app = $prometheus->psgi_app

Returns a new L<PSGI> application as a C<CODE> reference. This application
will render the metrics in the Prometheus text exposition format, suitable for
scraping by the Prometheus collector.

This application will respond to any C<GET> request, and reject requests for
any other method.

=cut

sub psgi_app
{
   my $self = shift;

   return sub {
      my $env = shift;
      my $method = $env->{REQUEST_METHOD};

      $method eq "GET" or return [
         405,
         [ "Content-Type" => "text/plain" ],
         [ "Method $method not supported" ],
      ];

      return [
         200,
         [ "Content-Type" => "text/plain" ],
         [ $self->render ],
      ];
   };
}

=head1 TODO

=over 8

=item *

Document the Collector / Metric distinction. Document how to make custom
Collectors

=item *

Process collector.

=item *

Callback gauges.

=item *

Split Registry out from toplevel instance.

=item *

Write some actual example programs.

=back

=cut

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;
