File: Settings.pm

package info (click to toggle)
libpdf-table-perl 1%3A1.006-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 532 kB
  • sloc: perl: 3,841; makefile: 17
file content (159 lines) | stat: -rw-r--r-- 6,979 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
package PDF::Table::Settings;

use strict;
use warnings;

use Carp;

our $VERSION = '1.006'; # VERSION
our $LAST_UPDATE = '1.003'; # manually update whenever code is changed

###########################################################
# move deprecated settings names to current names, and delete old
# assume any leading '-' already removed
# warning if both deprecated and new name given (use new)
# release at T-6 months, consider issuing warning to remind update needed
# release at T-0 months, give warning on use of deprecated items
# release at T+12 months, remove deprecated names
############################################################

sub deprecated_settings {
    my ($data, $row_props, $col_props, $cell_props, $header_props, $argref) = @_;
# 1 $row_props, 2 $col_props, 3 $cell_props, 4 $header_props
# need to use $_[n] form so that its call be reference, not value
#my $data = $_[0]; 
#my $argref = $_[5];
#my %arg = %{$argref};

    my %cur_names = (
        # old deprecated name        new current name
        #  (old_key)
        'start_y'               => 'y',
        'start_h'               => 'h',
        'row_height'            => 'min_rh',
        'background_color'      => 'bg_color',
        'background_color_odd'  => 'bg_color_odd',
        'background_color_even' => 'bg_color_even',
        'font_color'            => 'fg_color',
        'font_color_odd'        => 'fg_color_odd',
        'font_color_even'       => 'fg_color_even',
        'font_underline'        => 'underline',
       #'justify'               => 'align',  # different set of values allowed
        'lead'                  => 'leading',
        'border'                => 'border_w',
        'horizontal_borders'    => 'h_border_w',
        'vertical_borders'      => 'v_border_w',
        'border_color'          => 'border_c',
        # currently same color for H and V borders
    );

    # global arg
    foreach my $old_key (keys %cur_names) {
        if (defined $argref->{$old_key}) {
            # set deprecated name setting (need to transfer to new name).
            # did we also set new name setting?
            if (defined $argref->{$cur_names{$old_key}}) {
                carp "!! Warning !! both deprecated global name '$old_key' and current name '$cur_names{$old_key}' given, current name's value used.";
            } else {
                $argref->{$cur_names{$old_key}} = $argref->{$old_key};
                delete $argref->{$old_key};
                # eventually given warning to stop using $old_key
            }
        }
    }

    # row properties
    foreach my $old_key (keys %cur_names) {
        for (my $row = 0; $row < scalar(@$data); $row++) {
            if (defined $row_props->[$row]->{$old_key}) {
                # set deprecated name setting (need to transfer to new name).
                if (defined $row_props->[$row]->{$cur_names{$old_key}}) {
                    # did we also set new name setting?
                    carp "!! Warning !! both deprecated name '$old_key' and current name '$cur_names{$old_key}' given in row_props[$row], current name's value used.";
                } else {
                    # transfer deprecated setting to new
                    $row_props->[$row]->{$cur_names{$old_key}} = $row_props->[$row]->{$old_key};
                    delete $row_props->[$row]->{$old_key};
                    # eventually given warning to stop using $old_key
                }
            }
        }
    }

    # column properties
    foreach my $old_key (keys %cur_names) {
        for (my $col = 0; $col < scalar(@{$col_props}); $col++) {
            if (defined $col_props->[$col]->{$old_key}) {
                # set deprecated name setting (need to transfer to new name).
                if (defined $col_props->[$col]->{$cur_names{$old_key}}) {
                    # did we also set new name setting?
                    carp "!! Warning !! both deprecated name '$old_key' and current name '$cur_names{$old_key}' given in column_props[$col], current name's value used.";
                } else {
                    # transfer deprecated setting to new
                    $col_props->[$col]->{$cur_names{$old_key}} = $col_props->[$col]->{$old_key};
                    delete $col_props->[$col]->{$old_key};
                    # eventually given warning to stop using $old_key
                }
            }
        }
    }

    # cell properties
    foreach my $old_key (keys %cur_names) {
        for (my $row = 0; $row < scalar(@$data); $row++) {
            for ( my $col = 0; 
              $col < scalar(@{$data->[$row]}); 
              $col++ ) {
                if (defined $cell_props->[$row][$col]->{$old_key}) {
                    # set deprecated name setting (need to transfer to new name).
                    if (defined $cell_props->[$row][$col]->{$cur_names{$old_key}}) {
                        # did we also set new name setting?
                        carp "!! Warning !! both deprecated name '$old_key' and current name '$cur_names{$old_key}' given in cell_props[$row][$col], current name's value used.";
                    } else {
                        # transfer deprecated setting to new
                        $cell_props->[$row][$col]->{$cur_names{$old_key}} = $cell_props->[$row][$col]->{$old_key};
                        delete $cell_props->[$row][$col]->{$old_key};
                        # eventually given warning to stop using $old_key
                    }
                }
            }
        }
    }

    # header properties
    if ($header_props) {
        foreach my $old_key (keys %cur_names) {
            if (defined $header_props->{$old_key}) {
                # set deprecated name setting (need to transfer to new name).
                # did we also set new name setting?
                if (defined $header_props->{$cur_names{$old_key}}) {
                    carp "!! Warning !! both deprecated header name '$old_key' and current name '$cur_names{$old_key}' given, current name's value used.";
                } else {
                    $header_props->{$cur_names{$old_key}} = $header_props->{$old_key};
                    delete $header_props->{$old_key};
                    # eventually given warning to stop using $old_key
                }
            }
        }
    }

    return;
} # end of deprecated_settings()

############################################################
# validate/fix up settings and parameters as much as possible     TBD per #12
############################################################

sub check_settings {
    my (%arg) = @_;

    # TBD $arg{} values, some col, row, cell, header?
    # x, y >= 0; w, h >= 0; x+w < page width; y+h < page height
    # next_h (if def) > 0, next_y (if def) >= 0; next_y+next_h < page height
    # line widths >= 0, min_rh > 0
    # TBD in general, validate integer values and possibly some
    #     other values, per #12
    return;
} # end of check_settings()

1;