lib/SGN/Controller/AJAX/LabelDesigner.pm

   1 package SGN::Controller::AJAX::LabelDesigner;
   2
   3 use Moose;
   4 use CXGN::Stock;
   5 use CXGN::List;
   6 use CXGN::List::Transform;
   7 use Data::Dumper;
   8 use Try::Tiny;
   9 use JSON;
  10 use Barcode::Code128;
  11 use CXGN::QRcode;
  12 use CXGN::ZPL;
  13 use PDF::API2;
  14 use Sort::Versions;
  15 use Tie::UrlEncoder; our(%urlencode);
  16 use CXGN::Trial::TrialLayout;
  17 use CXGN::Trial;
  18 use CXGN::Trial::TrialLayoutDownload;
  19 use CXGN::Cross;
  20 use SGN::Model::Cvterm;
  21 use Sort::Naturally;
  22
  23 BEGIN { extends 'Catalyst::Controller::REST' }
  24
  25 #
  26 # DEFINE ADDITIONAL LABEL DATA FOR LIST ITEMS HERE
  27 # This info is used to provide additional properties for list items of
  28 # specific types to the label designer.
  29 # - The first-level hash key defines the list type
  30 # - The second-level hash key defines the propery name (displayed in the label designer)
  31 #   NOTE: Each list type needs to define (as '_transform') the list transform plugin name used to convert the list item names to database ids
  32 # - The value of the second-level hash is a subroutine that calculates the
  33 #   property value(s) for the specified list item(s)
  34 #   It accepts the following arguments:
  35 #       - $c = catalyst context
  36 #       - $schema = Bio::Chado::Schema
  37 #       - $dbh = DB Handle
  38 #       - $list_id = the id of the List
  39 #       - $list_item_ids = arrayref of list item ids
  40 #       - $list_item_names = arrayref of list item names
  41 #       - $list_item_db_ids = arrayref of original db ids of list items (stock ids, project ids, etc)
  42 #   and returns a hashref of property values (key = list item id, value = property value)
  43 #
  44 my %ADDITIONAL_LIST_DATA = (
  45
  46     'accessions' => {
  47
  48         '_transform' => 'stocks_2_stock_ids',
  49
  50         'accession id' => sub {
  51             my ($c, $schema, $dbh, $list_id, $list_item_ids, $list_item_names, $list_item_db_ids) = @_;
  52             my %values;
  53             for my $index (0 .. $#$list_item_ids ) {
  54                 $values{$list_item_ids->[$index]} = $list_item_db_ids->[$index];
  55             }
  56             return \%values;
  57         },
  58
  59         'accession pedigree' => sub {
  60             my ($c, $schema, $dbh, $list_id, $list_item_ids, $list_item_names, $list_item_db_ids) = @_;
  61             my %values;
  62             my $accession_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, "accession", "stock_type")->cvterm_id();
  63             my $mother_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'female_parent', 'stock_relationship')->cvterm_id();
  64             my $father_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'male_parent', 'stock_relationship')->cvterm_id();
  65
  66             foreach my $stock_id ( @$list_item_db_ids) {
  67
  68                 # Get the pedigree of the stock
  69                 my $prs = $schema->resultset("Stock::StockRelationship")->search([
  70                     {
  71                         'me.object_id' => $stock_id,
  72                         'me.type_id' => $father_type_id,
  73                         'subject.type_id'=> $accession_type_id
  74                     },
  75                     {
  76                         'me.object_id' => $stock_id,
  77                         'me.type_id' => $mother_type_id,
  78                         'subject.type_id'=> $accession_type_id
  79                     }
  80                 ], {
  81                     'join' => 'subject',
  82                     '+select' => ['subject.uniquename'],
  83                     '+as' => ['subject_uniquename']
  84                 });
  85
  86                 # Retrieve the names of the parents
  87                 my $parents = {};
  88                 while ( my $p = $prs->next() ) {
  89                     if ( $p->type_id == $mother_type_id ) {
  90                         $parents->{'mother'} = $p->get_column('subject_uniquename');
  91                     }
  92                     else {
  93                         $parents->{'father'} = $p->get_column('subject_uniquename');
  94                     }
  95                 }
  96
  97                 # Build pedigree string
  98                 my $pedigree = 'NA/NA';
  99                 if ( $parents->{'mother'} && $parents->{'father'} ) {
 100                     $pedigree = $parents->{'mother'} . '/' . $parents->{'father'};
 101                 }
 102
 103                 # Add pedigree to return hash
 104                 for my $index (0 .. $#$list_item_db_ids ) {
 105                     if ( $list_item_db_ids->[$index] eq $stock_id ) {
 106                         $values{$list_item_ids->[$index]} = $pedigree;
 107                     }
 108                 }
 109             }
 110
 111             return \%values;
 112         },
 113
 114         'accession synonyms' => sub {
 115             my ($c, $schema, $dbh, $list_id, $list_item_ids, $list_item_names, $list_item_db_ids) = @_;
 116             my %values;
 117             my $type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'stock_synonym', 'stock_property')->cvterm_id();
 118
 119             my $rs = $schema->resultset("Stock::Stockprop")->search({
 120                 'me.stock_id' => { in => $list_item_db_ids },
 121                 'me.type_id' => $type_id
 122             });
 123             while ( my $row = $rs->next() ) {
 124                 my $accession_id = $row->stock_id();
 125                 my $synonym = $row->value();
 126                 for my $index (0 .. $#$list_item_db_ids ) {
 127                     if ( $list_item_db_ids->[$index] eq $accession_id ) {
 128                         my $id = $list_item_ids->[$index];
 129                         $values{$id} = $values{$id} ? $values{$id} . ", " . $synonym : $synonym;
 130                     }
 131                 }
 132             }
 133
 134             return \%values;
 135         }
 136
 137     },
 138
 139     'seedlots' => {
 140
 141         '_transform' => 'stocks_2_stock_ids',
 142
 143         'seedlot id' => sub {
 144             my ($c, $schema, $dbh, $list_id, $list_item_ids, $list_item_names, $list_item_db_ids) = @_;
 145             my %values;
 146             for my $index (0 .. $#$list_item_ids ) {
 147                 $values{$list_item_ids->[$index]} = $list_item_db_ids->[$index];
 148             }
 149             return \%values;
 150         },
 151
 152         'seedlot contents' => sub {
 153             my ($c, $schema, $dbh, $list_id, $list_item_ids, $list_item_names, $list_item_db_ids) = @_;
 154             my %values;
 155             my $type_id = SGN::Model::Cvterm->get_cvterm_row($schema, "collection_of", "stock_relationship")->cvterm_id();
 156             my $accession_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, "accession", "stock_type")->cvterm_id();
 157             my $cross_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, "cross", "stock_type")->cvterm_id();
 158
 159             my $rs = $schema->resultset("Stock::StockRelationship")->search({
 160                 'me.object_id' => { in => $list_item_db_ids },
 161                 'me.type_id' => $type_id,
 162                 'subject.type_id' => { in => [$accession_type_id, $cross_type_id] }
 163             }, {
 164                 'join' => 'subject',
 165                 '+select' => ['subject.uniquename'],
 166                 '+as' => ['subject_uniquename']
 167             });
 168             while ( my $row = $rs->next() ) {
 169                 my $seedlot_id = $row->object_id();
 170                 my $accession_name = $row->get_column('subject_uniquename');
 171                 for my $index (0 .. $#$list_item_db_ids ) {
 172                     if ( $list_item_db_ids->[$index] eq $seedlot_id ) {
 173                         $values{$list_item_ids->[$index]} = $accession_name;
 174                     }
 175                 }
 176             }
 177
 178             return \%values;
 179         },
 180
 181         'seedlot contents pedigree' => sub {
 182             my ($c, $schema, $dbh, $list_id, $list_item_ids, $list_item_names, $list_item_db_ids) = @_;
 183             my %values;
 184             my $type_id = SGN::Model::Cvterm->get_cvterm_row($schema, "collection_of", "stock_relationship")->cvterm_id();
 185             my $accession_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, "accession", "stock_type")->cvterm_id();
 186             my $mother_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'female_parent', 'stock_relationship')->cvterm_id();
 187             my $father_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'male_parent', 'stock_relationship')->cvterm_id();
 188             my $cross_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, "cross", "stock_type")->cvterm_id();
 189
 190             # Get the stock ids of the seedlot contents
 191             my $rs = $schema->resultset("Stock::StockRelationship")->search({
 192                 'me.object_id' => { in => $list_item_db_ids },
 193                 'me.type_id' => $type_id,
 194                 'subject.type_id' => { in => [$accession_type_id, $cross_type_id] }
 195             }, {
 196                 'join' => 'subject',
 197                 '+select' => ['subject.uniquename', 'subject.stock_id'],
 198                 '+as' => ['subject_uniquename', 'subject_stockid']
 199             });
 200             while ( my $row = $rs->next() ) {
 201                 my $seedlot_id = $row->object_id();
 202                 my $stock_id = $row->get_column('subject_stockid');
 203
 204                 # Get the pedigree of the contents
 205                 my $prs = $schema->resultset("Stock::StockRelationship")->search([
 206                     {
 207                         'me.object_id' => $stock_id,
 208                         'me.type_id' => $father_type_id,
 209                         'subject.type_id'=> $accession_type_id
 210                     },
 211                     {
 212                         'me.object_id' => $stock_id,
 213                         'me.type_id' => $mother_type_id,
 214                         'subject.type_id'=> $accession_type_id
 215                     }
 216                 ], {
 217                     'join' => 'subject',
 218                     '+select' => ['subject.uniquename'],
 219                     '+as' => ['subject_uniquename']
 220                 });
 221
 222                 # Retrieve the names of the parents
 223                 my $parents = {};
 224                 while ( my $p = $prs->next() ) {
 225                     if ( $p->type_id == $mother_type_id ) {
 226                         $parents->{'mother'} = $p->get_column('subject_uniquename');
 227                     }
 228                     else {
 229                         $parents->{'father'} = $p->get_column('subject_uniquename');
 230                     }
 231                 }
 232
 233                 # Build pedigree string
 234                 my $pedigree = 'NA/NA';
 235                 if ( $parents->{'mother'} && $parents->{'father'} ) {
 236                     $pedigree = $parents->{'mother'} . '/' . $parents->{'father'};
 237                 }
 238
 239                 # Add pedigree to return hash
 240                 for my $index (0 .. $#$list_item_db_ids ) {
 241                     if ( $list_item_db_ids->[$index] eq $seedlot_id ) {
 242                         $values{$list_item_ids->[$index]} = $pedigree;
 243                     }
 244                 }
 245             }
 246
 247             return \%values;
 248         },
 249
 250         'seedlot box' => sub {
 251             my ($c, $schema, $dbh, $list_id, $list_item_ids, $list_item_names, $list_item_db_ids) = @_;
 252             my %values;
 253             my $type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'location_code', 'stock_property')->cvterm_id();
 254
 255             my $rs = $schema->resultset("Stock::Stockprop")->search({
 256                 'me.stock_id' => { in => $list_item_db_ids },
 257                 'me.type_id' => $type_id
 258             });
 259             while ( my $row = $rs->next() ) {
 260                 my $seedlot_id = $row->stock_id();
 261                 my $box = $row->value();
 262                 for my $index (0 .. $#$list_item_db_ids ) {
 263                     if ( $list_item_db_ids->[$index] eq $seedlot_id ) {
 264                         $values{$list_item_ids->[$index]} = $box;
 265                     }
 266                 }
 267             }
 268
 269             return \%values;
 270         }
 271
 272     }
 273
 274 );
 275
 276 __PACKAGE__->config(
 277     default   => 'application/json',
 278     stash_key => 'rest',
 279     map       => { 'application/json' => 'JSON' },
 280    );
 281
 282    sub retrieve_longest_fields :Path('/tools/label_designer/retrieve_longest_fields') {
 283         my $self = shift;
 284         my $c = shift;
 285         my $schema = $c->dbic_schema('Bio::Chado::Schema');
 286         my $data_type = $c->req->param("data_type");
 287         my $source_id = $c->req->param("source_id");
 288         my $data_level = $c->req->param("data_level");
 289         my %longest_hash;
 290         #print STDERR "Data type is $data_type and id is $source_id and data level is $data_level\n";
 291
 292         my ($trial_num, $design) = get_data($c, $schema, $data_type, $data_level, $source_id);
 293
 294        if ($trial_num > 1) {
 295            $c->stash->{rest} = { error => "The selected list contains plots, plants, subplots or tissues from more than one trial. This is not supported. Please select a different data source." };
 296            return;
 297        }
 298
 299        my %design = %{$design};
 300
 301        #delete any undefined fields
 302        my $num_units = scalar(keys %design);
 303        foreach my $key (keys %design) {
 304            my %plot = %{$design{$key}};
 305            delete $design{$key}{$_} for grep { !defined $plot{$_} } keys %plot;
 306        }
 307
 308        #get all fields in this trials design
 309        my $random_plot = $design{(keys %design)[rand keys %design]};
 310        my %reps;
 311        my @keys = keys %{$random_plot};
 312
 313        foreach my $field (@keys) {
 314
 315            # if rep_number, find unique options and return them
 316            if ($field eq 'rep_number') {
 317                print STDERR "Searching for unique rep numbers.\n";
 318                $reps{$_->{'rep_number'}}++ foreach values %design;
 319                print STDERR "Reps: ".Dumper(%reps);
 320            }
 321
 322            print STDERR " Searching for longest $field\n";
 323            #for each field order values by descending length, then save the first one
 324            foreach my $key ( sort { length($design{$b}{$field}) <=> length($design{$a}{$field}) or versioncmp($a, $b) } keys %design) {
 325                 print STDERR "Longest $field is: ".$design{$key}{$field}."\n";
 326                 my $longest = $design{$key}{$field};
 327                 unless (ref($longest) || length($longest) < 1) { # skip if not scalar or undefined
 328                     $longest_hash{$field} = $longest;
 329                 } elsif (ref($longest) eq 'ARRAY') { # if array (ex. plants), sort array by length and take longest
 330                     print STDERR "Processing array " . Dumper($longest) . "\n";
 331                     my @sorted = sort { length $a <=> length $b } @{$longest};
 332                     if (length($sorted[0]) > 0) {
 333                         $longest_hash{$field} = $sorted[0];
 334                     }
 335                 } elsif (ref($longest) eq 'HASH') {
 336                     print STDERR "Not handling hashes yet\n";
 337                 }
 338                 last;
 339             }
 340         }
 341
 342         # Get additional list data for just the longest item
 343         if ( $data_type eq 'Lists' ) {
 344             my %longest_additional_list_data;
 345             my $additional_list_data = get_additional_list_data($c, $source_id);
 346             if ( $additional_list_data ) {
 347                 foreach my $key ( keys(%$additional_list_data) ) {
 348                     my $fields = $additional_list_data->{$key};
 349                     if ( (ref($fields) eq "HASH") && (keys(%$fields) > 0) ) {
 350                         foreach my $field_name ( keys(%$fields) ) {
 351                             my $field_value = $fields->{$field_name};
 352                             if (exists $longest_additional_list_data{$field_name} ) {
 353                                 if ( length($field_value) > length($longest_additional_list_data{$field_name}) ) {
 354                                     $longest_additional_list_data{$field_name} = $field_value;
 355                                 }
 356                             }
 357                             else {
 358                                 $longest_additional_list_data{$field_name} = $field_value;
 359                             }
 360                         }
 361                     }
 362                 }
 363             }
 364             %longest_hash = (%longest_hash, %longest_additional_list_data);
 365         }
 366
 367         $c->stash->{rest} = {
 368             fields => \%longest_hash,
 369             reps => \%reps,
 370             num_units => $num_units
 371         };
 372    }
 373
 374    sub label_designer_download : Path('/tools/label_designer/download') : ActionClass('REST') { }
 375
 376    sub label_designer_download_GET : Args(0) {
 377         my $self = shift;
 378         my $c = shift;
 379         $c->forward('label_designer_download_POST');
 380     }
 381
 382   sub label_designer_download_POST : Args(0) {
 383        my $self = shift;
 384        my $c = shift;
 385        my $schema = $c->dbic_schema('Bio::Chado::Schema');
 386        my $download_type = $c->req->param("download_type");
 387        my $data_type = $c->req->param("data_type");
 388        my $data_level = $c->req->param("data_level");
 389        my $source_id = $c->req->param("source_id");
 390        my $source_name = $c->req->param("source_name");
 391        my $design_json = $c->req->param("design_json");
 392        # decode json
 393        my $json = new JSON;
 394        #my $design_params = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($design_json);
 395        my $design_params = decode_json($design_json);
 396        my $labels_to_download = $design_params->{'labels_to_download'} || undef;
 397        my $start_number = $design_params->{'start_number'} || undef;
 398        my $end_number = $design_params->{'end_number'} || undef;
 399
 400        if ($labels_to_download) {
 401            $start_number = $start_number || 1;
 402            $end_number = $labels_to_download;
 403        }
 404
 405        if ($start_number) { $start_number--; } #zero index
 406        if ($end_number) { $end_number--; } #zero index
 407
 408        my $conversion_factor = 2.83; # for converting from 8 dots per mmm to 2.83 per mm (72 per inch)
 409
 410        my ($trial_num, $design) = get_data($c, $schema, $data_type, $data_level, $source_id, 1);
 411
 412        my $label_params = $design_params->{'label_elements'};
 413
 414        if ($trial_num > 1) {
 415            $c->stash->{rest} = { error => "The selected list contains plots from more than one trial. This is not supported. Please select a different data source." };
 416            return;
 417        }
 418
 419        my %design = %{$design};
 420        if (!$design) {
 421            $c->stash->{rest} = { error => "$source_name is not linked to a valid field design. Can't create labels." };
 422            return;
 423        }
 424
 425        # Create a blank PDF file
 426        my $dir = $c->tempfiles_subdir('labels');
 427        my $file_prefix = $source_name;
 428        $file_prefix =~ s/[^a-zA-Z0-9-_]//g;
 429
 430        my ($FH, $filename) = $c->tempfile(TEMPLATE=>"labels/$file_prefix-XXXXX", SUFFIX=>".$download_type");
 431
 432        # initialize loop variables
 433        my $col_num = $design_params->{'start_col'} || 1;
 434        my $row_num = $design_params->{'start_row'} || 1;
 435        my $key_number = 0;
 436        my $sort_order_1 = $design_params->{'sort_order_1'};
 437        my $sort_order_2 = $design_params->{'sort_order_2'};
 438        my $sort_order_3 = $design_params->{'sort_order_3'};
 439        my @sorted_keys;
 440
 441        # Sort by Field Layout
 442        if ( $sort_order_1 eq 'Trial Layout: Plot Order') {
 443             my $layout_order = $design_params->{'sort_order_layout_order'};
 444             my $layout_start = $design_params->{'sort_order_layout_start'};
 445
 446             # Set the Trial IDs
 447             # - a single trial = the source id is the trial id
 448             # - a list of trials = the source id is the list id
 449             #       get the list contents and convert to database ids
 450             my @trial_ids;
 451             if ( $data_type eq 'Field Trials' ) {
 452                 push(@trial_ids, $source_id);
 453             }
 454             elsif ( $data_type eq 'Lists' ) {
 455                 my $list = CXGN::List->new({ dbh => $schema->storage->dbh(), list_id => $source_id });
 456                 my $list_elements = $list->retrieve_elements_with_ids($source_id);
 457                 my @trial_names = map { $_->[1] } @$list_elements;
 458                 my $lt = CXGN::List::Transform->new();
 459                 my $tr = $lt->transform($schema, "projects_2_project_ids", \@trial_names);
 460                 @trial_ids = @{$tr->{transform}};
 461             }
 462
 463             # Get the sorted plots, individually by trial
 464             # Add a _plot_order key to each plot in the label design
 465             foreach my $trial_id (@trial_ids) {
 466                 my $results = CXGN::Trial->get_sorted_plots($schema, [$trial_id], $layout_order, $layout_start);
 467                 if ( $results->{plots} ) {
 468                     foreach (@{$results->{plots}}) {
 469                         $design->{$_->{plot_name}}{_plot_order} = $_->{order};
 470                     }
 471                 }
 472             }
 473
 474             # Sort the label design elements by trial, plot order, plot number
 475             # (if the trial does not have a layout, it will default to sorting by plot number)
 476             @sorted_keys = sort {
 477                     ncmp($design->{$a}{trial_name}, $design->{$b}{trial_name}) ||
 478                     ncmp($design->{$a}{_plot_order}, $design->{$b}{_plot_order}) ||
 479                     ncmp($design->{$a}{plot_number}, $design->{$b}{plot_numer}) ||
 480                     ncmp($a, $b)
 481             } keys %design;
 482        }
 483
 484        # Sort by designated data property(s)
 485        else {
 486             @sorted_keys = sort {
 487                     ncmp($design->{$a}{$sort_order_1}, $design->{$b}{$sort_order_1}) ||
 488                     ncmp($design->{$a}{$sort_order_2}, $design->{$b}{$sort_order_2}) ||
 489                     ncmp($design->{$a}{$sort_order_3}, $design->{$b}{$sort_order_3}) ||
 490                     ncmp($a, $b)
 491             } keys %design;
 492        }
 493
 494        my $qrcode = Imager::QRCode->new(
 495            margin        => 0,
 496            version       => 0,
 497            level         => 'M',
 498            casesensitive => 1,
 499            lightcolor    => Imager::Color->new(255, 255, 255),
 500            darkcolor     => Imager::Color->new(0, 0, 0),
 501        );
 502        my ($jpeg_location, $jpeg_uri) = $c->tempfile( TEMPLATE => [ 'barcode', 'bc-XXXXX'], SUFFIX=>'.jpg');
 503
 504        if ($download_type eq 'pdf') {
 505
 506            print STDERR "Creating the PDF : ".localtime()."\n";
 507            my $pdf  = PDF::API2->new(-file => $FH);
 508            my $page = $pdf->page();
 509            my $text = $page->text();
 510            my $gfx = $page->gfx();
 511            $page->mediabox($design_params->{'page_width'}, $design_params->{'page_height'});
 512
 513            # loop through design hash, sorting via specified field or default
 514            foreach my $key (@sorted_keys) {
 515                if ($start_number && ($key_number < $start_number)){
 516                    $key_number++;
 517                    next;
 518                }
 519                if ($end_number && ($key_number > $end_number)){
 520                    last;
 521                }
 522
 523                my %design_info = %{$design{$key}};
 524
 525                if ( $design_params->{'plot_filter'} eq 'all' || $design_params->{'plot_filter'} eq $design_info{'rep_number'}) { # filter by rep if needed
 526
 527                     for (my $i=0; $i < $design_params->{'copies_per_plot'}; $i++) {
 528                         #print STDERR "Working on label num $i\n";
 529                         my $label_x = $design_params->{'left_margin'} + ($design_params->{'label_width'} + $design_params->{'horizontal_gap'}) * ($col_num-1);
 530                         my $label_y = $design_params->{'page_height'} - $design_params->{'top_margin'} - ($design_params->{'label_height'} + $design_params->{'vertical_gap'}) * ($row_num-1);
 531
 532                        foreach my $element (@$label_params) {
 533                            #print STDERR "Element Dumper\n" . Dumper($element);
 534                            my %element = %{$element};
 535                            my $elementx = $label_x + ( $element{'x'} / $conversion_factor );
 536                            my $elementy = $label_y - ( $element{'y'} / $conversion_factor );
 537
 538                            my $filled_value = $element{'value'};
 539                            $filled_value =~ s/\{(.*?)\}/process_field($1,$key_number,\%design_info)/ge;
 540
 541                            if ( $element{'type'} eq "Code128" || $element{'type'} eq "QRCode" ) {
 542
 543                                 if ( $element{'type'} eq "Code128" ) {
 544                                    # initialize barcode objs
 545                                    my $barcode_object = Barcode::Code128->new();
 546                                    my ($png_location, $png_uri) = $c->tempfile( TEMPLATE => [ 'barcode', 'bc-XXXXX'], SUFFIX=>'.png');
 547                                    open(PNG, ">", $png_location) or die "Can't write $png_location: $!\n";
 548                                    binmode(PNG);
 549
 550                                    $barcode_object->option("scale", $element{'size'}, "font_align", "center", "padding", 5, "show_text", 0);
 551                                    $barcode_object->barcode($filled_value);
 552                                    my $barcode = $barcode_object->gd_image();
 553                                    print PNG $barcode->png();
 554                                    close(PNG);
 555
 556                                     my $image = $pdf->image_png($png_location);
 557                                     my $height = $element{'height'} / $conversion_factor ; # scale to 72 pts per inch
 558                                     my $width = $element{'width'} / $conversion_factor ; # scale to 72 pts per inch
 559                                     my $elementy = $elementy - ($height/2); # adjust for img position sarting at bottom
 560                                     my $elementx = $elementx - ($width/2);
 561                                     #print STDERR 'adding Code 128 params $image, $elementx, $elementy, $width, $height with: '."$image, $elementx, $elementy, $width, $height\n";
 562                                     $gfx->image($image, $elementx, $elementy, $width, $height);
 563
 564                               } else { #QRCode
 565
 566                                   my $barcode = $qrcode->plot( $filled_value );
 567                                   my $barcode_file = $barcode->write(file => $jpeg_location);
 568
 569                                    my $image = $pdf->image_jpeg($jpeg_location);
 570                                    my $height = $element{'height'} / $conversion_factor ; # scale to 72 pts per inch
 571                                    my $width = $element{'width'} / $conversion_factor ; # scale to 72 pts per inch
 572                                    my $elementy = $elementy - ($height/2); # adjust for img position sarting at bottom
 573                                    my $elementx = $elementx - ($width/2);
 574                                    $gfx->image($image, $elementx, $elementy, $width, $height);
 575
 576                               }
 577                            }
 578                            else { #Text
 579
 580                                 my $font = $pdf->corefont($element{'font'}); # Add a built-in font to the PDF
 581                                 # Add text to the page
 582                                 my $adjusted_size = $element{'size'} / $conversion_factor; # scale to 72 pts per inch
 583                                 $text->font($font, $adjusted_size);
 584                                 my $height = $element{'height'} / $conversion_factor ; # scale to 72 pts per inch
 585                                 my $elementy = $elementy - ($height/4); # adjust for img position starting at bottom
 586                                 $text->translate($elementx, $elementy);
 587                                 $text->text_center($filled_value);
 588                            }
 589                        }
 590
 591                         if ($col_num < $design_params->{'number_of_columns'}) { #next column
 592                             $col_num++;
 593                         } else { #new row, reset col num
 594                             $col_num = 1;
 595                             $row_num++;
 596                         }
 597
 598                         if ($row_num > $design_params->{'number_of_rows'}) { #create new page and reset row and col num
 599                             $pdf->finishobjects($page, $gfx, $text); #flush the page to save memory on big PDFs
 600                             $page = $pdf->page();
 601                             $text = $page->text();
 602                             $gfx = $page->gfx();
 603                             $page->mediabox($design_params->{'page_width'}, $design_params->{'page_height'});
 604                             $row_num = 1;
 605                         }
 606                     }
 607                 }
 608              $key_number++;
 609              }
 610
 611            print STDERR "Saving the PDF : ".localtime()."\n";
 612            $pdf->save();
 613
 614        } elsif ($download_type eq 'zpl') {
 615
 616            print STDERR "Generating zpl . . .\n";
 617            my $zpl_obj = CXGN::ZPL->new(
 618                print_width => $design_params->{'label_width'} * $conversion_factor,
 619                label_length => $design_params->{'label_height'} * $conversion_factor
 620            );
 621            $zpl_obj->start_sequence();
 622            $zpl_obj->label_format();
 623            foreach my $element (@$label_params) {
 624                my $x = $element->{'x'} - ($element->{'width'}/2);
 625                my $y = $element->{'y'} - ($element->{'height'}/2);
 626                $zpl_obj->new_element($element->{'type'}, $x, $y, $element->{'size'}, $element->{'value'});
 627            }
 628            $zpl_obj->end_sequence();
 629            my $zpl_template = $zpl_obj->render();
 630            foreach my $key ( @sorted_keys ) {
 631
 632                if ($start_number && ($key_number < $start_number)){
 633                    $key_number++;
 634                    next;
 635                }
 636                if ($end_number && ($key_number > $end_number)){
 637                    last;
 638                }
 639
 640                my %design_info = %{$design{$key}};
 641
 642                my $zpl = $zpl_template;
 643                $zpl =~ s/\{(.*?)\}/process_field($1,$key_number,\%design_info)/ge;
 644               for (my $i=0; $i < $design_params->{'copies_per_plot'}; $i++) {
 645                   print $FH $zpl;
 646                }
 647             $key_number++;
 648             }
 649        }
 650
 651        close($FH);
 652        print STDERR "Returning with filename . . .\n";
 653        $c->stash->{rest} = {
 654            filename => $urlencode{$filename},
 655            filepath => $c->config->{basepath}."/".$filename
 656        };
 657
 658    }
 659
 660 sub process_field {
 661     my $field = shift;
 662     my $key_number = shift;
 663     my $design_info = shift;
 664     my %design_info = %{$design_info};
 665     #print STDERR "Field is $field\n";
 666     if ($field =~ m/Number:/) {
 667         our ($placeholder, $start_num, $increment) = split ':', $field;
 668         my $length = length($start_num);
 669         #print STDERR "Increment is $increment\nKey Number is $key_number\n";
 670         my $custom_num =  $start_num + ($increment * $key_number);
 671         return sprintf("%0${length}d", $custom_num);
 672     } else {
 673         return $design_info{$field};
 674     }
 675 }
 676
 677 sub convert_stock_list {
 678     my $c = shift;
 679     my $schema = shift;
 680     my $list_id = shift;
 681     my $list_data = SGN::Controller::AJAX::List->retrieve_list($c, $list_id);
 682     my @list_items = map { $_->[1] } @$list_data;
 683     my $t = CXGN::List::Transform->new();
 684     my $acc_t = $t->can_transform("stocks", "stock_ids");
 685     my $id_hash = $t->transform($schema, $acc_t, \@list_items);
 686     my @ids = @{$id_hash->{transform}};
 687     return \@ids;
 688 }
 689
 690 sub convert_project_list {
 691     my $c = shift;
 692     my $schema = shift;
 693     my $list_id = shift;
 694     my $list_data = SGN::Controller::AJAX::List->retrieve_list($c, $list_id);
 695     my @list_items = map { $_->[1] } @$list_data;
 696     my $t = CXGN::List::Transform->new();
 697     my $proj_t = $t->can_transform("projects", "project_ids");
 698     my $id_hash = $t->transform($schema, $proj_t, \@list_items);
 699     my @ids = @{$id_hash->{transform}};
 700     return \@ids;
 701 }
 702
 703 sub get_trial_from_stock_list {
 704     my $c = shift;
 705     my $schema = shift;
 706     my $ids = shift;
 707     my @ids = @{$ids};
 708
 709     my $genotyping_experiment_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'genotyping_layout', 'experiment_type')->cvterm_id();
 710     my $field_experiment_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'field_layout', 'experiment_type')->cvterm_id();
 711     my $cross_experiment_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'cross_experiment', 'experiment_type')->cvterm_id();
 712
 713
 714     my $trial_rs = $schema->resultset("NaturalDiversity::NdExperimentStock")->search({
 715         stock_id => { -in => \@ids }
 716     })->search_related('nd_experiment', {'nd_experiment.type_id'=>[$field_experiment_cvterm_id, $genotyping_experiment_cvterm_id, $cross_experiment_cvterm_id]
 717     })->search_related('nd_experiment_projects');
 718     my %trials = ();
 719     while (my $row = $trial_rs->next()) {
 720         #print STDERR "Looking at id ".$row->project_id()."\n";
 721         my $id = $row->project_id();
 722         $trials{$id} = 1;
 723     }
 724     my $num_trials = scalar keys %trials;
 725     my @all_trial_ids = keys %trials;
 726     #print STDERR "Number of linked trials is $num_trials\n";
 727     return \@all_trial_ids, $num_trials;
 728 }
 729
 730 sub filter_by_list_items {
 731     my $full_design = shift;
 732     my $stock_ids = shift;
 733     my $type = shift;
 734     my %full_design = %{$full_design};
 735     my @stock_ids = @{$stock_ids};
 736     my %plot_design;
 737
 738     foreach my $i (0 .. $#stock_ids) {
 739         #print STDERR "Stock id is ".$stock_ids[$i]."\n";
 740         foreach my $key (keys %full_design) {
 741             if ($full_design{$key}->{$type} eq $stock_ids[$i]) {
 742                 #print STDERR "Plot name is ".$full_design{$key}->{'plot_name'}."\n";
 743                 $plot_design{$key} = $full_design{$key};
 744                 $plot_design{$key}->{'list_order'} = $i;
 745             }
 746         }
 747     }
 748     return \%plot_design;
 749 }
 750
 751 sub get_trial_design {
 752     my $c = shift;
 753     my $schema = shift;
 754     my $trial_ids = shift;
 755     my $type = shift;
 756     my %selected_columns = (
 757         plate => {genotyping_project_name=>1,genotyping_facility=>1,trial_name=>1,acquisition_date=>1,exported_tissue_sample_name=>1,tissue_sample_name=>1,well_A01=>1,row_number=>1,col_number=>1,source_observation_unit_name=>1,accession_name=>1,synonyms=>1,accession_id=>1,pedigree=>1,dna_person=>1,notes=>1,tissue_type=>1,extraction=>1,concentration=>1,volume=>1,is_blank=>1,year=>1,location_name=>1},
 758         plots => {plot_name=>1,plot_id=>1,accession_name=>1,synonyms=>1,accession_id=>1,plot_number=>1,block_number=>1,is_a_control=>1,rep_number=>1,range_number=>1,row_number=>1,col_number=>1,seedlot_name=>1,seed_transaction_operator=>1,num_seed_per_plot=>1,pedigree=>1,location_name=>1,trial_name=>1,year=>1,tier=>1,plot_geo_json=>1},
 759         plants => {plant_name=>1,plant_id=>1,subplot_name=>1,subplot_id=>1,plot_name=>1,plot_id=>1,accession_name=>1,synonyms=>1,accession_id=>1,plot_number=>1,block_number=>1,is_a_control=>1,range_number=>1,rep_number=>1,row_number=>1,col_number=>1,seedlot_name=>1,seed_transaction_operator=>1,num_seed_per_plot=>1,subplot_number=>1,plant_number=>1,pedigree=>1,location_name=>1,trial_name=>1,year=>1,tier=>1,plot_geo_json=>1},
 760         subplots => {subplot_name=>1,subplot_id=>1,plot_name=>1,plot_id=>1,accession_name=>1,synonyms=>1,accession_id=>1,plot_number=>1,block_number=>1,is_a_control=>1,rep_number=>1,range_number=>1,row_number=>1,col_number=>1,seedlot_name=>1,seed_transaction_operator=>1,num_seed_per_plot=>1,subplot_number=>1,pedigree=>1,location_name=>1,trial_name=>1,year=>1,tier=>1,plot_geo_json=>1},
 761         field_trial_tissue_samples => {tissue_sample_name=>1,tissue_sample_id=>1,plant_name=>1,plant_id=>1,subplot_name=>1,subplot_id=>1,plot_name=>1,plot_id=>1,accession_name=>1,synonyms=>1,accession_id=>1,plot_number=>1,block_number=>1,is_a_control=>1,range_number=>1,rep_number=>1,row_number=>1,col_number=>1,seedlot_name=>1,seed_transaction_operator=>1,num_seed_per_plot=>1,subplot_number=>1,plant_number=>1,tissue_sample_number=>1,pedigree=>1,location_name=>1,trial_name=>1,year=>1,tier=>1,plot_geo_json=>1}
 762     );
 763     my %unique_identifier = (
 764         plate => 'tissue_sample_name',
 765         plots => 'plot_name',
 766         plants => 'plant_name',
 767         subplots => 'subplot_name',
 768         field_trial_tissue_samples => 'tissue_sample_name',
 769     );
 770
 771     my %mapped_design;
 772     foreach my $trial_id (@$trial_ids) {
 773         my $trial = CXGN::Trial->new({ bcs_schema => $schema, trial_id => $trial_id });
 774         my $trial_name = $schema->resultset("Project::Project")->search({ project_id => $trial_id })->first->name();
 775         my $entry_numbers = $trial->get_entry_numbers();
 776
 777         my $treatments = $trial->get_treatments();
 778         my @treatment_ids = map { $_->[0] } @{$treatments};
 779         # print STDERR "treatment ids are @treatment_ids\n";
 780         my $trial_layout_download = CXGN::Trial::TrialLayoutDownload->new({
 781             schema => $schema,
 782             trial_id => $trial_id,
 783             data_level => $type,
 784             treatment_project_ids => \@treatment_ids,
 785             selected_columns => $selected_columns{$type},
 786             selected_trait_ids => [],
 787             use_synonyms => 'false',
 788             include_measured => 'true'
 789         });
 790         my $layout = $trial_layout_download->get_layout_output();
 791
 792         # map array of arrays into hash
 793         my @outer_array = @{$layout->{'output'}};
 794         my ($inner_array, @keys);
 795         for my $i (0 .. $#outer_array) {
 796             $inner_array = $outer_array[$i];
 797         # foreach my $inner_array (@{$outer_array}) {
 798             if (scalar @keys > 0) {
 799                 my %detail_hash;
 800                 @detail_hash{@keys} = @{$outer_array[$i]};
 801
 802                 my @applied_treatments;
 803                 foreach my $key (keys %detail_hash) {
 804                     if ( $key =~ /ManagementFactor/ && $detail_hash{$key} ) {
 805                         my $treatment = $key;
 806                         $treatment =~ s/ManagementFactor://;
 807                         $treatment =~ s/$trial_name//;
 808                         $treatment =~ s/^_//;
 809                         push @applied_treatments, $treatment;
 810                         delete($detail_hash{$key});
 811                     }
 812                     elsif ( $key =~ /ManagementFactor/ ) {
 813                         delete($detail_hash{$key});
 814                     }
 815                 }
 816                 $detail_hash{'management_factor'} = join(",", @applied_treatments);
 817                 $detail_hash{'entry_number'} = $entry_numbers ? $entry_numbers->{$detail_hash{accession_id}} : undef;
 818                 $mapped_design{$detail_hash{$unique_identifier{$type}}} = \%detail_hash;
 819
 820             }
 821             else {
 822                 @keys = @{$inner_array};
 823             }
 824         }
 825     }
 826     return \%mapped_design;
 827 }
 828
 829 sub get_data {
 830     my $c = shift;
 831     my $schema = shift;
 832     my $data_type = shift;
 833     my $data_level = shift;
 834     my $id = shift;
 835     my $include_additional_list_data = shift;
 836     my $num_trials = 1;
 837     my $design;
 838     my $dbh = $schema->storage->dbh();
 839
 840     # print STDERR "starting to get data,level is $data_level and type is $data_type\n";
 841     # use data level as well as type to determine and enact correct retrieval
 842
 843     if ($data_level =~ /batch-/) {  # handle batches of identifiers
 844         my $match = substr($data_level, 6);
 845         my $list_data = SGN::Controller::AJAX::List->retrieve_list($c, $id);
 846         my @list_data = @{$list_data};
 847         my $json = new JSON;
 848         #my $identifier_object = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($list_data[0][1]);
 849         my $identifier_object = decode_json($list_data[0][1]);
 850         my $records = $identifier_object->{'records'};
 851         foreach my $record (@{$records}) {
 852             my $next_number = $record->{'next_number'};
 853             if ($next_number eq $match) {
 854                 my $generated_identifiers = $record->{'generated_identifiers'};
 855                 foreach my $identifier (@{$generated_identifiers}) {
 856                     $design->{$identifier} = { 'identifier' => $identifier };
 857                 }
 858             }
 859         }
 860     }
 861     if ($data_level eq "list") {
 862         my $list_data = SGN::Controller::AJAX::List->retrieve_list($c, $id);
 863         my $additional_list_data = {};
 864         if ( $include_additional_list_data ) {
 865             $additional_list_data = get_additional_list_data($c, $id);
 866         }
 867         foreach my $item (@{$list_data}) {
 868             my $list_fields = { 'list_item_name' => $item->[1], 'list_item_id' => $item->[0] };
 869             my $additional_list_fields = $additional_list_data->{$item->[0]};
 870             $design->{$item->[0]} = { %$list_fields, $additional_list_fields ? %$additional_list_fields : () };
 871         }
 872     }
 873     elsif ($data_level eq "plate") {
 874         $design = get_trial_design($c, $schema, [$id], 'plate');
 875     }
 876     elsif ($data_level eq "plots") {
 877         if ($data_type =~ m/Field Trials/) {
 878             $design = get_trial_design($c, $schema, [$id], 'plots');
 879         }
 880         elsif ($data_type =~ m/List/) {
 881             my $list = CXGN::List->new({ dbh => $dbh, list_id => $id });
 882             my $list_type = $list->type();
 883             if ( $list_type eq "trials" ) {
 884                 my $trial_ids = convert_project_list($c, $schema, $id);
 885                 $design = get_trial_design($c, $schema, $trial_ids, 'plots');
 886             }
 887             elsif ( $list_type eq "plots" ) {
 888                 my $plot_ids = convert_stock_list($c, $schema, $id);
 889                 my $list_data = SGN::Controller::AJAX::List->retrieve_list($c, $id);
 890                 my @list_items = map { $_->[1] } @$list_data;
 891                 my ($trial_ids, $num_trials) = get_trial_from_stock_list($c, $schema, $plot_ids);
 892                 $design = get_trial_design($c, $schema, $trial_ids, 'plots');
 893                 $design = filter_by_list_items($design, \@list_items, 'plot_name');
 894             }
 895         }
 896     }
 897     elsif ($data_level eq "plants") {
 898         if ($data_type =~ m/Field Trials/) {
 899             $design = get_trial_design($c, $schema, [$id], 'plants');
 900         }
 901         elsif ($data_type =~ m/List/) {
 902             my $list_ids = convert_stock_list($c, $schema, $id);
 903             my $list_data = SGN::Controller::AJAX::List->retrieve_list($c, $id);
 904             my @list_items = map { $_->[1] } @$list_data;
 905             my ($trial_ids, $num_trials) = get_trial_from_stock_list($c, $schema, $list_ids);
 906             $design = get_trial_design($c, $schema, $trial_ids, 'plants');
 907             $design = filter_by_list_items($design, \@list_items, 'plant_name');
 908         }
 909     }
 910     elsif ($data_level eq "subplots") {
 911         if ($data_type =~ m/Field Trials/) {
 912             $design = get_trial_design($c, $schema, [$id], 'subplots');
 913         }
 914         elsif ($data_type =~ m/List/) {
 915             my $list_ids = convert_stock_list($c, $schema, $id);
 916             my $list_data = SGN::Controller::AJAX::List->retrieve_list($c, $id);
 917             my @list_items = map { $_->[1] } @$list_data;
 918             my ($trial_ids, $num_trials) = get_trial_from_stock_list($c, $schema, $list_ids);
 919             $design = get_trial_design($c, $schema, $trial_ids, 'subplots');
 920             $design = filter_by_list_items($design, \@list_items, 'subplot_name');
 921         }
 922     }
 923     elsif ($data_level eq "tissue_samples") {
 924         if ($data_type =~ m/Field Trials/) {
 925             $design = get_trial_design($c, $schema, [$id], 'field_trial_tissue_samples');
 926         }
 927         elsif ($data_type =~ m/List/) {
 928             my $list_ids = convert_stock_list($c, $schema, $id);
 929             my $list_data = SGN::Controller::AJAX::List->retrieve_list($c, $id);
 930             my @list_items = map { $_->[1] } @$list_data;
 931             my ($trial_ids, $num_trials) = get_trial_from_stock_list($c, $schema, $list_ids);
 932             $design = get_trial_design($c, $schema, $trial_ids, 'field_trial_tissue_samples');
 933             $design = filter_by_list_items($design, \@list_items, 'tissue_sample_name');
 934         }
 935     }
 936     elsif ($data_level eq "crosses") {
 937         my $project;
 938         my $cross_list_ids;
 939         my %all_design;
 940         if ($data_type =~ m/Crossing Experiments/) {
 941             $project = CXGN::Cross->new({ schema => $schema, trial_id => $id});
 942         } elsif ($data_type =~ m/List/) {
 943             $cross_list_ids = convert_stock_list($c, $schema, $id);
 944             my ($crossing_experiment_id, $num_trials) = get_trial_from_stock_list($c, $schema, $cross_list_ids);
 945             $project = CXGN::Cross->new({ schema => $schema, trial_id => $crossing_experiment_id});
 946         }
 947
 948         my $result = $project->get_crosses_and_details_in_crossingtrial();
 949         my @cross_data = @$result;
 950         foreach my $cross (@cross_data){
 951             my $cross_combination;
 952             my $male_parent_name;
 953             my $male_parent_id;
 954
 955             if ($cross->[2] eq ''){
 956                 $cross_combination = 'No cross combination available';
 957             } else {
 958                 $cross_combination = $cross->[2];
 959             }
 960
 961             if ($cross->[8] eq ''){
 962                 $male_parent_name = 'No male parent available';
 963             } else {
 964                 $male_parent_name = $cross->[8];
 965             }
 966
 967             if ($cross->[7] eq ''){
 968                 $male_parent_id = 'No male parent available';
 969             } else {
 970                 $male_parent_id = $cross->[7];
 971             }
 972
 973             $all_design{$cross->[0]} = {'cross_name' => $cross->[1],
 974                                       'cross_id' => $cross->[0],
 975                                       'cross_combination' => $cross_combination,
 976                                       'cross_type' => $cross->[3],
 977                                       'female_parent_name' => $cross->[5],
 978                                       'female_parent_id' => $cross->[4],
 979                                       'male_parent_name' => $male_parent_name,
 980                                       'male_parent_id' => $male_parent_id};
 981         }
 982
 983         if ($data_type =~ m/List/) {
 984             my %filtered_hash = map { $_ => $all_design{$_} } @$cross_list_ids;
 985             $design = \%filtered_hash;
 986         } else {
 987             $design = \%all_design;
 988         }
 989     }
 990
 991 #    print STDERR "Design is ".Dumper($design)."\n";
 992     return $num_trials, $design;
 993 }
 994
 995 sub get_additional_list_data {
 996     my $c = shift;
 997     my $list_id = shift;
 998     my $list_item_id = shift;
 999     my $list_item_name = shift;
1000     my $schema = $c->dbic_schema('Bio::Chado::Schema');
1001     my $dbh = $schema->storage->dbh();
1002
1003     if ( !$list_id || $list_id eq '' ) {
1004         die "List ID not provided!";
1005     }
1006
1007     my $list;
1008     my $list_type;
1009     my $list_type_data_def;
1010     eval {
1011         $list = CXGN::List->new({ dbh => $dbh, list_id => $list_id });
1012         $list_type = $list->type();
1013         $list_type_data_def = $ADDITIONAL_LIST_DATA{$list_type};
1014     };
1015     if ( $@ || !$list ) {
1016         die "List not found!"
1017     }
1018
1019     # No additional list data defined for list type...
1020     if ( !$list_type_data_def ) {
1021         return {};
1022     }
1023
1024     # Set arrays of List Item IDs and Names
1025     my @list_item_ids;
1026     my @list_item_names;
1027     if ( $list_item_id && $list_item_name ) {
1028         push(@list_item_ids, $list_item_id);
1029         push(@list_item_names, $list_item_name);
1030     }
1031     else {
1032         my $list_elements = $list->retrieve_elements_with_ids($list_id);
1033         @list_item_names = map { $_->[1] } @$list_elements;
1034         @list_item_ids = map { $_->[0] } @$list_elements;
1035     }
1036
1037     # Set original DB IDs (stock ids, project ids, etc) of List Items
1038     my @list_item_db_ids;
1039     my $transform = $list_type_data_def->{'_transform'};
1040     if ( $transform ) {
1041         my $lt = CXGN::List::Transform->new();
1042         my $tr = $lt->transform($schema, $transform, \@list_item_names);
1043         @list_item_db_ids = @{$tr->{transform}};
1044     }
1045
1046     # Calculate list properties
1047     # - organized by property name, list item id
1048     my %fields_by_prop;
1049     while ( my ($name, $calc) = each (%$list_type_data_def) ) {
1050         if ( $name =~ /^(?!_).*/ ) {
1051             $fields_by_prop{$name} = &$calc($c, $schema, $dbh, $list_id, \@list_item_ids, \@list_item_names, \@list_item_db_ids);
1052         }
1053     }
1054
1055     # Reorganize list properties
1056     # - organized by list item id, property name
1057     my %fields;
1058     foreach my $list_item_id (@list_item_ids) {
1059         foreach my $name (keys %fields_by_prop) {
1060             $fields{$list_item_id}{$name} = $fields_by_prop{$name}{$list_item_id};
1061         }
1062     }
1063
1064     return \%fields;
1065 }
1066
1067 #########
1068 1;
1069 #########