diff --git a/build/lemonldap-ng/scripts/DoxyGen/PerlFilter.pm b/build/lemonldap-ng/scripts/DoxyGen/PerlFilter.pm index 60411c0a3..a160010e1 100644 --- a/build/lemonldap-ng/scripts/DoxyGen/PerlFilter.pm +++ b/build/lemonldap-ng/scripts/DoxyGen/PerlFilter.pm @@ -4,30 +4,30 @@ # Copyright (C) 2002 Bart Schuller # Copyright (C) 2006 Phinex Informatik AG # All Rights Reserved -# +# # Doxygen Filter is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. -# +# # Larry Wall's 'Artistic License' for perl can be found in # http://www.perl.com/pub/a/language/misc/Artistic.html -# +# # ======================================================================= -# +# # Author: Aeby Thomas, Phinex Informatik AG, # Based on DoxygenFilter from Bart Schuller # E-Mail: tom.aeby@phinex.ch -# +# # Phinex Informatik AG # Thomas Aeby # Kirchweg 52 # 1735 Giffers -# +# # ======================================================================= -# +# # @(#) $Id: PerlFilter.pm,v 1.4 2006/01/31 17:46:06 aeby Exp $ -# +# # Revision History: -# +# # $Log: PerlFilter.pm,v $ # Revision 1.4 2006/01/31 17:46:06 aeby # filter(): avoid warnings about uninitialized values @@ -36,14 +36,13 @@ # Revision 1.3 2006/01/31 16:53:52 aeby # added copyright info # -# +# # ======================================================================= ## @file # implementation of DoxyGen::PerlFilter. # - ## @class # Filter from perl syntax API docs to Doxygen-compatible syntax. # This class is meant to be used as a filter for the @@ -59,44 +58,61 @@ my $id = __PACKAGE__; # Do the filtering. # @param infh input filehandle, normally STDIN sub filter { - my($self, $infile) = @_; - open(my $infh, $infile); + my ( $self, $infile ) = @_; + open( my $infh, $infile ); my $current_class = ""; - my $file = []; - my $endMark = 1; - while( <$infh> ) { - $endMark = 0 if(/\s*use\s+AutoLoader/); - last if($endMark and /^__END__$/); - push( @$file, $_ ); + my $file = []; + my $endMark = 1; + my ( $cc, $cl, $lc, $ll ) = ( 0, 0, 0, 0 ); + while (<$infh>) { + $endMark = 0 if (/^\s*use\s+AutoLoader/); + 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 - for( my $line=0; $line <= $#$file; ) { - $_ = $file->[$line++]; - last if($endMark and /^__END__$/); + #print STDERR @$file; + $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 + for ( my $line = 0 ; $line <= $#$file ; ) { + $_ = $file->[ $line++ ]; + last if ( $endMark and /^__END__$/ ); if (/^##\s*\@(\S+)\s*(.*)/) { - my($command, $args) = ($1, $2); + my ( $command, $args ) = ( $1, $2 ); my @more; - while ( $_ = $file->[$line++] ) { + while ( $_ = $file->[ $line++ ] ) { if (/^#\s?(.+)/s) { push @more, $1; - } else { + } + else { last; } } - if ($command eq 'file') { + if ( $command eq 'file' ) { $args ||= $infile; $self->start("\@$command $args"); $self->more(@more); $self->end; - } elsif ($command eq 'class') { + } + elsif ( $command eq 'class' ) { $objcontext = 1; unless ($args) { ($args) = /package\s(.*);/; @@ -106,123 +122,146 @@ sub filter { $self->print("};\n"); } $current_class = $args; - $self->emit_class( $args, $line, [ - "\@$command $args", - @more, - "\@nosubgrouping" - ] ); - } elsif ($command eq 'imethod') { + $self->emit_class( $args, $line, + [ "\@$command $args", @more, "\@nosubgrouping" ] ); + } + elsif ( $command eq 'imethod' ) { unless ($args) { - ($args) = $self->analyze_sub( $line-1 ); + ($args) = $self->analyze_sub( $line - 1 ); } $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->print($args, ";\n"); + $self->print( $args, ";\n" ); $self->pop; - } elsif ($command eq 'apmethod') { + } + elsif ( $command eq 'apmethod' ) { unless ($args) { - ($args) = $self->analyze_sub( $line-1 ); + ($args) = $self->analyze_sub( $line - 1 ); } $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->print($args, ";\n"); + $self->print( $args, ";\n" ); $self->pop; - } elsif ($command eq 'rmethod') { + } + elsif ( $command eq 'rmethod' ) { unless ($args) { - ($args) = $self->analyze_sub( $line-1 ); + ($args) = $self->analyze_sub( $line - 1 ); } $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->print($args, ";\n"); + $self->print( $args, ";\n" ); $self->pop; - } elsif ($command eq 'cmethod') { + } + elsif ( $command eq 'cmethod' ) { unless ($args) { - ($args) = $self->analyze_sub( $line-1 ); + ($args) = $self->analyze_sub( $line - 1 ); } $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->print($args, ";\n"); + $self->print( $args, ";\n" ); $self->pop; - } elsif ($command eq 'ifn') { + } + elsif ( $command eq 'ifn' ) { unless ($args) { - ($args) = $self->analyze_sub( $line-1 ); + ($args) = $self->analyze_sub( $line - 1 ); } $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->print($args, ";\n"); + $self->print( $args, ";\n" ); $self->pop; - } elsif ($command eq 'rfn') { + } + elsif ( $command eq 'rfn' ) { unless ($args) { - ($args) = $self->analyze_sub( $line-1 ); + ($args) = $self->analyze_sub( $line - 1 ); } $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->print($args, ";\n"); + $self->print( $args, ";\n" ); $self->pop; - } elsif ($command eq 'fn') { + } + elsif ( $command eq 'fn' ) { unless ($args) { - ($args) = $self->analyze_sub( $line-1 ); + ($args) = $self->analyze_sub( $line - 1 ); } $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->print($args, ";\n"); + $self->print( $args, ";\n" ); $self->pop; - } elsif ($command eq 'method') { + } + elsif ( $command eq 'method' ) { unless ($args) { - ($args) = $self->analyze_sub( $line-1 ); + ($args) = $self->analyze_sub( $line - 1 ); } $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->print($args, ";\n"); + $self->print( $args, ";\n" ); $self->pop; - } elsif ($command eq 'enum') { + } + elsif ( $command eq 'enum' ) { $self->start("\@$command $args"); $self->more(@more); $self->end; $self->print("$command $args;\n"); - } else { + } + else { $self->start("\@$command $args"); $self->more(@more); $self->end; } + # We ate a line when we got the rest of the comment lines redo if defined $_; - } elsif (/^use\s+([\w:]+)/) { + } + elsif (/^use\s+([\w:]+)/) { my $inc = $1; + #$inc =~ s/::/\//g; $self->print("#include \"$inc.pm\"\n"); - } elsif (/^package\s+([\w:]+)/) { + } + elsif (/^package\s+([\w:]+)/) { if ($current_class) { $self->flush; $self->print("};\n"); } - next unless( $objcontext ); + next unless ($objcontext); $current_class = $1; $self->emit_class( $current_class, $line ); - } elsif (/^\s*sub\s+([\w:]+)/) { - my( $proto, $name, @args ) = $self->analyze_sub( $line-1 ); - if( $current_class && @args && ($args[0] eq "\$self") ) { - $self->push($self->protection($proto).' Object Methods'); + } + elsif (/^\s*sub\s+([\w:]+)/) { + my ( $proto, $name, @args ) = $self->analyze_sub( $line - 1 ); + if ( $current_class && @args && ( $args[0] eq "\$self" ) ) { + $self->push( $self->protection($proto) . ' Object Methods' ); $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*//; - } elsif( $current_class - && ((@args && ($args[0] eq "\$class")) || ($name eq "new")) ) { - $self->push($self->protection($proto).' Class Methods'); - } else { - $self->push($self->protection($proto).' Functions'); + } + elsif ( + $current_class + && ( ( @args && ( $args[0] eq "\$class" ) ) + || ( $name eq "new" ) ) + ) + { + $self->push( $self->protection($proto) . ' Class Methods' ); + } + else { + $self->push( $self->protection($proto) . ' Functions' ); } $proto = $self->munge_parameters($proto); - $self->print($proto, ";\n"); + $self->print( $proto, ";\n" ); $self->pop; } } @@ -232,8 +271,6 @@ sub filter { } } - - ## @method @ analyze_sub( int line ) # analyzes a subroutine declaration starting at the given line. Tries # to determine whicht arguments it takes. @@ -242,38 +279,44 @@ sub filter { # @return A function prototype, the name of the function and a # list of arguments it takes sub analyze_sub { - my( $self, $line ) = @_; + my ( $self, $line ) = @_; my $file = $self->file_contents(); $file->[$line] =~ /sub\s+(.*)\{/; my $name = $1; my $proto; my @args; - if( $name =~ /^(.*)\s*\((.*)\)/ ) { - $name = $1; + if ( $name =~ /^(.*)\s*\((.*)\)/ ) { + $name = $1; $proto = $2; } else { my $forward = 5; - for( my $i=0; $forward && ($i+$line <= $#$file) && ! $proto; $i++ ) { - $_ = $file->[$i+$line]; - if( /^\s*my\s*\((.*)\)\s*=\s*\@_/ ) { + for ( + my $i = 0 ; + $forward && ( $i + $line <= $#$file ) && !$proto ; + $i++ + ) + { + $_ = $file->[ $i + $line ]; + if (/^\s*my\s*\((.*)\)\s*=\s*\@_/) { $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 ); } - 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; } - elsif( /shift\s*->\s*[a-z0-9_]+\(/ ) { + elsif (/shift\s*->\s*[a-z0-9_]+\(/) { + # assuming anonymously used shifted value is $self push( @args, '$self' ); } - elsif( /^\s*\n/ || /^\s*#/ ) { + elsif ( /^\s*\n/ || /^\s*#/ ) { ; } - elsif( /}/ ) { + elsif (/}/) { $forward = 0; } else { @@ -281,22 +324,21 @@ sub analyze_sub { } } } - if( $proto ) { + if ($proto) { $proto =~ s/\s+//g; $proto =~ s/,/, /g; @args = split( ", ", $proto ); } - + $name =~ s/\s+$//; my $protection = ""; - if( substr( $name, 0, 1 ) eq "_" ) { + if ( substr( $name, 0, 1 ) eq "_" ) { $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 ) # Emit one class definition. If the doc parameter is defined, # 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 doc (optional) an array with comment lines 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(); - while ($_ = $file->[$line++] ) { + while ( $_ = $file->[ $line++ ] ) { if (/^\s*(?:use base|\@ISA\s*=|\@${class}::ISA\s*=)\s+(.+);/) { push @current_isa, eval $1; - $file->[$line-1] = "\n"; - } elsif (/^\s*(?:use|require)\s+([\w:]+)/) { + $file->[ $line - 1 ] = "\n"; + } + elsif (/^\s*(?:use|require)\s+([\w:]+)/) { 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/); $inc =~ s/::/\//g; - $inc =~ s#Lemonldap/NG/(\w+)#"lemonldap-ng-".lc($1)."/lib/Lemonldap/NG/$1"#e; - print STDERR $inc; + $inc =~ +s#Lemonldap/NG/(\w+)#"lemonldap-ng-".lc($1)."/lib/Lemonldap/NG/$1"#e; + + #print STDERR $inc; push @current_include, $inc; - $file->[$line-1] = "\n"; - } elsif (/^package/) { + $file->[ $line - 1 ] = "\n"; + } + elsif (/^package/) { last; - } elsif (/#\s*inherits\s+([\w:]+)/) { + } + elsif (/#\s*inherits\s+([\w:]+)/) { 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("\n"); - - if( $doc ) { - $self->start($doc->[0]); - $self->more( @$doc[1 .. $#$doc] ); + + if ($doc) { + $self->start( $doc->[0] ); + $self->more( @$doc[ 1 .. $#$doc ] ); $self->end(); } $self->print("class $class"); - if (@current_isa or @current_priv_isa) { + if ( @current_isa or @current_priv_isa ) { my @tmp; - @tmp = map {"public $_"} @current_isa; - if($ENV{COLLABORATIVE_GRAPH}) { - foreach my $type(qw(public protected private)) { - push @tmp, map {"$type $_"} keys %{$links{$type}}; + @tmp = map { "public $_" } @current_isa; + if ( $ENV{COLLABORATIVE_GRAPH} ) { + foreach my $type (qw(public protected private)) { + push @tmp, map { "$type $_" } keys %{ $links{$type} }; } } - push @tmp, map {"private $_"} @current_priv_isa; - $self->print(":", join(", ", @tmp)); + push @tmp, map { "private $_" } @current_priv_isa; + $self->print( ":", join( ", ", @tmp ) ); } $self->print(" {\n"); - foreach my $target(qw(private protected public)) { - if($links{$target}) { - $self->print("$target:\n"); - foreach(keys %{$links{$target}}) { - $self->print("/** \@var $_ $links{$target}{$_}\n"); - $links{$target}{$_} =~ s/\n.*$//s; - $self->print("*/\n$_ $links{$target}{$_};\n"); + foreach my $target (qw(private protected public)) { + if ( $links{$target} ) { + $self->print("$target:\n"); + foreach ( keys %{ $links{$target} } ) { + $self->print("/** \@var $_ $links{$target}{$_}\n"); + $links{$target}{$_} =~ s/\n.*$//s; + $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 ) # set/get an array containing the whole input file, each # line at one array index. @@ -376,14 +428,12 @@ sub emit_class { # @param contents (optional) file array ref # @return The file array ref sub file_contents { - my( $self, $contents ) = @_; + my ( $self, $contents ) = @_; - $self->{"$id file"} = $contents if( defined $contents ); - return( $self->{"$id file"} ); + $self->{"$id file"} = $contents if ( defined $contents ); + return ( $self->{"$id file"} ); } - - ## @method munge_parameters($args) # Munge the argument list. Because DoxyGen does not seem to handle $, @ and % # 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 # @return Processed string. sub munge_parameters { - my ($this, $args) = @_; + my ( $this, $args ) = @_; $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/\%/hash /g; -# my ($ret, $remainder) = ($args =~ /^\s*(\S+)(.+)/); -# if ($ret) { -# if ($ret eq '$') { -# $ret = 'scalar'; -# } elsif ($ret eq '@') { -# $ret = 'list'; -# } elsif ($ret eq '$@') { -# $ret = 'scalar_or_list'; -# } elsif ($ret eq '@$') { -# $ret = 'list_or_scalar'; -# } -# -# $args = "$ret$remainder"; -# } + # my ($ret, $remainder) = ($args =~ /^\s*(\S+)(.+)/); + # if ($ret) { + # if ($ret eq '$') { + # $ret = 'scalar'; + # } elsif ($ret eq '@') { + # $ret = 'list'; + # } elsif ($ret eq '$@') { + # $ret = 'scalar_or_list'; + # } elsif ($ret eq '@$') { + # $ret = 'list_or_scalar'; + # } + # + # $args = "$ret$remainder"; + # } return $args; } - 1; diff --git a/modules/lemonldap-ng-manager/lib/Lemonldap/NG/Manager.pm b/modules/lemonldap-ng-manager/lib/Lemonldap/NG/Manager.pm index fb818f288..459a8cfda 100644 --- a/modules/lemonldap-ng-manager/lib/Lemonldap/NG/Manager.pm +++ b/modules/lemonldap-ng-manager/lib/Lemonldap/NG/Manager.pm @@ -1,8 +1,13 @@ +## @file +# Lemonldap::NG manager main file + +## @class +# Lemonldap::NG manager main class package Lemonldap::NG::Manager; use strict; -use Lemonldap::NG::Handler::CGI qw(:globalStorage :locationRules); -use Lemonldap::NG::Manager::Help; #inherits +use Lemonldap::NG::Handler::CGI qw(:globalStorage :locationRules); #inherits +use Lemonldap::NG::Manager::Help; #inherits our $VERSION = '0.93'; our @ISA = qw( @@ -17,6 +22,10 @@ BEGIN { *process = *doall; } +## @cmethod Lemonldap::NG::Manager new(hashRef args) +# Class constructor. +#@param args hash reference +#@return Lemonldap::NG::Manager object sub new { my ( $class, $args ) = @_; my $self = $class->SUPER::new($args) @@ -63,9 +72,12 @@ sub new { return $self; } +## @method string menu() +# Build the tree menu. +# @return HTML string sub menu { my $self = shift; - require Lemonldap::NG::Manager::Downloader; #inherits + require Lemonldap::NG::Manager::Downloader; return '