package C4::Patroncards::Patroncard;

# Copyright 2009 Foundations Bible College.
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <https://www.gnu.org/licenses>.

use strict;
use warnings;

use autouse 'Data::Dumper' => qw(Dumper);

#use Font::TTFMetrics;

use C4::Creators::Lib    qw( get_unit_values );
use C4::Creators::PDF    qw(StrWidth);
use C4::Patroncards::Lib qw(
    box
    get_borrower_attributes
    leading
    text_alignment
);

=head1 NAME

C4::Patroncards::Patroncard

=head1 SYNOPSIS

    use C4::Patroncards::Patroncard;

    # Please extend


=head1 DESCRIPTION

   This module allows you to ...

=head1 FUNCTIONS

=head2 new

=cut

sub new {
    my ( $invocant, %params ) = @_;
    my $type = ref($invocant) || $invocant;

    my $units     = get_unit_values();
    my $unitvalue = 1;
    my $unitdesc  = '';
    foreach my $un (@$units) {
        if ( $un->{'type'} eq $params{'layout'}->{'units'} ) {
            $unitvalue = $un->{'value'};
            $unitdesc  = $un->{'desc'};
        }
    }

    my $self = {
        batch_id => $params{'batch_id'},

        #card_number             => $params{'card_number'},
        borrower_number      => $params{'borrower_number'},
        llx                  => $params{'llx'},
        lly                  => $params{'lly'},
        height               => $params{'height'},
        width                => $params{'width'},
        layout               => $params{'layout'},
        unitvalue            => $unitvalue,
        unitdesc             => $unitdesc,
        text_wrap_cols       => $params{'text_wrap_cols'},
        barcode_height_scale => $params{'layout'}->{'barcode'}[0]->{'height_scale'} || 0.01,
        barcode_width_scale  => $params{'layout'}->{'barcode'}[0]->{'width_scale'}  || 0.8,
    };
    bless( $self, $type );
    return $self;
}

=head2 draw_barcode

=cut

sub draw_barcode {
    my ( $self, $pdf ) = @_;

    # Default values for barcode scaling are set in constructor to work with pre-existing installations
    my $barcode_height_scale = $self->{'barcode_height_scale'};
    my $barcode_width_scale  = $self->{'barcode_width_scale'};
    my $llx                  = $self->{'llx'}                               || 0;
    my $llx_layout           = $self->{'layout'}->{'barcode'}->[0]->{'llx'} || 0;
    my $lly                  = $self->{'lly'}                               || 0;
    my $lly_layout           = $self->{'layout'}->{'barcode'}->[0]->{'lly'} || 0;
    _draw_barcode(
        $self,
        llx            => $llx + $llx_layout * $self->{'unitvalue'},
        lly            => $lly + $lly_layout * $self->{'unitvalue'},
        width          => $self->{'width'} * $barcode_width_scale,
        y_scale_factor => $self->{'height'} * $barcode_height_scale,
        barcode_type   => $self->{'layout'}->{'barcode'}->[0]->{'type'},
        barcode_data   => $self->{'layout'}->{'barcode'}->[0]->{'data'},
        text           => $self->{'layout'}->{'barcode'}->[0]->{'text_print'},
    );
}

=head2 draw_guide_box

=cut

sub draw_guide_box {
    my ( $self, $pdf ) = @_;
    warn sprintf('No pdf object passed in.') and return -1 if !$pdf;

    my $obj_stream = "q\n";                                                                  # save the graphic state
    $obj_stream .= "0.5 w\n";                                                                # border line width
    $obj_stream .= "1.0 0.0 0.0  RG\n";                                                      # border color red
    $obj_stream .= "1.0 1.0 1.0  rg\n";                                                      # fill color white
    $obj_stream .= "$self->{'llx'} $self->{'lly'} $self->{'width'} $self->{'height'} re\n";  # a rectangle
    $obj_stream .= "B\n";                                                                    # fill (and a little more)
    $obj_stream .= "Q\n";                                                                    # restore the graphic state
    $pdf->Add($obj_stream);
}

