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;