1package App::Netdisco::Web::GenericReport;
2
3use Dancer ':syntax';
4use Dancer::Plugin::DBIC;
5use Dancer::Plugin::Auth::Extensible;
6
7use App::Netdisco::Web::Plugin;
8use Path::Class 'file';
9use Storable 'dclone';
10use Safe;
11
12our ($config, @data);
13
14foreach my $report (@{setting('reports')}) {
15  my $r = $report->{tag};
16
17  register_report({
18    tag => $r,
19    label => $report->{label},
20    category => ($report->{category} || 'My Reports'),
21    ($report->{hidden} ? (hidden => true) : ()),
22    provides_csv => true,
23    api_endpoint => true,
24    bind_params  => $report->{bind_params},
25    api_parameters => $report->{api_parameters},
26  });
27
28  get "/ajax/content/report/$r" => require_login sub {
29      # TODO: this should be done by creating a new Virtual Result class on
30      # the fly (package...) and then calling DBIC register_class on it.
31
32      my $schema = ($report->{database} || 'netdisco');
33      my $rs = schema($schema)->resultset('Virtual::GenericReport')->result_source;
34      (my $query = $report->{query}) =~ s/;$//;
35
36      # unpick the rather hairy config of 'columns' to get field,
37      # displayname, and "_"-prefixed options
38      my %column_config = ();
39      my @column_order  = ();
40      foreach my $col (@{ $report->{columns} }) {
41        foreach my $k (keys %$col) {
42          if ($k !~ m/^_/) {
43            push @column_order, $k;
44            $column_config{$k} = dclone($col || {});
45            $column_config{$k}->{displayname} = delete $column_config{$k}->{$k};
46          }
47        }
48      }
49
50      $rs->view_definition($query);
51      $rs->remove_columns($rs->columns);
52      $rs->add_columns( exists $report->{query_columns}
53        ? @{ $report->{query_columns} } : @column_order
54      );
55
56      my $set = schema($schema)->resultset('Virtual::GenericReport')
57        ->search(undef, {
58          result_class => 'DBIx::Class::ResultClass::HashRefInflator',
59          ( (exists $report->{bind_params})
60            ? (bind => [map { param($_) } @{ $report->{bind_params} }]) : () ),
61        });
62      @data = $set->all;
63
64      # Data Munging support...
65
66      my $compartment = Safe->new;
67      $config = $report; # closure for the config of this report
68      $compartment->share(qw/$config @data/);
69      $compartment->permit_only(qw/:default sort/);
70
71      my $munger  = file(($ENV{NETDISCO_HOME} || $ENV{HOME}), 'site_plugins', $r)->stringify;
72      my @results = ((-f $munger) ? $compartment->rdo( $munger ) : @data);
73      return if $@ or (0 == scalar @results);
74
75      if (request->is_ajax) {
76          template 'ajax/report/generic_report.tt',
77              { results => \@results,
78                is_custom_report => true,
79                column_options => \%column_config,
80                headings => [map {$column_config{$_}->{displayname}} @column_order],
81                columns => [@column_order] };
82      }
83      else {
84          header( 'Content-Type' => 'text/comma-separated-values' );
85          template 'ajax/report/generic_report_csv.tt',
86              { results => \@results,
87                headings => [map {$column_config{$_}->{displayname}} @column_order],
88                columns => [@column_order] };
89      }
90  };
91}
92
93true;
94