=head2 draw_guide_grid

    $patron_card->draw_guide_grid($pdf)

Adds a grid to the PDF output ($pdf) to support layout design

=cut

sub draw_guide_grid {
    my ( $self, $pdf ) = @_;
    warn sprintf('No pdf object passed in.') and return -1 if !$pdf;

    # Set up the grid in user defined units.
    # Each 5th and 10th line get separate values

    my $obj_stream = "q\n";            # save the graphic state
    my $x          = $self->{'llx'};
    my $y          = $self->{'lly'};

    my $cnt = 0;
    for (
        $x = $self->{'llx'} / $self->{'unitvalue'} ;
        $x <= ( $self->{'llx'} + $self->{'width'} ) / $self->{'unitvalue'} ;
        $x++
        )
    {
        my $xx = $x * $self->{'unitvalue'};
        my $yy = $y + $self->{'height'};
        if ( ( $cnt % 10 ) && !( $cnt % 5 ) ) {
            $obj_stream .= "0.0 1.0 0.0  RG\n";
            $obj_stream .= "0 w\n";
        } elsif ( $cnt % 5 ) {
            $obj_stream .= "0.0 1.0 1.0  RG\n";
            $obj_stream .= "0 w\n";
        } else {
            $obj_stream .= "0.0 0.0 1.0  RG\n";
            $obj_stream .= "0 w\n";
        }
        $cnt++;

        $obj_stream .= "$xx $y m\n";
        $obj_stream .= "$xx $yy l\n";

        $obj_stream .= "s\n";
    }

    $x   = $self->{'llx'};
    $y   = $self->{'lly'};
    $cnt = 0;
    for (
        $y = $self->{'lly'} / $self->{'unitvalue'} ;
        $y <= ( $self->{'lly'} + $self->{'height'} ) / $self->{'unitvalue'} ;
        $y++
        )
    {

        my $xx = $x + $self->{'width'};
        my $yy = $y * $self->{'unitvalue'};

        if ( ( $cnt % 10 ) && !( $cnt % 5 ) ) {
            $obj_stream .= "0.0 1.0 0.0  RG\n";
            $obj_stream .= "0 w\n";
        } elsif ( $cnt % 5 ) {
            $obj_stream .= "0.0 1.0 1.0  RG\n";
            $obj_stream .= "0 w\n";
        } else {
            $obj_stream .= "0.0 0.0 1.0  RG\n";
            $obj_stream .= "0 w\n";
        }
        $cnt++;

        $obj_stream .= "$x $yy m\n";
        $obj_stream .= "$xx $yy l\n";
        $obj_stream .= "s\n";
    }

    $obj_stream .= "Q\n";    # restore the graphic state
    $pdf->Add($obj_stream);

    # Add info about units
    my $strbottom = "0/0 $self->{'unitdesc'}";
    my $strtop    = sprintf( '%.2f', $self->{'width'} / $self->{'unitvalue'} ) . '/'
        . sprintf( '%.2f', $self->{'height'} / $self->{'unitvalue'} );
    my $font_size = 6;
    $pdf->Font('Courier');
    $pdf->FontSize($font_size);
    my $strtop_len = $pdf->StrWidth($strtop) * 1.5;
    $pdf->Text( $self->{'llx'} + 2, $self->{'lly'} + 2, $strbottom );
    $pdf->Text(
        $self->{'llx'} + $self->{'width'} - $strtop_len, $self->{'lly'} + $self->{'height'} - $font_size,
        $strtop
    );
}

=head2 draw_text

    $patron_card->draw_text($pdf)

Draws text to PDF output ($pdf)

=cut

