Xavier Guimard
10 years ago
parent
29da93cbf4
commit
74105ced92
@ -0,0 +1,397 @@ |
||||
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 Data::Dumper; |
||||
use Regexp::Assemble; |
||||
use JSON; |
||||
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 ); |
||||
|
||||
my @managerAttrKeys = qw(keyTest type test msgFail default); |
||||
my $format = 'Creating %-69s: '; |
||||
my $reIgnoreKeys = qr/^$/; |
||||
|
||||
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 |
||||
) |
||||
]; |
||||
}; |
||||
|
||||
sub run { |
||||
my $self = shift; |
||||
$self = __PACKAGE__->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 $0. 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 = Dumper($defaultValues); |
||||
$defaultAttr =~ s/^\$VAR1\s*=/sub defaultValues {\n return/; |
||||
$defaultAttr = "# This file is generated by $0. 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 = Dumper($managerAttr); |
||||
$managerAttr =~ s/^\$VAR1\s*=/sub attributes {\n return/; |
||||
my $managerTypes = |
||||
Dumper( Lemonldap::NG::Manager::Build::Attributes::types() ); |
||||
$managerTypes =~ s/^\$VAR1\s*=/sub types {\n return/; |
||||
$managerAttr = "# This file is generated by $0. 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"; |
||||
} |
||||
|
||||
sub scanTree { |
||||
my ( $self, $tree, $json, $prefix, $path ) = splice @_; |
||||
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; |
||||
} |
||||
|
||||
#if ( $opts{f} ) { |
||||
# my $js = getData( $prefix . $leaf ); |
||||
#} |
||||
} |
||||
else { |
||||
#if ( $opts{f} ) { |
||||
# my $file = $jleaf->{get} // $jleaf->{title}; |
||||
# my $js = getData($file); |
||||
# $jleaf->{get} = $file = $file . ".json"; |
||||
# open F, ">app/confs/$opts{f}/$file" |
||||
# or die $!; |
||||
# print F $js; |
||||
# close F; |
||||
#} |
||||
if ( $prefix and !$jleaf->{get} ) { |
||||
$jleaf->{get} = $prefix . $jleaf->{title}; |
||||
} |
||||
} |
||||
push @$json, $jleaf; |
||||
} |
||||
} |
||||
} |
||||
|
||||
__END__ |
||||
sub getData { |
||||
die $opts{f} unless $opts{f} =~ /^\d+$/; |
||||
my $k = shift; |
||||
my $q = "/confs/$opts{f}/$k"; |
||||
return $run->( |
||||
{ |
||||
HTTP_ACCEPT => 'application/json', |
||||
PATH_INFO => $q, |
||||
QUERY_STRING => '', |
||||
REQUEST_URI => $q, |
||||
REQUEST_METHOD => 'GET', |
||||
} |
||||
)->[2]->[0]; |
||||
} |
||||
|
||||
1; |
||||
Loading…
Reference in new issue