C4/Creators/Lib.pm

   1 package C4::Creators::Lib;
   2
   3 # Copyright 2009 Foundations Bible College.
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 use warnings;
  22
  23 use autouse 'Data::Dumper' => qw(Dumper);
  24
  25 use C4::Context;
  26 use C4::Debug;
  27
  28 BEGIN {
  29     use version; our $VERSION = qv('1.0.0_1');
  30     use base qw(Exporter);
  31     our @EXPORT = qw(get_all_templates
  32                      get_all_layouts
  33                      get_all_profiles
  34                      get_all_image_names
  35                      get_batch_summary
  36                      get_label_summary
  37                      get_card_summary
  38                      get_barcode_types
  39                      get_label_types
  40                      get_font_types
  41                      get_text_justification_types
  42                      get_output_formats
  43                      get_column_names
  44                      get_table_names
  45                      get_unit_values
  46                      html_table
  47     );
  48 }
  49
  50 #=head2 C4::Creators::Lib::_SELECT()
  51 #
  52 #    This function returns a recordset upon success and 1 upon failure. Errors are logged to the Apache log.
  53 #
  54 #    examples:
  55 #
  56 #        my $field_value = _SELECT(field_name, table_name, condition);
  57 #
  58 #=cut
  59
  60 sub _SELECT {
  61     my @params = @_;
  62     my $query = "SELECT $params[0] FROM $params[1]";
  63     $params[2] ? $query .= " WHERE $params[2];" : $query .= ';';
  64     my $sth = C4::Context->dbh->prepare($query);
  65 #    $sth->{'TraceLevel'} = 3;
  66     $sth->execute();
  67     if ($sth->err) {
  68         warn sprintf('Database returned the following error: %s', $sth->errstr);
  69         return 1;
  70     }
  71     my $record_set = [];
  72     while (my $row = $sth->fetchrow_hashref()) {
  73         push(@$record_set, $row);
  74     }
  75     return $record_set;
  76 }
  77
  78 my $barcode_types = [
  79     {type => 'CODE39',          name => 'Code 39',              desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern.',                                  selected => 0},
  80     {type => 'CODE39MOD',       name => 'Code 39 + Modulo43',   desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern. Encodes Mod 43 checksum.',         selected => 0},
  81     {type => 'CODE39MOD10',     name => 'Code 39 + Modulo10',   desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern. Encodes Mod 10 checksum.',         selected => 0},
  82     {type => 'COOP2OF5',        name => 'COOP2of5',             desc => 'Creates COOP2of5 barcodes from a string consisting of the numeric characters 0-9',                                                                     selected => 0},
  83 #    {type => 'EAN13',           name => 'EAN13',                desc => 'Creates EAN13 barcodes from a string of 12 or 13 digits. The check number (the 13:th digit) is calculated if not supplied.',                           selected => 0},
  84 #    {type => 'EAN8',            name => 'EAN8',                 desc => 'Translates a string of 7 or 8 digits to EAN8 barcodes. The check number (the 8:th digit) is calculated if not supplied.',                              selected => 0},
  85 #    {type => 'IATA2of5',        name => 'IATA2of5',             desc => 'Creates IATA2of5 barcodes from a string consisting of the numeric characters 0-9',                                                                     selected => 0},
  86     {type => 'INDUSTRIAL2OF5',  name => 'Industrial2of5',       desc => 'Creates Industrial2of5 barcodes from a string consisting of the numeric characters 0-9',                                                               selected => 0},
  87 #    {type => 'ITF',             name => 'Interleaved2of5',      desc => 'Translates the characters 0-9 to a barcodes. These barcodes could also be called 'Interleaved2of5'.',                                                  selected => 0},
  88 #    {type => 'MATRIX2OF5',      name => 'Matrix2of5',           desc => 'Creates Matrix2of5 barcodes from a string consisting of the numeric characters 0-9',                                                                   selected => 0},
  89 #    {type => 'NW7',             name => 'NW7',                  desc => 'Creates a NW7 barcodes from a string consisting of the numeric characters 0-9',                                                                        selected => 0},
  90 #    {type => 'UPCA',            name => 'UPCA',                 desc => 'Translates a string of 11 or 12 digits to UPCA barcodes. The check number (the 12:th digit) is calculated if not supplied.',                           selected => 0},
  91 #    {type => 'UPCE',            name => 'UPCE',                 desc => 'Translates a string of 6, 7 or 8 digits to UPCE barcodes. If the string is 6 digits long, '0' is added first in the string. The check number (the 8:th digit) is calculated if not supplied.',                                 selected => 0},
  92 ];
  93
  94 my $label_types = [
  95     {type => 'BIB',     name => 'Biblio',               desc => 'Only the bibliographic data is printed.',                              selected => 0},
  96     {type => 'BARBIB',  name => 'Barcode/Biblio',       desc => 'Barcode proceeds bibliographic data.',                                 selected => 0},
  97     {type => 'BIBBAR',  name => 'Biblio/Barcode',       desc => 'Bibliographic data proceeds barcode.',                                 selected => 0},
  98     {type => 'ALT',     name => 'Alternating',          desc => 'Barcode and bibliographic data are printed on alternating labels.',    selected => 0},
  99     {type => 'BAR',     name => 'Barcode',              desc => 'Only the barcode is printed.',                                         selected => 0},
 100 ];
 101
 102 my $font_types = [
 103     {type => 'TR',      name => 'Times-Roman',                  selected => 0},
 104     {type => 'TB',      name => 'Times-Bold',                   selected => 0},
 105     {type => 'TI',      name => 'Times-Italic',                 selected => 0},
 106     {type => 'TBI',     name => 'Times-Bold-Italic',            selected => 0},
 107     {type => 'C',       name => 'Courier',                      selected => 0},
 108     {type => 'CB',      name => 'Courier-Bold',                 selected => 0},
 109     {type => 'CO',      name => 'Courier-Oblique',              selected => 0},
 110     {type => 'CBO',     name => 'Courier-Bold-Oblique',         selected => 0},
 111     {type => 'H',       name => 'Helvetica',                    selected => 0},
 112     {type => 'HB',      name => 'Helvetica-Bold',               selected => 0},
 113     {type => 'HBO',     name => 'Helvetica-Bold-Oblique',       selected => 0},
 114 ];
 115
 116 my $text_justification_types = [
 117     {type => 'L',       name => 'Left',                         selected => 0},
 118     {type => 'C',       name => 'Center',                       selected => 0},
 119     {type => 'R',       name => 'Right',                        selected => 0},
 120 #    {type => 'F',       name => 'Full',                         selected => 0},
 121 ];
 122
 123 my $unit_values = [
 124     {type       => 'POINT',      desc    => 'PostScript Points',  value   => 1,                 selected => 0},
 125     {type       => 'AGATE',      desc    => 'Adobe Agates',       value   => 5.1428571,         selected => 0},
 126     {type       => 'INCH',       desc    => 'US Inches',          value   => 72,                selected => 0},
 127     {type       => 'MM',         desc    => 'SI Millimeters',     value   => 2.83464567,        selected => 0},
 128     {type       => 'CM',         desc    => 'SI Centimeters',     value   => 28.3464567,        selected => 0},
 129 ];
 130
 131 my $output_formats = [
 132     {type       => 'pdf',       desc    => 'PDF File'},
 133     {type       => 'csv',       desc    => 'CSV File'},
 134 ];
 135
 136 =head2 C4::Creators::Lib::get_all_templates()
 137
 138     This function returns a reference to a hash containing all templates upon success and 1 upon failure. Errors are logged to the Apache log.
 139
 140     examples:
 141
 142         my $templates = get_all_templates();
 143
 144 =cut
 145
 146 sub get_all_templates {
 147     my %params = @_;
 148     my @templates = ();
 149     my $query = "SELECT " . ($params{'field_list'} ? $params{'field_list'} : '*') . " FROM creator_templates";
 150     $query .= ($params{'filter'} ? " WHERE $params{'filter'};" : ';');
 151     my $sth = C4::Context->dbh->prepare($query);
 152     $sth->execute();
 153     if ($sth->err) {
 154         warn sprintf('Database returned the following error: %s', $sth->errstr);
 155         return -1;
 156     }
 157     ADD_TEMPLATES:
 158     while (my $template = $sth->fetchrow_hashref) {
 159         push(@templates, $template);
 160     }
 161     return \@templates;
 162 }
 163
 164 =head2 C4::Creators::Lib::get_all_layouts()
 165
 166     This function returns a reference to a hash containing all layouts upon success and 1 upon failure. Errors are logged to the Apache log.
 167
 168     examples:
 169
 170         my $layouts = get_all_layouts();
 171
 172 =cut
 173
 174 sub get_all_layouts {
 175     my %params = @_;
 176     my @layouts = ();
 177     my $query = "SELECT " . ($params{'field_list'} ? $params{'field_list'} : '*') . " FROM creator_layouts";
 178     $query .= ($params{'filter'} ? " WHERE $params{'filter'};" : ';');
 179     my $sth = C4::Context->dbh->prepare($query);
 180     $sth->execute();
 181     if ($sth->err) {
 182         warn sprintf('Database returned the following error: %s', $sth->errstr);
 183         return -1;
 184     }
 185     ADD_LAYOUTS:
 186     while (my $layout = $sth->fetchrow_hashref) {
 187         push(@layouts, $layout);
 188     }
 189     return \@layouts;
 190 }
 191
 192 =head2 C4::Creators::Lib::get_all_profiles()
 193
 194     This function returns an arrayref whose elements are hashes containing all profiles upon success and 1 upon failure. Errors are logged
 195     to the Apache log. Two parameters are accepted. The first limits the field(s) returned. This parameter should be string of comma separted
 196     fields. ie. "field_1, field_2, ...field_n" The second limits the records returned based on a string containing a valud SQL 'WHERE' filter.
 197
 198     NOTE: Do not pass in the keyword 'WHERE.'
 199
 200     examples:
 201
 202         my $profiles = get_all_profiles();
 203         my $profiles = get_all_profiles(field_list => field_list, filter => filter_string);
 204
 205 =cut
 206
 207 sub get_all_profiles {
 208     my %params = @_;
 209     my @profiles = ();
 210     my $query = "SELECT " . ($params{'field_list'} ? $params{'field_list'} : '*') . " FROM printers_profile";
 211     $query .= ($params{'filter'} ? " WHERE $params{'filter'};" : ';');
 212     my $sth = C4::Context->dbh->prepare($query);
 213 #    $sth->{'TraceLevel'} = 3 if $debug;
 214     $sth->execute();
 215     if ($sth->err) {
 216         warn sprintf('Database returned the following error: %s', $sth->errstr);
 217         return -1;
 218     }
 219     ADD_PROFILES:
 220     while (my $profile = $sth->fetchrow_hashref) {
 221         push(@profiles, $profile);
 222     }
 223     return \@profiles;
 224 }
 225
 226 =head2 C4::Creators::Lib::get_all_image_names()
 227
 228 =cut
 229
 230 sub get_all_image_names {
 231     my $image_names = [];
 232     my $query = "SELECT image_name FROM creator_images";
 233     my $sth = C4::Context->dbh->prepare($query);
 234 #    $sth->{'TraceLevel'} = 3 if $debug;
 235     $sth->execute();
 236     if ($sth->err) {
 237         warn sprintf('Database returned the following error: %s', $sth->errstr);
 238         return -1;
 239     }
 240     grep {push @$image_names, {type => $$_[0], name => $$_[0], selected => 0}} @{$sth->fetchall_arrayref([0])};
 241     return $image_names;
 242 }
 243
 244 =head2 C4::Creators::Lib::get_batch_summary()
 245
 246     This function returns an arrayref whose elements are hashes containing the batch_ids of current batches along with the item count
 247     for each batch upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
 248     One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
 249
 250     NOTE: Do not pass in the keyword 'WHERE.'
 251
 252     examples:
 253
 254         my $batches = get_batch_summary();
 255         my $batches = get_batch_summary(filter => filter_string);
 256
 257 =cut
 258
 259 sub get_batch_summary {
 260     my %params = @_;
 261     my @batches = ();
 262     my $query = "SELECT DISTINCT batch_id FROM creator_batches WHERE creator=?";
 263     $query .= ($params{'filter'} ? " AND $params{'filter'};" : ';');
 264     my $sth = C4::Context->dbh->prepare($query);
 265 #    $sth->{'TraceLevel'} = 3;
 266     $sth->execute($params{'creator'});
 267     if ($sth->err) {
 268         warn sprintf('Database returned the following error on attempted SELECT: %s', $sth->errstr);
 269         return -1;
 270     }
 271     ADD_BATCHES:
 272     while (my $batch = $sth->fetchrow_hashref) {
 273         my $query = "SELECT count(batch_id) FROM creator_batches WHERE batch_id=? AND creator=?;";
 274         my $sth1 = C4::Context->dbh->prepare($query);
 275         $sth1->execute($batch->{'batch_id'}, $params{'creator'});
 276         if ($sth1->err) {
 277             warn sprintf('Database returned the following error on attempted SELECT count: %s', $sth1->errstr);
 278             return -1;
 279         }
 280         my $count = $sth1->fetchrow_arrayref;
 281         $batch->{'_item_count'} = @$count[0];
 282         push(@batches, $batch);
 283     }
 284     return \@batches;
 285 }
 286
 287 =head2 C4::Creators::Lib::get_label_summary()
 288
 289     This function returns an arrayref whose elements are hashes containing the label_ids of current labels along with the item count
 290     for each label upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
 291     One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
 292
 293     NOTE: Do not pass in the keyword 'WHERE.'
 294
 295     examples:
 296
 297         my $labels = get_label_summary();
 298         my $labels = get_label_summary(items => @item_list);
 299
 300 =cut
 301
 302 sub get_label_summary {
 303     my %params = @_;
 304     my $label_number = 0;
 305     my @label_summaries = ();
 306     my $query = "     SELECT b.title, b.author, bi.itemtype, i.barcode, i.biblionumber
 307                       FROM creator_batches AS c LEFT JOIN items AS i ON (c.item_number=i.itemnumber)
 308                       LEFT JOIN biblioitems AS bi ON (i.biblioitemnumber=bi.biblioitemnumber)
 309                       LEFT JOIN biblio AS b ON (bi.biblionumber=b.biblionumber)
 310                       WHERE itemnumber=? AND batch_id=?;
 311                   ";
 312     my $sth = C4::Context->dbh->prepare($query);
 313     foreach my $item (@{$params{'items'}}) {
 314         $label_number++;
 315         $sth->execute($item->{'item_number'}, $params{'batch_id'});
 316         if ($sth->err) {
 317             warn sprintf('Database returned the following error on attempted SELECT: %s', $sth->errstr);
 318             return -1;
 319         }
 320         my $record = $sth->fetchrow_hashref;
 321         my $label_summary->{'_label_number'} = $label_number;
 322         $record->{'author'} =~ s/[^\.|\w]$// if $record->{'author'};  # strip off ugly trailing chars... but not periods or word chars
 323         $record->{'title'} =~ s/\W*$//;  # strip off ugly trailing chars
 324         # FIXME contructing staff interface URLs should be done *much* higher up the stack - for the most part, C4 module code
 325         # should not know that it's part of a web app
 326         $record->{'title'} = '<a href="/cgi-bin/koha/catalogue/detail.pl?biblionumber=' . $record->{'biblionumber'} . '"> ' . $record->{'title'} . '</a>';
 327         $label_summary->{'_summary'} = $record->{'title'} . " | " . ($record->{'author'} ? $record->{'author'} : 'N/A');
 328         $label_summary->{'_item_type'} = $record->{'itemtype'};
 329         $label_summary->{'_barcode'} = $record->{'barcode'};
 330         $label_summary->{'_item_number'} = $item->{'item_number'};
 331         $label_summary->{'_label_id'} = $item->{'label_id'};
 332         push (@label_summaries, $label_summary);
 333     }
 334     return \@label_summaries;
 335 }
 336
 337 =head2 C4::Creators::Lib::get_card_summary()
 338
 339     This function returns an arrayref whose elements are hashes containing the label_ids of current cards along with the item count
 340     for each card upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
 341     One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
 342
 343     NOTE: Do not pass in the keyword 'WHERE.'
 344
 345     examples:
 346
 347         my $cards = get_card_summary();
 348         my $cards = get_card_summary(items => @item_list);
 349
 350 =cut
 351
 352 sub get_card_summary {
 353     my %params = @_;
 354     my $card_number = 0;
 355     my @card_summaries = ();
 356     my $query = "SELECT CONCAT_WS(', ', surname, firstname) AS name, cardnumber FROM borrowers WHERE borrowernumber=?;";
 357     my $sth = C4::Context->dbh->prepare($query);
 358     foreach my $item (@{$params{'items'}}) {
 359         $card_number++;
 360         $sth->execute($item->{'borrower_number'});
 361         if ($sth->err) {
 362             warn sprintf('Database returned the following error on attempted SELECT: %s', $sth->errstr);
 363             return -1;
 364         }
 365         my $record = $sth->fetchrow_hashref;
 366         my $card_summary->{'_card_number'} = $card_number;
 367         $card_summary->{'_summary'} = $record->{'name'};
 368         $card_summary->{'borrowernumber'} = $item->{'borrower_number'};
 369         $card_summary->{'_label_id'} = $item->{'label_id'};
 370         push (@card_summaries, $card_summary);
 371     }
 372     return \@card_summaries;
 373 }
 374
 375 =head2 C4::Creators::Lib::get_barcode_types()
 376
 377     This function returns a reference to an array of hashes containing all barcode types along with their name and description.
 378
 379     examples:
 380
 381         my $barcode_types = get_barcode_types();
 382
 383 =cut
 384
 385 sub get_barcode_types {
 386     return $barcode_types;
 387 }
 388
 389 =head2 C4::Creators::Lib::get_label_types()
 390
 391     This function returns a reference to an array of hashes containing all label types along with their name and description.
 392
 393     examples:
 394
 395         my $label_types = get_label_types();
 396
 397 =cut
 398
 399 sub get_label_types {
 400     return $label_types;
 401 }
 402
 403 =head2 C4::Creators::Lib::get_font_types()
 404
 405     This function returns a reference to an array of hashes containing all font types along with their name and description.
 406
 407     examples:
 408
 409         my $font_types = get_font_types();
 410
 411 =cut
 412
 413 sub get_font_types {
 414     return $font_types;
 415 }
 416
 417 =head2 C4::Creators::Lib::get_text_justification_types()
 418
 419     This function returns a reference to an array of hashes containing all text justification types along with their name and description.
 420
 421     examples:
 422
 423         my $text_justification_types = get_text_justification_types();
 424
 425 =cut
 426
 427 sub get_text_justification_types {
 428     return $text_justification_types;
 429 }
 430
 431 =head2 C4::Creators::Lib::get_unit_values()
 432
 433     This function returns a reference to an array of  hashes containing all unit types along with their description and multiplier. NOTE: All units are relative to a PostScript Point.
 434     There are 72 PS points to the inch.
 435
 436     examples:
 437
 438         my $unit_values = get_unit_values();
 439
 440 =cut
 441
 442 sub get_unit_values {
 443     return $unit_values;
 444 }
 445
 446 =head2 C4::Creators::Lib::get_output_formats()
 447
 448     This function returns a reference to an array of hashes containing all label output formats along with their description.
 449
 450     examples:
 451
 452         my $label_output_formats = get_output_formats();
 453
 454 =cut
 455
 456 sub get_output_formats {
 457     return $output_formats;
 458 }
 459
 460 =head2 C4::Creators::Lib::get_column_names($table_name)
 461
 462 Return an arrayref of an array containing the column names of the supplied table.
 463
 464 =cut
 465
 466 sub get_column_names {
 467     my $table = shift;
 468     my $dbh = C4::Context->dbh();
 469     my $column_names = [];
 470     my $sth = $dbh->column_info(undef,undef,$table,'%');
 471     while (my $info = $sth->fetchrow_hashref()){
 472         $$column_names[$info->{'ORDINAL_POSITION'}] = $info->{'COLUMN_NAME'};
 473     }
 474     return $column_names;
 475 }
 476
 477 =head2 C4::Creators::Lib::get_table_names($search_term)
 478
 479 Return an arrayref of an array containing the table names which contain the supplied search term.
 480
 481 =cut
 482
 483 sub get_table_names {
 484     my $search_term = shift;
 485     my $dbh = C4::Context->dbh();
 486     my $table_names = [];
 487     my $sth = $dbh->table_info(undef,undef,"%$search_term%");
 488     while (my $info = $sth->fetchrow_hashref()){
 489         push (@$table_names, $info->{'TABLE_NAME'});
 490     }
 491     return $table_names;
 492 }
 493
 494 =head2 C4::Creators::Lib::html_table()
 495
 496     This function returns an arrayref of an array of hashes contianing the supplied data formatted suitably to
 497     be passed off as a T::P template parameter and used to build an html table.
 498
 499     examples:
 500
 501        my $table = html_table(header_fields, array_of_row_data);
 502        $template->param(
 503             TABLE => $table,
 504        );
 505
 506     html example:
 507
 508        <table>
 509             <!-- TMPL_LOOP NAME="TABLE" -->
 510             <!-- TMPL_IF NAME="header_fields" -->
 511             <tr>
 512             <!-- TMPL_LOOP NAME="header_fields" -->
 513                 <th><!-- TMPL_VAR NAME="field_label" --></th>
 514             <!-- /TMPL_LOOP -->
 515             </tr>
 516             <!-- TMPL_ELSE -->
 517             <tr>
 518             <!-- TMPL_LOOP NAME="text_fields" -->
 519             <!-- TMPL_IF NAME="select_field" -->
 520                 <td align="center"><input type="checkbox" name="action" value="<!-- TMPL_VAR NAME="field_value" -->" /></td>
 521             <!-- TMPL_ELSIF NAME="field_value" -->
 522                 <td><!-- TMPL_VAR NAME="field_value" --></td>
 523             <!-- TMPL_ELSE -->
 524                 <td>&nbsp;</td>
 525             <!-- /TMPL_IF -->
 526             <!-- /TMPL_LOOP -->
 527             </tr>
 528             <!-- /TMPL_IF -->
 529             <!-- /TMPL_LOOP -->
 530         </table>
 531
 532 =cut
 533
 534 sub html_table {
 535     my $headers = shift;
 536     my $data = shift;
 537     return undef if scalar(@$data) == 0;      # no need to generate a table if there is not data to display
 538     my $table = [];
 539     my $fields = [];
 540     my @table_columns = ();
 541     my ($row_index, $col_index) = (0,0);
 542     my $cols = 0;       # number of columns to wrap on
 543     my $field_count = 0;
 544     my $select_value = undef;
 545     my $link_field = undef;
 546     POPULATE_HEADER:
 547     foreach my $header (@$headers) {
 548         my @key = keys %$header;
 549         if ($key[0] eq 'select' ) {
 550             push (@table_columns, $key[0]);
 551             $$fields[$col_index] = {hidden => 0, select_field => 0, field_name => ($key[0]), field_label => $header->{$key[0]}{'label'}};
 552             # do special formatting stuff....
 553             $select_value = $header->{$key[0]}{'value'};
 554         }
 555         else {
 556             # do special formatting stuff....
 557             $link_field->{$key[0]} = ($header->{$key[0]}{'link_field'} == 1 ? 1 : 0);
 558             push (@table_columns, $key[0]);
 559             $$fields[$col_index] = {hidden => 0, select_field => 0, field_name => ($key[0]), field_label => $header->{$key[0]}{'label'}};
 560         }
 561         $field_count++;
 562         $col_index++;
 563     }
 564     $$table[$row_index] = {header_fields => $fields};
 565     $cols = $col_index;
 566     $field_count *= scalar(@$data);     # total fields to be displayed in the table
 567     $col_index = 0;
 568     $row_index++;
 569     $fields = [];
 570     POPULATE_TABLE:
 571     foreach my $db_row (@$data) {
 572         POPULATE_ROW:
 573         foreach my $table_column (@table_columns) {
 574             if (grep {$table_column eq $_} keys %$db_row) {
 575                 $$fields[$col_index] = {hidden => 0, link_field => $link_field->{$table_column}, select_field => 0, field_name => ($table_column . "_tbl"), field_value => $db_row->{$table_column}};
 576                 $col_index++;
 577                 next POPULATE_ROW;
 578             }
 579             elsif ($table_column =~ m/^_((.*)_(.*$))/) {   # this a special case
 580                 my $table_name = get_table_names($2);
 581                 my $record_set = _SELECT($1, @$table_name[0], $2 . "_id = " . $db_row->{$2 . "_id"});
 582                 $$fields[$col_index] = {hidden => 0, link_field => $link_field->{$table_column}, select_field => 0, field_name => ($table_column . "_tbl"), field_value => $$record_set[0]{$1}};
 583                 $col_index++;
 584                 next POPULATE_ROW;
 585             }
 586             elsif ($table_column eq 'select' ) {
 587                 $$fields[$col_index] = {hidden => 0, select_field => 1, field_name => 'select', field_value => $db_row->{$select_value}};
 588             }
 589         }
 590         $$table[$row_index] = {text_fields => $fields};
 591         $col_index = 0;
 592         $row_index++;
 593         $fields = [];
 594     }
 595     return $table;
 596 }
 597
 598 1;
 599 __END__
 600
 601 =head1 AUTHOR
 602
 603 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 604
 605 =cut