lemonldap-ng/lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Build.pm

package Lemonldap::NG::Manager::Build;

use strict;
use Mouse;
use Lemonldap::NG::Manager::Build::Attributes;
use Lemonldap::NG::Manager::Build::Tree;
use Lemonldap::NG::Manager::Build::CTrees;
use Lemonldap::NG::Manager::Conf::Zero;
use Data::Dumper;
use Regexp::Assemble;
use JSON::MaybeXS;
use Getopt::Std;
use IO::String;

has structFile            => ( isa => 'Str', is => 'ro', required => 1 );
has confTreeFile          => ( isa => 'Str', is => 'ro', required => 1 );
has managerConstantsFile  => ( isa => 'Str', is => 'ro', required => 1 );
has managerAttributesFile => ( isa => 'Str', is => 'ro', required => 1 );
has defaultValuesFile     => ( isa => 'Str', is => 'ro', required => 1 );
has firstLmConfFile       => ( isa => 'Str', is => 'ro', required => 1 );

my @managerAttrKeys = qw(keyTest select type test msgFail default);
my $format          = 'Creating %-69s: ';
my $reIgnoreKeys    = qr/^$/;
my $module          = __PACKAGE__;

my @angularScopeVars;
my @cnodesKeys;
my %cnodesRe;
my @ignoreKeys;
my $ignoreKeys;
my $mainTree;
my @sessionTypes;
my @simpleHashKeys;

my $attributes = Lemonldap::NG::Manager::Build::Attributes::attributes();
my $jsonEnc    = JSON->new()->allow_nonref;
$jsonEnc->canonical(1);

$Data::Dumper::Sortkeys = sub {
    my ($hash) = @_;
    return [
        ( defined $hash->{id}    ? ('id')       : () ),
        ( defined $hash->{title} ? ( 'title', ) : () ),
        (
            grep { /^(?:id|title)$/ ? 0 : 1 }
              sort {
                return 1
                  if ( $a =~ /node/ and $b !~ /node/ );
                return -1 if ( $b =~ /node/ );
                lc($a) cmp lc($b);
              } keys %$hash
        )
    ];
};

$Data::Dumper::Deparse = 1;

