view release on metacpan or  search on metacpan

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

# $Id: Config.pm 539 2013-12-09 22:28:11Z oetiker $
package CallBackery::Config;

=head1 NAME

CallBackery::Config - get parse configuration file for CallBackery

=head1 SYNOPSIS

 use Nq::Config;
 my $cfg = CallBackery::Config->new(file=>$file);
 my $hash_ref = $cfg->cfgHash();
 my $pod = $cfg->pod();

=head1 DESCRIPTION

CallBackery gets much of its configuration from this config file.

=cut

use Mojo::Base -base,-async_await, -signatures;
use CallBackery::Exception qw(mkerror);
use CallBackery::Translate qw(trm);
use Config::Grammar::Dynamic;
use Carp;
use autodie;
use File::Spec;
use Locale::PO;
use Mojo::Promise;
use Mojo::Loader qw(load_class);
use Mojo::JSON qw(true false);
use Mojo::Exception;
use Scalar::Util qw(blessed);
# use Devel::Cycle;

=head2 file

the name of the config file

=cut

has file => sub { croak "the file parameter is mandatory" };

has secretFile => sub ($self) {
    my $secretFile = $self->file.'.secret';
    if (not -f $secretFile){
        open my $rand, '>', $secretFile;
        chmod 0600,$secretFile;
        print $rand sprintf('%x%x',int(rand()*1e14),int(rand()*1e14));
        close $rand;
        chmod 0400,$secretFile;
    }
    return $secretFile;
};

has app => sub { croak "the app parameter is mandatory" }, weak => 1;

has log => sub {
    shift->app->log;
};

=head2 cfgHash

a hash containing the data from the config file

=cut

has cfgHash => sub {
    my $self = shift;
    my $cfg_file = shift;
    my $parser = $self->makeParser();
    my $cfg = $parser->parse($self->file, {encoding => 'utf8'}) or croak($parser->{err});
    # the grammar is self referential, so we need to clean it up
    $self->grammar(undef);
    return $cfg;
};

=head2 pod

returns a pod documenting the config file

=cut

has pod => sub {
    my $self = shift;
    my $parser = $self->makeParser();
    my $E = '=';
    my $footer = <<"FOOTER";

${E}head1 COPYRIGHT

Copyright (c) 2014 by OETIKER+PARTNER AG. All rights reserved.

${E}head1 AUTHOR

S<Tobias Oetiker E<lt>tobi\@oetiker.chE<gt>>
S<Fritz Zaucker E<lt>fritz.zaucker\@oetiker.chE<gt>>

${E}head1 HISTORY

 2014-01-11 to 1.0 first version
 2014-04-29 fz 1.1 implement plugin path

FOOTER
    my $header = <<"HEADER";
${E}head1 NAME

callbackery.cfg - The Appliance FRONTEND Builder config file

${E}head1 SYNOPSIS

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

    open my $fh ,'<', \$config;
    my $zip = Archive::Zip->new();
    $zip->readFromFileHandle($fh);
    my %stateFileCache;
    for my $member ($zip->members){
        for ($member->fileName){
            /^\{DATABASE\}$/ && do {
                $self->log->warn("Restoring Database!");
                $self->app->database->mojoSqlDb->disconnect;
                unlink glob $cfg->{BACKEND}{cfg_db}.'*';
                $member->extractToFileNamed($cfg->{BACKEND}{cfg_db});
                last;
            };
            /^\{DATABASEDUMP\}$/ && do {
                $self->log->warn("Restoring Database Dump!");
                $self->app->database->mojoSqlDb->disconnect;
                unlink glob $cfg->{BACKEND}{cfg_db}.'*';
                open my $sqlite, '|-', '/usr/bin/sqlite3',$cfg->{BACKEND}{cfg_db};
                my $sql = $member->contents();
                $sql =~ s/0$//; # for some reason the dump ends in 0
                print $sqlite $sql;
                close $sqlite;
                last;
            };
            m/^\{PLUGINSTATE\.([^.]+)\}(.+)/ && do {
                my $plugin = $1;
                my $file = $2;
                if (not $stateFileCache{$plugin}){
                    my $obj = eval {
                         $self->instantiatePlugin($plugin,$user);
                    };
                    if (not $obj){
                        $self->log->warn("Ignoring $file from plugin $plugin since the plugin is not available here.");
                        next;
                    }
                    $stateFileCache{$plugin} = { map { $_ => 1 } @{$obj->stateFiles} };
                };
                if ($stateFileCache{$plugin}{$file}){
                    $member->extractToFileNamed($file);
                }
                else {
                    $self->log->warn("Ignoring $file from archive since it is not listed in $plugin stateFiles.");
                }
            }
        }
    }
    $self->reConfigure;
}

=head2 $cfg->reConfigure()

Regenerate all the template based configuration files using input from the database.

=cut

sub reConfigure {
    my $self = shift;
    my $secretFile = $self->secretFile;
    if (not -f $secretFile){
        open my $rand, '>', $secretFile;
        chmod 0600,$secretFile;
        print $rand sprintf('%x%x',int(rand()*1e14),int(rand()*1e14));
        close $rand;
        chmod 0400,$secretFile;
    }
    for my $obj (@{$self->configPlugins}){
        $obj->reConfigure;
    }
}

=head2 $cfg->unConfigure()

Restore the system to unconfigured state. By removing the
configuration database, unlinking all user supplied configuration
files and regenerating all template based configuration files with
empty input.

=cut

sub unConfigure {
    no autodie;
    my $self = shift;
    my $cfg = $self->cfgHash;
    $self->log->debug("unlinking config database ".$cfg->{BACKEND}{cfg_db});
    unlink $cfg->{BACKEND}{cfg_db} if -f $cfg->{BACKEND}{cfg_db};
    open my $gen, '>', $cfg->{BACKEND}{cfg_db}.'.flush';
    close $gen;
    #get 'clean' config files
    $self->reConfigure();
    # and now remove all state
    for my $obj (@{$self->configPlugins}){
        for my $file (@{$obj->stateFiles},@{$obj->unConfigureFiles}) {
            next if not -f $file;
            $self->log->debug('['.$obj->name."] unlinking $file");
            unlink $file;
        }
    }
    unlink $cfg->{BACKEND}{log_file} if defined $cfg->{BACKEND}{log_file} and -f $cfg->{BACKEND}{log_file} ;
    unlink $self->secretFile if -f $self->secretFile;
    system "sync";
}

=head2 $cfg->promisify(xxx)

always return a promise resolving to the value

=cut

sub promisify {
    my $self = shift;
    my $value = shift;
    if (eval { blessed $value && $value->isa('Mojo::Promise') }){
        return $value;
    }

    return Mojo::Promise->resolve($value);
}

=head2 $cfg->promiseDeath(xxx)

die when there is a promise response

=cut