package LIMS::Local::ExcelHandler;

# ParseExcel_XLHTML speeds up Spreadsheet::ParseExcel; requires xlhtml package (apt-get install xlhtml)
# IO::All & .csv file *much* faster than ParseExcel_XLHTML
# Text::CSV::Simple - about 50% of speed of IO::All->getline, but handles native .csv files better
# Text::CSV::Slurp in conjunction with Text::CSV_XL >0.80 nearly same speed as IO::All
# now using Text::CSV::Slurp::_from_handle() v0.901 patch (mst) direct in _text_csv_slurp()

use strict;
use warnings;

use IO::File;
use Text::CSV;
use File::stat;
use Data::Dumper;
use Text::CSV_XS 0.88; # faster csv parsing
use LIMS::Local::Config;
use Spreadsheet::WriteExcel;
use Spreadsheet::ParseExcel::Simple;

# use Text::CSV::Slurp 0.901; # using v0.901 patch direct now in _text_csv_slurp()
# use Text::CSV::Simple; replaced with T::C::Slurp - faster & avoids lousy on_failure error
# use Spreadsheet::ParseExcel_XLHTML;
# use Spreadsheet::ParseExcel::Simple; # too slow

=begin # add a more explicit warning for Text::CSV::Simple errors:
Text::CSV::Simple->add_trigger(on_failure => sub { 
	my ($self, $csv) = @_;
    if ( my $err = $csv->error_input ) {
        warn qq!Text::CSV::Simple parser failed on: "$err"\n!;
        # warn Dumper [$csv->error_diag]; # call error_diag() in list context
    }
});
=cut

# use Time::HiRes qw(gettimeofday tv_interval); my $t0 = [gettimeofday];

my $cfg = LIMS::Local::Config->instance;
my $path_to_app_root = $cfg->{path_to_app_root}
    || die "Couldn't find path to application directory"; # warn $path_to_app_root;

my ($specialities, $locales); # for lookup hashref tables, used if lookup = clinician

#------------------------------------------------------------------------------
sub new {
    my $class = shift;
    my $self  = {};

    $self->{WORKBOOK}      = undef;
    $self->{LOCATION_TYPE} = undef;
	$self->{FILEHANDLE}    = undef; # for write_excel_file()
    bless ($self, $class);

    return $self;
}

#------------------------------------------------------------------------------
# setter: receives target type (hospital, clinician, etc) as arg, sets target xls file for target type:
# getter & setter: returns xls filename
sub source {
    my $self = shift;

    if (@_) {
        $self->{LOCATION_TYPE} = shift; # warn $self->{LOCATION_TYPE};

        $self->{WORKBOOK} = $self->_get_file('filename')
            || die "Cannot find target xls file for location type: $self->{LOCATION_TYPE}";
    }
    else {
        return $self->{WORKBOOK}; # filename from yml file
    }
}

#------------------------------------------------------------------------------
sub filedata {
	my $self = shift;

    my $src_file = $self->source;
    my $path_to_file = $path_to_app_root . '/src/data/' . $src_file . '.csv'; # warn $path_to_file;
	my $filedate = DateTime->from_epoch( epoch => stat($path_to_file)->mtime );
	my $age_in_months = DateTime->now->subtract_datetime($filedate)->delta_months;

	return { filename => $src_file, age => $age_in_months };
}

#------------------------------------------------------------------------------
# parse source file for $terms:
sub parse {
    my $self = shift;
    my $term = shift;

    # my $matches = $self->_parse_excel($term); # very slow
    # my $matches = $self->_parse_excel_xlhtml($term); # faster than ParseExcel
    my $matches = $self->_parse_csv_file($term); # massively faster even than ParseExcel_XLHTML

    # return ref to array of hashrefs:
    return $matches;
}

#------------------------------------------------------------------------------
sub parse_xl_file {
	my ($self, $xl_file, $args) = @_; # warn $xl_file; # args is optional
	
	my $sheet_no = $args->{sheet} || 0; # optional - can pass required worksheet no

    # use Spreadsheet::ParseExcel_XLHTML qw/-install/; # speeds up 4x
	-e $xl_file or die "file does not exist: $xl_file";

    my $xls = Spreadsheet::ParseExcel::Simple->read($xl_file) or die $!;

    my @worksheets = $xls->sheets;
    my $worksheet  = $worksheets[$sheet_no]; # defaults to 0 unless specified
	
	my @data = (); # create array of row arrayrefs:
    while ($worksheet->has_data) {
		push @data, [ $worksheet->next_row ]; # next_row() = array mode
    }
    return \@data;
}

