view release on metacpan or  search on metacpan

bin/device-chip-sensor-exporter  view on Meta::CPAN

      # Config file is YAML and can override a number of settings, and add chips
      my $config = YAML::LoadFile( $path );

      if( $config->{adapters} ) {
         foreach my $c ( ( delete $config->{adapters} )->@* ) {
            my $type = delete $c->{type} // croak "Expected adapter config to have a 'type'";
            my $chips = delete $c->{chips} // croak "Expected adapter config to have a 'chips'";

            # TODO: It'd be really nice if Device::Chip::Adapter->make( $type, %opts ) existed
            my $desc = $type . join( ":", "", map { "$_=$c->{$_}" } sort keys %$c );
            my $adapter = Device::Chip::Adapter->new_from_description( $desc );

            foreach my $c ( $chips->@* ) {
               my ( $type, %config ) = ( reftype($c)//"" eq "HASH" )
                  ? ( delete $c->{type}, $c->%* )
                  : ( $c, () );

               $self->add_chip(
                  type      => $type,
                  adapter   => $adapter,
                  mountopts => $config{mountopts},
                  config    => $config{config},
               );
            }
         }
      }

      if( exists $config->{port} ) {
         $PORT = $config->{port};
         delete $config->{port};
      }

      foreach my $opt (qw( interval best_effort filter )) {
         exists $config->{$opt} and
            $self->$opt = delete $config->{$opt};
      }

      # Legacy support
      exists $config->{mid3} and
         $self->filter = "mid3", delete $config->{mid3};

      die "Unrecognised config file items " . join( ", ", sort keys %$config ) . "\n"
         if keys %$config;
   }

   async method after_sensors :override ( @sensors )
   {
      my %got;

      foreach my $sensor ( @sensors ) {
         my $name = $sensor->name;
         my $units = $sensor->units;

         my $chip = $sensor->chip;
         my $chipname = ( ref $chip ) =~ s/^Device::Chip:://r;

         # Convert some common characters that Prometheus will get upset by
         if( defined $units ) {
            $units =~ s{/}{_per_};

            $units =~ s/%/percentage/g;
            $units =~ s/°/degrees/g;
            $units =~ s/µ/micro/g;

            $units =~ s/m²/square_metre/g;
            $units =~ s/m³/cubic_metre/g;
         }

         $got{$name}++ and next;

         my $m = "make_" . $sensor->type;
         $metrics->$m( $name,
            name        => join( "_", "sensor", $name, grep { defined } $units ),
            description => "Sensor $name",
            labels      => [qw( chip )],
         );

         $metrics->inc_counter_by( chip_failures => 0, [ chip => $chipname ] );
      }
   }

   # Count the failures per reading round
   field %failures_per_chip;
   # Counts in total
   field %chip_failures;

   method output_readings ( $now, $sensors, $values )
   {
      if( $VERBOSE ) {
         printf "At %s\n", strftime( $STRFTIME, localtime );
         $self->print_readings( $sensors, $values );
      }

      foreach my $i ( 0 .. $#$sensors ) {
         my $sensor = $sensors->[$i];
         my $value  = $values->[$i];

         my $chip = $sensor->chip;
         my $chipname = ( ref $chip ) =~ s/^Device::Chip:://r;

         my $m = ( $sensor->type eq "gauge" )   ? "set_gauge_to" :
                 ( $sensor->type eq "counter" ) ? "inc_counter_by" :
                                                  die "Unrecognised sensor type";
         $metrics->$m( $sensor->name,
            $self->_format_reading( $sensor, $value ), [ chip => $chipname ] );
      }

      foreach my $chipaddr ( keys %failures_per_chip ) {
         if( ++$chip_failures{ $chipaddr } >= 5 ) {
            die "This sensor chip has failed 5 times in a row; aborting\n";
         }
         if( keys %chip_failures >= 3 ) {
            die "Three or more sensor chips have failed; aborting\n";
         }
      }
      undef %failures_per_chip;
   }

   method on_sensor_fail ( $sensor, $failure ) {
      $self->SUPER::on_sensor_fail( $sensor, $failure );