view release on metacpan or  search on metacpan

lib/CallBackery/Config.pm  view on Meta::CPAN

EXAMPLE_END
                _sub => sub {
                    if ($_[0] =~ /^\s*([0-9a-f]{3,6})\s*$/i){
                        $_[0] = '#'.lc($1);
                    }
                    return undef;
                }
            }
        },
        '/PLUGIN:\s*\S+/' => {
            _order => 1,
            _doc => 'Plugins providing appliance specific funtionality',
            _vars => [qw(module)],
            _mandatory => [qw(module)],
            module => {
                _sub => sub {
                    eval {
                        $_[0] = $self->loadAndNewPlugin($_[0]);
                    };
                    if ($@){
                        return "Failed to load Plugin $_[0]: $@";
                    }
                    return undef;
                },
                _dyn => sub {
                    my $var   = shift;
                    my $module = shift;
                    $module = $self->loadAndNewPlugin($module) if not ref $module;
                    my $tree  = shift;
                    my $grammar = $module->grammar();
                    push @{$grammar->{_vars}}, 'module';
                    for my $key (keys %$grammar){
                        $tree->{$key} = $grammar->{$key};
                    }
                },
                _dyndoc => $pluginList,
            },
        }
    };
};

sub makeParser {
    my $self = shift;
    my $parser =  Config::Grammar::Dynamic->new($self->grammar);
    return $parser;
}

=head2 getTranslations

Load translations from po files

=cut

sub getTranslations {
    my $self = shift;
    my $cfg = shift || {};
    my %lx;
    my $path = $cfg->{path} // $self->app->home->rel_file("share");
    my $po = new Locale::PO();
    for my $file (glob(File::Spec->catdir($path, '*.po'))) {
        my ($volume, $localePath, $localeName) = File::Spec->splitpath($file);
        my $locale = $localeName;
        $locale =~ s/\.po$//;
        my $lang = $locale;
        $lang =~ s/_.+//;
        local $_; # since load_file_ashash modifies $_ and does not localize it
        my $href = Locale::PO->load_file_ashash($file, 'utf8');
        for my $key (keys %$href) {
            my $o = $href->{$key};
            my $id  = $po->dequote($o->msgid);
            my $str = $po->dequote($o->msgstr);
            next unless $id;
            $lx{$locale}{$id} = $str;
        }
    }
    return \%lx;
}

=head2 postProcessCfg

Post process the configuration data into a format that is easily used
by the application.

=cut

sub postProcessCfg {
    my $self = shift;
    my $cfg = $self->cfgHash;
    # only postprocess once
    return $cfg if $cfg->{PLUGIN}{list};
    my %plugin;
    my @pluginOrder;
    for my $section (sort keys %$cfg){
        my $sec = $cfg->{$section};
        next unless ref $sec eq 'HASH'; # skip non hash stuff
        for my $key (keys %$sec){
            next unless ref $sec->{$key} eq 'HASH' and $sec->{$key}{_text};
            $sec->{$key} = $sec->{$key}{_text};
        }
        if ($section =~ /^PLUGIN:\s*(.+)/){
            my $name = $1;
            $pluginOrder[$sec->{_order}] = $name;
            delete $sec->{_order};
            my $obj = $cfg->{PLUGIN}{prototype}{$name} = $sec->{module};
            delete $sec->{module};
            $obj->config($sec);
            $obj->name($name);
            $obj->app($self->app);
            $obj->massageConfig($cfg);
            # cleanup the config
            delete $cfg->{$section};
        }
        $cfg->{PLUGIN}{list} = \@pluginOrder;
    }
    # rename section
    # delete returns the value of the deleted hash element
    if (exists $cfg->{'FRONTEND-COLORS'}) {
        $cfg->{FRONTEND}{COLORS} = $cfg->{'FRONTEND-COLORS'};
        delete $cfg->{'FRONTEND-COLORS'};
    }
    $cfg->{FRONTEND}{TRANSLATIONS} = $self->getTranslations();
    return $cfg;
}

=head2 instantiatePlugin(pluginName,userObj,args)

create a new instance of this plugin prototype

=cut

sub _getPluginObject {
    my $self = shift;
    my $name = shift;