File Coverage

blib/lib/Quote/LineProtocol.pm

Criterion	Covered	Total	%
statement	48	56	85.7
branch	20	38	52.6
condition	3	10	30.0
subroutine	9	10	90.0
pod	4	4	100.0
total	84	118	71.1

package Quote::LineProtocol;

use v5.26;
use warnings;
use Time::Moment;
use Scalar::Util 'blessed';
use Syntax::Keyword::Match;

use Exporter 'import';
our @EXPORT_OK = qw(measurement tags fields timestamp);

our $VERSION = "0.1.4";
our $TELEGRAF = $ENV{QUOTE_TELEGRAF} // 0; # Telegraf requires special quoting

my $qr = qr{([,=\s])};    # Match tag and field keys, and tag values
my $qs = $TELEGRAF ? qr{(["\\,=])} : qr{(["\\,=\s])}; # Match field string values

sub measurement {
  my $str = shift;
  return $str =~ s{([,\s])}{\Q$1\E}gr;
}

sub tags {
  my (%tags) = @_;
  my @r;

  for my $key (keys %tags) {
    my $val = $tags{$key};
    $val = "$val" if blessed($val);
    next if $val eq '';
    push @r, sprintf(qq(%s=%s), $key =~ s{$qr}{\Q$1\E}gr, $val =~ s{$qr}{\Q$1\E}gr);
  }

  return join ',', @r;
}

sub fields {
  my (%fields) = @_;
  my @r;

  for my $key (sort keys %fields) {
    my $val = $fields{$key};
    $val = "$val" if blessed($val);
    next if $val eq '';
    my $type;

    if(ref $val) {
      die "Type missing or invalid for field '$key'" unless exists $val->{type} && $val->{type} =~  /^[fisbu]\z/;
      $type = $val->{type};
      $val = $val->{value};
      die "Type is UInt but value is negative, '$key' = '$val'" if $type eq 'u' && $val < 0;
    }
    else {
      match($val : =~) {
        case(/^-?[0-9]+\.[0-9]+$/) {
          $type = 'f';
        }
        case(/^-?[0-9]+$/) {
          $type = 'i';
        }
        case(/\w+/) {
          $type = 's';
        }
      }
    }

    match($type : eq) {
      case('f') {
        push @r, sprintf(qq(%s=%s),   $key =~ s{$qr}{\Q$1\E}gr, $val);
      }
      case('i') {
        push @r, sprintf(qq(%s=%di),  $key =~ s{$qr}{\Q$1\E}gr, $val);
      }
      case('u') {
        push @r, sprintf(qq(%s=%du),  $key =~ s{$qr}{\Q$1\E}gr, $val);
      }
      case('s') {
        push @r, sprintf(qq)%s="%s"), $key =~ s{$qr}{\Q$1\E}gr, $val =~ s{$qs}{\Q$1\E}gr);
      }
      case('b') {
        push @r, sprintf(qq(%s=%s),   $key =~ s{$qr}{\Q$1\E}gr, $val);
      }
      default {
        push @r, sprintf(qq(%s="%s"), $key =~ s{$qr}{\Q$1\E}gr, $val =~ s{$qs}{\Q$1\E}gr);
      }
    }
  }

  return join ',', @r;
}

sub timestamp {
  my ($unit, $utc) = @_;
  $utc //= 0;
  $unit //= '';
  my $now = $utc ? Time::Moment->now_utc : Time::Moment->now;
  return sprintf("%d", sprintf("%d%d", $now->epoch, $unit eq 'ns' ? $now->nanosecond
                                                  : $unit eq 'us' ? $now->microsecond
                                                  : $unit eq 'ms' ? $now->millisecond
                                                  : $now->nanosecond));
}

1;
__END__