view release on metacpan or  search on metacpan

lib/Morpheus/Plugin/File.pm  view on Meta::CPAN

package Morpheus::Plugin::File;
{
  $Morpheus::Plugin::File::VERSION = '0.46';
}
use strict;

# ABSTRACT: plugin reading perl-based configs

use base qw(Morpheus::Plugin::Content);

use Morpheus;
use File::Find;
use Params::Validate;

sub new {
    my $class = shift;
    my $self = validate(@_, {
        path => { default => sub { morph('/morpheus/plugin/file/options/path') } },
        suffix => { default => qr/(?:\.(-?\d+))?\.(?:cfg|conf)$/ },
    });

    if (ref $self->{suffix} eq "Regexp") {
        my $re = $self->{suffix};
        $self->{suffix} = sub {
            my $fname = shift;
            $fname =~ s/$re// or return;
            return ($fname, $1);
        };
    }

    bless $self => $class;
}

sub content ($$) {
    my ($self, $file) = @_;
    open my $fh, "<", "$file" or die "open '$file' failed: $!";
    my $content = do { local $/; <$fh> };
    close $fh or die "close '$file' failed: $!";
    return $content;
}

sub list ($$) {
    my ($self, $main_ns) = @_;
    $main_ns =~ s{^/+}{};

    my $paths = $self->{path};
    $paths = $paths->() if ref $paths eq "CODE";
    return () unless $paths;
    die unless ref $paths eq "ARRAY";
    #FIXME: cache those paths?
    
    my $suffix = $self->{suffix};

    my @list;
    for my $path (@{$paths}) {
        $path =~ s{/+$}{};
        my %list;

        my $process_file = sub ($;$) {
            my ($full_file, $desired_ns) = @_;
            -f $full_file or return;
            die 'mystery' unless $full_file =~ m{^\Q$path\E/(.*)};
            my $file = $1;
            my ($ns, $priority) = $suffix->($file);
            return if not $ns or $desired_ns and $ns ne $desired_ns;
            push @{$list{$ns}}, {
                file => $full_file,
                priority => $priority || 0,
            };
        };

        if (-d "$path/$main_ns") {
            find({
                no_chdir => 1,
                follow_skip => 2,
                wanted => sub { $process_file->($File::Find::name) },
            }, "$path/$main_ns");
        }

        my $ns = $main_ns;
        while ($ns) {
            for my $file (glob ("$path/$ns*")) { # $ns.cfg or $ns.10.cfg but not $ns-blah.cfg
                $process_file->($file, $ns);
            }
            $ns =~ s{/?[^/]+$}{};
        }

        for my $ns (sort { length $b <=> length $a } keys %list) {
            for (sort { $b->{priority} <=> $a->{priority} } @{$list{$ns}}) {
                push @list, $ns => $_->{file};
            }