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