RSS Git Download  Clone
Raw Blame History
package Labels::Model;

use Modern::Perl qw(2012); # 5.14

use Moo;
use IO::All;
use Template;
use Path::Tiny;
use File::Spec;
use Data::Dumper;
use IO::Socket::INET;
use Spreadsheet::XLSX; # can't handle scalarref content
use Spreadsheet::ParseExcel::Simple;
use FindBin qw($RealBin); # warn $RealBin;

use lib '/home/raj/perl-lib';
use Local::MooX::Types qw(ArrayReference);

use constant TMPL_DIR => path($RealBin, '..', 'views')->realpath;
use constant LABEL_TT => 'label.tt';

has $_ => ( is => 'ro', required => 1) for qw( content config );
has labels => ( is => 'ro', isa => ArrayReference, default => sub { [] } );

=begin # only needed if saving content to file
sub extract_file {
    my ($self, $src_file) = @_;
    
    my $content = $src_file->content; # p $content;
    my $f = File::Spec->catfile('/tmp', $src_file->filename); # p $f;
    $content > io($f);
}
=cut

sub parse_xls {
	my $self = shift;
    my $content = $self->content;
    
    my $xls = Spreadsheet::ParseExcel::Simple->read(\$content) or die $!;
    my $sheet = ($xls->sheets)[0]; # warn Dumper $sheet; # 1st one

    while ($sheet->has_data) {  
        my @row = $sheet->next_row; # p @row;
		next if $row[0] !~ m!\d+/\d+!; # eg header row
		my %h; @h{qw/labno name label/} = @row[0..2]; # warn Dumper \%h;
        $self->_add_to_labels(\%h);
    } # warn Dumper $self->labels;
}

# can't accept scalarref
sub parse_xlsx {
	my $self = shift;
    my $content = $self->content;

    my $excel = Spreadsheet::XLSX->new($content);
    foreach my $sheet (@{$excel -> {Worksheet}}) { 
       printf("Sheet: %s\n", $sheet->{Name});
    }
}

sub print_labels {
	my $self = shift;
	
	my $labels = $self->labels; # p $labels; # AoA

	my $peer_addr = $self->config->{printer_addr}
		|| die 'no setting for label printer address found in config file';

    my $socket = new IO::Socket::INET(
        PeerAddr => $peer_addr,
        PeerPort => 9100,
        Proto 	 => 'tcp',
		Timeout  => 10,
    ) || die 'could not create socket: ' . $!;
    
    # need to shift 1st item from @data to format 1st label: 
    my $first_label = shift @$labels;

    my %first_label_data = (
		labno => $first_label->{labno},
		name  => $first_label->{name},
		label => $first_label->{label},
	);
	
    my $t = Template->new({ INCLUDE_PATH => TMPL_DIR }); 
    
    my $label_body;
	# process label.tt template:
	$t->process(LABEL_TT, \%first_label_data, \$label_body);

	# send 1st label to printer:
	print $socket $label_body;
	
    # (R)eplace 'labno', 'name' & 'label' params for rest of labels:
    for my $next_label (@$labels) { # warn Dumper $next_label;
		for my $field( qw/labno name label/ ) { # eg R LABEL;Giemsa R LABNO;H1/10 etc
			print $socket sprintf "R %s;%s\n", uc $field, $next_label->{$field};
		}
		print $socket "A 1\n"; # print 1 label each
    }

    close $socket;
	
	return 0; # as caller expects only errors returned
}

sub _add_to_labels {
	my ($self, $ref) = @_;
	push @{ $self->labels }, $ref;
}

1;