#-------------------------------------------------------------------------------
sub initialise_fh { # for write_excel_file()
	my $self = shift;
	
	if (@_) {
		my $str = shift; # reference to an empty container
		open my $fh, '>', $str or die "failed to open filehandle: $!";
		$self->{FILEHANDLE} = $fh; # warn $self->{FILEHANDLE};
	}
	else {
		return $self->{FILEHANDLE};
	}
}

#-------------------------------------------------------------------------------
sub write_excel_file {
	my $self = shift;
	my $data = shift; # arrayref of hrefs (data, headers & name)

	my $fh = $self->initialise_fh();
	
	my $workbook = Spreadsheet::WriteExcel->new($fh);

	for my $sheet (@$data) {
		my $name       = $sheet->{name}; # optional - defaults to 'Sheet<n>'
		my $data       = $sheet->{data};
		my $headers    = $sheet->{headers};
		my $columns    = $sheet->{columns}; # optional hashref of col widths
		my $opt_format = $sheet->{format}; # optional hashref - forces cell width

		my $row = 0; # row counter

		my $worksheet = $workbook->add_worksheet($name);

		{ # write headers:
			my $format = $workbook->add_format();
			$format->set_bold();
			$format->set_font("Courier New");
			$format->set_align('center');
			$format->set_align('vcenter');
			$format->set_text_wrap() if ( grep $_ eq 'text_wrap', @$opt_format );

			# format columns if required:
			$worksheet->set_column($_, $_, $columns->{$_}) for keys %$columns;

			$worksheet->write( $row++, 0, $headers, $format );
		}
		{ # write rows:
			my $format = $workbook->add_format();
			$format->set_text_wrap() if ( grep $_ eq 'text_wrap', @$opt_format );
			
			$worksheet->write( $row++, 0, $_, $format ) for @$data; # $_ is arrayref
		}
	}
	
	$workbook->close();
}

#------------------------------------------------------------------------------
sub fetch_all {
	my $self = shift;

	my $data = $self->_read_file;
	return $data;
}

#------------------------------------------------------------------------------
sub fetch_cols {
    my $self = shift;
    my $args = shift; # warn Dumper $args;

    my $fields = $args->{fields}; # cols to return data from
    my $select = $args->{select}; # which field to select on eg 'practice_code'
    my $value  = $args->{value};  # value of field eg 'B12345'

    my $file = $self->source;
    my $src_file = $path_to_app_root . '/src/data/' . $file . '.csv'; # warn $src_file;

    my $cols = $self->_get_file('fields'); # warn Dumper $fields;
    my %args = (file => $src_file, field_order => $cols);
	my $rows = $self->_text_csv_slurp(\%args);

    # retrieve required cols for rows where $select field matches $value:
    no warnings 'uninitialized'; # eg undefined cols in src file
    my @data = map { [ @{$_}{@$fields} ] } 
        grep { $_->{$select} eq $value } @$rows; # warn Dumper \@data;
    return \@data;
}

#-------------------------------------------------------------------------------
# this is Text::CSV::Slurp::_from_handle() v0.901 patch (allows field_order):
sub _text_csv_slurp {
    my $self = shift;
    my $args = shift;
    
    # my $io = io($args->{file}); # times out on new Deb6 ??why
    my $io = new IO::File; # ok on new Deb6
    open( $io, '<', $args->{file} ) || return $self->error($!);

    my $order = $args->{field_order};
    my $opt   = { binary => 1 }; # recommended to set true
    
    my $csv = Text::CSV->new($opt);

    if ( $order ) {
        $csv->column_names($order);
    } 
    elsif ( my $head = $csv->getline($io) ) {
        $csv->column_names( $head );
    }
    else {
        return $self->error( $csv->error_diag() );
    }
    
    my @results;
    while ( my $ref = $csv->getline_hr($io) ) {
        push @results, $ref;
    }
    
    return \@results;
}

#------------------------------------------------------------------------------
sub _parse_csv_file {
    my $self = shift;
    my $term = shift;

	my $src_file = $self->source; # warn $src_file;
    my $data = $self->_read_file($term);
	my $fields = $self->_get_file('fields');

    if ($src_file eq 'econcur') {
        $specialities = $self->_get_specialities;
        $locales = $self->_get_locales;
    }

    my @matches; # for results

    ROW: foreach my $row (@$data) { # warn Dumper $row; # next;
        # next ROW unless grep { $row->{$_} =~ /$term/i } keys %$row; - using add_trigger() now
        if ($src_file eq 'econcur') {
            $self->_manipulate_clinician_data($row);
        }

        my $display = join ', ', map $row->{$_},
            grep $row->{$_}, # if field contains entry
                grep $_ !~ /^(code|null)$/, # skip code field & nulls
                    @$fields;

        push @matches, {
            code    => $row->{code},
            display => $display,
        };
    } # timings($t0);

    return \@matches;
}

