• Files
• Commits
• Log
• Graph
• Stats

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');
    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 '<rs id="%s" info="%s">%s</rs>', # 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 '<?xml version="1.0" encoding="utf-8" ?><results>%s</results>', join '', @output;

    # set header type to xml:
    $self->header_props(-type=>'text/xml');

    my $data = q!
<results>
<rs id="48" info="RBL14 ">Arrowe Park, Wirral</rs>
<rs id="21" info="NT308 ">BUPA - Gatwick Park</rs>
<rs id="22" info="NT320 ">BUPA - Park Way</rs>
<rs id="29" info="NT409 ">Chelsfield Park Hospital</rs>
</results>!;

    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;