sub draw_text {
    my ( $self, $pdf, %params ) = @_;
    warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
    my @card_text = ();
    return unless ( ref( $self->{'layout'}->{'text'} ) eq 'ARRAY' );    # just in case there is not text

    my $text = [ @{ $self->{'layout'}->{'text'} } ];    # make a copy of the arrayref *not* simply a pointer
    while ( scalar @$text ) {
        my $line       = shift @$text;
        my $parse_line = $line;
        my @orig_line  = split( / /, $line );
        if ( $parse_line =~ m/<[A-Za-z0-9_]+>/ ) {      # test to see if the line has db fields embedded...
            my @fields = ();
            while ( $parse_line =~ m/<([A-Za-z0-9_]+)>(.*$)/ ) {
                push( @fields, $1 );
                $parse_line = $2;
            }
            my $borrower_attributes = get_borrower_attributes( $self->{'borrower_number'}, @fields );
            @orig_line = map {    # substitute data for db fields
                my $l = $_;
                if ( $l =~ m/<([A-Za-z0-9_]+)>/ ) {
                    my $field = $1;
                    $l =~ s/$l/$borrower_attributes->{$field}/;
                }
                $l;
            } @orig_line;
            $line = join( ' ', @orig_line );
        }
        my $text_attribs  = shift @$text;
        my $llx           = $self->{'llx'}         || 0;
        my $llx_text_attr = $text_attribs->{'llx'} || 0;
        my $lly           = $self->{'lly'}         || 0;
        my $lly_text_attr = $text_attribs->{'lly'} || 0;

        my $origin_llx = $llx + $llx_text_attr * $self->{'unitvalue'};
        my $origin_lly = $lly + $lly_text_attr * $self->{'unitvalue'};
        my $Tx         = 0;                                              # final text llx
        my $Ty         = $origin_lly;                                    # final text lly
        my $Tw = 0;    # final text word spacing. See http://www.adobe.com/devnet/pdf/pdf_reference.html ISO 32000-1

        #FIXME: Move line wrapping code to its own sub if possible
        my $trim  = '';
        my @lines = ();

        #FIXME: Using embedded True Type fonts is a far superior way of handing things as well as being much more unicode friendly.
        #       However this will take significant work using better than PDF::Reuse to do it. For the time being, I'm leaving
        #       the basic code here commented out to preserve the basic method of accomplishing this. -chris_n
        #
        #        my $m = Font::TTFMetrics->new("/usr/share/fonts/truetype/msttcorefonts/Times_New_Roman_Bold.ttf");
        #        my $units_per_em =  $m->get_units_per_em();
        #        my $font_units_width = $m->string_width($line);
        #        my $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
## Please see file perltidy.ERR
        my $string_width = C4::Creators::PDF->StrWidth( $line, $text_attribs->{'font'}, $text_attribs->{'font_size'} );
        if ( ( $string_width + $llx_text_attr ) > $self->{'width'} ) {
            my $cur_line = "";
        WRAP_LINES:
            while (1) {

                #                $line =~ m/^.*(\s\b.*\b\s*|\s&|\<\b.*\b\>)$/; # original regexp... can be removed after dev stage is over
                $line =~ m/^.*(\s.*\s*|\s&|\<.*\>)$/;
                $trim = $1 . $trim;

                #Sanitize the input into this regular expression so regex metacharacters are escaped as literal values (https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=22429)
                $line =~ s/\Q$1\E$//;
                $string_width =
                    C4::Creators::PDF->StrWidth( $line, $text_attribs->{'font'}, $text_attribs->{'font_size'} );

                #                $font_units_width = $m->string_width($line);
                #                $string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
                if ( $string_width && ( ( $string_width + $text_attribs->{'llx'} ) < $self->{'width'} ) ) {
                    ( $Tx, $Tw ) = text_alignment(
                        $origin_llx, $self->{'width'}, $text_attribs->{'llx'}, $string_width, $line,
                        $text_attribs->{'text_alignment'}
                    );
                    push @lines, { line => $line, Tx => $Tx, Ty => $Ty, Tw => $Tw };
                    $line = undef;
                    last WRAP_LINES if $trim eq '';
                    $Ty -= leading( $text_attribs->{'font_size'} );
                    $line = $trim;
                    $trim = '';
                    $string_width =
                        C4::Creators::PDF->StrWidth( $line, $text_attribs->{'font'}, $text_attribs->{'font_size'} );

                    #$font_units_width = $m->string_width($line);
                    #$string_width = ($font_units_width * $text_attribs->{'font_size'}) / $units_per_em;
                    if ( $string_width + ( $text_attribs->{'llx'} * $self->{'unitvalue'} ) < $self->{'width'} ) {
                        ( $Tx, $Tw ) = text_alignment(
                            $origin_llx, $self->{'width'},
                            $text_attribs->{'llx'} * $self->{'unitvalue'}, $string_width, $line,
                            $text_attribs->{'text_alignment'}
                        );
                        $line =~ s/^\s+//g;    # strip naughty leading spaces
                        push @lines, { line => $line, Tx => $Tx, Ty => $Ty, Tw => $Tw };
                        last WRAP_LINES;
                    }
                } else {

                    # We only split lines on spaces - it seems if we push a line too far, it can end
                    # never getting short enough in which case we need to escape and the malformed PDF
                    # will indicate the layout problem
                    last WRAP_LINES if $cur_line eq $line;
                    $cur_line = $line;
                }
            }
        } else {
            ( $Tx, $Tw ) = text_alignment(
                $origin_llx, $self->{'width'}, $lly_text_attr * $self->{'unitvalue'}, $string_width,
                $line,       $text_attribs->{'text_alignment'}
            );
            $line =~ s/^\s+//g;    # strip naughty leading spaces
            push @lines, { line => $line, Tx => $Tx, Ty => $Ty, Tw => $Tw };
        }

        # Draw boxes around text box areas
        # FIXME: This needs to compensate for the point height of decenders. In its current form it is helpful but not really usable. The boxes are also not transparent atm.
        #        If these things were fixed, it may be desirable to give the user control over whether or not to display these boxes for layout design.
        if (0) {
            my $box_height = 0;
            my $box_lly    = $origin_lly;
            if ( scalar(@lines) > 1 ) {
                $box_height += scalar(@lines) * ( $text_attribs->{'font_size'} * 1.2 );
                $box_lly    -= ( $text_attribs->{'font_size'} * 0.2 );
            } else {
                $box_height += $text_attribs->{'font_size'};
            }
            box(
                $origin_llx, $box_lly, $self->{'width'} - ( $text_attribs->{'llx'} * $self->{'unitvalue'} ),
                $box_height, $pdf
            );
        }
        $pdf->Font( $text_attribs->{'font'} );
        $pdf->FontSize( $text_attribs->{'font_size'} );
        foreach my $line (@lines) {
            $pdf->Text( $line->{'Tx'}, $line->{'Ty'}, $line->{'line'} );
        }
    }
}

