File Coverage

lib/CGI/Application/Plugin/MetadataDB.pm

Criterion	Covered	Total	%
statement	33	146	22.6
branch	2	54	3.7
condition	0	16	0.0
subroutine	9	19	47.3
pod	9	9	100.0
total	53	244	21.7

package CGI::Application::Plugin::MetadataDB;
use strict;
require Exporter;
require CGI::Application;
use LEOCHARRE::DEBUG;
use vars qw(@ISA $VERSION @EXPORT_OK @EXPORT);

# what modules does this code need
use HTML::Template::Default 'get_tmpl';
use CGI::Application::Plugin::Feedback;
use CGI::Application::Plugin::Session;


no strict 'refs';
# this sets default
__PACKAGE__->_set_class_defaults(
   mdw_per_page_limit => 100,
   mdw_result_code => '


   id

   ',
   mdw_search_results_tmpl_name => 'mdw.search_results.html',
   mdw_search_tmpl_name => 'mdw.search.html',

);

# export...
@ISA = qw(Exporter);
@EXPORT_OK = qw(mds_object
mdw_per_page_limit
mdw_process_search
mdw_record_params
mdw_records_loop
mdw_result_code
mdw_results_loop_detailed
mdw_search_args_submitted
mdw_search_results_tmpl
mdw_search_results_tmpl_name
mdw_search_results_tmpl_code
mdw_search_tmpl
mdw_search_tmpl_name);
@EXPORT = @EXPORT_OK;



sub _set_class_defaults {
   my $class = shift;
   my %arg = @_;
   while( my($k,$v) = each %arg ){
      ${"$class\::$k"} = $v;
      _make_class_accessor_setget($class,$k);
   }
   return;
}

sub _make_class_accessor_setget {
   my($class,$name)= @_;
   defined $class or die;
   defined $name or die;

   *{"$class\::$name"} =
   sub {
      my ($self,$val) = @_;

      if( defined $val ){
         # store it in object only
         $self->{$name} = $val;
      }

      unless( defined $self->{$name} ){

         # check if it's defined in the class default
         if( defined ${"$class\::$name"} ){
            $self->{$name} = ${"$class\::$name"};
         }
      }
      return $self->{$name};
   };
}




