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;
|