#------------------------------------------------------------------------------
=begin # fastest method - reads csv file directly:
sub parse_csv_file {
    my $self = shift;
    my $term = shift;

    my $xls_file = $self->source;

    my $path_to_file = $path_to_app_root . '/src/data/' . $xls_file;

    my $io = io($path_to_file . '.csv');

    my @matches; # for results
    # get field definitions hashref (eg CODE => 0, NAME => 1, etc):
    my $FIELD = $self->_get_file('fields');
    # get array of required field positions (eg 0, 1, 4, 5, etc):
    my @field_positions = grep $_, @{$FIELD}{ qw(NAME CODE2 ADDR1 ADDR2 ADDR3 ADDR4 PCODE) };

    use Time::HiRes qw(gettimeofday tv_interval);
    my $t0 = [gettimeofday];

    {    # localise to switch off warnings:
        no warnings 'uninitialized'; # for regex on potentially empty fields

#       timings($t0);
        ROW : while ( my $line = $io->getline ) { # TODO: doesn't work if row contains comma within field
            # split line on comma:
            my @cells = split ',', $line; # warn Dumper @cells; next;
            # get national code, or skip line:
            my $code_cell = $cells[$FIELD->{CODE}] || next ROW; # warn Dumper $code_cell; next;
            # get rest of required fields (if defined) into array:
            my @data_cells = grep $_, @cells[@field_positions]; # warn Dumper \@data_cells; next;

            # look for matches in all collected fields, or skip line:
            next ROW unless grep { $_ =~ /$term/i } (@data_cells, $code_cell);

            push @matches, {
                code    => $code_cell,
                display => join ', ', @data_cells,
            };
        }
       timings($t0);
    }

    return \@matches;
}
=cut

#------------------------------------------------------------------------------
=begin # use the Spreadsheet::ParseExcel_XLHTML method - several times faster than Spreadsheet::ParseExcel:
sub _parse_excel_xhtml {
    my $self = shift;
    my $term = shift;

    my $xls_file = $self->source;

    my $path_to_file = $path_to_app_root . '/src/data/' . $xls_file;

    my $excel = new Spreadsheet::ParseExcel_XLHTML;

    my $workbook  = $excel->Parse($path_to_file . '.xls');
    my $worksheet = $workbook->Worksheet(0);

    my ( $row_min, $row_max ) = $worksheet->row_range();

    my @matches; # results array
    my $FIELD_FOR = $self->_get_file('fields'); # hashref

    ROW : for my $row ( $row_min .. $row_max ) {
        my $code_cell = $worksheet->get_cell( $row, $FIELD_FOR->{CODE} );
        next ROW unless $code_cell; # next ROW unless length $code > 3; need parent code for appropriate matching

        my @location_cells;
        CELL : for my $col ( @{$FIELD_FOR}{ qw(NAME CODE2 ADDR1 ADDR2 ADDR3 ADDR4 PCODE) } ) {
            my $cell = $worksheet->get_cell( $row, $col );
            next CELL unless $cell;
            push @location_cells, $cell;
        }

        next ROW unless grep $_->value =~ /$term/i, (@location_cells, $code_cell);

        push @matches, {
            code    => $code_cell->value,
            display => join ', ', map { $_->value } @location_cells,
        };
    }

    return \@matches;
}
=cut

#------------------------------------------------------------------------------
=begin # uses Spreadsheet::ParseExcel::Simple - much slower than Spreadsheet::ParseExcel_XLHTML
sub _parse_excel {
    my $self = shift;
    my $term = shift;

    my $xls_file = $self->source_file;

    my $path_to_file = $path_to_app_root . '/src/data/' . $xls_file;

    my $xls = Spreadsheet::ParseExcel::Simple->read($path_to_file . '.xls');

    my @worksheets = $xls->sheets;
    my $worksheet  = $worksheets[0];

    my $FIELD_FOR = $self->_get_file('fields');

    my @matches; # results array

    while ($worksheet->has_data) {
        my @data = $worksheet->next_row; # warn Dumper \@data;

        # skip regional entries eg RR8, RAE, etc
        next unless length $data[ $FIELD_FOR->{CODE} ] > 3; # warn Dumper $data[ $FIELD_FOR->{CODE} ];

        next unless grep $data[ $FIELD_FOR->{$_} ] =~ /$term/i, qw(NAME ADDR CITY);
            # warn Dumper join ', ', @data[ @$FIELD_FOR{ qw(NAME ADDR CITY PCODE) } ];

        push @matches, {
            code    => $data[ $FIELD_FOR->{CODE} ],
            display => join ', ', @data[ @$FIELD_FOR{ qw(NAME ADDR1 CITY PCODE) } ],
        };
    }

    # return ref to array of hashrefs:
    return \@matches;
}
=cut

