Doxygen doc
This commit is contained in:
parent
a8601a0e5f
commit
29b8c86848
|
@ -4,30 +4,30 @@
|
||||||
# Copyright (C) 2002 Bart Schuller
|
# Copyright (C) 2002 Bart Schuller
|
||||||
# Copyright (C) 2006 Phinex Informatik AG
|
# Copyright (C) 2006 Phinex Informatik AG
|
||||||
# All Rights Reserved
|
# All Rights Reserved
|
||||||
#
|
#
|
||||||
# Doxygen Filter is free software; you can redistribute it and/or modify
|
# Doxygen Filter is free software; you can redistribute it and/or modify
|
||||||
# it under the same terms as Perl itself.
|
# it under the same terms as Perl itself.
|
||||||
#
|
#
|
||||||
# Larry Wall's 'Artistic License' for perl can be found in
|
# Larry Wall's 'Artistic License' for perl can be found in
|
||||||
# http://www.perl.com/pub/a/language/misc/Artistic.html
|
# http://www.perl.com/pub/a/language/misc/Artistic.html
|
||||||
#
|
#
|
||||||
# =======================================================================
|
# =======================================================================
|
||||||
#
|
#
|
||||||
# Author: Aeby Thomas, Phinex Informatik AG,
|
# Author: Aeby Thomas, Phinex Informatik AG,
|
||||||
# Based on DoxygenFilter from Bart Schuller
|
# Based on DoxygenFilter from Bart Schuller
|
||||||
# E-Mail: tom.aeby@phinex.ch
|
# E-Mail: tom.aeby@phinex.ch
|
||||||
#
|
#
|
||||||
# Phinex Informatik AG
|
# Phinex Informatik AG
|
||||||
# Thomas Aeby
|
# Thomas Aeby
|
||||||
# Kirchweg 52
|
# Kirchweg 52
|
||||||
# 1735 Giffers
|
# 1735 Giffers
|
||||||
#
|
#
|
||||||
# =======================================================================
|
# =======================================================================
|
||||||
#
|
#
|
||||||
# @(#) $Id: PerlFilter.pm,v 1.4 2006/01/31 17:46:06 aeby Exp $
|
# @(#) $Id: PerlFilter.pm,v 1.4 2006/01/31 17:46:06 aeby Exp $
|
||||||
#
|
#
|
||||||
# Revision History:
|
# Revision History:
|
||||||
#
|
#
|
||||||
# $Log: PerlFilter.pm,v $
|
# $Log: PerlFilter.pm,v $
|
||||||
# Revision 1.4 2006/01/31 17:46:06 aeby
|
# Revision 1.4 2006/01/31 17:46:06 aeby
|
||||||
# filter(): avoid warnings about uninitialized values
|
# filter(): avoid warnings about uninitialized values
|
||||||
|
@ -36,14 +36,13 @@
|
||||||
# Revision 1.3 2006/01/31 16:53:52 aeby
|
# Revision 1.3 2006/01/31 16:53:52 aeby
|
||||||
# added copyright info
|
# added copyright info
|
||||||
#
|
#
|
||||||
#
|
#
|
||||||
# =======================================================================
|
# =======================================================================
|
||||||
|
|
||||||
## @file
|
## @file
|
||||||
# implementation of DoxyGen::PerlFilter.
|
# implementation of DoxyGen::PerlFilter.
|
||||||
#
|
#
|
||||||
|
|
||||||
|
|
||||||
## @class
|
## @class
|
||||||
# Filter from perl syntax API docs to Doxygen-compatible syntax.
|
# Filter from perl syntax API docs to Doxygen-compatible syntax.
|
||||||
# This class is meant to be used as a filter for the
|
# This class is meant to be used as a filter for the
|
||||||
|
@ -59,44 +58,61 @@ my $id = __PACKAGE__;
|
||||||
# Do the filtering.
|
# Do the filtering.
|
||||||
# @param infh input filehandle, normally STDIN
|
# @param infh input filehandle, normally STDIN
|
||||||
sub filter {
|
sub filter {
|
||||||
my($self, $infile) = @_;
|
my ( $self, $infile ) = @_;
|
||||||
open(my $infh, $infile);
|
open( my $infh, $infile );
|
||||||
my $current_class = "";
|
my $current_class = "";
|
||||||
my $file = [];
|
my $file = [];
|
||||||
my $endMark = 1;
|
my $endMark = 1;
|
||||||
while( <$infh> ) {
|
my ( $cc, $cl, $lc, $ll ) = ( 0, 0, 0, 0 );
|
||||||
$endMark = 0 if(/\s*use\s+AutoLoader/);
|
while (<$infh>) {
|
||||||
last if($endMark and /^__END__$/);
|
$endMark = 0 if (/^\s*use\s+AutoLoader/);
|
||||||
push( @$file, $_ );
|
last if ( $endMark and /^__END__$/ );
|
||||||
|
#next if (/^$/);
|
||||||
|
$cc = ( /^\s*#/ ? 1 : 0 );
|
||||||
|
$lc = ( /[\{\}\[\];]\s*$/ ? 1 : 0 );
|
||||||
|
if ( $cc or $cl or $ll or not(@$file) ) {
|
||||||
|
push( @$file, $_ );
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$file->[ $#{$file} ] =~ s/[\r\n]/ /g;
|
||||||
|
$file->[ $#{$file} ] .= $_;
|
||||||
|
}
|
||||||
|
$cl = $cc;
|
||||||
|
$ll = $lc;
|
||||||
|
$cl++ if(/\s#/);
|
||||||
}
|
}
|
||||||
$self->file_contents( $file );
|
|
||||||
my $objcontext =
|
|
||||||
grep( /^\s*use\s+base\s/, @$file )
|
|
||||||
|| grep( /\@ISA/, @$file )
|
|
||||||
|| grep( /^\s*bless/, @$file )
|
|
||||||
|| grep( /^\s*sub\s+new\s/, @$file )
|
|
||||||
|| grep( /\$self/, @$file );
|
|
||||||
|
|
||||||
push( @$file, "" ); # in order to have a delimiting empty line at EOF
|
#print STDERR @$file;
|
||||||
for( my $line=0; $line <= $#$file; ) {
|
$self->file_contents($file);
|
||||||
$_ = $file->[$line++];
|
my $objcontext =
|
||||||
last if($endMark and /^__END__$/);
|
grep( /^\s*use\s+base\s/, @$file )
|
||||||
|
|| grep( /\@ISA/, @$file )
|
||||||
|
|| grep( /^\s*bless/, @$file )
|
||||||
|
|| grep( /^\s*sub\s+new\s/, @$file )
|
||||||
|
|| grep( /\$self/, @$file );
|
||||||
|
|
||||||
|
push( @$file, "" ); # in order to have a delimiting empty line at EOF
|
||||||
|
for ( my $line = 0 ; $line <= $#$file ; ) {
|
||||||
|
$_ = $file->[ $line++ ];
|
||||||
|
last if ( $endMark and /^__END__$/ );
|
||||||
if (/^##\s*\@(\S+)\s*(.*)/) {
|
if (/^##\s*\@(\S+)\s*(.*)/) {
|
||||||
my($command, $args) = ($1, $2);
|
my ( $command, $args ) = ( $1, $2 );
|
||||||
my @more;
|
my @more;
|
||||||
while ( $_ = $file->[$line++] ) {
|
while ( $_ = $file->[ $line++ ] ) {
|
||||||
if (/^#\s?(.+)/s) {
|
if (/^#\s?(.+)/s) {
|
||||||
push @more, $1;
|
push @more, $1;
|
||||||
} else {
|
}
|
||||||
|
else {
|
||||||
last;
|
last;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if ($command eq 'file') {
|
if ( $command eq 'file' ) {
|
||||||
$args ||= $infile;
|
$args ||= $infile;
|
||||||
$self->start("\@$command $args");
|
$self->start("\@$command $args");
|
||||||
$self->more(@more);
|
$self->more(@more);
|
||||||
$self->end;
|
$self->end;
|
||||||
} elsif ($command eq 'class') {
|
}
|
||||||
|
elsif ( $command eq 'class' ) {
|
||||||
$objcontext = 1;
|
$objcontext = 1;
|
||||||
unless ($args) {
|
unless ($args) {
|
||||||
($args) = /package\s(.*);/;
|
($args) = /package\s(.*);/;
|
||||||
|
@ -106,123 +122,146 @@ sub filter {
|
||||||
$self->print("};\n");
|
$self->print("};\n");
|
||||||
}
|
}
|
||||||
$current_class = $args;
|
$current_class = $args;
|
||||||
$self->emit_class( $args, $line, [
|
$self->emit_class( $args, $line,
|
||||||
"\@$command $args",
|
[ "\@$command $args", @more, "\@nosubgrouping" ] );
|
||||||
@more,
|
}
|
||||||
"\@nosubgrouping"
|
elsif ( $command eq 'imethod' ) {
|
||||||
] );
|
|
||||||
} elsif ($command eq 'imethod') {
|
|
||||||
unless ($args) {
|
unless ($args) {
|
||||||
($args) = $self->analyze_sub( $line-1 );
|
($args) = $self->analyze_sub( $line - 1 );
|
||||||
}
|
}
|
||||||
$args = $self->munge_parameters($args);
|
$args = $self->munge_parameters($args);
|
||||||
$self->push($self->protection($args).' Initialization Methods');
|
$self->push(
|
||||||
|
$self->protection($args) . ' Initialization Methods' );
|
||||||
$self->start("\@fn $args")->more(@more)->end;
|
$self->start("\@fn $args")->more(@more)->end;
|
||||||
$self->print($args, ";\n");
|
$self->print( $args, ";\n" );
|
||||||
$self->pop;
|
$self->pop;
|
||||||
} elsif ($command eq 'apmethod') {
|
}
|
||||||
|
elsif ( $command eq 'apmethod' ) {
|
||||||
unless ($args) {
|
unless ($args) {
|
||||||
($args) = $self->analyze_sub( $line-1 );
|
($args) = $self->analyze_sub( $line - 1 );
|
||||||
}
|
}
|
||||||
$args = $self->munge_parameters($args);
|
$args = $self->munge_parameters($args);
|
||||||
$self->push($self->protection($args).' Authentication Process Methods');
|
$self->push( $self->protection($args)
|
||||||
|
. ' Authentication Process Methods' );
|
||||||
$self->start("\@fn $args")->more(@more)->end;
|
$self->start("\@fn $args")->more(@more)->end;
|
||||||
$self->print($args, ";\n");
|
$self->print( $args, ";\n" );
|
||||||
$self->pop;
|
$self->pop;
|
||||||
} elsif ($command eq 'rmethod') {
|
}
|
||||||
|
elsif ( $command eq 'rmethod' ) {
|
||||||
unless ($args) {
|
unless ($args) {
|
||||||
($args) = $self->analyze_sub( $line-1 );
|
($args) = $self->analyze_sub( $line - 1 );
|
||||||
}
|
}
|
||||||
$args = $self->munge_parameters($args);
|
$args = $self->munge_parameters($args);
|
||||||
$self->push($self->protection($args).' Running Methods');
|
$self->push( $self->protection($args) . ' Running Methods' );
|
||||||
$self->start("\@fn $args")->more(@more)->end;
|
$self->start("\@fn $args")->more(@more)->end;
|
||||||
$self->print($args, ";\n");
|
$self->print( $args, ";\n" );
|
||||||
$self->pop;
|
$self->pop;
|
||||||
} elsif ($command eq 'cmethod') {
|
}
|
||||||
|
elsif ( $command eq 'cmethod' ) {
|
||||||
unless ($args) {
|
unless ($args) {
|
||||||
($args) = $self->analyze_sub( $line-1 );
|
($args) = $self->analyze_sub( $line - 1 );
|
||||||
}
|
}
|
||||||
$args = $self->munge_parameters($args);
|
$args = $self->munge_parameters($args);
|
||||||
$self->push($self->protection($args).' Class Methods');
|
$self->push( $self->protection($args) . ' Class Methods' );
|
||||||
$self->start("\@fn $args")->more(@more)->end;
|
$self->start("\@fn $args")->more(@more)->end;
|
||||||
$self->print($args, ";\n");
|
$self->print( $args, ";\n" );
|
||||||
$self->pop;
|
$self->pop;
|
||||||
} elsif ($command eq 'ifn') {
|
}
|
||||||
|
elsif ( $command eq 'ifn' ) {
|
||||||
unless ($args) {
|
unless ($args) {
|
||||||
($args) = $self->analyze_sub( $line-1 );
|
($args) = $self->analyze_sub( $line - 1 );
|
||||||
}
|
}
|
||||||
$args = $self->munge_parameters($args);
|
$args = $self->munge_parameters($args);
|
||||||
$self->push($self->protection($args).' Initialization Functions');
|
$self->push(
|
||||||
|
$self->protection($args) . ' Initialization Functions' );
|
||||||
$self->start("\@fn $args")->more(@more)->end;
|
$self->start("\@fn $args")->more(@more)->end;
|
||||||
$self->print($args, ";\n");
|
$self->print( $args, ";\n" );
|
||||||
$self->pop;
|
$self->pop;
|
||||||
} elsif ($command eq 'rfn') {
|
}
|
||||||
|
elsif ( $command eq 'rfn' ) {
|
||||||
unless ($args) {
|
unless ($args) {
|
||||||
($args) = $self->analyze_sub( $line-1 );
|
($args) = $self->analyze_sub( $line - 1 );
|
||||||
}
|
}
|
||||||
$args = $self->munge_parameters($args);
|
$args = $self->munge_parameters($args);
|
||||||
$self->push($self->protection($args).' Running Functions');
|
$self->push( $self->protection($args) . ' Running Functions' );
|
||||||
$self->start("\@fn $args")->more(@more)->end;
|
$self->start("\@fn $args")->more(@more)->end;
|
||||||
$self->print($args, ";\n");
|
$self->print( $args, ";\n" );
|
||||||
$self->pop;
|
$self->pop;
|
||||||
} elsif ($command eq 'fn') {
|
}
|
||||||
|
elsif ( $command eq 'fn' ) {
|
||||||
unless ($args) {
|
unless ($args) {
|
||||||
($args) = $self->analyze_sub( $line-1 );
|
($args) = $self->analyze_sub( $line - 1 );
|
||||||
}
|
}
|
||||||
$args = $self->munge_parameters($args);
|
$args = $self->munge_parameters($args);
|
||||||
$self->push($self->protection($args).' Functions');
|
$self->push( $self->protection($args) . ' Functions' );
|
||||||
$self->start("\@fn $args")->more(@more)->end;
|
$self->start("\@fn $args")->more(@more)->end;
|
||||||
$self->print($args, ";\n");
|
$self->print( $args, ";\n" );
|
||||||
$self->pop;
|
$self->pop;
|
||||||
} elsif ($command eq 'method') {
|
}
|
||||||
|
elsif ( $command eq 'method' ) {
|
||||||
unless ($args) {
|
unless ($args) {
|
||||||
($args) = $self->analyze_sub( $line-1 );
|
($args) = $self->analyze_sub( $line - 1 );
|
||||||
}
|
}
|
||||||
$args = $self->munge_parameters($args);
|
$args = $self->munge_parameters($args);
|
||||||
$self->push($self->protection($args).' Object Methods');
|
$self->push( $self->protection($args) . ' Object Methods' );
|
||||||
$self->start("\@fn $args")->more(@more)->end;
|
$self->start("\@fn $args")->more(@more)->end;
|
||||||
$self->print($args, ";\n");
|
$self->print( $args, ";\n" );
|
||||||
$self->pop;
|
$self->pop;
|
||||||
} elsif ($command eq 'enum') {
|
}
|
||||||
|
elsif ( $command eq 'enum' ) {
|
||||||
$self->start("\@$command $args");
|
$self->start("\@$command $args");
|
||||||
$self->more(@more);
|
$self->more(@more);
|
||||||
$self->end;
|
$self->end;
|
||||||
$self->print("$command $args;\n");
|
$self->print("$command $args;\n");
|
||||||
} else {
|
}
|
||||||
|
else {
|
||||||
$self->start("\@$command $args");
|
$self->start("\@$command $args");
|
||||||
$self->more(@more);
|
$self->more(@more);
|
||||||
$self->end;
|
$self->end;
|
||||||
}
|
}
|
||||||
|
|
||||||
# We ate a line when we got the rest of the comment lines
|
# We ate a line when we got the rest of the comment lines
|
||||||
redo if defined $_;
|
redo if defined $_;
|
||||||
} elsif (/^use\s+([\w:]+)/) {
|
}
|
||||||
|
elsif (/^use\s+([\w:]+)/) {
|
||||||
my $inc = $1;
|
my $inc = $1;
|
||||||
|
|
||||||
#$inc =~ s/::/\//g;
|
#$inc =~ s/::/\//g;
|
||||||
$self->print("#include \"$inc.pm\"\n");
|
$self->print("#include \"$inc.pm\"\n");
|
||||||
} elsif (/^package\s+([\w:]+)/) {
|
}
|
||||||
|
elsif (/^package\s+([\w:]+)/) {
|
||||||
if ($current_class) {
|
if ($current_class) {
|
||||||
$self->flush;
|
$self->flush;
|
||||||
$self->print("};\n");
|
$self->print("};\n");
|
||||||
}
|
}
|
||||||
next unless( $objcontext );
|
next unless ($objcontext);
|
||||||
$current_class = $1;
|
$current_class = $1;
|
||||||
$self->emit_class( $current_class, $line );
|
$self->emit_class( $current_class, $line );
|
||||||
} elsif (/^\s*sub\s+([\w:]+)/) {
|
}
|
||||||
my( $proto, $name, @args ) = $self->analyze_sub( $line-1 );
|
elsif (/^\s*sub\s+([\w:]+)/) {
|
||||||
if( $current_class && @args && ($args[0] eq "\$self") ) {
|
my ( $proto, $name, @args ) = $self->analyze_sub( $line - 1 );
|
||||||
$self->push($self->protection($proto).' Object Methods');
|
if ( $current_class && @args && ( $args[0] eq "\$self" ) ) {
|
||||||
|
$self->push( $self->protection($proto) . ' Object Methods' );
|
||||||
$proto =~ s/\$self,*\s*//;
|
$proto =~ s/\$self,*\s*//;
|
||||||
} elsif( $current_class && @args && ($args[0] eq "\$self") ) {
|
}
|
||||||
$self->push($self->protection($proto).' Initialization Methods');
|
elsif ( $current_class && @args && ( $args[0] eq "\$self" ) ) {
|
||||||
|
$self->push(
|
||||||
|
$self->protection($proto) . ' Initialization Methods' );
|
||||||
$proto =~ s/\$self,*\s*//;
|
$proto =~ s/\$self,*\s*//;
|
||||||
} elsif( $current_class
|
}
|
||||||
&& ((@args && ($args[0] eq "\$class")) || ($name eq "new")) ) {
|
elsif (
|
||||||
$self->push($self->protection($proto).' Class Methods');
|
$current_class
|
||||||
} else {
|
&& ( ( @args && ( $args[0] eq "\$class" ) )
|
||||||
$self->push($self->protection($proto).' Functions');
|
|| ( $name eq "new" ) )
|
||||||
|
)
|
||||||
|
{
|
||||||
|
$self->push( $self->protection($proto) . ' Class Methods' );
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$self->push( $self->protection($proto) . ' Functions' );
|
||||||
}
|
}
|
||||||
$proto = $self->munge_parameters($proto);
|
$proto = $self->munge_parameters($proto);
|
||||||
$self->print($proto, ";\n");
|
$self->print( $proto, ";\n" );
|
||||||
$self->pop;
|
$self->pop;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -232,8 +271,6 @@ sub filter {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
## @method @ analyze_sub( int line )
|
## @method @ analyze_sub( int line )
|
||||||
# analyzes a subroutine declaration starting at the given line. Tries
|
# analyzes a subroutine declaration starting at the given line. Tries
|
||||||
# to determine whicht arguments it takes.
|
# to determine whicht arguments it takes.
|
||||||
|
@ -242,38 +279,44 @@ sub filter {
|
||||||
# @return A function prototype, the name of the function and a
|
# @return A function prototype, the name of the function and a
|
||||||
# list of arguments it takes
|
# list of arguments it takes
|
||||||
sub analyze_sub {
|
sub analyze_sub {
|
||||||
my( $self, $line ) = @_;
|
my ( $self, $line ) = @_;
|
||||||
|
|
||||||
my $file = $self->file_contents();
|
my $file = $self->file_contents();
|
||||||
$file->[$line] =~ /sub\s+(.*)\{/;
|
$file->[$line] =~ /sub\s+(.*)\{/;
|
||||||
my $name = $1;
|
my $name = $1;
|
||||||
my $proto;
|
my $proto;
|
||||||
my @args;
|
my @args;
|
||||||
if( $name =~ /^(.*)\s*\((.*)\)/ ) {
|
if ( $name =~ /^(.*)\s*\((.*)\)/ ) {
|
||||||
$name = $1;
|
$name = $1;
|
||||||
$proto = $2;
|
$proto = $2;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
my $forward = 5;
|
my $forward = 5;
|
||||||
for( my $i=0; $forward && ($i+$line <= $#$file) && ! $proto; $i++ ) {
|
for (
|
||||||
$_ = $file->[$i+$line];
|
my $i = 0 ;
|
||||||
if( /^\s*my\s*\((.*)\)\s*=\s*\@_/ ) {
|
$forward && ( $i + $line <= $#$file ) && !$proto ;
|
||||||
|
$i++
|
||||||
|
)
|
||||||
|
{
|
||||||
|
$_ = $file->[ $i + $line ];
|
||||||
|
if (/^\s*my\s*\((.*)\)\s*=\s*\@_/) {
|
||||||
$proto = $1;
|
$proto = $1;
|
||||||
}
|
}
|
||||||
elsif( /^\s*(local|my)\s*([^\s]*)\s*=\s*shift\s*;/ ) {
|
elsif (/^\s*(local|my)\s*([^\s]*)\s*=\s*shift\s*;/) {
|
||||||
push( @args, $2 );
|
push( @args, $2 );
|
||||||
}
|
}
|
||||||
elsif( /^\s*(local|my)\s*([^\s]*)\s*=\s*\$_\[\s*(\d+)\s*]/ ) {
|
elsif (/^\s*(local|my)\s*([^\s]*)\s*=\s*\$_\[\s*(\d+)\s*]/) {
|
||||||
$args[$3] = $2;
|
$args[$3] = $2;
|
||||||
}
|
}
|
||||||
elsif( /shift\s*->\s*[a-z0-9_]+\(/ ) {
|
elsif (/shift\s*->\s*[a-z0-9_]+\(/) {
|
||||||
|
|
||||||
# assuming anonymously used shifted value is $self
|
# assuming anonymously used shifted value is $self
|
||||||
push( @args, '$self' );
|
push( @args, '$self' );
|
||||||
}
|
}
|
||||||
elsif( /^\s*\n/ || /^\s*#/ ) {
|
elsif ( /^\s*\n/ || /^\s*#/ ) {
|
||||||
;
|
;
|
||||||
}
|
}
|
||||||
elsif( /}/ ) {
|
elsif (/}/) {
|
||||||
$forward = 0;
|
$forward = 0;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
|
@ -281,22 +324,21 @@ sub analyze_sub {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if( $proto ) {
|
if ($proto) {
|
||||||
$proto =~ s/\s+//g;
|
$proto =~ s/\s+//g;
|
||||||
$proto =~ s/,/, /g;
|
$proto =~ s/,/, /g;
|
||||||
@args = split( ", ", $proto );
|
@args = split( ", ", $proto );
|
||||||
}
|
}
|
||||||
|
|
||||||
$name =~ s/\s+$//;
|
$name =~ s/\s+$//;
|
||||||
my $protection = "";
|
my $protection = "";
|
||||||
if( substr( $name, 0, 1 ) eq "_" ) {
|
if ( substr( $name, 0, 1 ) eq "_" ) {
|
||||||
$protection = "protected";
|
$protection = "protected";
|
||||||
}
|
}
|
||||||
return( "$protection retval $name( ".join(", ", @args )." )", $name, @args );
|
return ( "$protection retval $name( " . join( ", ", @args ) . " )",
|
||||||
|
$name, @args );
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
## @method emit_class( string class, int line, arrayref doc )
|
## @method emit_class( string class, int line, arrayref doc )
|
||||||
# Emit one class definition. If the doc parameter is defined,
|
# Emit one class definition. If the doc parameter is defined,
|
||||||
# emits the array as a comment just before the class definition,
|
# emits the array as a comment just before the class definition,
|
||||||
|
@ -306,69 +348,79 @@ sub analyze_sub {
|
||||||
# @param line the current line number
|
# @param line the current line number
|
||||||
# @param doc (optional) an array with comment lines
|
# @param doc (optional) an array with comment lines
|
||||||
sub emit_class {
|
sub emit_class {
|
||||||
my( $self, $class, $line, $doc ) = @_;
|
my ( $self, $class, $line, $doc ) = @_;
|
||||||
|
|
||||||
my(@current_isa, @current_priv_isa, @current_include, %links);
|
my ( @current_isa, @current_priv_isa, @current_include, %links );
|
||||||
my $file = $self->file_contents();
|
my $file = $self->file_contents();
|
||||||
while ($_ = $file->[$line++] ) {
|
while ( $_ = $file->[ $line++ ] ) {
|
||||||
if (/^\s*(?:use base|\@ISA\s*=|\@${class}::ISA\s*=)\s+(.+);/) {
|
if (/^\s*(?:use base|\@ISA\s*=|\@${class}::ISA\s*=)\s+(.+);/) {
|
||||||
push @current_isa, eval $1;
|
push @current_isa, eval $1;
|
||||||
$file->[$line-1] = "\n";
|
$file->[ $line - 1 ] = "\n";
|
||||||
} elsif (/^\s*(?:use|require)\s+([\w:]+)/) {
|
}
|
||||||
|
elsif (/^\s*(?:use|require)\s+([\w:]+)/) {
|
||||||
my $inc = $1;
|
my $inc = $1;
|
||||||
$links{$1||'public'}{$inc} = $2 . ($3 ? "\n* $3" : '') if (/#\s*link\s+(?:(private|protected|public)\s+)?(\S+)(?:\s+(.*))?\s*$/);
|
$links{ $1 || 'public' }{$inc} = $2 . ( $3 ? "\n* $3" : '' )
|
||||||
|
if (
|
||||||
|
/#\s*link\s+(?:(private|protected|public)\s+)?(\S+)(?:\s+(.*))?\s*$/
|
||||||
|
);
|
||||||
push @current_priv_isa, $inc if (/#\s*inherits/);
|
push @current_priv_isa, $inc if (/#\s*inherits/);
|
||||||
$inc =~ s/::/\//g;
|
$inc =~ s/::/\//g;
|
||||||
$inc =~ s#Lemonldap/NG/(\w+)#"lemonldap-ng-".lc($1)."/lib/Lemonldap/NG/$1"#e;
|
$inc =~
|
||||||
print STDERR $inc;
|
s#Lemonldap/NG/(\w+)#"lemonldap-ng-".lc($1)."/lib/Lemonldap/NG/$1"#e;
|
||||||
|
|
||||||
|
#print STDERR $inc;
|
||||||
push @current_include, $inc;
|
push @current_include, $inc;
|
||||||
$file->[$line-1] = "\n";
|
$file->[ $line - 1 ] = "\n";
|
||||||
} elsif (/^package/) {
|
}
|
||||||
|
elsif (/^package/) {
|
||||||
last;
|
last;
|
||||||
} elsif (/#\s*inherits\s+([\w:]+)/) {
|
}
|
||||||
|
elsif (/#\s*inherits\s+([\w:]+)/) {
|
||||||
push @current_priv_isa, $1;
|
push @current_priv_isa, $1;
|
||||||
} elsif (/#\s*link\s+([\w:]+)\s+(?:(private|protected|public)\s+)?(\S+)(?:\s+(.*))?\s*$/) {
|
}
|
||||||
$links{$2||'public'}{$1} = $3 . ($4 ? "\n* $4" : '');
|
elsif (
|
||||||
|
/#\s*link\s+([\w:]+)\s+(?:(private|protected|public)\s+)?(\S+)(?:\s+(.*))?\s*$/
|
||||||
|
)
|
||||||
|
{
|
||||||
|
$links{ $2 || 'public' }{$1} = $3 . ( $4 ? "\n* $4" : '' );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
$self->print("#include \"$_.pm\"\n") foreach @current_include;
|
$self->print("#include \"$_.pm\"\n") foreach @current_include;
|
||||||
$self->print("\n");
|
$self->print("\n");
|
||||||
|
|
||||||
if( $doc ) {
|
if ($doc) {
|
||||||
$self->start($doc->[0]);
|
$self->start( $doc->[0] );
|
||||||
$self->more( @$doc[1 .. $#$doc] );
|
$self->more( @$doc[ 1 .. $#$doc ] );
|
||||||
$self->end();
|
$self->end();
|
||||||
}
|
}
|
||||||
$self->print("class $class");
|
$self->print("class $class");
|
||||||
|
|
||||||
if (@current_isa or @current_priv_isa) {
|
if ( @current_isa or @current_priv_isa ) {
|
||||||
my @tmp;
|
my @tmp;
|
||||||
@tmp = map {"public $_"} @current_isa;
|
@tmp = map { "public $_" } @current_isa;
|
||||||
if($ENV{COLLABORATIVE_GRAPH}) {
|
if ( $ENV{COLLABORATIVE_GRAPH} ) {
|
||||||
foreach my $type(qw(public protected private)) {
|
foreach my $type (qw(public protected private)) {
|
||||||
push @tmp, map {"$type $_"} keys %{$links{$type}};
|
push @tmp, map { "$type $_" } keys %{ $links{$type} };
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
push @tmp, map {"private $_"} @current_priv_isa;
|
push @tmp, map { "private $_" } @current_priv_isa;
|
||||||
$self->print(":", join(", ", @tmp));
|
$self->print( ":", join( ", ", @tmp ) );
|
||||||
}
|
}
|
||||||
$self->print(" {\n");
|
$self->print(" {\n");
|
||||||
foreach my $target(qw(private protected public)) {
|
foreach my $target (qw(private protected public)) {
|
||||||
if($links{$target}) {
|
if ( $links{$target} ) {
|
||||||
$self->print("$target:\n");
|
$self->print("$target:\n");
|
||||||
foreach(keys %{$links{$target}}) {
|
foreach ( keys %{ $links{$target} } ) {
|
||||||
$self->print("/** \@var $_ $links{$target}{$_}\n");
|
$self->print("/** \@var $_ $links{$target}{$_}\n");
|
||||||
$links{$target}{$_} =~ s/\n.*$//s;
|
$links{$target}{$_} =~ s/\n.*$//s;
|
||||||
$self->print("*/\n$_ $links{$target}{$_};\n");
|
$self->print("*/\n$_ $links{$target}{$_};\n");
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
$self->print("public:\n") unless ( $links{public} );
|
||||||
$self->print("public:\n") unless($links{public});
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
## @method arrayref file_contents( arrayref contents )
|
## @method arrayref file_contents( arrayref contents )
|
||||||
# set/get an array containing the whole input file, each
|
# set/get an array containing the whole input file, each
|
||||||
# line at one array index.
|
# line at one array index.
|
||||||
|
@ -376,14 +428,12 @@ sub emit_class {
|
||||||
# @param contents (optional) file array ref
|
# @param contents (optional) file array ref
|
||||||
# @return The file array ref
|
# @return The file array ref
|
||||||
sub file_contents {
|
sub file_contents {
|
||||||
my( $self, $contents ) = @_;
|
my ( $self, $contents ) = @_;
|
||||||
|
|
||||||
$self->{"$id file"} = $contents if( defined $contents );
|
$self->{"$id file"} = $contents if ( defined $contents );
|
||||||
return( $self->{"$id file"} );
|
return ( $self->{"$id file"} );
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
## @method munge_parameters($args)
|
## @method munge_parameters($args)
|
||||||
# Munge the argument list. Because DoxyGen does not seem to handle $, @ and %
|
# Munge the argument list. Because DoxyGen does not seem to handle $, @ and %
|
||||||
# as argument types properly, we replace them with full length strings.
|
# as argument types properly, we replace them with full length strings.
|
||||||
|
@ -391,7 +441,7 @@ sub file_contents {
|
||||||
# @param args String specifying anything after a directive
|
# @param args String specifying anything after a directive
|
||||||
# @return Processed string.
|
# @return Processed string.
|
||||||
sub munge_parameters {
|
sub munge_parameters {
|
||||||
my ($this, $args) = @_;
|
my ( $this, $args ) = @_;
|
||||||
|
|
||||||
$args =~ s/\$\@/scalar_or_list /g;
|
$args =~ s/\$\@/scalar_or_list /g;
|
||||||
$args =~ s/\@\$/scalar_or_list /g;
|
$args =~ s/\@\$/scalar_or_list /g;
|
||||||
|
@ -399,23 +449,22 @@ sub munge_parameters {
|
||||||
$args =~ s/\@/list /g;
|
$args =~ s/\@/list /g;
|
||||||
$args =~ s/\%/hash /g;
|
$args =~ s/\%/hash /g;
|
||||||
|
|
||||||
# my ($ret, $remainder) = ($args =~ /^\s*(\S+)(.+)/);
|
# my ($ret, $remainder) = ($args =~ /^\s*(\S+)(.+)/);
|
||||||
# if ($ret) {
|
# if ($ret) {
|
||||||
# if ($ret eq '$') {
|
# if ($ret eq '$') {
|
||||||
# $ret = 'scalar';
|
# $ret = 'scalar';
|
||||||
# } elsif ($ret eq '@') {
|
# } elsif ($ret eq '@') {
|
||||||
# $ret = 'list';
|
# $ret = 'list';
|
||||||
# } elsif ($ret eq '$@') {
|
# } elsif ($ret eq '$@') {
|
||||||
# $ret = 'scalar_or_list';
|
# $ret = 'scalar_or_list';
|
||||||
# } elsif ($ret eq '@$') {
|
# } elsif ($ret eq '@$') {
|
||||||
# $ret = 'list_or_scalar';
|
# $ret = 'list_or_scalar';
|
||||||
# }
|
# }
|
||||||
#
|
#
|
||||||
# $args = "$ret$remainder";
|
# $args = "$ret$remainder";
|
||||||
# }
|
# }
|
||||||
|
|
||||||
return $args;
|
return $args;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
@ -1,8 +1,13 @@
|
||||||
|
## @file
|
||||||
|
# Lemonldap::NG manager main file
|
||||||
|
|
||||||
|
## @class
|
||||||
|
# Lemonldap::NG manager main class
|
||||||
package Lemonldap::NG::Manager;
|
package Lemonldap::NG::Manager;
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use Lemonldap::NG::Handler::CGI qw(:globalStorage :locationRules);
|
use Lemonldap::NG::Handler::CGI qw(:globalStorage :locationRules); #inherits
|
||||||
use Lemonldap::NG::Manager::Help; #inherits
|
use Lemonldap::NG::Manager::Help; #inherits
|
||||||
|
|
||||||
our $VERSION = '0.93';
|
our $VERSION = '0.93';
|
||||||
our @ISA = qw(
|
our @ISA = qw(
|
||||||
|
@ -17,6 +22,10 @@ BEGIN {
|
||||||
*process = *doall;
|
*process = *doall;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @cmethod Lemonldap::NG::Manager new(hashRef args)
|
||||||
|
# Class constructor.
|
||||||
|
#@param args hash reference
|
||||||
|
#@return Lemonldap::NG::Manager object
|
||||||
sub new {
|
sub new {
|
||||||
my ( $class, $args ) = @_;
|
my ( $class, $args ) = @_;
|
||||||
my $self = $class->SUPER::new($args)
|
my $self = $class->SUPER::new($args)
|
||||||
|
@ -63,9 +72,12 @@ sub new {
|
||||||
return $self;
|
return $self;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method string menu()
|
||||||
|
# Build the tree menu.
|
||||||
|
# @return HTML string
|
||||||
sub menu {
|
sub menu {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
require Lemonldap::NG::Manager::Downloader; #inherits
|
require Lemonldap::NG::Manager::Downloader;
|
||||||
return
|
return
|
||||||
'<ul class="simpleTree">'
|
'<ul class="simpleTree">'
|
||||||
. $self->li( 'root', 'root' )
|
. $self->li( 'root', 'root' )
|
||||||
|
|
|
@ -1,3 +1,8 @@
|
||||||
|
##@file
|
||||||
|
# Configuration tree file
|
||||||
|
|
||||||
|
##@class Lemonldap::NG::Manager::Downloader
|
||||||
|
# Configuration tree builder
|
||||||
package Lemonldap::NG::Manager::Downloader;
|
package Lemonldap::NG::Manager::Downloader;
|
||||||
|
|
||||||
use MIME::Base64;
|
use MIME::Base64;
|
||||||
|
@ -5,9 +10,14 @@ use MIME::Base64;
|
||||||
# TODO
|
# TODO
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
|
|
||||||
require Lemonldap::NG::Manager::_Struct; #inherits
|
require Lemonldap::NG::Manager::_Struct; #inherits
|
||||||
require Lemonldap::NG::Manager::_i18n; #inherits
|
require Lemonldap::NG::Manager::_i18n; #inherits
|
||||||
|
|
||||||
|
## @method string node(string node)
|
||||||
|
# Build the part of the tree that does not depends of the the configuration.
|
||||||
|
# Call corresp(), ajaxNode(), confNode() or itself with li() and span().
|
||||||
|
#@param $node Node to display
|
||||||
|
#@return HTML string
|
||||||
sub node {
|
sub node {
|
||||||
my ( $self, $node ) = @_;
|
my ( $self, $node ) = @_;
|
||||||
my $res;
|
my $res;
|
||||||
|
@ -71,6 +81,15 @@ sub node {
|
||||||
return $res;
|
return $res;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method string confNode(string node, string target, string help, string js)
|
||||||
|
# Build the part of the tree that does not depends of the the configuration.
|
||||||
|
# Call ajaxNode(), itself, keyToH(), li(), span().
|
||||||
|
# @param node Unique identifier for the node
|
||||||
|
# @param target String that represents the type and the position of the
|
||||||
|
# parameter in the configuration
|
||||||
|
# @param help Help chapter to display when selected
|
||||||
|
# @param js Javascript function to launch when selected
|
||||||
|
# @return HTML string
|
||||||
sub confNode {
|
sub confNode {
|
||||||
my ( $self, $node, $target, $help, $js ) = @_;
|
my ( $self, $node, $target, $help, $js ) = @_;
|
||||||
my $res;
|
my $res;
|
||||||
|
@ -164,6 +183,11 @@ sub confNode {
|
||||||
return $res;
|
return $res;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method hashref keyToH(string key, hashref h)
|
||||||
|
# Return the part of $h corresponding to $key.
|
||||||
|
# Example, if $h={a=>{b=>{c=>1}}} and $key='/a/b' then keyToH() will
|
||||||
|
# return {c=>1}
|
||||||
|
# @return hashref
|
||||||
sub keyToH {
|
sub keyToH {
|
||||||
my ( $self, $key, $h ) = @_;
|
my ( $self, $key, $h ) = @_;
|
||||||
$key =~ s/^\///;
|
$key =~ s/^\///;
|
||||||
|
@ -174,6 +198,19 @@ sub keyToH {
|
||||||
return $h;
|
return $h;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method array corresp(string key,boolean last)
|
||||||
|
# Search a the key $key in the hashref Lemonldap::NG::Manager::struct().
|
||||||
|
# If $key is not set, uses Lemonldap::NG::Manager::struct().
|
||||||
|
# If the URL parameter key is set, uses Lemonldap::NG::Manager::cstruct()
|
||||||
|
# with this parameter.
|
||||||
|
# This function call itself 1 time if the key is not found using cstruct()
|
||||||
|
# using the flag $last.
|
||||||
|
# @return An array containing :
|
||||||
|
# - the (sub)structure of the menu
|
||||||
|
# - the help chapter (using inheritance of the up key)
|
||||||
|
# - the optional javascript function to use when node is selected
|
||||||
|
# @param key string
|
||||||
|
# @param last optional boolean
|
||||||
sub corresp {
|
sub corresp {
|
||||||
my ( $self, $key, $last ) = @_;
|
my ( $self, $key, $last ) = @_;
|
||||||
$key =~ s/^\///;
|
$key =~ s/^\///;
|
||||||
|
@ -218,6 +255,10 @@ sub corresp {
|
||||||
return $h, $help, $js;
|
return $h, $help, $js;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected hashref conf()
|
||||||
|
# If configuration is not in memory, calls
|
||||||
|
# Lemonldap::NG::Common::Conf::getConf() and returns it.
|
||||||
|
# @return Lemonldap::NG configuration
|
||||||
sub conf {
|
sub conf {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
return $self->{_conf} if ( $self->{_conf} );
|
return $self->{_conf} if ( $self->{_conf} );
|
||||||
|
@ -230,6 +271,10 @@ sub conf {
|
||||||
return $self->{_conf};
|
return $self->{_conf};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected Lemonldap::NG::Common::Conf confObj()
|
||||||
|
# At the first call, creates a new Lemonldap::NG::Common::Conf object and
|
||||||
|
# return it. This object is cached for later calls.
|
||||||
|
# @return Lemonldap::NG::Common::Conf object
|
||||||
sub confObj {
|
sub confObj {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
return $self->{_confObj} if ( $self->{_confObj} );
|
return $self->{_confObj} if ( $self->{_confObj} );
|
||||||
|
@ -244,11 +289,17 @@ sub confObj {
|
||||||
return $self->{_confObj};
|
return $self->{_confObj};
|
||||||
}
|
}
|
||||||
|
|
||||||
## @method protected void ajaxnode(string id, string text, string param)
|
## @method protected string ajaxnode(string id,string text,string param,string help,string js,string data,boolean noT)
|
||||||
# Display tree node with Ajax functions inside for opening the node.
|
# Returns a tree node with Ajax functions inside for opening the node later.
|
||||||
# @param $id HTML id of the element.
|
# Call li() and span().
|
||||||
|
# @param $id HTML id of the element
|
||||||
# @param $text text to display
|
# @param $text text to display
|
||||||
# @param $param Parameters for the Ajax query
|
# @param $param Parameters for the Ajax query
|
||||||
|
# @param $help Help chapter to display
|
||||||
|
# @param $js Javascript function to call when selected
|
||||||
|
# @param $data Value of the parameter
|
||||||
|
# @param $noT Optional flag to block translation
|
||||||
|
# @return HTML string
|
||||||
sub ajaxNode {
|
sub ajaxNode {
|
||||||
my ( $self, $id, $text, $param, $help, $js, $data, $noT ) = @_;
|
my ( $self, $id, $text, $param, $help, $js, $data, $noT ) = @_;
|
||||||
$param .= "&cfgNum=$self->{cfgNum}";
|
$param .= "&cfgNum=$self->{cfgNum}";
|
||||||
|
@ -262,6 +313,16 @@ sub ajaxNode {
|
||||||
. "}</li></ul></li>\n";
|
. "}</li></ul></li>\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected string span(string id,string text,string param,string help,string js,string data,boolean noT)
|
||||||
|
# Return the span part of the node
|
||||||
|
# @param $id HTML id of the element
|
||||||
|
# @param $text text to display
|
||||||
|
# @param $param Parameters for the Ajax query
|
||||||
|
# @param $help Help chapter to display
|
||||||
|
# @param $js Javascript function to call when selected
|
||||||
|
# @param $data Value of the parameter
|
||||||
|
# @param $noT Optional flag to block translation
|
||||||
|
# @return HTML string
|
||||||
sub span {
|
sub span {
|
||||||
my ( $self, $id, $text, $data, $js, $help, $noT ) = @_;
|
my ( $self, $id, $text, $data, $js, $help, $noT ) = @_;
|
||||||
use Carp qw(cluck);
|
use Carp qw(cluck);
|
||||||
|
@ -281,6 +342,11 @@ sub span {
|
||||||
";
|
";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected string li(string id,string class)
|
||||||
|
# Returns the LI part of the node.
|
||||||
|
# @param $id HTML id of the element
|
||||||
|
# @param $class CSS class
|
||||||
|
# @return HTML string
|
||||||
sub li {
|
sub li {
|
||||||
my ( $self, $id, $class ) = @_;
|
my ( $self, $id, $class ) = @_;
|
||||||
$id = "li_" . encode_base64( $id, '' );
|
$id = "li_" . encode_base64( $id, '' );
|
||||||
|
|
|
@ -1,3 +1,8 @@
|
||||||
|
## @file
|
||||||
|
# Test uploaded parameters and store new configuration
|
||||||
|
|
||||||
|
## @class
|
||||||
|
# Test uploaded parameters and store new configuration
|
||||||
package Lemonldap::NG::Manager::Uploader;
|
package Lemonldap::NG::Manager::Uploader;
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
|
@ -7,13 +12,17 @@ use MIME::Base64;
|
||||||
|
|
||||||
# TODO
|
# TODO
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use Lemonldap::NG::Common::Safelib; #link protected safe Safe object
|
use Lemonldap::NG::Common::Safelib; #link protected safe Safe object
|
||||||
use Lemonldap::NG::Manager::Downloader;
|
use Lemonldap::NG::Manager::Downloader; #inherits
|
||||||
use Lemonldap::NG::Manager::_Struct;
|
use Lemonldap::NG::Manager::_Struct; #inherits
|
||||||
|
|
||||||
our $VERSION = '0.1';
|
our $VERSION = '0.1';
|
||||||
our ( $stylesheet, $parser );
|
our ( $stylesheet, $parser );
|
||||||
|
|
||||||
|
## @method void confUpload(ref rdata)
|
||||||
|
# Parse rdata to find parameters using XSLT, test them and tries to store the
|
||||||
|
# new configuration
|
||||||
|
# @param $rdata pointer to posted datas
|
||||||
sub confUpload {
|
sub confUpload {
|
||||||
my ( $self, $rdata ) = @_;
|
my ( $self, $rdata ) = @_;
|
||||||
$$rdata =~ s/<img.*?>//g;
|
$$rdata =~ s/<img.*?>//g;
|
||||||
|
@ -48,7 +57,7 @@ sub confUpload {
|
||||||
$id =~ s/\r//g;
|
$id =~ s/\r//g;
|
||||||
$id =~ s/^\///;
|
$id =~ s/^\///;
|
||||||
$id =~ s/(?:\/[^\/]*)?$/\/$name/ if ($NK);
|
$id =~ s/(?:\/[^\/]*)?$/\/$name/ if ($NK);
|
||||||
print STDERR "$id\n"if($NK);
|
print STDERR "$id\n" if ($NK);
|
||||||
next if ( $id =~ /^(generalParameters|virtualHosts)/ );
|
next if ( $id =~ /^(generalParameters|virtualHosts)/ );
|
||||||
my ( $confKey, $test ) = $self->getConfTests($id);
|
my ( $confKey, $test ) = $self->getConfTests($id);
|
||||||
my ( $res, $m );
|
my ( $res, $m );
|
||||||
|
@ -103,7 +112,7 @@ sub confUpload {
|
||||||
foreach ( @{ $result->getChildrenByTagName('ignore') } ) {
|
foreach ( @{ $result->getChildrenByTagName('ignore') } ) {
|
||||||
my $node = $_->getAttribute('value');
|
my $node = $_->getAttribute('value');
|
||||||
$node =~ s/^.*node=(.*?)(?:&.*)?\}$/$1/;
|
$node =~ s/^.*node=(.*?)(?:&.*)?\}$/$1/;
|
||||||
foreach my $k ( $self->findAllConfKeys( $self->corresp($node,1) ) ) {
|
foreach my $k ( $self->findAllConfKeys( $self->corresp( $node, 1 ) ) ) {
|
||||||
my $v = $self->keyToH( $k, $self->conf );
|
my $v = $self->keyToH( $k, $self->conf );
|
||||||
$v = $self->keyToH( $k, $self->defaultConf ) unless ( defined $v );
|
$v = $self->keyToH( $k, $self->defaultConf ) unless ( defined $v );
|
||||||
if ( defined $v ) {
|
if ( defined $v ) {
|
||||||
|
@ -113,26 +122,36 @@ sub confUpload {
|
||||||
$self->lmLog( "No default value found for $k", 'warn' );
|
$self->lmLog( "No default value found for $k", 'warn' );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
print LOG "Ignore $node\n";
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#print STDERR Dumper( $newConf, \%errors, \%warnings );
|
#print STDERR Dumper( $newConf, $res );
|
||||||
close LOG;
|
$res->{result}->{cfgNum} = $self->confObj->saveConf($newConf)
|
||||||
$res->{result}->{cfgNum} = $self->confObj->saveConf($newConf) unless($res->{errors});
|
unless ( $res->{errors} );
|
||||||
my $buf = '{';
|
my $buf = '{';
|
||||||
my $i=0;
|
my $i = 0;
|
||||||
while ( my ( $type, $h ) = each %$res ) {
|
while ( my ( $type, $h ) = each %$res ) {
|
||||||
$buf .= ',' if($i);
|
$buf .= ',' if ($i);
|
||||||
$buf .= "'$type':{";
|
$buf .= "'$type':{";
|
||||||
$buf .= join( ',', map { "'$_':'$h->{$_}'" } keys %$h );
|
$buf .= join( ',', map { "'$_':'$h->{$_}'" } keys %$h );
|
||||||
$buf .= '}';
|
$buf .= '}';
|
||||||
$i++;
|
$i++;
|
||||||
}
|
}
|
||||||
$buf .= '}';
|
$buf .= '}';
|
||||||
print $self->header( -type => 'application/json', -Content_Length => length($buf) ).$buf;
|
print $self->header(
|
||||||
|
-type => 'application/json',
|
||||||
|
-Content_Length => length($buf)
|
||||||
|
) . $buf;
|
||||||
$self->quit();
|
$self->quit();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected array applyTest(void* test,string value)
|
||||||
|
# Apply the test to the value and return the result and an optional message
|
||||||
|
# returned by the test if the sub ref.
|
||||||
|
# @param $test Ref to a regexp or a sub
|
||||||
|
# @param $value Value to test
|
||||||
|
# @return Array containing:
|
||||||
|
# - the test result
|
||||||
|
# - an optional message
|
||||||
sub applyTest {
|
sub applyTest {
|
||||||
my ( $self, $test, $value ) = @_;
|
my ( $self, $test, $value ) = @_;
|
||||||
my ( $res, $msg );
|
my ( $res, $msg );
|
||||||
|
@ -145,6 +164,8 @@ sub applyTest {
|
||||||
return ( $res, $msg );
|
return ( $res, $msg );
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected array getConfTests(string id)
|
||||||
|
# Call Lemonldap::NG::Manager::_Struct::testStruct().
|
||||||
sub getConfTests {
|
sub getConfTests {
|
||||||
my ( $self, $id ) = @_;
|
my ( $self, $id ) = @_;
|
||||||
my ( $confKey, $tmp ) = ( $id =~ /^(.*?)(?:\/(.*))?$/ );
|
my ( $confKey, $tmp ) = ( $id =~ /^(.*?)(?:\/(.*))?$/ );
|
||||||
|
@ -155,6 +176,11 @@ sub getConfTests {
|
||||||
return ( $confKey, $h );
|
return ( $confKey, $h );
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected array findAllConfKeys(hashref h)
|
||||||
|
# Parse a tree structure to find all nodes corresponding to a configuration
|
||||||
|
# value.
|
||||||
|
# @param $h Tree structure
|
||||||
|
# @return Array of configuration parameter names
|
||||||
sub findAllConfKeys {
|
sub findAllConfKeys {
|
||||||
my ( $self, $h ) = @_;
|
my ( $self, $h ) = @_;
|
||||||
my @res = ();
|
my @res = ();
|
||||||
|
@ -168,10 +194,17 @@ sub findAllConfKeys {
|
||||||
push @res, ( $m =~ /^(?:.*?:)?(.*?)(?:\:.*)?$/ ? $1 : () );
|
push @res, ( $m =~ /^(?:.*?:)?(.*?)(?:\:.*)?$/ ? $1 : () );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
push @res, @{$h->{_upload}} if($h->{_upload});
|
push @res, @{ $h->{_upload} } if ( $h->{_upload} );
|
||||||
return @res;
|
return @res;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected void setKeyToH(hashref h,string key,string k2,string value)
|
||||||
|
# Insert key=>$value in $h at the position declared with $key. If $k2 is set,
|
||||||
|
# insert key=>{$k2=>$value}. Note that $key is splited with "/". The last part
|
||||||
|
# is used as key.
|
||||||
|
# @param $h New Lemonldap::NG configuration
|
||||||
|
# @param $key String "/path/key"
|
||||||
|
# @param $k2 Optional subkey
|
||||||
sub setKeyToH {
|
sub setKeyToH {
|
||||||
my $value = pop;
|
my $value = pop;
|
||||||
my ( $self, $h, $key, $k2 ) = @_;
|
my ( $self, $h, $key, $k2 ) = @_;
|
||||||
|
@ -196,12 +229,18 @@ sub setKeyToH {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method private XML::LibXML parser()
|
||||||
|
# @return XML::LibXML object (cached in global $parser variable)
|
||||||
sub parser {
|
sub parser {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
return $parser if ($parser);
|
return $parser if ($parser);
|
||||||
$parser = XML::LibXML->new();
|
$parser = XML::LibXML->new();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method private XML::LibXSLT stylesheet()
|
||||||
|
# Returns XML::LibXSLT parser (cached in global $stylesheet variable). Use
|
||||||
|
# datas stored at the end of this file to initialize the object.
|
||||||
|
# @return XML::LibXSLT object
|
||||||
sub stylesheet {
|
sub stylesheet {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
|
|
|
@ -1,8 +1,19 @@
|
||||||
|
## @file
|
||||||
|
# Manager tree structure and tests
|
||||||
|
|
||||||
|
## @class
|
||||||
|
# Manager tree structure and tests
|
||||||
package Lemonldap::NG::Manager::_Struct;
|
package Lemonldap::NG::Manager::_Struct;
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
our $VERSION = '0.1';
|
our $VERSION = '0.1';
|
||||||
|
|
||||||
|
## @method protected hashref cstruct(hashref h,string k)
|
||||||
|
# Merge $h with the structure produced with $k and return it.
|
||||||
|
# Used to manage virtual hosts.
|
||||||
|
#@param $h Result of struct()
|
||||||
|
#@param $k Name of the virtual host
|
||||||
|
#@return Tree structure
|
||||||
sub cstruct {
|
sub cstruct {
|
||||||
shift;
|
shift;
|
||||||
my ( $h, $k ) = @_;
|
my ( $h, $k ) = @_;
|
||||||
|
@ -23,6 +34,11 @@ sub cstruct {
|
||||||
return $h;
|
return $h;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected hashref struct(hashref h,string k)
|
||||||
|
# Returns the tree structure
|
||||||
|
#@param $h Result of struct()
|
||||||
|
#@param $k Name of the virtual host
|
||||||
|
#@return Tree structure
|
||||||
sub struct {
|
sub struct {
|
||||||
return {
|
return {
|
||||||
_nodes => [qw(n:generalParameters n:groups n:virtualHosts)],
|
_nodes => [qw(n:generalParameters n:groups n:virtualHosts)],
|
||||||
|
@ -129,6 +145,9 @@ sub struct {
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected hashref testStruct()
|
||||||
|
# Returns the tests to do with the datas uploaded.
|
||||||
|
# @return hashref
|
||||||
sub testStruct {
|
sub testStruct {
|
||||||
my $assignTest = qr/(?<=[^=<!>\?])=(?![=~])/;
|
my $assignTest = qr/(?<=[^=<!>\?])=(?![=~])/;
|
||||||
my $assignMsg = 'containsAnAssignment';
|
my $assignMsg = 'containsAnAssignment';
|
||||||
|
@ -302,6 +321,8 @@ sub testStruct {
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
## @method protected hashref defaultConf()
|
||||||
|
#@return Hashref of default values
|
||||||
sub defaultConf {
|
sub defaultConf {
|
||||||
return {
|
return {
|
||||||
authentication => 'LDAP',
|
authentication => 'LDAP',
|
||||||
|
@ -316,17 +337,4 @@ sub defaultConf {
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub newNode {
|
|
||||||
virtualHost => {
|
|
||||||
'*' => {
|
|
||||||
exportedHeaders => { 'Auth-User' => '$uid' },
|
|
||||||
locationRules => { 'default' => 'deny' },
|
|
||||||
}
|
|
||||||
},
|
|
||||||
groups => { 'NewGroup' => '0', },
|
|
||||||
macro => { 'NewMacro' => '', },
|
|
||||||
globalStorageOptions => { 'NewOption' => '', },
|
|
||||||
;
|
|
||||||
}
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
@ -11,8 +11,11 @@ use strict;
|
||||||
use AutoLoader qw(AUTOLOAD);
|
use AutoLoader qw(AUTOLOAD);
|
||||||
our $VERSION = '0.5';
|
our $VERSION = '0.5';
|
||||||
|
|
||||||
## @fn void import(string lang)
|
## @method string translate(string text,string lang)
|
||||||
# Import messages
|
# Returns $text translated in $lang.
|
||||||
|
#@param $text textId
|
||||||
|
#@param $lang Optional language string. If not set, uses Accept-Language
|
||||||
|
# HTTP header.
|
||||||
sub translate {
|
sub translate {
|
||||||
my ( $self, $text, $lang ) = @_;
|
my ( $self, $text, $lang ) = @_;
|
||||||
return $text unless ( $text =~ /[a-z]/ );
|
return $text unless ( $text =~ /[a-z]/ );
|
||||||
|
@ -39,6 +42,7 @@ sub translate {
|
||||||
*en_us = *en;
|
*en_us = *en;
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
__END__
|
||||||
|
|
||||||
sub en {
|
sub en {
|
||||||
return {
|
return {
|
||||||
|
@ -106,130 +110,3 @@ sub fr {
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
__END__
|
|
||||||
|
|
||||||
=pod
|
|
||||||
=cut
|
|
||||||
|
|
||||||
sub en {
|
|
||||||
return {
|
|
||||||
apacheSessionModule => 'Apache::Session module',
|
|
||||||
applyConf => 'Apply',
|
|
||||||
areYouSure => 'Are you sure ?',
|
|
||||||
authenticationType => 'Authentication Type',
|
|
||||||
canNotReadApplyConfFile => 'Configuration not applied: cannot read configuration file',
|
|
||||||
changesAppliedLater => 'Changes will be effective within 10 minutes. Use "apachectl reload" on concerned servers for immediate reloading',
|
|
||||||
checkLogs => 'Check Apache logs',
|
|
||||||
confSaved => 'Configuration saved with number',
|
|
||||||
configLoaded => 'Configuration loaded',
|
|
||||||
configurationDeleted => 'Configuration deleted',
|
|
||||||
configurationNotDeleted => 'Configuration not deleted',
|
|
||||||
configurationWasChanged => 'Configuration has been changed since you got it',
|
|
||||||
confirmDeleteConf => "You're going to delete configuration. Do you confirm ?",
|
|
||||||
containsAnAssignment => 'contains an assignment ("="). Possible confusion with "==".',
|
|
||||||
deleteConf => 'Delete',
|
|
||||||
deleteNode => 'Delete',
|
|
||||||
deleteVirtualHost => 'Delete virtual host',
|
|
||||||
error => 'Error',
|
|
||||||
field => 'Field',
|
|
||||||
group => 'Group',
|
|
||||||
httpHeaders => 'HTTP Headers',
|
|
||||||
invalidLine => 'Invalid Line',
|
|
||||||
invalidVirtualHostName => 'Invalid virtual host name',
|
|
||||||
invalidWhatToTrace => "Data to use in Apache's logs can contain only an exported attribute or a macro",
|
|
||||||
isNotANumber => 'is not a number',
|
|
||||||
isNotAValidAttributeName => 'is not a valid attribute name',
|
|
||||||
isNotAValidCookieName => 'is not a valid cookie name',
|
|
||||||
isNotAValidDomainName => 'is not a valid domain name',
|
|
||||||
isNotAValidGroupName => 'is not a valid group name',
|
|
||||||
isNotAValidHTTPHeaderName => 'is not a valid HTTP header name',
|
|
||||||
isNotAValidLDAPAttributeName => 'is not a valid LDAP attribute name',
|
|
||||||
isNotAValidMacroName => 'is not a valid macro name',
|
|
||||||
isNotAValidVirtualHostName => 'is not a valid virtual host name',
|
|
||||||
lastConf => 'Last',
|
|
||||||
locationRules => 'Rules',
|
|
||||||
macro => 'Macro',
|
|
||||||
newGSOpt => 'New Option',
|
|
||||||
newGroup => 'New Group',
|
|
||||||
newHeader => 'New Header',
|
|
||||||
newMacro => 'New Macro',
|
|
||||||
newVar => 'New Variable',
|
|
||||||
newVirtualHost => 'New Virtual Host',
|
|
||||||
nextConf => 'Next',
|
|
||||||
prevConf => 'Previous',
|
|
||||||
result => 'Result',
|
|
||||||
rule => 'Rule',
|
|
||||||
saveConf => 'Save',
|
|
||||||
saveFailure => 'Save failure',
|
|
||||||
syntaxError => 'Syntax error',
|
|
||||||
unableToSave => 'Your browser does not support XMLHTTPRequest objects: fail to save.',
|
|
||||||
unknownError => 'Unknown error',
|
|
||||||
unknownErrorInVars => 'Unknown error in exported attributes',
|
|
||||||
userGroups => 'User Groups',
|
|
||||||
value => 'Value',
|
|
||||||
waitingResult => 'Waiting result...',
|
|
||||||
warningConfNotApplied => 'You have to reload handlers to take the saved configuration in account',
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
sub fr {
|
|
||||||
return {
|
|
||||||
apacheSessionModule => 'Module Apache::Session',
|
|
||||||
applyConf => 'Appliquer',
|
|
||||||
areYouSure => 'Êtes vous sur ?',
|
|
||||||
authenticationType => "Type d'authentification",
|
|
||||||
canNotReadApplyConfFile => 'Configuration non appliquée: impossible de lire le fichier de configuration',
|
|
||||||
changesAppliedLater => "Les changements seront effectifs d'ici 10 minutes. Utilisez \"apachectl reload\" sur les serveurs concernés pour forcer la prise en compte immédiate",
|
|
||||||
checkLogs => "Consultez les journaux d'Apache",
|
|
||||||
confSaved => 'Configuration sauvegardée sous le numéro',
|
|
||||||
configLoaded => 'Configuration chargée',
|
|
||||||
configurationDeleted => 'Configuration éffacée',
|
|
||||||
configurationNotDeleted => 'Configuration non éffacée',
|
|
||||||
configurationWasChanged => "configuration modifiée depuis que vous l'avez téléchargée",
|
|
||||||
confirmDeleteConf => 'Vous allez effacer cette configuration. Confirmez-vous ?',
|
|
||||||
containsAnAssignment => 'contient une affectation ("="). Confusion possible avec "==".',
|
|
||||||
deleteConf => 'Effacer',
|
|
||||||
deleteNode => 'Supprimer',
|
|
||||||
deleteVirtualHost => "Supprimer l'hôte virtuel",
|
|
||||||
error => 'Erreur',
|
|
||||||
field => 'Champ',
|
|
||||||
group => 'Groupe',
|
|
||||||
httpHeaders => 'En-têtes HTTP',
|
|
||||||
invalidLine => 'Ligne invalide',
|
|
||||||
invalidVirtualHostName => "Nom de d'hôte virtuel incorrect",
|
|
||||||
invalidWhatToTrace => "La donnée à inscrire dans les journaux ne peut contenir qu'un attribut exporté ou une macro",
|
|
||||||
isNotANumber => "n'est pas un nombre",
|
|
||||||
isNotAValidAttributeName => "n'est pas un nom d'attribut valide",
|
|
||||||
isNotAValidCookieName => "n'est pas un nom de cookie valide",
|
|
||||||
isNotAValidDomainName => "n'est pas un nom de domaine valide",
|
|
||||||
isNotAValidGroupName => "n'est pas un nom de groupe valide",
|
|
||||||
isNotAValidHTTPHeaderName => "n'est pas un nom d'en-tête HTTP valide",
|
|
||||||
isNotAValidLDAPAttributeName => "n'est pas un nom d'attribut LDAP valide",
|
|
||||||
isNotAValidMacroName => "n'est pas un nom de macro valide",
|
|
||||||
isNotAValidVirtualHostName => "n'est pas un nom d'hôte virtuel valide",
|
|
||||||
lastConf => 'Dernière',
|
|
||||||
locationRules => 'Règles',
|
|
||||||
macro => 'Macro',
|
|
||||||
macros => 'Macros',
|
|
||||||
newGSOpt => 'Nouvelle option',
|
|
||||||
newGroup => 'Nouveau groupe',
|
|
||||||
newHeader => 'Nouvel en-tête',
|
|
||||||
newMacro => 'Nouvelle macro',
|
|
||||||
newVar => 'Nouvelle variable',
|
|
||||||
newVirtualHost => 'Nouvel hôte virtuel',
|
|
||||||
nextConf => 'Suivante',
|
|
||||||
prevConf => 'Précédente',
|
|
||||||
result => 'Résultat',
|
|
||||||
rule => 'Règle',
|
|
||||||
saveConf => 'Sauvegarder',
|
|
||||||
saveFailure => 'Échec de la sauvegarde',
|
|
||||||
syntaxError => 'Erreur de syntaxe',
|
|
||||||
unableToSave => 'Votre navigateur ne supporte pas les objets XMLHTTPRequest: sauvegarde impossible.',
|
|
||||||
unknownError => 'Erreur inconnue',
|
|
||||||
unknownErrorInVars => 'Erreur inconnue dans les attributs exportés',
|
|
||||||
userGroups => "Groupes d'utilisateurs",
|
|
||||||
value => 'Valeur',
|
|
||||||
waitingResult => 'En attente...',
|
|
||||||
warningConfNotApplied => 'Vous devez recharger les agents pour que la configuration sauvegardée soit appliquée',
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user