• Files
• Commits
• Log
• Graph
• Stats

# automates registration of multiple patients under fastcgi process
# assumes fastcgi server running
# if using lims_test db:
#	at least 1 test script has previously run (to populate db tables),
# 	patients table contains 'green'
# if using prod db:
#	no requirements

###########################################################################################################
# need to temp. set $ENV{ROSEDB_DEVINIT} to required db in fcgi script
# also need temp. override in M::User::verify_credentials() to return $user->username without passwd matching
# coz browser login into lims_test db doesn't work anymore
###########################################################################################################

use strict;
use warnings;

BEGIN { 
    use FindBin qw($Bin); # warn 'BIN:'.$Bin;
    # set lib paths for app:
    use lib (
        '/home/raj/perl5/lib/perl5',
        "$Bin/../lib",
        "$Bin/..",
    );
	# this won't work - clobbered by 'while' loop in fastcgi script:
	# $ENV{ROSEDB_DEVINIT} = "$Bin/../config/rosedb_devinit_test.pl";
}

use WWW::Mechanize;
use DBIx::Simple;
use Data::Dumper;
use DateTime;

my $mech = WWW::Mechanize->new();

# url that points to fastcgi process:
my $home_url = 'http://localhost/hmds';

open my $fh, '>' . './mech.txt' or die $!;

use vars qw($random_number);

require LIMS::DB;

my $db = LIMS::DB->new_or_cached;
my $dbh = $db->retain_dbh or die LIMS::DB->error; # use Data::Dumper; warn Dumper $db->dsn;
my $dbix = DBIx::Simple->new($dbh);

# max request number this yr:
my $max_req_no = $dbix->query( "select max(request_number) from requests where year = ?", DateTime->now->year)->list;
# specimens list: 
my $specimens = $dbix->query( 'select sample_code from specimens')->flat; 
# get 100 random surnames, 5 letters beginning with 'c' & no spaces, from hilis4.patients table:
my $surnames = $dbix->query( "select distinct(last_name) from hilis4.patients where last_name like 'c____' limit 100")->flat;

#my $last_name = 'green'; # if using lims_test

# warn $max_req_no; exit;
# warn Dumper $surnames; exit;
# warn Dumper $specimens; exit;

do_login(); # print $mech->content; exit;

do_registration($_) for (1..100);

sub do_registration {  warn shift;
	my $surname = $surnames->[$random_number]; # warn $surname; return;
	$random_number = int rand(@$surnames); # warn $random_number; return;
	
	$mech->get($home_url . '/register'); # print $fh $mech->content;
	
	$mech->submit_form( fields => { name => $surname } ); # print $fh $mech->content; exit;
	#sleep(1);
	
	# select 1st one:
	$mech->follow_link( url_regex => qr/(?i:select_patient)/ ); # print $fh $mech->content; exit;
	#sleep(1);
	
	# select 1st one:
	$mech->follow_link( url_regex => qr/(?i:add_new)/ ); # print $fh $mech->content; exit;
	#sleep(1);
	
	$random_number = int rand(@$specimens);
	
	my %fields = (
		request_number => ++$max_req_no,
		referrer_code  => 'C9999998', # unknown
		specimen       => $specimens->[$random_number],
	);
	
	$mech->submit_form( fields => \%fields ); # print $fh $mech->content; exit;
	sleep(1);
}

sub do_login {
    my $userid = 'unknown.user';
    my $passwd = 'not-required'; # doesn't work on lims_test anymore

    $mech->get($home_url); # warn $mech->content; exit;
	
    # login:
    $mech->submit_form(
		form_name => 'login_form',
        fields => {
            authen_username => $userid, 
            authen_password => $passwd,
        },
    ); # warn $mech->content;
}