=head2 draw_image

    $patron_card->draw_image($pdf)

Draws images to PDF output ($pdf)

=cut

sub draw_image {
    my ( $self, $pdf ) = @_;
    warn sprintf('No pdf object passed in.') and return -1 if !$pdf;
    my $images = $self->{'layout'}->{'images'};

PROCESS_IMAGES:
    foreach my $image ( keys %$images ) {
        next PROCESS_IMAGES if $images->{$image}->{'data_source'}->[0]->{'image_source'} eq 'none';
        my $Tx = $self->{'llx'} + $images->{$image}->{'Tx'} * $self->{'unitvalue'};
        my $Ty = $self->{'lly'} + $images->{$image}->{'Ty'} * $self->{'unitvalue'};
        warn sprintf('No image passed in.') and next if !$images->{$image}->{'data'};
        my $intName = $pdf->AltJpeg(
            $images->{$image}->{'data'},          $images->{$image}->{'Sx'}, $images->{$image}->{'Sy'}, 1,
            $images->{$image}->{'alt'}->{'data'}, $images->{$image}->{'alt'}->{'Sx'},
            $images->{$image}->{'alt'}->{'Sy'},   1
        );
        my $obj_stream = "q\n";
        $obj_stream .=
            "$images->{$image}->{'Sx'} $images->{$image}->{'Ox'} $images->{$image}->{'Oy'} $images->{$image}->{'Sy'} $Tx $Ty cm\n"
            ;    # see http://www.adobe.com/devnet/pdf/pdf_reference.html sec 8.3.3 of ISO 32000-1
        $obj_stream .= "$images->{$image}->{'scale'} 0 0 $images->{$image}->{'scale'} 0 0 cm\n";    #scale to 20%
        $obj_stream .= "/$intName Do\n";
        $obj_stream .= "Q\n";
        $pdf->Add($obj_stream);
    }
}