sub run {
    my $self = shift;
    $self = $module->new(@_) unless ref $self;

    # 1. confTree.js
    printf STDERR $format, $self->confTreeFile;
    $mainTree = Lemonldap::NG::Manager::Build::CTrees::cTrees();

    my $script =
        'function templates(tpl,key){'
      . 'var ind;'
      . 'var scalarTemplate=function(r){'
      . 'return{'
      . '"id":tpl+"s/"+(ind++),'
      . '"title":r,'
      . '"get":tpl+"s/"+key+"/"+r};};'
      . 'switch(tpl){';

    # To build confTree.js, each special node is scanned from
    # Lemonldap::NG::Manager::Build::CTrees
    foreach my $node ( sort keys %$mainTree ) {
        @cnodesKeys = ();
        my $jsonTree = [];
        $self->scanTree( $mainTree->{$node}, $jsonTree, '__KEY__', '' );
        my $tmp = $jsonEnc->encode($jsonTree);
        $tmp =~ s!"__KEY__!tpl+"s/"+key+"/"+"!mg;
        $tmp =~ s/"(true|false)"/$1/sg;
        $tmp =~ s/:\s*"(\d+)"\s*(["\}])/:$1$2/sg;
        $script .= "case'$node':return$tmp;";

        # Second step, Manager/Constants.pm file will contain datas issued from
        # this scan
        my $ra = Regexp::Assemble->new;

        # Build $oidcOPMetaDataNodeKeys, $samlSPMetaDataNodeKeys,...
        foreach my $r (@cnodesKeys) {
            $ra->add($r);
        }
        $cnodesRe{$node} = $ra->as_string;

        push @ignoreKeys, $node;
    }
    $script .= 'default:return [];}}';
    open F, ">", $self->confTreeFile or die $!;
    print F $script;
    close F;
    print STDERR "done\n";
    my $ra = Regexp::Assemble->new;
    foreach my $re (@ignoreKeys) {
        $ra->add($re);
    }
    $ignoreKeys   = $ra->as_string;
    $reIgnoreKeys = $ra->re;

    # 2. struct.json
    printf STDERR $format, $self->structFile;
    $mainTree = Lemonldap::NG::Manager::Build::Tree::tree();
    my $jsonTree = [];
    $self->scanTree( $mainTree, $jsonTree, '', '' );
    $script = 'function setScopeVars(scope){';
    foreach my $v (@angularScopeVars) {
        $script .= "scope.$v->[0]=scope$v->[1];scope.getKey(scope.$v->[0]);";
    }
    $script .= '}';
    open F, ">>", $self->confTreeFile || die $!;
    print F $script;
    close F;
    open F, ">", $self->structFile || die $!;
    my $tmp = $jsonEnc->encode($jsonTree);
    $tmp =~ s/"(true|false)"/$1/sg;
    $tmp =~ s/:\s*"(\d+)"\s*(["\}])/:$1$2/sg;
    print F $tmp;
    close F;
    print STDERR "done\n";
    $tmp = undef;

    printf STDERR $format, $self->managerConstantsFile;
    my $sessionTypes = join( "', '", @sessionTypes );

    open F, ">", $self->managerConstantsFile or die($!);
    my $exportedVars =
        '$'
      . join( 'Keys $', 'simpleHash', 'specialNode', sort keys %cnodesRe )
      . 'Keys $specialNodeHash @sessionTypes';
    print F <<EOF;
# This file is generated by $module. Don't modify it by hand
package Lemonldap::NG::Manager::Constants;

use strict;
use Exporter 'import';
use base qw(Exporter);

our \$VERSION = '$Lemonldap::NG::Manager::Build::Attributes::VERSION';

our %EXPORT_TAGS = ( 'all' => [qw($exportedVars)] );
our \@EXPORT_OK   = ( \@{ \$EXPORT_TAGS{'all'} } );
our \@EXPORT      = ( \@{ \$EXPORT_TAGS{'all'} } );

our \$specialNodeHash = {
    virtualHosts         => [qw(exportedHeaders locationRules post vhostOptions)],
    samlIDPMetaDataNodes => [qw(samlIDPMetaDataXML samlIDPMetaDataExportedAttributes samlIDPMetaDataOptions)],
    samlSPMetaDataNodes  => [qw(samlSPMetaDataXML samlSPMetaDataExportedAttributes samlSPMetaDataOptions)],
    oidcOPMetaDataNodes  => [qw(oidcOPMetaDataJSON oidcOPMetaDataJWKS oidcOPMetaDataOptions oidcOPMetaDataExportedVars)],
    oidcRPMetaDataNodes  => [qw(oidcRPMetaDataOptions oidcRPMetaDataExportedVars)],
};

our \@sessionTypes = ( '$sessionTypes' );

EOF

    $ra = Regexp::Assemble->new;
    foreach (@simpleHashKeys) {
        $ra->add($_);
    }
    print F "our \$simpleHashKeys = '" . $ra->as_string . "';\n"
      . "our \$specialNodeKeys = '${ignoreKeys}s';\n";
    foreach ( sort keys %cnodesRe ) {
        print F "our \$${_}Keys = '$cnodesRe{$_}';\n";
    }

    print F "\n1;\n";
    close F;
    print STDERR "done\n";

    printf STDERR $format, $self->defaultValuesFile;
    my $defaultValues = {
        map {
            defined $attributes->{$_}->{default}
              ? ( $_ => $attributes->{$_}->{default} )
              : ()
        } keys(%$attributes)
    };
    my $defaultAttr = mydump( $defaultValues, 'defaultValues' );
    $defaultAttr = "# This file is generated by $module. Don't modify it by hand
package Lemonldap::NG::Common::Conf::DefaultValues;

our \$VERSION = '$Lemonldap::NG::Manager::Build::Attributes::VERSION';

$defaultAttr}

1;
";

    my $dst;

    eval {
        require Perl::Tidy;
        Perl::Tidy::perltidy(
            source      => IO::String->new($defaultAttr),
            destination => \$dst
        );
    };
    $dst = $defaultAttr if ($@);

    open( F, ">", $self->defaultValuesFile ) or die($!);
    print F $dst;
    close F;
    print STDERR "done\n";

    printf STDERR $format, $self->managerAttributesFile;
    my $managerAttr = {
        map {
            my @r;
            foreach my $f (@managerAttrKeys) {
                push @r, $f, $attributes->{$_}->{$f}
                  if ( defined $attributes->{$_}->{$f} );
            }
            ( $_ => {@r} );
        } keys(%$attributes)
    };
    $managerAttr = mydump( $managerAttr, 'attributes' );
    my $managerTypes =
      mydump( Lemonldap::NG::Manager::Build::Attributes::types(), 'types' );
    $managerAttr = "# This file is generated by $module. Don't modify it by hand
package Lemonldap::NG::Manager::Attributes;

our \$VERSION = '$Lemonldap::NG::Manager::Build::Attributes::VERSION';

$managerTypes}

$managerAttr}

";
    eval {
        Perl::Tidy::perltidy(
            source      => IO::String->new($managerAttr),
            destination => \$dst
        );
    };
    $dst = $managerAttr if ($@);

    open( F, ">", $self->managerAttributesFile ) or die($!);
    print F $dst;
    close F;
    print STDERR "done\n";

    $self->buildZeroConf();
}

sub buildZeroConf {
    my $self = shift;
    $jsonEnc->pretty(1);
    printf STDERR $format, $self->firstLmConfFile;
    open( F, '>', $self->firstLmConfFile ) or die($!);
    print F $jsonEnc->encode(
        Lemonldap::NG::Manager::Conf::Zero::zeroConf(
            '__DNSDOMAIN__',   '__SESSIONDIR__',
            '__PSESSIONDIR__', '__NOTIFICATIONDIR__'
        )
    );
    close F;
    print STDERR "done\n";
}

sub mydump {
    my ( $obj, $subname ) = @_;
    my $t = Dumper($obj);
    $t =~ s/^\s*(?:use strict;|package .*?;|)\n//gm;
    $t =~ s/^\$VAR1\s*=/sub $subname {\n    return/;
    return $t;
}

sub scanTree {
    my ( $self, $tree, $json, $prefix, $path ) = @_;
    unless ( ref($tree) eq 'ARRAY' ) {
        die 'Not an array';
    }
    $prefix //= '';
    my $ord = -1;
    my $nodeName = $path ? '_nodes' : 'data';
    foreach my $leaf (@$tree) {
        $ord++;
        my $jleaf = {};

        # Grouped leaf
        if ( ref($leaf) and $leaf->{group} ) {
            die "'form' is required when using 'group'"
              unless ( $leaf->{form} );
            push @$json,
              {
                id    => "$prefix$leaf->{title}",
                title => $leaf->{title},
                type  => $leaf->{form},
                get   => $leaf->{group}
              };
        }

        # Subnode
        elsif ( ref($leaf) ) {
            $jleaf->{title} = $jleaf->{id} = $leaf->{title};
            $jleaf->{type} = $leaf->{form} if ( $leaf->{form} );
            foreach my $n (qw(nodes nodes_cond)) {
                if ( $leaf->{$n} ) {
                    $jleaf->{"_$n"} = [];
                    $self->scanTree( $leaf->{$n}, $jleaf->{"_$n"}, $prefix,
                        "$path.$nodeName\[$ord\]" );
                    if ( $n eq 'nodes_cond' ) {
                        foreach my $sn ( @{ $jleaf->{"_$n"} } ) {
                            $sn->{show} = 'false';
                        }
                    }
                }
            }
            $jleaf->{help} = $leaf->{help} if ( $leaf->{help} );
            $jleaf->{_nodes_filter} = $leaf->{nodes_filter}
              if ( $leaf->{nodes_filter} );
            push @$json, $jleaf;
        }

        # Leaf
        else {
            # Get data type and build tree
            #
            # Types : PerlModule bool boolOrExpr catAndAppList file hostname int
            # keyTextContainer lmAttrOrMacro longtext openidServerList pcre
            # rulesContainer samlAssertion samlAttributeContainer samlService
            # select text trool url virtualHostContainer word
            # password

            if ( $leaf =~ s/^\*// ) {
                push @angularScopeVars, [ $leaf, "$path._nodes[$ord]" ];
            }
            push @sessionTypes, $1
              if ( $leaf =~ /^(.*)(?<!notification)StorageOptions$/ );
            my $attr = $attributes->{$leaf} or die("Missing attribute $leaf");
            $jleaf = { id => "$prefix$leaf", title => $leaf };
            unless ( $attr->{type} ) {
                print STDERR "Fatal: no type: $leaf\n";
                exit;
            }

            # TODO: change this
            $attr->{type} =~
              s/^(?:url|word|pcre|lmAttrOrMacro|hostname|PerlModule)$/text/;
            $jleaf->{type} = $attr->{type} if ( $attr->{type} ne 'text' );
            foreach my $w (qw(default select get template)) {
                $jleaf->{$w} = $attr->{$w} if ( defined $attr->{$w} );
            }
            if ( $jleaf->{default} and ref( $jleaf->{default} ) ) {
                $jleaf->{default} = [];
                my $type = $attr->{type};
                $type =~ s/Container//;
                foreach my $k ( sort keys( %{ $attr->{default} } ) ) {
                    push @{ $jleaf->{default} },
                      {
                        id    => "$prefix$leaf/$k",
                        title => $k,
                        type  => $type,
                        data  => $attr->{default}->{$k},
                        (
                            $type eq 'rule'
                            ? ( re => $k )
                            : ()
                        ),
                      };
                }
            }
            if ($prefix) {
                push @cnodesKeys, $leaf;
            }
            if ( $attr->{type} =~ /^(?:catAndAppList|\w+Container)$/ ) {
                $jleaf->{cnodes} = $prefix . $leaf;
                unless ( $prefix or $leaf =~ $reIgnoreKeys ) {
                    push @simpleHashKeys, $leaf;
                }
            }
            else {
                if ( $prefix and !$jleaf->{get} ) {
                    $jleaf->{get} = $prefix . $jleaf->{title};
                }
            }
            push @$json, $jleaf;
        }
    }
}

1;
__END__

=head1 NAME

=encoding utf8

Lemonldap::NG::Manager::Build - Static files generator of Lemonldap::NG Web-SSO
system.

=head1 SYNOPSIS

  use Lemonldap::NG::Manager::Build;
  
  Lemonldap::NG::Manager::Build->run(
    structFile            => "site/static/struct.json",
    confTreeFile          => "site/static/js/conftree.js",
    managerConstantsFile  => "lib/Lemonldap/NG/Manager/Constants.pm",
    managerAttributesFile => 'lib/Lemonldap/NG/Manager/Attributes.pm',
    defaultValuesFile     => "lib/Lemonldap/NG/Common/Conf/DefaultValues.pm",
    firstLmConfFile       => "_example/conf/lmConf-1.js",
  );

=head1 DESCRIPTION

Lemonldap::NG::Manager::Build is used only to build javascript files and
Lemonldap::NG constants Perl files. It has to be launched after each change.

=head2 DEVELOPPER CORNER

To add a new parameter, you have to:

=over

=item declare it in Manager/Build/Attributes.pm;

=item declare its position in the tree in Manager/Build/Tree.pm (or
Manager/Build/CTrees.pm for complex nodes);

=item refresh files using this (or launch any build makefile target at the
root of the Lemonldap::NG project sources).

=back

See below for details.

=head3 Attribute declaration

Set your new attribute as a key of attributes() function that points to a hash
ref containing:

=over

=item type (required):

the type of the content. It must be declared in sub
types() in the same file (except if attribute embeds its own tests) and must
correspond to a form stored in the static/forms/ directory;

=item help (optional):

the relative HTML path to the help page (relative to
/doc/pages/documentation/<version>/);

=item default (recommended):

a default value to set if not defined;

=item select (optional):

required only if type is `select`. In this case, it
must contains an array of { k => <keyName>, v => <display name> } hashref

=item documentation (recommended):

some words for other developpers

=item test (optional):

if test is not defined for this type or if test must
be more restrictive, set her a regular expression or a subroutine. Arguments
passed to subroutine are (keyValue, newConf, currentKey), it returns 2
arguments: a boolean result and a message (if non empty will be displayed as
warning or error depending of result);

=item msgFail (optional):

for regexp based tests, message to display in case of
error. Words to translate have to be written as so: __toTranslate__;

=item keyTest (optional):

for keys/values attributes, test to be applied on
key;

=item keyMsgFail (optional):

for regexp based key tests, same as msgFail for
keys test;

=back

If you decide to declare a new type, you have to declare the following
properties:

=over

=item test, msgFail, keyTest, keyMsgFail as shown above,

=item form: the form to use if it doesn't have the same name.

=back

=head3 Tree positioning

The tree is now very simple: it contains nodes and leaf. Leaf are designed only
by their attribute name. All description must be done in the file described
above. Nodes are array member designed as this:

  {
    title => 'titleToTranslate',
    help  => 'helpUrl',
    form  => 'relativeUrl',
    nodes => [
      ... nodes or leaf ...
    ]
  }

Explanations:

=over

=item title (required):

it must contain an entry of static/languages/lang.json

=item help (recommended):

as above, the relative HTML path to the help page
(relative to /doc/pages/documentation/<version>/);

=item form (optional):

the name of a static/forms/<name>.html file

=item nodes:

array of sub nodes and leaf attached to this node

=item group:

must never be used in conjunction with nodes. Array of leafs only
to be displayed in the same form

=item nodes_cond:

array of sub nodes that will be displayed with a filter. Not
yet documented here, see the source code of site/static/js/filterFunctions.js.

=item nodes_filter:

filter entry in site/static/js/filterFunctions.js for the same feature.

=back

=head1 SEE ALSO

L<Lemonldap::NG::Manager>, L<http://lemonldap-ng.org/>

=head1 AUTHORS

=over

=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>

=item François-Xavier Deltombe, E<lt>fxdeltombe@gmail.com.E<gt>

=item Xavier Guimard, E<lt>x.guimard@free.frE<gt>

=item Thomas Chemineau, E<lt>thomas.chemineau@gmail.comE<gt>

=back

=head1 BUG REPORT

Use OW2 system to report bug or ask for features:
L<http://jira.ow2.org>

=head1 DOWNLOAD

Lemonldap::NG is available at
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>

=head1 COPYRIGHT AND LICENSE

=over

=item Copyright (C) 2015 by Xavier Guimard, E<lt>x.guimard@free.frE<gt>

=item Copyright (C) 2015 by Clément Oudot, E<lt>clem.oudot@gmail.comE<gt>

=back

This library is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see L<http://www.gnu.org/licenses/>.

=cut