#!/usr/bin/perl BEGIN { use lib '/home/raj/perl5/lib/perl5'; # *must* come before FindBin($Bin) use FindBin qw($Bin); # warn $Bin; exit; use lib $Bin . '/../../../lib'; # override default db test: $ENV{ROSEDB_DEVINIT} = "$Bin/../../../config/rosedb_devinit_prod.pl"; } my $JUST_TESTING = 0; # not relevant use Scalar::Util; use Modern::Perl; use Config::Auto; use Data::Printer; use SQL::Abstract::More; use LIMS::Local::Utils; use LIMS::Local::Reports; use LIMS::Local::ScriptHelpers; # get tools from LIMS::Local::ScriptHelpers: my $tools = LIMS::Local::ScriptHelpers->new(); $tools->test_only($JUST_TESTING); my $config = $tools->config(); my $dbix = $tools->dbix(); my $start = LIMS::Local::Utils::last_working_date(); # considers public hols #my $start = LIMS::Local::Utils::last_working_date->subtract(days => 20); # p $start; my $end = $tools->time_now; # p $start; p $end; exit; # substitutes LIMS methods required by Role::RecordHandler : my $lims = LIMS::Local::Reports->new({ tools => $tools }); # localhost http address - for charts; is_print_request for tt formatting: $lims->tt_params( app_url => 'http://localhost/hilis4', is_print_request => 1, # can't use c.get_current_runmode method ); my $multi = PDF::API2->new; { my ($sql, @bind) = get_query_params(); # dump_query($sql, @bind); my $request_ids = $dbix->query($sql, @bind)->flat; # p $request_ids; my $title = sprintf 'Print run [%s - %s]', $start->ymd, $end->ymd; $multi->info( Title => $title ); for my $request_id (@$request_ids) { # warn $request_id; next; # generate pdf: my $req = $lims->get_single_request_data($request_id); # L::C::Roles::RecordHandler import_pdf($req); # generate 2nd copy with 'cc' as referrer if copy_to selected: if ( $req->{request_options}->{copy_to}->{is_selected} ) { # p $request_id; my $o = $req->{data}; # $request_data is RDBO object $o->referrer_department->referrer->name('cc'); # replace referrer name import_pdf($req); } } my $file_name = '/backups/print_run/printrun_' . $end->ymd . '.pdf'; $multi->saveas($file_name); # save file to disk } #=============================================================================== sub import_pdf { my $data = shift; my $pdf = $lims->format_print_run_report($data); my $api = PDF::API2->open_scalar($pdf); $multi->importpage($api, $_) foreach 1 .. $api->pages; } sub get_query_params { my @tbl_rels = ( # table|alias # FK-PK relationship 'requests|r' , 'r.referrer_department_id = rd.id' , 'referrer_department|rd' , 'rd.referrer_id = ref.id' , 'referrers|ref' , 'r.patient_case_id = pc.id' , 'patient_case|pc' , 'rr.request_id = r.id' , 'request_report_view|rr' , 'r.status_option_id = so.id' , 'status_options|so' , 'pc.referral_source_id = rs.id' , 'referral_sources|rs' , 'rs.parent_organisation_id = po.id' , 'parent_organisations|po' ); my %query = ( 'rr.updated_at' => { -between => [ $start, $end ] }, 'so.description' => { -in => [ qw/authorised complete/ ] }, ); # exclude any locations which don't require paper copies: if ( my $cfg = $tools->get_yaml_file('skip_paper_reports') ) { # p $cfg; if ( my $org_codes = $cfg->{organisation} ) { # p $org_codes; $query{'po.parent_code'} = { -not_in => $org_codes }; } if ( my $hospitals = $cfg->{hospital} ) { # p $hospitals; $query{'rs.organisation_code'} = { -not_in => $hospitals }; } if ( my $departments = $cfg->{department} ) { # p $departments; for (@$departments) { # eg RWA/823 my ($location, $department) = split '/'; # p $location; p $department; # 5-digits (hospital) or 3-digits (organisation) code: my $site_type = length $location > 3 ? 'rs.organisation_code' : 'po.parent_code'; my %h = ( $site_type => $location, 'rd.hospital_department_code' => $department, ); push @{ $query{-not_bool} }, \%h; } } } # p %query; exit; my @sort_by = qw(ref.name r.year r.request_number); my ($sql, @bind) = SQL::Abstract::More->new->select( -columns => 'r.id', -from => [ -join => @tbl_rels ], -where => \%query, -order_by => \@sort_by, ); # p $sql; p @bind; return ($sql, @bind); } sub dump_query { # might need to use DBIx::Simple::_replace_omniholder() if sql contains '??' my ($sql, @bind) = @_; my $i = 0; for (@bind) { # replace each '?' with next element of array: my $val = Scalar::Util::looks_like_number($bind[$i]) ? $bind[$i] : $dbix->dbh->quote($bind[$i]); # say $bind[$i]; $sql =~ s/\Q?/$val/; $i++; } $sql =~ s/(FROM|INNER|WHERE|ORDER BY|GROUP BY)/\n$1/g; # p $sql; }