source: trunk/LATMOS-Accounts-Web/lib/LATMOS/Accounts/Web/Controller/Json/Tree.pm @ 1484

Last change on this file since 1484 was 1484, checked in by nanardon, 9 years ago

Add user tree web page

File size: 2.5 KB
Line 
1package LATMOS::Accounts::Web::Controller::Json::Tree;
2use Moose;
3use namespace::autoclean;
4
5BEGIN { extends 'Catalyst::Controller'; }
6
7=head1 NAME
8
9LATMOS::Accounts::Web::Controller::Json::Expire - Catalyst Controller
10
11=head1 DESCRIPTION
12
13Catalyst Controller.
14
15=head1 METHODS
16
17=cut
18
19
20=head2 index
21
22=cut
23
24sub index :Path :Args(0) {
25    my ( $self, $c ) = @_;
26
27    my $base = $c->model('Accounts')->db;
28
29    my %users = map { $_ => 1 } $base->search_objects('user', 'active=1', 'givenName=*');
30    my %dpmts = map { $_ => 1 } $base->search_objects('group', 'sutype=dpmt');
31    my %userdpmt = $base->attributes_summary_by_object('user', 'department');
32    my %dpmtmanager = $base->attributes_summary_by_object('group', 'managedBy');
33    my %usermanager = $base->attributes_summary_by_object('user', 'managerContact');
34
35    my %nodes;
36    my $data = {
37        nodes => [],
38        links => [],
39    };
40
41    foreach my $user (keys %users) {
42        push(@{ $data->{nodes} }, {
43                "name" => $user,
44                label => $user,
45        });
46        $nodes{$user} = $#{ $data->{nodes} };
47    }
48    push(@{ $data->{nodes} }, {
49            "name" => '-direction',
50            label => 'Direction',
51        });
52    $nodes{'-direction'} = $#{ $data->{nodes} };
53
54    foreach my $user (keys %dpmts) {
55        push(@{ $data->{nodes} }, {
56                "name" => '-' . $user,
57                label => $user,
58        });
59        $nodes{'-' . $user} = $#{ $data->{nodes} };
60        push(@{ $data->{links} },
61            {
62                "source" => $nodes{'-' . $user},
63                "target" => $nodes{'-direction'},
64                color => 'red',
65            }
66        );
67
68    }
69
70   
71    foreach my $user (keys %users) {
72
73        if (my $dpmt = $userdpmt{$user}) {
74            push(@{ $data->{links} },
75                {
76                    "source" => $nodes{$user},
77                    "target" => $nodes{'-' . $dpmt->[0]},
78                }
79            ) if ($dpmt->[0]);
80        }
81        if (my $manag = $usermanager{$user}) {
82            my $target = $manag->[0];
83            push(@{ $data->{links} },
84                {
85                    "source" => $nodes{$user},
86                    "target" => $nodes{$target},
87                }
88            ) if ($target);
89        }
90
91
92    }
93   
94    $c->stash->{data} = $data;
95}
96
97
98
99=encoding utf8
100
101=head1 AUTHOR
102
103Olivier Thauvin,Guyancourt - B1428,+33 1 80285052,
104
105=head1 LICENSE
106
107This library is free software. You can redistribute it and/or modify
108it under the same terms as Perl itself.
109
110=cut
111
112__PACKAGE__->meta->make_immutable;
113
1141;
Note: See TracBrowser for help on using the repository browser.