File Coverage

lib/Dancer/Plugin/DynamicConfig.pm

Criterion	Covered	Total	%
statement	63	66	95.4
branch	17	22	77.2
condition	3	3	100.0
subroutine	14	14	100.0
pod	1	3	33.3
total	98	108	90.7

package Dancer::Plugin::DynamicConfig;
use strict;
use warnings;
use Dancer ':syntax';
use Dancer::FileUtils qw(read_file_content);
use Dancer::ModuleLoader;
use Dancer::Plugin;
use Encode qw(encode);
use JSON::XS qw(decode_json);
use Time::HiRes;
use Try::Tiny;

our $VERSION = '0.07';

my @file_types = ({
  type => 'json',
  re => qr{\.json$},
  parser => sub {
    my ($filename) = @_;
    my $json;
    try {
      read_file_content($filename) =~ /(.*)/s; # untaint
      try {
        $json = decode_json(encode('UTF-8', $1));
      } catch {
        warning "couldn't parse json file ($filename): $_\n";
      };
    } catch {
      warning "couldn't find file to parse ($filename): $_\n";
    };
    return $json;
  },
});

my $dynamic_config;

register dynamic_config => sub {
  my ($file_key) = @_;

  initialize() unless $dynamic_config;

  if (my $fileinfo = $dynamic_config->{$file_key}) {
    my $mtime = (dc_stat($fileinfo->{path}))[9];

    if (not defined $fileinfo->{data} or $mtime > $fileinfo->{mtime}) {
      my $parsed = $fileinfo->{parser}->($fileinfo->{path});

      if (defined $parsed) {
        $fileinfo->{mtime}  = $mtime;
        $fileinfo->{data}   = $fileinfo->{rewrite_class} ? $fileinfo->{rewrite_class}->rewrite($parsed) : $parsed;
      } else {
        warning "could not parse $fileinfo->{path}";
        warning "$@" if $@;
      }
    }

    return $fileinfo->{data};
  } else {
    warning "unknown dynamic_config key [$file_key]";
  }

  return '';
};

sub reinitialize { undef $dynamic_config; initialize() }

sub initialize {
  SETTING: while (my ($file_key, $etc) = each %{ plugin_setting() }) {
    my ($path, $rewrite_class);
    if (ref $etc) {
      $path = $etc->{path};
      $rewrite_class = $etc->{rewrite_class};
    } else {
      $path = $etc;
    }

    foreach my $ft (@file_types) {
      if ($path =~ $ft->{re}) {
        $dynamic_config->{$file_key} = {
          path          => $path,
          mtime         => undef,
          data          => undef,
          type          => $ft->{type},
          parser        => $ft->{parser},
          rewrite_class => $rewrite_class,
        };

        if ($rewrite_class) {
          Dancer::ModuleLoader->load($rewrite_class) or die "Could not load $rewrite_class";
        }
        next SETTING;
      } else {
        warning "ignoring config key [$file_key]:  unknown filetype for [$path]";
        warn "ignoring config key [$file_key]:  unknown filetype for [$path]";
        # should this die? your config is so broken we can't start up
      }
    }
  }

  return;
}

sub dc_stat {
    my ($filething) = @_;

    if (defined &Time::HiRes::stat) {
        return Time::HiRes::stat($filething);
    } else {
        return stat($filething);
    }
}

register_plugin;

1;

__END__