=head2 draw_barcode

    $patron_card->draw_barcode($pdf)

Draws a barcode to PDF output ($pdf)

=cut

sub _draw_barcode {    # this is cut-and-paste from Label.pm because there is no common place for it atm...
    my $self   = shift;
    my %params = @_;

    my $x_scale_factor = 1;
    my $num_of_chars   = length( $params{'barcode_data'} );
    my $tot_bar_length = 0;
    my $bar_length     = 0;
    my $guard_length   = 10;
    if ( $params{'barcode_type'} =~ m/CODE39/ ) {
        $bar_length     = '17.5';
        $tot_bar_length = ( $bar_length * $num_of_chars ) +
            ( $guard_length * 2 );    # not sure what all is going on here and on the next line; this is old (very) code
        $x_scale_factor = ( $params{'width'} / $tot_bar_length );
        if ( $params{'barcode_type'} eq 'CODE39MOD' ) {
            my $c39 = CheckDigits('code_39');    # get modulo 43 checksum
            $params{'barcode_data'} = $c39->complete( $params{'barcode_data'} );
        } elsif ( $params{'barcode_type'} eq 'CODE39MOD10' ) {
            my $c39_10 = CheckDigits('siret');    # get modulo 10 checksum
            $params{'barcode_data'} = $c39_10->complete( $params{'barcode_data'} );
        }
        eval {
            PDF::Reuse::Barcode::Code39(
                x             => $params{'llx'},
                y             => $params{'lly'},
                value         => "*$params{barcode_data}*",
                xSize         => $x_scale_factor,
                ySize         => $params{'y_scale_factor'},
                hide_asterisk => 1,
                text          => $params{'text'},
                mode          => 'graphic',
            );
        };
        if ($@) {
            warn sprintf( 'Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@ );
        }
    } elsif ( $params{'barcode_type'} eq 'COOP2OF5' ) {
        $bar_length     = '9.43333333333333';
        $tot_bar_length = ( $bar_length * $num_of_chars ) + ( $guard_length * 2 );
        $x_scale_factor = ( $params{'width'} / $tot_bar_length ) * 0.9;
        eval {
            PDF::Reuse::Barcode::COOP2of5(
                x     => $params{'llx'},
                y     => $params{'lly'},
                value => $params{barcode_data},
                xSize => $x_scale_factor,
                ySize => $params{'y_scale_factor'},
                mode  => 'graphic',
            );
        };
        if ($@) {
            warn sprintf( 'Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@ );
        }
    } elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
        $bar_length     = '13.1333333333333';
        $tot_bar_length = ( $bar_length * $num_of_chars ) + ( $guard_length * 2 );
        $x_scale_factor = ( $params{'width'} / $tot_bar_length ) * 0.9;
        eval {
            PDF::Reuse::Barcode::Industrial2of5(
                x     => $params{'llx'},
                y     => $params{'lly'},
                value => $params{barcode_data},
                xSize => $x_scale_factor,
                ySize => $params{'y_scale_factor'},
                mode  => 'graphic',
            );
        };
        if ($@) {
            warn sprintf( 'Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@ );
        }
    }
}

1;
__END__

=head1 AUTHOR

Chris Nighswonger <cnighswonger AT foundations DOT edu>

=cut