#------------------------------------------------------------------------------
sub _get_file {
    my $self = shift;
    my $attr = shift || die 'attribute arg required';

    my $location_type = $self->{LOCATION_TYPE}
        or die 'Cannot get location type'; # warn 'LOCATION TYPE:'.$location_type;

    my %args = (
        yaml_dir => $cfg->{settings}->{yaml_dir},
        app_root => $path_to_app_root,
        filename => 'cfh_data_files',
    );
    my $cfh_data_file = LIMS::Local::Utils::get_yaml(\%args); # warn Dumper $yaml;

    return $cfh_data_file->{$location_type}->{$attr};
}

#------------------------------------------------------------------------------
# uses Text::CSV::Simple - faster than ParseExcel, but slower than direct read
# (IO::All->getline); but speed boost using add_trigger() in _read_file()
# now uses Text::CSV::Slurp - faster than Text::CSV::Simple & better error handling
sub _read_file {
	my $self = shift;
    my $term = shift; # optional term to search for 

    my $file = $self->source;
    my $src_file = $path_to_app_root . '/src/data/' . $file . '.csv';

    # get field definitions arrayref (eg code name null addr1, etc):
    my $fields = $self->_get_file('fields'); # warn Dumper $fields; 
 	my $unique = LIMS::Local::Utils::get_unique_elements($fields);

=begin # replaced with Text::CSV::Slurp
    my $parser = Text::CSV::Simple->new();
    $parser->field_map(@$fields);
	
    if ($term) { # warn Dumper $term;
        # get array positions of @$fields non-null vals:
        my @indexes = grep { $fields->[$_] ne 'null' } (0 .. @$fields -1); # warn @indexes;
        # this is faster than collecting all rows & discarding all not matching $term
        $parser->add_trigger( after_parse => sub {
            my ($self, $data) = @_; # warn Dumper $data;
            die unless grep $data->[$_] =~ /$term/i, @indexes; # 'die' is OK - see docs
          });
    }
    my @data = $parser->read_file($path_to_file . '.csv'); # timings($t0);
=cut
    my %args = (file => $src_file, field_order => $fields);
    my $rows = $self->_text_csv_slurp(\%args);
    if (! $term) { return $rows } # return immediately if nothing to seach for

    no warnings 'uninitialized'; # possibly empty cells
    my @data = grep { grep /$term/i, @{$_}{@$unique} } @$rows; # warn Dumper \@data;
	return \@data;
}

#------------------------------------------------------------------------------
sub _get_locales {
    my $self = shift;

    my $file = $path_to_app_root . '/src/data/etr.csv';

    my @fields = qw(code organisation);
    
    my %args = (file => $file, field_order => \@fields);
    my $data = $self->_text_csv_slurp(\%args);
    
    my %locales = map { $_->{code} => uc $_->{organisation} } @$data;
    return \%locales;
}

#------------------------------------------------------------------------------
sub _get_specialities {
    my $self = shift;

    my $file = $path_to_app_root . '/src/data/specialities.csv';

    my @fields = qw(code speciality);
    my %args = (file => $file, field_order => \@fields);
    my $data = $self->_text_csv_slurp(\%args);

    my %specialities = map { $_->{code} => uc $_->{speciality} } @$data;
    return \%specialities;
}

#------------------------------------------------------------------------------
sub _manipulate_clinician_data {
    my $self = shift;
    my $row  = shift;

    my $id = sprintf '%s %s [%s]', @{$row}{qw(name init sex)};
    map delete $row->{$_}, qw(name init sex);
    $row->{name} = $id;

    my $org_code = $row->{org_code};
    $row->{org_code} = $locales->{$org_code} || "UNKNOWN LOCATION [$org_code]";
    my $speciality_code = $row->{speciality_code};
    $row->{speciality_code} = $specialities->{$speciality_code} || "UNKNOWN SPECIALITY [$speciality_code]";
}

#------------------------------------------------------------------------------
sub timings {
#    my $t0 = shift;
#    warn sprintf "%.4f sec\n", tv_interval $t0, [gettimeofday];
}

1;