Downloader.pm 12.8 KB
Newer Older
Yadd's avatar
Yadd committed
1
2
3
4
5
##@file
# Configuration tree file

##@class Lemonldap::NG::Manager::Downloader
# Configuration tree builder
Yadd's avatar
Yadd committed
6
7
8
9
10
11
12
package Lemonldap::NG::Manager::Downloader;

use MIME::Base64;

# TODO
use Data::Dumper;

Yadd's avatar
Yadd committed
13
14
require Lemonldap::NG::Manager::_Struct;    #inherits
require Lemonldap::NG::Manager::_i18n;      #inherits
Yadd's avatar
Yadd committed
15

Yadd's avatar
Yadd committed
16
17
18
19
20
## @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
Yadd's avatar
Yadd committed
21
22
23
24
25
26
27
28
29
30
31
sub node {
    my ( $self, $node ) = @_;
    my $res;
    $node =~ s/^\///;

    #$self->lmLog( "Processing to node: $node", 'debug' );
    if ( my ( $tmp, $help, $js ) = $self->corresp($node) ) {

        # Menu node
        if ( ref($tmp) ) {

32
33
34
35
36
            # expand _nodes
            if ( ref( $tmp->{_nodes} ) eq 'CODE' ) {
                $tmp->{_nodes} = $tmp->{_nodes}->($self);
            }

Yadd's avatar
Yadd committed
37
38
39
40
41
42
43
44
45
46
47
48
49
            # Scan subnodes
            foreach ( @{ $tmp->{_nodes} } ) {
                my $flag = ( $_ =~ s/^(\w+):// ? $1 : '' );
                my ( $target, $_h, $_j ) = split /:\s*/;
                $help ||= $_h;

                # subnode is an ajax subnode
                if ( $flag =~ /^(c?)n$/ ) {
                    $res .= $self->ajaxNode(
                        ( $1 ? $target : "$node/$target" ),
                        "$target",
                        "node=$node/$target",
                        $tmp->{$target}->{_help} || $help,
Yadd's avatar
Yadd committed
50
51
52
53
                        $tmp->{$target}->{_js},
                        '',
                        0,
                        $tmp->{$target}->{_call}
Yadd's avatar
Yadd committed
54
                    );
55
56
57
58
59
60
                    next;
                }

                # Substitute sub by its value
                if ( ref( $tmp->{$target} ) eq 'sub' ) {
                    $tmp->{$target} = &{ $tmp->{$target} }($self);
Yadd's avatar
Yadd committed
61
62
63
                }

                # subnode is a node
64
                if ( ref( $tmp->{$target} ) ) {
Yadd's avatar
Yadd committed
65
66
67
68
69
                    $res .= $self->li( "$node/$target", "closed" )
                      . $self->span(
                        "$node/$target", $target, '',
                        $tmp->{$target}->{_js},
                        $tmp->{$target}->{_help} || $help
Yadd's avatar
Yadd committed
70
71
72
73
                      )
                      . "<ul>"
                      . $self->node("$node/$target")
                      . "</ul></li>";
Yadd's avatar
Yadd committed
74
75
76
77
                }

                # subnode points to a configuration node
                elsif ( $flag =~ /^n?hash$/ ) {
Yadd's avatar
Yadd committed
78
79
                    $res .=
                      $self->confNode( $node, "$flag:$target", $help, $_j );
Yadd's avatar
Yadd committed
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
                }

                else {
                    $res .= $self->node("$node/$target");
                }
            }
        }

        # node points to a configuration point
        else {
            $res .= $self->confNode( $node, $tmp, $help, $js );
        }
    }
    else {
        $self->lmLog( "$node was not found in tree\n", 'error' );
    }
    return $res;
}

Yadd's avatar
Yadd committed
99
100
101
102
103
104
105
106
107
## @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
Yadd's avatar
Yadd committed
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
sub confNode {
    my ( $self, $node, $target, $help, $js ) = @_;
    my $res;
    $self->lmLog( "Processing to configuration node: $target", 'debug' );
    $target =~ s/^\///;
    if ( $target =~ /^(.+?):(?!\/)(.+?):(?!\/)(.+?)$/ ) {
        ( $target, $help, $js ) = ( $1, $2, $3 );
    }

    # Hash datas downloaded later by ajax if needed
    if ( $target =~ s/^nhash:// ) {
        my $h = $self->keyToH( $target, $self->conf );
        return unless ($h);
        foreach ( sort keys %$h ) {
            if ( ref($h) ) {
Yadd's avatar
Yadd committed
123
124
                $res .= $self->ajaxNode( "$target/$_", $_,
                    "node=$node/$_\&amp;key=$_", $help, $js, undef, 1 );
Yadd's avatar
Yadd committed
125
126
            }
            else {
Yadd's avatar
Yadd committed
127
128
129
                $res .=
                  $self->confNode( "$target/$_", "btext:$target/$_", $help,
                    $js );
Yadd's avatar
Yadd committed
130
131
132
133
134
135
136
            }
        }
    }

    # Hash datas
    elsif ( $target =~ s/^hash:// ) {
        my $h = $self->keyToH( $target, $self->conf );
Yadd's avatar
Yadd committed
137
138
139
140
141
142
143
144
145
146
        unless ($h) {
            my $tmp;
            unless ( ($tmp) = ( $target =~ /^\/?(.*)\// )
                and $h = $self->subDefaultConf()->{$tmp} )
            {
                $self->lmLog( "$target hash is not defined in configuration",
                    'error' );
                return;
            }
        }
Yadd's avatar
Yadd committed
147
148
149
150
151
152
153
154
155
156
157
        foreach ( sort keys %$h ) {
            if ( ref( $h->{$_} ) ) {
                $res .= $self->confNode( "$target/$_", $help, $js );
            }
            else {
                $js ||= 'btext';
                my $id = "$target/$_";
                $id =~ s/=*$//;

                # Here, "notranslate" is set to true : hash values must not be
                # translated
Yadd's avatar
Yadd committed
158
159
                $res .=
                    $self->li($id)
Yadd's avatar
Yadd committed
160
161
162
163
                  . $self->span( $id, "$_", $h->{$_}, $js, $help, 1 ) . "</li>";
            }
        }
    }
164
165
166
167
168
169
170
171

    # subnode is a conditaional node
    elsif ( $target =~ s/^sub:// ) {
        foreach my $s ( $self->_sub($target) ) {
            $res .= $self->confNode( $node, $s, $help );
        }
    }

Yadd's avatar
Yadd committed
172
173
174
175
176
177
178
179
180
181
    else {
        $target =~ s/^(\w+)://;
        my $type = $1 || 'text';
        $js ||= $type;
        my $text = $target;
        $text =~ s/^.*\///;
        my $h = $self->keyToH( $target, $self->conf );

        $h = $self->keyToH( $target, $self->defaultConf ) unless ( defined $h );
        unless ( defined $h ) {
Yadd's avatar
Yadd committed
182
183
184
185
186
187
188
            $self->lmLog( "$target does not exists in menu hash", "debug" );
            $h = {
                text  => '',
                hash  => {},
                'int' => 0,
            }->{$type};
            $self->lmLog( "Type $type unknown", 'warn' ) unless ( defined $h );
Yadd's avatar
Yadd committed
189
190
        }
        if ( ref($h) ) {
Yadd's avatar
Yadd committed
191
192
            $res .=
                $self->li( "$target", "closed" )
Yadd's avatar
Yadd committed
193
194
195
              . $self->span( "$target", $text, '', $js, $help ) . "<ul>";
            foreach ( sort keys %$h ) {
                if ( ref( $h->{$_} ) ) {
Yadd's avatar
Yadd committed
196
197
                    $res .=
                      $self->confNode( '', "btext:$target/$_", $help, $js );
Yadd's avatar
Yadd committed
198
199
200
                }
                else {
                    my $id = "$target/$_";
Yadd's avatar
Yadd committed
201
202
                    $res .=
                        $self->li($id)
Yadd's avatar
Yadd committed
203
204
205
206
207
208
209
                      . $self->span( $id, $_, $h->{$_}, $js, $help ) . "</li>";
                }
            }
            $res .= '</ul></li>';
        }
        else {
            my $id = "$target";
Yadd's avatar
Yadd committed
210
211
            $res .=
                $self->li($id)
Yadd's avatar
Yadd committed
212
213
214
215
216
217
              . $self->span( $id, $text, $h, $js, $help ) . "</li>";
        }
    }
    return $res;
}

Yadd's avatar
Yadd committed
218
219
220
221
222
## @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
Yadd's avatar
Yadd committed
223
224
225
226
227
228
229
230
231
232
sub keyToH {
    my ( $self, $key, $h ) = @_;
    $key =~ s/^\///;
    foreach ( split /\//, $key ) {
        return () unless ( defined( $h->{$_} ) );
        $h = $h->{$_};
    }
    return $h;
}

Yadd's avatar
Yadd committed
233
234
235
236
237
## @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.
238
239
# This function call itself 1 time if the key is not found using cstruct().
# The flag $last is used to avoid loop.
Yadd's avatar
Yadd committed
240
241
242
243
244
245
# @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
Yadd's avatar
Yadd committed
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
sub corresp {
    my ( $self, $key, $last ) = @_;
    $key =~ s/^\///;
    my $h = $self->struct();
    return $h unless ($key);
    if ( my $k2 = $self->param('key') ) {
        $h = $self->cstruct( $h, $k2 );
    }
    my @tmp1 = split /\//, $key;
    my $help;
    my $js;
    while ( $_ = shift(@tmp1) ) {
        if ( ref($h) and defined $h->{$_} ) {
            $help = $h->{_help} if ( $h->{_help} );
            $js   = $h->{_js}   if ( $h->{_js} );
            $h    = $h->{$_};
        }

        # The wanted key does not exists
        elsif ( ref($h) ) {
            unless ($last) {
                $self->param( 'key', $_ );
                return $self->corresp( $key, 1 );
            }
            else {
                $self->lmLog( "Key $key does not exist in configuration hash",
                    'error' );
                return ();
            }
        }

        # If the key does not exist in manager tree, it must be defined in
        # configuration hash
        else {
            return "$h/" . join( '/', $_, @tmp1 );
        }
    }
    if ( ref($h) ) {
        $help = $h->{_help} if ( $h->{_help} );
        $js   = $h->{_js}   if ( $h->{_js} );
    }
    return $h, $help, $js;
}

Yadd's avatar
Yadd committed
290
291
292
293
## @method protected hashref conf()
# If configuration is not in memory, calls
# Lemonldap::NG::Common::Conf::getConf() and returns it.
# @return Lemonldap::NG configuration
Yadd's avatar
Yadd committed
294
295
296
297
298
299
300
301
302
sub conf {
    my $self = shift;
    return $self->{_conf} if ( $self->{_conf} );
    my $args = { cfgNum => $self->{cfgNum} };
    $args->{noCache} = 1 if ( $self->param('cfgNum') );
    $self->{_conf} = $self->confObj->getConf($args);
    $self->abort( 'Unable to get configuration',
        $Lemonldap::NG::Common::Conf::msg )
      unless ( $self->{_conf} );
Yadd's avatar
Yadd committed
303
304
    if ( my $c = $self->param('conf') ) {
        $self->{_conf}->{$_} = $self->param($_) foreach ( split /\s+/, $c );
305
    }
Yadd's avatar
Yadd committed
306
307
308
    return $self->{_conf};
}

Yadd's avatar
Yadd committed
309
310
311
312
## @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
Yadd's avatar
Yadd committed
313
314
315
316
317
318
319
320
321
322
323
324
325
326
sub confObj {
    my $self = shift;
    return $self->{_confObj} if ( $self->{_confObj} );
    $self->{_confObj} =
      Lemonldap::NG::Common::Conf->new( $self->{configStorage} );
    $self->abort(
        'Unable to access to configuration',
        $Lemonldap::NG::Common::Conf::msg
    ) unless ( $self->{_confObj} );
    $self->lmLog( $Lemonldap::NG::Common::Conf::msg, 'debug' )
      if ($Lemonldap::NG::Common::Conf::msg);
    return $self->{_confObj};
}

Yadd's avatar
Yadd committed
327
328
329
330
## @method protected string ajaxnode(string id,string text,string param,string help,string js,string data,boolean noT)
# Returns a tree node with Ajax functions inside for opening the node later.
# Call li() and span().
# @param $id HTML id of the element
Yadd's avatar
Yadd committed
331
332
# @param $text text to display
# @param $param Parameters for the Ajax query
Yadd's avatar
Yadd committed
333
334
335
336
337
# @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
Yadd's avatar
Yadd committed
338
sub ajaxNode {
Yadd's avatar
Yadd committed
339
    my ( $self, $id, $text, $param, $help, $js, $data, $noT, $call ) = @_;
Yadd's avatar
Yadd committed
340
    $param .= "&amp;cfgNum=$self->{cfgNum}";
Yadd's avatar
Yadd committed
341
342
    return
        $self->li($id)
343
      . $self->span( $id, $text, $data, $js, $help, $noT )
Yadd's avatar
Yadd committed
344
345
346
      . "<ul class=\"ajax\">"
      . $self->li("sub_$id")
      . ".{url:$ENV{SCRIPT_NAME}?$param"
347
348
349

      #  . ( $js   ? ",js:$js"     : '' )
      . ( $call ? ",call:$call" : '' ) . "}</li></ul></li>\n";
Yadd's avatar
Yadd committed
350
351
}

Yadd's avatar
Yadd committed
352
353
354
355
356
357
358
359
360
361
## @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
Yadd's avatar
Yadd committed
362
363
364
365
366
367
368
369
370
sub span {
    my ( $self, $id, $text, $data, $js, $help, $noT ) = @_;
    use Carp qw(cluck);
    cluck('dd') if ( $js eq 'default' );
    my $tmp = $text;
    $data = '' unless ( defined $data );
    $js ||= "none";
    $id = "li_" . encode_base64( $id, '' );
    $id   =~ s/(=*)$/length($1)/e;
371
    $js .= "('$id')" unless ( $js =~ /\(/ );
Yadd's avatar
Yadd committed
372
373
    $data =~ s/"/&#39;/g;
    $tmp  =~ s/"/&#39;/g;
Yadd's avatar
Yadd committed
374
375
    $text = join ' ', map { $self->translate($_) } split /\s+/, $text
      unless ($noT);
Yadd's avatar
Yadd committed
376
377
    $text = $self->escapeHTML($text);
    return
378
"<span name=\"$tmp\" id=\"text_$id\" onclick=\"$js\" help=\"$help\" value=\"$data\">$text</span>
Yadd's avatar
Yadd committed
379
380
381
";
}

Yadd's avatar
Yadd committed
382
383
384
385
386
## @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
Yadd's avatar
Yadd committed
387
388
389
390
391
392
393
394
sub li {
    my ( $self, $id, $class ) = @_;
    $id = "li_" . encode_base64( $id, '' );
    $id =~ s/(=*)$/length($1)/e;
    return "<li id=\"$id\"" . ( $class ? " class=\"$class\">" : ">" );
}

1;