package LIMS::Controller::Test; # contains methods for test purposes only use Data::Dumper; use LIMS::Local::PDF; use LIMS::Local::Sugar; use CGI::Application::Plugin::Output::XSV (':all'); use base 'LIMS::Base'; # for test harness: # $ENV{DEBUG_ON}=1; startmode default { $self->_debug_path($self->get_current_runmode); return $self->dump_html; } # test flash under redirect: runmode test_flash ($mode) { $self->_debug_path($self->get_current_runmode); # for 99test.t: if ($mode) { $self->flash( $mode => 'redirect from ' . $self->get_current_runmode ); } # for Resources/Test flash: else { for ( qw/error warning info/ ) { $self->flash( $_ => 'redirect from ' . $self->get_current_runmode ); } } #warn 'FLASH IS_EMPTY: '.$self->flash->is_empty; #$self->flash->set( $mode => 'redirected from ' . $self->get_current_runmode ); #warn 'FLASH IS_EMPTY: '.$self->flash->is_empty; #warn Dumper $self->flash->dump; return $self->redirect( $self->query->url . '/resources' ); } runmode test_email { $self->_debug_path($self->get_current_runmode); my $cfg = $self->cfg('settings'); if ( $self->query->param('test_fail') ) { delete $cfg->{email_from}; # make it fail } my %data = ( recipient => $cfg->{admin_contact}, settings => $cfg, subject => 'Test message from ' . $cfg->{application_name}, message => 'Test sent: ' . DateTime->now->dmy, ); my $rtn = $self->model('Email')->send_message(\%data); return $self->tt_process({ result => $rtn }); } runmode print_pdf { $self->_debug_path($self->get_current_runmode); my $o = LIMS::Local::PDF->new( path => $self->cfg('path_to_www_docs') ); my $html = $self->dump_html; my $pdf = $o->make_pdf({ html => $html }); $self->header_add(-type => 'application/pdf', -expires => 'now'); return $pdf; } # display $q->url methods: runmode test_urls { my $q = $self->query; my %data = ( '' => $q->url(), 'full=>1' => $q->url(-full=>1), # alternative syntax 'relative=>1' => $q->url(-relative=>1), 'absolute=>1' => $q->url(-absolute=>1), 'path_info=>1' => $q->url(-path_info=>1), 'base => 1' => $q->url(-base => 1), 'rewrite=>1' => $q->url(-rewrite=>1), 'rewrite=>0' => $q->url(-rewrite=>0), 'path_info=>1, -query=>1' => $q->url(-path_info=>1,-query=>1), 'path_info=>1, -rewrite=>1' => $q->url(-path_info=>1, -rewrite=>1), 'path_info=>1, -rewrite=>0' => $q->url(-path_info=>1, -rewrite=>0), ); $self->tt_params( queries => \%data ); return $self->tt_process; } runmode forbidden_page { return $self->forbidden(); } runmode rose_helpers { # get some db objects with relationships: my $data = $self->model('Test')->get_all_diagnoses; foreach my $o ( @$data ) { warn Dumper { $o->column_value_pairs }; } $self->tt_params( data => $data ); return $self->tt_process; } # test $SIG{__DIE__} handler: runmode no_validation_profile { $self->js_validation_profile('no_exists'); return $self->dump_html; } runmode xl_out { my @fields = qw(member_id first_name last_name); my $headers = clean_field_names( \@fields ); my $data = [ { member_id => 1, first_name => 'foo', last_name => 'bar', } ]; my %opts = ( fields => $headers, values => $data, csv_opts => { sep_char => "\t" }, # = default filename => 'members.csv', include_headers => 1, # = default ); return $self->xsv_report_web(\%opts); } runmode iterator { my $lots_of_records = $self->model('Base')->get_objects_iterator('Specimen'); my $i = 0; while ( my $rec = $lots_of_records->next ) { if ( ++$i > 10 ) { # $self->pager({ query => \%args_for_search, total => $count }); } # warn $i; } return $self->dump_html; } runmode xml_out ($location) { return unless $location && length $location >= 3; warn 'here'; use XML::Simple qw(:strict); # need to specify ForceArray & KeyAttr if using :strict here my $xs = XML::Simple->new(); my %xs_out_options = ( RootName => 'results', NoAttr => 1, XMLDecl => 1, , SuppressEmpty => 1, # ? only works for xml_in KeyAttr => [], ); my %args = ( query => [ display_name => { like => '%' . $location . '%' } ], sort_by => 'display_name', limit => 10, ); my $sources = $self->model('Base')->get_objects( 'ReferralSource', \%args ); # $self->debug( [ map { $_->display_name } @$sources ] ); my @output = map { sprintf '%s', # escape html (eg '&') or ajax function silently fails: $_->id, $_->organisation_code, $self->query->escapeHTML($_->display_name); } @$sources; # TODO: use XML::Simple to generate xml (My::ULISA) #my $xml = sprintf '%s', join '', @output; # set header type to xml: $self->header_props(-type=>'text/xml'); my $data = q! Arrowe Park, Wirral BUPA - Gatwick Park BUPA - Park Way Chelsfield Park Hospital !; my $ref = XMLin($data, ForceArray => 1, KeyAttr => []); $self->debug($ref); my %rs; foreach (@$sources) { my $data = { info => $_->organisation_code, content => $self->query->escapeHTML($_->display_name) }; #push @{$rs{rs}}, $data; $rs{$_->id} = $data; } # $self->debug(\%rs); my $xml = XMLout($ref, %xs_out_options); return $xml; } 1;