#  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::Metric;

use strict;
use warnings;

our $VERSION = '0.01';

use Carp;
our @CARP_NOT = qw( Net::Prometheus );

=head1 NAME

C<Net::Prometheus::Metric> - the base class for observed metrics

=head1 DESCRIPTION

This class provides the basic methods shared by the concrete subclasses,

=over 2

=item *

L<Net::Prometheus::Gauge>

=item *

L<Net::Prometheus::Counter>

=item *

L<Net::Prometheus::Summary>

=back

=cut

sub make_childlabel_method
{
   my $class = shift;
   my ( $method ) = @_;

   no strict 'refs';
   *{"${class}::${method}"} = sub {
      my $self = shift;
      $self->labels( splice @_, 0, $self->labelcount )->$method( @_ );
   };
}

=head1 CONSTRUCTOR

=cut

=head2 new

   $metric = Net::Prometheus::Metric->new(
      name => $name,
      help => $help,
   )

The constructor is not normally used directly by instrumented code. Instead it
is more common to use one of the C<new_*> methods on the containing
L<Net::Prometheus> client instance.

   $metric = $prometheus->new_counter(
      name => $name,
      help => $help,
   )

In either case, it returns a newly-constructed metric.

Takes the following named arguments:

=over

=item namespace => STR

=item subsystem => STR

Optional strings giving the namespace and subsystem name parts of the variable
name.

=item name => STR

The basename of the exported variable.

=item help => STR

Descriptive help text for the variable.

=item labels => ARRAY of STR

Optional ARRAY reference giving the names of labels for the metric.

=back

=cut

sub new
{
   my $class = shift;
   my %args = @_;

   my $fullname = join "_", grep { defined } $args{namespace}, $args{subsystem}, $args{name};

   defined $args{help} or
      croak "Required 'help' argument missing";

   return bless {
      fullname => $fullname,
      help => $args{help},
      labels => $args{labels} // [],
   }, $class;
}

=head1 METHODS

=cut

=head2 fullname

   $fullname = $metric->fullname

Returns the full name for the metric. This is formed by joining any of the
defined values for C<namespace>, C<subsystem> and C<name> with C<'_'>.

=cut

sub fullname
{
   my $self = shift;
   return $self->{fullname};
}

=head2 labelcount

   $labels = $metric->labelcount

Returns the number of labels defined for this metric.

=cut

sub labelcount
{
   my $self = shift;
   return scalar @{ $self->{labels} };
}

=head2 labels

   $child = $metric->labels( @values )

Returns a child metric to represent the general one with the given set of
labels. This object may be cached for efficiency.

The child instance supports the same methods to control the value of the
reported metric as the parent metric object, except that any label values are
already provided.

=cut

sub labels
{
   my $self = shift;
   my @values = @_;

   my $labelcount = $self->labelcount;
   @values >= $labelcount or
      croak "Insufficient values given for labels";
   @values == $labelcount or
      croak "Too many values given for labels";

   # Encode \x00 or \x01 as \x{01}0 or \x{01}1 in order to escape the \x00 but
   # preserve full leixcal ordering
   $_ =~ s/\x01/\x011/g, $_ =~ s/\x00/\x010/g for @values;

   return Net::Prometheus::Metric::_Child->new(
      $self, join "\x00", @values,
   );
}

=head2 render

   @strs = $metric->render

Returns a list of string in the Prometheus text exposition format containing
the current values of the metric, along with the descriptive help text and
type information. These strings will individually contain their own linefeeds;
the result can be joined simply with

   $str = join "", $metric->render

=cut

sub _render_value
{
   my $self = shift;
   my ( $varname, $labelkey, $value ) = @_;

   return "$varname $value\n" if $labelkey eq "";

   my $labels = $self->{labels};
   my @labvalues = split m/\x00/, $labelkey;

   return $varname . "{" . join( ",", map {
      qq($labels->[$_]="$labvalues[$_]")
   } 0 .. $#labvalues ) . "} $value\n";
}

sub render
{
   my $self = shift;

   my $fullname = $self->fullname;
   my $type = $self->_type;

   return
      "# HELP $fullname $self->{help}\n",
      "# TYPE $fullname $type\n";
}

package
   Net::Prometheus::Metric::_Child;

use constant {
   METRIC   => 0,
   LABELKEY => 1,
};

sub new
{
   my $class = shift;
   my ( $metric, $labelkey ) = @_;
   return bless [ $metric, $labelkey ], $class;
}

foreach my $method (qw( set inc dec observe )) {
   my $childmethod = "_${method}_child";

   no strict 'refs';
   *$method = sub {
      my $self = shift;
      $self->[METRIC]->$childmethod( $self->[LABELKEY], @_ );
   };
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;
