lib/CXGN/List/Validate/Plugin/LabelDesign.pm

   1
   2 package CXGN::List::Validate::Plugin::LabelDesign;
   3
   4 use Moose;
   5 use Data::Dumper;
   6 use JSON::Any;
   7 use Try::Tiny;
   8 use Scalar::Util qw(looks_like_number);
   9
  10 sub name {
  11     return "label_design";
  12 }
  13
  14 sub validate {
  15     my $self = shift;
  16     my $schema = shift;
  17     my $list = shift;
  18     my @problems = ();
  19     use Text::ParseWords;
  20
  21     my %page_param_check = (
  22         "page_format" => \&check_page_format,
  23         "page_width" => \&check_is_numeric,
  24         "page_height" => \&check_is_numeric,
  25         "left_margin" => \&check_is_numeric,
  26         "top_margin" => \&check_is_numeric,
  27         "horizontal_gap" => \&check_is_numeric,
  28         "vertical_gap" => \&check_is_numeric,
  29         "number_of_columns" => \&check_is_numeric,
  30         "number_of_rows" => \&check_is_numeric,
  31         "copies_per_plot" => \&check_is_numeric,
  32         "sort_order" => \&check_sort_order,
  33         "label_format" => \&check_label_format,
  34         "label_width" => \&check_is_numeric,
  35         "label_height" => \&check_is_numeric,
  36     );
  37
  38     my %element_check = (
  39         "x" => \&check_is_numeric,
  40         "y" => \&check_is_numeric,
  41         "height" => \&check_is_numeric,
  42         "width" => \&check_is_numeric,
  43         "scale" => \&check_scale,
  44         "value" => \&check_field,
  45         "type" => \&check_type,
  46         "font" => \&check_font,
  47         "size" => \&check_is_numeric,
  48     );
  49
  50     my $JSON = "{". join(",", @$list) . "}";
  51     my $obj_ref;
  52     try {
  53         print STDERR "Trying now . . .\n";
  54         $obj_ref = JSON::Any->decode($JSON);
  55     } catch {
  56         push @problems, "\nInvalid JSON in list items\n";
  57         push @problems, "$_\n";
  58         print STDERR "Returning with error . . .\n";
  59     };
  60
  61     if ( scalar @problems ) {
  62         return { missing => \@problems };
  63     }
  64
  65     my %obj = %{$obj_ref};
  66
  67     foreach my $key (keys %obj) {
  68         my $value = $obj{$key};
  69         if ( $key =~ m/element/ ) {
  70             my %elem_hash = %{$value};
  71             foreach my $elem_key (keys %elem_hash) {
  72                 my $elem_value = $elem_hash{$elem_key};
  73                 print STDERR "Elem Key is $elem_key and Elem value is $elem_value\n";
  74                 $element_check{$elem_key}($elem_value) ? print STDERR "Check returned: ".$element_check{$elem_key}($elem_value)."\n" : push @problems, $elem_key . ":" . $elem_value;
  75             }
  76         } else {
  77              print STDERR "Key is $key and value is $value\n";
  78              $page_param_check{$key}($value) ? print STDERR "Check returned: ".$page_param_check{$key}($value) : push @problems, $key . ":" . $value;
  79         }
  80     }
  81
  82     return { missing => \@problems };
  83
  84 }
  85
  86 sub check_is_numeric {
  87     my $num = shift;
  88     looks_like_number($num) ? return 1 : return 0;
  89 }
  90
  91 sub check_page_format {
  92     my $format = shift;
  93     my %valid_formats = (
  94         "US Letter PDF" => 1,
  95         "A4 PDF" => 1,
  96         "Zebra printer file" => 1,
  97         "Custom" => 1
  98     );
  99     return $valid_formats{$format};
 100 }
 101
 102 sub check_label_format {
 103     my $format = shift;
 104     my %valid_formats = (
 105         '1" x 2 5/8"' => 1,
 106         '1" x 4"' => 1,
 107         '1 1/3" x 4"' => 1,
 108         '2" x 2 5/8"' => 1,
 109         '1 1/4" x 2"' => 1,
 110         'Custom' => 1,
 111     );
 112     return $valid_formats{$format};
 113 }
 114
 115 sub check_sort_order {
 116     my $order = shift;
 117     my %valid_orders = (
 118         "accession_name" => 1,
 119         "plot_name" => 1,
 120         "plot_number" => 1,
 121         "rep_number" => 1,
 122         "row_number" => 1,
 123         "column_number" => 1,
 124     );
 125     return $valid_orders{$order};
 126 }
 127
 128 sub check_scale {
 129     my $scale = shift;
 130     my @scale = @{$scale};
 131     my $x = $scale[0];
 132     my $y = $scale[1];
 133     print STDERR "X is $x and Y is $y\n";
 134     looks_like_number($x) ? 1 : return 0;
 135     looks_like_number($y) ? return 1 : return 0;
 136 }
 137
 138 sub check_field {
 139     my $field = shift;
 140     my %valid_fields = (
 141         "accession_id" => 1,
 142         "accession_name" => 1,
 143         "block_number" => 1,
 144         "col_number" => 1,
 145         "pedigree_string" => 1,
 146         "plot_id" => 1,
 147         "plot_name" => 1,
 148         "plot_number" => 1,
 149         "range_number" => 1,
 150         "rep_number" => 1,
 151         "row_number" => 1,
 152         "trial_name" => 1,
 153         "year" => 1,
 154     );
 155     my %return_values;
 156     $field =~ s/\{(.*?)\}/process_field($1,\%valid_fields,\%return_values)/ge;
 157     foreach my $key (keys %return_values) {
 158         if (!$return_values{$key}) {
 159             return 0;
 160         }
 161     }
 162     return 1;
 163 }
 164
 165 sub check_type {
 166     my $type = shift;
 167     my %valid_types = (
 168         "PDFText" => 1,
 169         "ZebraText" => 1,
 170         "Code128" => 1,
 171         "QRCode" => 1,
 172     );
 173     return $valid_types{$type};
 174 }
 175
 176 sub check_font {
 177     my $font = shift;
 178     my %valid_fonts = (
 179         "Courier" => 1,
 180         "Courier-Bold" => 1,
 181         "Courier-Oblique" => 1,
 182         "Courier-BoldOblique" => 1,
 183         "Helvetica" => 1,
 184         "Helvetica-Bold" => 1,
 185         "Helvetica-Oblique" => 1,
 186         "Helvetica-BoldOblique" => 1,
 187         "Times" => 1,
 188         "Times-Bold" => 1,
 189         "Times-Italic" => 1,
 190         "Times-BoldItalic" => 1,
 191     );
 192     return $valid_fonts{$font};
 193 }
 194
 195 sub process_field {
 196     my $field = shift;
 197     my $valid_fields = shift;
 198     my $return_values = shift;
 199     my %valid_fields = %{$valid_fields};
 200     my %return_values = %{$return_values};
 201
 202     print STDERR "Field is $field\n";
 203     if ($field =~ m/Number:/) {
 204         our ($placeholder, $start_num, $increment) = split ':', $field;
 205         my $length = length($start_num);
 206         #print STDERR "Increment is $increment\nKey Number is $key_number\n";
 207         my $custom_num =  $start_num + ($increment * 1);
 208         my $final_num = sprintf("%0${length}d", $custom_num);
 209         $return_values{$field} = looks_like_number($final_num);
 210     } else {
 211         $return_values{$field} = $valid_fields{$field};
 212     }
 213 }
 214
 215 1;