File Coverage

lib/Metadata/DB/WUI.pm
Criterion Covered Total %
statement 28 30 93.3
branch n/a
condition n/a
subroutine 10 10 100.0
pod n/a
total 38 40 95.0


line stmt bran cond sub pod time code
1             package Metadata::DB::WUI;
2 1     1   25021 use strict;
  1         3  
  1         31  
3 1     1   5 use base 'CGI::Application';
  1         2  
  1         1257  
4              
5 1     1   9396 use CGI::Application::Plugin::MetadataDB;
  1         3  
  1         110  
6              
7 1     1   5 use Carp;
  1         2  
  1         64  
8 1     1   1220 use CGI::Application::Plugin::AutoRunmode;
  1         11181  
  1         10  
9 1     1   182 use CGI::Application::Plugin::Feedback;
  1         3  
  1         9  
10 1     1   111 use CGI::Application::Plugin::Session;
  1         3  
  1         10  
11 1     1   93 use HTML::Template::Default 'get_tmpl';
  1         1  
  1         48  
12              
13 1     1   1126 use CGI::Application::Plugin::Forward;
  1         585  
  1         49  
14 1     1   623 use CGI::Application::Plugin::Menu;
  0            
  0            
15             use LEOCHARRE::DEBUG;
16              
17             use LEOCHARRE::DBI;
18              
19             #use Cwd;
20             our $VERSION = sprintf "%d.%02d", q$Revision: 1.16 $ =~ /(\d+)/g;
21              
22              
23              
24             sub conf {
25             my $self = shift;
26              
27             unless($self->{__conf}){
28             if( my $abs = $self->_abs_conf ){
29             debug("attempting $abs conf load..");
30             require YAML;
31             my $conf = YAML::LoadFile($abs);
32             #$conf->{mdw_search_tmpl_name} ||= 'mdw.search.html';
33             #$conf->{mdw_search_results_tmpl_name} ||= 'mdw.search_results.html';
34            
35             $self->mdw_search_tmpl_name( $conf->{mdw_search_tmpl_name} ); # if undef, changes nothing
36             $self->mdw_search_results_tmpl_name( $conf->{mdw_search_results_tmpl_name} ); # same
37             $ENV{HTML_TEMPLATE_ROOT} ||= $conf->{HTML_TEMPLATE_ROOT};
38              
39             my $DBH;
40             if ($conf->{DBABSPATH}){
41             $DBH = DBI::connect_sqlite($conf->{DBABSPATH});
42             }
43             elsif( $conf->{DBNAME} ){
44             $DBH = DBI::connect_mysql(
45             $conf->{DBNAME}, $conf->{DBUSER}, $conf->{DBPASSWORD}, $conf->{DBHOST}
46             );
47             }
48             if ($DBH){
49             $self->param( DBH => $DBH );
50             }
51              
52             $self->{__conf} = $conf;
53             }
54             }
55             return $self->{__conf};
56             }
57             sub _abs_conf {
58             my $self = shift;
59              
60             # detect the change
61             if ( my $val = $self->query->param('conf') ){
62             $self->feedback("changed to $val");
63             $self->session->param('conf' => $val );
64             }
65             my $abs_conf;
66             $abs_conf = $self->query->param('conf');
67             $abs_conf ||= $self->session->param('conf');
68             $abs_conf ||= $self->param('conf');
69             $abs_conf ||='mdw.conf';
70              
71             unless( -f "./$abs_conf" ){
72             $self->feedback("$abs_conf not on disk");
73             return;
74             }
75             return $abs_conf;
76             }
77             sub _mdw_confs { # returns list
78             my $self = shift;
79              
80             unless( $self->{_mdw_confs} ){
81              
82             if( opendir(DIR,'./') ){
83             my @p = grep { /md.+\.conf$/ } readdir DIR;
84             $self->{_mdw_confs} = \@p;
85             }
86             else {
87             $self->{_mdw_confs} = [];
88             }
89             }
90             return $self->{_mdw_confs};
91             }
92             sub _mdw_confs_count {
93             my $self = shift;
94             return ( scalar @{$self->_mdw_confs} );
95             }
96             sub mdw_select : Runmode {
97             my $self = shift;
98              
99             my $code = q{
100            
Select..
101            
102            
103            
  • 104            
    105            
    106             };
    107              
    108             my $tmpl = get_tmpl(\$code);
    109             my $outer = $self->feed_tmpl_mdw;
    110            
    111             my @seloop;
    112             for my $conf ( @{$self->_mdw_confs} ){
    113             push @seloop, { FILE => $conf };
    114             }
    115             $tmpl->param( MDW_CONFS_LOOP => \@seloop );
    116             $outer->param( BODY => ($tmpl->output) );
    117             return $outer->output;
    118             }
    119             sub setup {
    120             my $self = shift;
    121             $self->start_mode('mdw_search');
    122             $self->mode_param('rm');
    123             $self->conf;
    124              
    125             }
    126              
    127              
    128              
    129             # runmode
    130             # the search form is generated by Metadata::DB::WUI bin/mdri
    131             # for options see on the command line: # mdri -h
    132             sub mdw_search : Runmode {
    133             my $self = shift;
    134              
    135             my $tmpl = $self->mdw_search_tmpl;
    136              
    137             my $outer = $self->feed_tmpl_mdw;
    138             $outer->param( BODY => ($tmpl->output) );
    139             return $outer->output;
    140            
    141             }
    142              
    143             sub mdw_help : Runmode {
    144             my $self = shift;
    145             my $default = q{
    146            
     
    147             For help, please see admin.
    148             This document will be further updated.
    149            
    150             };
    151             my $tmpl = get_tmpl('mdw_help.html',\$default);
    152             my $outer = $self->feed_tmpl_mdw;
    153             $outer->param( BODY => $tmpl->output);
    154              
    155             return $outer->output;
    156             }
    157              
    158             # runmode
    159             sub mdw_search_results : Runmode {
    160             my $self = shift;
    161              
    162             $self->mdw_process_search
    163             or return $self->forward('mdw_search');
    164              
    165             my $tmpl = $self->mdw_search_results_tmpl;
    166            
    167             my $search_results_loop = $self->mdw_results_loop_detailed;
    168            
    169             $tmpl->param(
    170             SEARCH_RESULTS_LOOP => $search_results_loop,
    171             );
    172            
    173            
    174             my $outer = $self->feed_tmpl_mdw;
    175             $outer->param( BODY => $tmpl->output );
    176             my $output = $outer->output;
    177             return $output;
    178             }
    179              
    180              
    181             sub feed_tmpl_mdw {
    182             my $self = shift;
    183              
    184             my $tmain = $self->tmpl_outer;
    185              
    186             $tmain->param(
    187             FEEDBACK => $self->get_feedback_html,
    188             MENU => ($self->menu->output),
    189             );
    190            
    191             return $tmain;
    192             }
    193              
    194              
    195             sub tmpl_outer {
    196             my $self = shift;
    197              
    198             unless ( $self->{tmpl_outer} ){
    199            
    200              
    201             my $default_code = q{
    202            
    203              
    204             <TMPL_VAR NAME="TITLE" DEFAULT="Metadata Search">
    205            
    206            
    207              
    208            
    209              
    210            
    211              
    212            
    213            
    214            
    215            

    216            
    217            
    218             };
    219              
    220             $self->{tmpl_outer} = get_tmpl(\$default_code, 'mdw_main.html');
    221             $self->feedback("loaded mdw_main.html") if DEBUG;
    222            
    223             # init menu
    224              
    225             $self->menu->add('mdw_search', 'new search');
    226             $self->menu->add('mdw_select', 'select conf') if ( $self->_mdw_confs_count > 1 );
    227             }
    228              
    229             return $self->{tmpl_outer};
    230              
    231             }
    232              
    233              
    234              
    235              
    236             1;
    237              
    238              
    239             __END__