sub mdw_search_tmpl {
   my ($self,$tmpl) = @_;

   if(defined $tmpl){
      $self->{_mdw_search_tmpl} =$tmpl;
   }

   unless( $self->{_mdw_search_tmpl} ){

      $ENV{HTML_TEMPLATE_ROOT} or die('$ENV{HTML_TEMPLATE_ROOT} is not set');

      my $filename = $self->mdw_search_tmpl_name;
      $self->feedback("trying for tmpl '$filename'") if DEBUG;

      my $abs  = "$ENV{HTML_TEMPLATE_ROOT}/$filename";
      -f $abs or die("$abs not on disk, missing $filename
         in HTML_TEMPLATE_ROOT, please see Metadata::DB::WUI");

      debug("found '$abs'");
      require HTML::Template::Default;
      my $tmpl = HTML::Template::Default::get_tmpl($filename);
      $self->{_mdw_search_tmpl} = $tmpl;
   }
   return $self->{_mdw_search_tmpl};
}

sub mdw_search_results_tmpl {
   my($self,$tmpl) = @_;
   if(defined $tmpl){
      $self->{_mdw_search_results_tmpl} = $tmpl;
   }
   unless( $self->{_mdw_search_results_tmpl} ){

      my $filename      = $self->mdw_search_results_tmpl_name;
      my $default_code  = $self->mdw_search_results_tmpl_code;
      $self->feedback("trying for tmpl '$filename'") if DEBUG;

      require HTML::Template::Default;
      my $tmpl = HTML::Template::Default::get_tmpl($filename,\$default_code);
      $self->{_mdw_search_results_tmpl} = $tmpl;
   }
   return $self->{_mdw_search_results_tmpl};
}






# TEMPLATES ...............................



sub mdw_search_results_tmpl_code {
   my $self = shift;
   my $rc = $self->mdw_result_code;
   my $default_code =  qq{
   $rc

   };
   return $default_code;
}


# end templates --------------------------------------------------------------------










# START GET ARGS ////////////////////////////////////////// //////////////////////////
# the output of this is fed to Metadata::DB::Search::search()
sub mdw_search_args_submitted  {
   my $self = shift;
   my %h=();

   # the form needs to list what the attribute params are..
   # this means though, that we cannot reload a search without posting

   # DONT MESS WITH THIS
   require Metadata::DB::Search::InterfaceHTML;
   my $PREPEND_FIELD_NAME = $Metadata::DB::Search::InterfaceHTML::PREPEND_FIELD_NAME;

   my $prepend = $self->query->param($PREPEND_FIELD_NAME);
   $prepend
      or warn("missing ($PREPEND_FIELD_NAME:$prepend) in post data")
      and return;
   debug("prepend $PREPEND_FIELD_NAME = $prepend");


   my @a = $self->query->param( "$prepend\_attribute")
      or debug("No search params requested. Missing [$prepend\_attribute] in form.")
      and return;

   unless ( defined @a and scalar @a ){
      debug('no search params requested');
      $self->feedback('No search params requested.');
      return;
   }

   my $message;

   ATT: for my $key (@a){
      my $val = $self->query->param("$prepend\_$key");
      defined $val and $val=~/\w/ or next ATT;

      my $type = $self->query->param("$prepend\_$key\_match_type");
      $type or warn("no type in $type");
      $type ||='like';
         #TODO this is not working

      $h{"$key:$type"} = $val;
      debug("search param: $key ($type) $val");

      $self->feedback("You searched for '$key' ($type) '$val'");
   }

   %h or $self->feedback('No search params requested and resolved.') and return;

   return \%h;
}


# END GeT ARGS ///////////////////////////////////////////// ///////////////

#*mdw_results_loop_detailed = \&mdw_results_loop;
sub mdw_results_loop_detailed {
   my ($self,$mds) = @_;
   $mds ||= $self->mds_object;

   my @ids = @{$mds->ids};
   my $count = $mds->ids_count;

   my $limit = $self->mdw_per_page_limit;

   $self->feedback("Found $count results.");

   if( $count > $limit ){
      $#ids = ($limit - 1);
      debug("results count $count is more then limit $limit, will prune down");
      $self->feedback("Showing $limit results.");
   }

   my $loop = $self->mdw_records_loop( \@ids );
   return $loop;
}

# returns vars for html template in a hashref
sub mdw_record_params {
   my ($self,$id) = @_;

   my $mds = $self->mds_object;

   my $meta={
      id => $id,
   };

   my $hash = $mds->_record_entries_hashref($id);

   my $ul = "\t\n";
   for ( sort keys %$hash ){
      unless( $_=~/_path$/ ){ # maybe have a regex for this
         $ul.="\t\t".$_ .' : '. $hash->{$_}->[0] ."\n";
      }
      $meta->{'meta_'.$_} = $hash->{$_}->[0];
   }
   $ul.="\t\n";
   $meta->{meta_as_ul_html} = $ul;

   return $meta;
}


sub mdw_records_loop {
   my($self,$ids) = @_; #search object

   my $mds = $self->mds_object;

   my @results_loop = ();

   my $i;
   for my $id ( @{$ids} ){
      my $record_meta = $self->mdw_record_params($id);
      $record_meta->{list_index} = ++$i;
      push @results_loop, $record_meta;
   }
   return \@results_loop;
}




# get a Metadata::DB::Search object, cached
sub mds_object {
   my ($self) = @_;



   unless( $self->{_mdsearch_object} ){
      require Metadata::DB::Search;
      my $dbh = $self->param('DBH');
      $dbh or die('missing DBH in param');
      debug('DBH has '. ref $dbh);

      $self->{_mdsearch_object} = Metadata::DB::Search->new({ DBH => $self->param('DBH') })
         or die;
   }
   return $self->{_mdsearch_object};
}


sub mdw_process_search {
   my $self = shift;

   # get search params
   my $search_args = $self->mdw_search_args_submitted
      or return 0;

   #get the search object
   my $mds = $self->mds_object
      or return;

   # feed it
   unless( $mds->search($search_args) ) {
      $self->feedback('Something went wrong with the search.');
      $self->feedback('Please wait and try again, or contact the system administrator.');
      return;
   }



   return 1;
}




1;

__END__