home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Chart.pm < prev    next >
Encoding:
Text File  |  2002-10-23  |  81.8 KB  |  3,254 lines
  1. #23456789012345678901234567890123456789012345678901234567890123456789012345
  2. #
  3. #   Copyright (c) 2001,2002, Dean Arnold
  4. #
  5. #   You may distribute under the terms of the Artistic License, as 
  6. #    specified in the Perl README file.
  7. #
  8. #    History:
  9. #
  10. #        0.80    2002-Sep-13    D. Arnold
  11. #            enhanced syntax in support of DBIx::Chart
  12. #            programmable fonts
  13. #            added chart_type_map to permit external
  14. #                type specs for parameterized datasources
  15. #            add BORDER property
  16. #
  17. #        0.73    2002-Sep-11    D. Arnold
  18. #            fix error reporting from ::Plot
  19. #            fix the SYNOPSIS
  20. #
  21. #        0.72    2002-Aug-17    D. Arnold
  22. #            fix legend placement
  23. #
  24. #        0.71    2002-Aug-12    D. Arnold
  25. #            fix LINEWIDTH property to be local
  26. #            add ANCHORED property
  27. #            fixed VERSION value
  28. #
  29. #        0.70    2002-Jun-01    D. Arnold
  30. #            added quadtree plots
  31. #            added cumulative (aka stacked) barcharts
  32. #            fix for individual graph SHOWVALUES
  33. #            added support for official DBI array binding
  34. #            added LINEWIDTH property
  35. #            added chart_map_modifier attribute
  36. #            added installation tests
  37. #
  38. #        0.63    2002-May-16    D. Arnold
  39. #            Fix for Gantt date axis alignment
  40. #
  41. #        0.62    2002-Apr-22    D. Arnold
  42. #            Fix for numeric month validation
  43. #
  44. #        0.61    2001-Mar-14    D. Arnold
  45. #            Fix for multicolor histos
  46. #            Replace hyphenated properties with
  47. #                underscores
  48. #            Support quoted color and shape names
  49. #            Support IN (...) syntax for color, shape, and icon lists
  50. #            added 'dot' shape (contributed by Andrea Spinelli)
  51. #
  52. #        0.60    2001-Jan-12    D. Arnold
  53. #            Temporal datatypes
  54. #            Appl. defined colors
  55. #            Histograms
  56. #            composite images (derived tables)
  57. #            Gantt charts
  58. #
  59. #        0.52    2001-Dec-14    D. Arnold
  60. #            Fixed 2-D barchart crashes
  61. #
  62. #        0.51    2001-Dec-01 D. Arnold
  63. #            Support multicolor single range barcharts
  64. #            Support for 3D piecharts
  65. #            Support for temporal datatypes
  66. #
  67. #        0.50    2001-Oct-29 D. Arnold
  68. #            Add ICON(ICONS) property
  69. #            Add COLORS synonym
  70. #            Add FONT property
  71. #            Add GRIDCOLOR property
  72. #            Add TEXTCOLOR property
  73. #            Add Z-AXIS property
  74. #            Add IMAGEMAP output type
  75. #
  76. #        0.43    2001-Oct-11 P. Scott
  77. #            Allow a 'gif' (or any future format supported by
  78. #            GD::Image) FORMAT and GIF logos, added use Carp.
  79. #
  80. #        0.42    2001-Sep-29 D. Arnold
  81. #            fix to support X-ORIENT='HORIZONTAL' on candlestick and 
  82. #            symbolic domains
  83. #
  84. #        0.41    2001-Jun-01 D. Arnold
  85. #            fix to strip quotes from string literal in INSERT stmt
  86. #            fix for literal data index in prepare of INSERT
  87. #
  88. #        0.40    2001-May-09 D. Arnold
  89. #            fix for final column definition in CREATE TABLE
  90. #            added Y-MIN, Y-MAX
  91. #
  92. #        0.21    2001-Mar-17 D. Arnold
  93. #            Remove newlines from SQL stmts in prepare().
  94. #
  95. #        0.20    2001-Mar-12    D. Arnold
  96. #            Coded.
  97. #
  98. require 5.6.0;
  99. use strict;
  100.  
  101. our %mincols = ( 
  102. 'PIECHART', 2, 
  103. 'BARCHART', 2, 
  104. 'HISTOGRAM', 2,
  105. 'POINTGRAPH', 2, 
  106. 'LINEGRAPH', 2, 
  107. 'AREAGRAPH', 2, 
  108. 'CANDLESTICK', 3, 
  109. 'SURFACEMAP', 3,
  110. 'BOXCHART', 1,
  111. 'GANTT', 3,
  112. 'QUADTREE', '3'
  113. );
  114.  
  115. our %binary_props = (
  116. 'SHOWGRID', 1, 
  117. 'X_LOG', 1, 
  118. 'Y_LOG', 1, 
  119. 'THREE_D', 1, 
  120. 'SHOWPOINTS', 1, 
  121. 'KEEPORIGIN', 1,
  122. 'CUMULATIVE', 1,
  123. 'STACK', 1,
  124. 'ANCHORED', 1,
  125. 'BORDER', 1
  126. );
  127.     
  128. our %num_props = (
  129. 'SHOWVALUES', 1
  130. );
  131.  
  132. our %string_props = (
  133. 'X_AXIS', 1, 
  134. 'Y_AXIS', 1, 
  135. 'Z_AXIS', 1, 
  136. 'TITLE', 1, 
  137. 'SIGNATURE', 1, 
  138. 'LOGO', 1, 
  139. 'X_ORIENT', 1, 
  140. 'FORMAT', 1,
  141. 'TEMPLATE', 1,
  142. 'MAPURL', 1,
  143. 'MAPSCRIPT', 1,
  144. 'MAPNAME', 1,
  145. 'MAPTYPE', 1
  146. );
  147.  
  148. our %trans_props = (
  149. 'X-AXIS', 'X_AXIS',
  150. 'Y-AXIS', 'Y_AXIS',
  151. 'Z-AXIS', 'Z_AXIS',
  152. 'X-LOG', 'X_LOG',
  153. 'Y-LOG', 'Y_LOG',
  154. '3-D', 'THREE_D',
  155. 'Y-MAX', 'Y_MAX',
  156. 'Y-MIN', 'Y_MIN',
  157. 'COLORS', 'COLOR',
  158. 'ICONS', 'ICON',
  159. 'SHAPES', 'SHAPE',
  160. 'X-ORIENT', 'X_ORIENT',
  161. 'CUMULATIVE', 'STACK'
  162. );
  163.  
  164. our %valid_props    = ( 
  165. 'SHOWVALUES', 1, 
  166. 'SHOWPOINTS', 1, 
  167. 'BACKGROUND', 1,
  168. 'KEEPORIGIN', 1, 
  169. 'SIGNATURE', 1, 
  170. 'SHOWGRID', 1, 
  171. 'X-AXIS', 1, 
  172. 'Y-AXIS', 1,
  173. 'Z-AXIS', 1, 
  174. 'X_AXIS', 1, 
  175. 'Y_AXIS', 1,
  176. 'Z_AXIS', 1, 
  177. 'TITLE', 1, 
  178. 'COLOR', 1, 
  179. 'COLORS', 1, 
  180. 'WIDTH', 1, 
  181. 'HEIGHT', 1, 
  182. 'SHAPE', 1,
  183. 'SHAPES', 1,
  184. 'X-ORIENT', 1, 
  185. 'X_ORIENT', 1, 
  186. 'FORMAT', 1, 
  187. 'LOGO', 1, 
  188. 'X-LOG', 1, 
  189. 'Y-LOG', 1, 
  190. '3-D', 1,
  191. 'Y-MAX', 1, 
  192. 'Y-MIN', 1,
  193. 'X_LOG', 1, 
  194. 'Y_LOG', 1, 
  195. 'THREE_D', 1,
  196. 'Y_MAX', 1, 
  197. 'Y_MIN', 1,
  198. 'ICON', 1,
  199. 'ICONS', 1,
  200. 'FONT', 1,
  201. 'TEMPLATE', 1,
  202. 'GRIDCOLOR', 1,
  203. 'TEXTCOLOR', 1,
  204. 'MAPURL', 1,
  205. 'MAPSCRIPT', 1,
  206. 'MAPNAME', 1,
  207. 'MAPTYPE', 1,
  208. 'CUMULATIVE', 1,
  209. 'STACK', 1,
  210. 'LINEWIDTH', 1,
  211. 'ANCHORED', 1,
  212. 'BORDER', 1
  213. );
  214.  
  215. our %valid_colors = (
  216.     white    => [255,255,255], 
  217.     lgray    => [191,191,191], 
  218.     gray    => [127,127,127],
  219.     dgray    => [63,63,63],
  220.     black    => [0,0,0],
  221.     lblue    => [0,0,255], 
  222.     blue    => [0,0,191],
  223.     dblue    => [0,0,127], 
  224.     gold    => [255,215,0],
  225.     lyellow    => [255,255,0], 
  226.     yellow    => [191,191,0], 
  227.     dyellow    => [127,127,0],
  228.     lgreen    => [0,255,0], 
  229.     green    => [0,191,0], 
  230.     dgreen    => [0,127,0],
  231.     lred    => [255,0,0], 
  232.     red        => [191,0,0],
  233.     dred    => [127,0,0],
  234.     lpurple    => [255,0,255], 
  235.     purple    => [191,0,191],
  236.     dpurple    => [127,0,127],
  237.     lorange    => [255,183,0], 
  238.     orange    => [255,127,0],
  239.     pink    => [255,183,193], 
  240.     dpink    => [255,105,180],
  241.     marine    => [127,127,255], 
  242.     cyan    => [0,255,255],
  243.     lbrown    => [210,180,140], 
  244.     dbrown    => [165,42,42],
  245.     transparent => [1,1,1]
  246. );
  247.  
  248. our @dfltcolors = qw( red green blue yellow purple orange 
  249. dblue cyan dgreen lbrown );
  250.  
  251. our %valid_shapes = (
  252. 'fillsquare', 1,
  253. 'opensquare', 2,
  254. 'horizcross', 3,
  255. 'diagcross', 4,
  256. 'filldiamond', 5,
  257. 'opendiamond', 6,
  258. 'fillcircle', 7,
  259. 'opencircle', 8,
  260. 'icon', 9,
  261. 'dot', 10);
  262.  
  263. {
  264. package DBD::Chart;
  265.  
  266. use DBI;
  267. use DBI qw(:sql_types);
  268.  
  269. # Do NOT @EXPORT anything.
  270. $DBD::Chart::VERSION = '0.80';
  271.  
  272. $DBD::Chart::drh = undef;
  273. $DBD::Chart::err = 0;
  274. $DBD::Chart::errstr = '';
  275. $DBD::Chart::state = '00000';
  276. %DBD::Chart::charts = ();    # defined chart list; 
  277.                             # hash of (name, property hash)
  278. $DBD::Chart::seqno = 1;    # id for each CREATEd chart so we don't access 
  279.                         # stale names
  280.  
  281. sub driver {
  282. #
  283. #    if we've already been init'd, don't do it again
  284. #
  285.     return $DBD::Chart::drh if $DBD::Chart::drh;
  286.     my($class, $attr) = @_;
  287.     $class .= '::dr';
  288.     
  289.     $DBD::Chart::drh = DBI::_new_drh($class,
  290.         {
  291.             'Name' => 'Chart',
  292.             'Version' => $DBD::Chart::VERSION,
  293.             'Err' => \$DBD::Chart::err,
  294.             'Errstr' => \$DBD::Chart::errstr,
  295.             'State' => \$DBD::Chart::state,
  296.             'Attribution' => 'DBD::Chart by Dean Arnold'
  297.         });
  298.     DBI->trace_msg("DBD::Chart v.$DBD::Chart::VERSION loaded on $^O\n", 1);
  299. #
  300. #    generate the base colormap
  301. #
  302.     my %table = ();
  303.     $table{columns} = { 
  304.         'NAME' => 0,
  305.         'REDVALUE' => 1,
  306.         'GREENVALUE' => 2,
  307.         'BLUEVALUE' => 3 };
  308.     $table{types} = [ SQL_VARCHAR, SQL_INTEGER,  SQL_INTEGER,  SQL_INTEGER ];
  309.     $table{precisions} = [ 30, 4, 4, 4 ];
  310.     $table{scales} = [ 0, 0, 0, 0 ];
  311.     $table{version} = 1.0;
  312.     my @ary = ( [ ], [ ], [ ], [ ] );
  313.     foreach my $color (keys(%valid_colors)) {
  314.         push(@{$ary[0]}, $color);
  315.         push(@{$ary[1]}, $valid_colors{$color}->[0]);
  316.         push(@{$ary[2]}, $valid_colors{$color}->[1]);
  317.         push(@{$ary[3]}, $valid_colors{$color}->[2]);
  318.     }
  319.     $table{data} = \@ary;
  320.     $DBD::Chart::charts{COLORMAP} = \%table;
  321.  
  322.     return $DBD::Chart::drh;
  323. }
  324.  
  325. 1;
  326. }
  327.  
  328. #
  329. #    check on attributes
  330. #
  331. {   package DBD::Chart::dr; # ====== DRIVER ======
  332. $DBD::Chart::dr::imp_data_size = 0;
  333.  
  334. # we use default connect()
  335.  
  336. sub disconnect_all { }
  337. sub DESTROY { undef }
  338.  
  339. 1;
  340. }
  341.  
  342. {   package DBD::Chart::db; # ====== DATABASE ======
  343.     $DBD::Chart::db::imp_data_size = 0;
  344.     use Carp;
  345.  
  346. use DBI qw(:sql_types);
  347. use constant SQL_INTERVAL_HR2SEC => 110;
  348. #
  349. #    for compatibility between DBI pre 1.200
  350. #    and new DBI
  351.  
  352. my %typeval = ( 
  353. 'CHAR', SQL_CHAR, 
  354. 'VARCHAR', SQL_VARCHAR, 
  355. 'INT', SQL_INTEGER,
  356. 'SMALLINT', SQL_SMALLINT,
  357. 'TINYINT', SQL_TINYINT,
  358. 'FLOAT', SQL_FLOAT,
  359. 'DEC', SQL_DECIMAL,
  360. 'DATE', SQL_DATE,
  361. 'TIMESTAMP', SQL_TIMESTAMP,
  362. 'INTERVAL', SQL_INTERVAL_HR2SEC,
  363. 'TIME', SQL_TIME
  364. );
  365.  
  366. my %typeszs = ( 
  367. 'CHAR', 1,
  368. 'VARCHAR', 32000, 
  369. 'INT', 4,
  370. 'SMALLINT', 2,
  371. 'TINYINT', 1,
  372. 'FLOAT', 8,
  373. 'DEC', 4,
  374. 'DATE', 4,
  375. 'TIMESTAMP', 26,
  376. 'INTERVAL', 26,
  377. 'TIME', 16
  378. );
  379.  
  380. my %inv_pieprop = (
  381. 'SHAPE', 1, 
  382. 'SHAPES', 1, 
  383. 'SHOWGRID', 1, 
  384. 'SHOWPOINTS', 1, 
  385. 'X-AXIS', 1, 
  386. 'Y-AXIS', 1, 
  387. 'Z-AXIS', 1, 
  388. 'X_AXIS', 1, 
  389. 'Y_AXIS', 1, 
  390. 'Z_AXIS', 1, 
  391. 'SHOWVALUES', 1, 
  392. 'X-LOG', 1, 
  393. 'Y-LOG', 1, 
  394. 'Y-MAX', 1, 
  395. 'Y-MIN', 1,
  396. 'X_LOG', 1, 
  397. 'Y_LOG', 1, 
  398. 'Y_MAX', 1, 
  399. 'Y_MIN', 1,
  400. 'ICON', 1,
  401. 'ICONS', 1,
  402. 'CUMULATIVE', 1,
  403. 'STACK', 1,
  404. 'LINEWIDTH', 1,
  405. 'ANCHORED', 1
  406. );
  407.  
  408. my %inv_quadtree = (
  409. 'SHAPE', 1, 
  410. 'SHAPES', 1, 
  411. 'SHOWGRID', 1, 
  412. 'SHOWPOINTS', 1, 
  413. 'X-AXIS', 1, 
  414. 'Y-AXIS', 1, 
  415. 'Z-AXIS', 1, 
  416. 'X_AXIS', 1, 
  417. 'Y_AXIS', 1, 
  418. 'Z_AXIS', 1, 
  419. 'SHOWVALUES', 1, 
  420. 'X-LOG', 1, 
  421. 'Y-LOG', 1, 
  422. 'Y-MAX', 1, 
  423. 'Y-MIN', 1,
  424. 'X_LOG', 1, 
  425. 'Y_LOG', 1, 
  426. 'Y_MAX', 1, 
  427. 'Y_MIN', 1,
  428. 'ICON', 1,
  429. 'ICONS', 1,
  430. 'CUMULATIVE', 1,
  431. 'STACK', 1,
  432. 'ANCHORED', 1,
  433. 'LINEWIDTH', 1
  434. );
  435.  
  436. my %inv_barprop = (
  437. 'SHAPE', 1, 
  438. 'SHAPES', 1, 
  439. 'SHOWPOINTS', 1, 
  440. 'X-LOG', 1,
  441. 'X_LOG', 1,
  442. 'LINEWIDTH', 1
  443. );
  444.  
  445. my %inv_candle = (
  446. 'X_LOG', 1,
  447. 'THREE_D', 1,
  448. 'X-LOG', 1,
  449. 'ANCHORED', 1,
  450. '3-D', 1
  451. );
  452.  
  453. #
  454. #    defaults for simple queries
  455. my %dfltprops = ( 
  456. 'SHAPE', undef, 
  457. 'WIDTH', 300, 
  458. 'HEIGHT', 300,
  459. 'SHOWGRID', 0, 
  460. 'SHOWPOINTS', 0, 
  461. 'SHOWVALUES', 0, 
  462. 'X_AXIS', 'X axis', 
  463. 'Y_AXIS', 'Y axis', 
  464. 'Z_AXIS', undef, 
  465. 'TITLE', '', 
  466. 'COLORS', \@dfltcolors, 
  467. 'X_LOG', 0, 
  468. 'Y_LOG', 0, 
  469. 'THREE_D', 0, 
  470. 'BACKGROUND', 'white',
  471. 'SIGNATURE', undef, 
  472. 'LOGO', undef, 
  473. 'X_ORIENT', 'DEFAULT', 
  474. 'FORMAT', 'PNG',
  475. 'KEEPORIGIN', 0, 
  476. 'Y_MAX', undef, 
  477. 'Y_MIN', undef,
  478. 'ICONS', undef,
  479. 'FONT', undef,
  480. 'GRIDCOLOR', 'black',
  481. 'TEXTCOLOR', 'black',
  482. 'TEMPLATE', undef,
  483. 'MAPURL', undef,
  484. 'MAPSCRIPT', undef,
  485. 'MAPNAME', undef,
  486. 'MAPTYPE', undef,
  487. 'STACK', undef,
  488. 'ANCHORED', 1,
  489. 'LINEWIDTH', undef,
  490. 'BORDER', 1
  491. );
  492. #
  493. #    default globals for composite queries
  494. my %dfltglobals = ( 
  495. 'WIDTH', 300, 
  496. 'HEIGHT', 300,
  497. 'SHOWGRID', 0, 
  498. 'X_AXIS', 'X axis', 
  499. 'Y_AXIS', 'Y axis', 
  500. 'TITLE', '', 
  501. 'X_LOG', 0, 
  502. 'Y_LOG', 0, 
  503. 'THREE_D', 0, 
  504. 'BACKGROUND', 'white',
  505. 'SIGNATURE', undef, 
  506. 'LOGO', undef, 
  507. 'X_ORIENT', 'DEFAULT', 
  508. 'FORMAT', 'PNG',
  509. 'KEEPORIGIN', 0, 
  510. 'FONT', undef,
  511. 'GRIDCOLOR', 'black',
  512. 'TEXTCOLOR', 'black',
  513. 'TEMPLATE', undef,
  514. 'MAPURL', undef,
  515. 'MAPSCRIPT', undef,
  516. 'MAPNAME', undef,
  517. 'MAPTYPE', undef,
  518. 'BORDER', 1
  519. );
  520. #
  521. #    default subquery props for composite queries
  522. my %dfltcomposites = (
  523. 'SHAPE', undef, 
  524. 'SHOWPOINTS', 0, 
  525. 'SHOWVALUES', 0, 
  526. 'COLORS', \@dfltcolors, 
  527. 'ICONS', undef,
  528. 'STACK', undef,
  529. 'ANCHORED', 1,
  530. 'LINEWIDTH', undef
  531. );
  532. #
  533. #    map of compatible chart types in composite
  534. #    images
  535. my %compatibility = (
  536. 'PIECHART', undef,
  537. 'QUADTREE', undef,
  538. 'BOXCHART', 
  539.     {
  540.     'BARCHART' => 1,
  541.     'POINTGRAPH' => 1,
  542.     'LINEGRAPH' => 1,
  543.     'AREAGRAPH' => 1,
  544.     'CANDLESTICK' => 1,
  545.     'BOXCHART' => 1
  546.     },
  547. 'HISTOGRAM', { 'HISTOGRAM' => 1 },
  548. 'SURFACEMAP', { 'SURFACEMAP' => 1 },
  549. 'BARCHART', 
  550.     { 
  551.     'BARCHART' => 1,
  552.     'POINTGRAPH' => 1,
  553.     'LINEGRAPH' => 1,
  554.     'AREAGRAPH' => 1,
  555.     'CANDLESTICK' => 1,
  556.     'BOXCHART' => 1
  557.     },
  558.  
  559. 'POINTGRAPH',
  560.     { 
  561.     'BARCHART' => 1,
  562.     'POINTGRAPH' => 1,
  563.     'LINEGRAPH' => 1,
  564.     'AREAGRAPH' => 1,
  565.     'CANDLESTICK' => 1,
  566.     'BOXCHART' => 1
  567.     },
  568. 'LINEGRAPH',
  569.     { 
  570.     'BARCHART' => 1,
  571.     'POINTGRAPH' => 1,
  572.     'LINEGRAPH' => 1,
  573.     'AREAGRAPH' => 1,
  574.     'BOXCHART' => 1,
  575.     'CANDLESTICK' => 1
  576.     },
  577. 'AREAGRAPH',
  578.     { 
  579.     'BARCHART' => 1,
  580.     'POINTGRAPH' => 1,
  581.     'LINEGRAPH' => 1,
  582.     'AREAGRAPH' => 1,
  583.     'BOXCHART' => 1,
  584.     'CANDLESTICK' => 1
  585.     },
  586. 'CANDLESTICK', 
  587.     { 
  588.     'BARCHART' => 1,
  589.     'POINTGRAPH' => 1,
  590.     'LINEGRAPH' => 1,
  591.     'AREAGRAPH' => 1,
  592.     'BOXCHART' => 1,
  593.     'CANDLESTICK' => 1
  594.     }
  595. );
  596. #
  597. #    map the global properties for composites
  598. my %global_props    = ( 
  599. 'BACKGROUND', 1,
  600. 'KEEPORIGIN', 1, 
  601. 'SIGNATURE', 1, 
  602. 'SHOWGRID', 1, 
  603. 'X_AXIS', 1,
  604. 'Y_AXIS', 1,
  605. 'Z_AXIS', 1,
  606. 'TITLE', 1,
  607. 'WIDTH', 1, 
  608. 'HEIGHT', 1, 
  609. 'X_ORIENT', 1, 
  610. 'FORMAT', 1,
  611. 'LOGO', 1,
  612. 'X_LOG', 1,
  613. 'Y_LOG', 1,
  614. 'THREE_D', 1,
  615. 'Y_MAX', 1,
  616. 'Y_MIN', 1,
  617. 'TEMPLATE', 1,
  618. 'GRIDCOLOR', 1,
  619. 'TEXTCOLOR', 1,
  620. 'MAPURL', 1,
  621. 'MAPSCRIPT', 1,
  622. 'MAPNAME', 1,
  623. 'MAPTYPE', 1,
  624. 'BORDER', 1
  625. );
  626.  
  627. sub check_color {
  628.     my ($color) = @_;
  629.     
  630.     my $table = $DBD::Chart::charts{COLORMAP};
  631.     my $col1 = $table->{data}->[0];
  632.     my $c;
  633.     foreach $c (@$col1) {
  634.         return 1 if ($color eq $c);
  635.     }
  636.     return undef;
  637. }
  638.  
  639. sub parse_col_defs {
  640.     my ($req, $cols, $typeary, $typelen, $typescale) = @_;
  641. #
  642. #    normalize
  643. #
  644.     $req = uc $req;
  645.     $req =~s/(\S),/$1 ,/g;
  646.     $req =~s/,(\S)/, $1/g;
  647.     $req =~s/(\S)\(/$1 \(/g;
  648.     $req =~s/(\S)\)/$1 \)/g;
  649.     
  650.     $req=~s/\s+NOT\s+NULL//ig;
  651.     $req =~s/\bLONG\s+VARCHAR\b/ VARCHAR(32000)/g;
  652.     $req =~s/\bCHAR\s+VARYING\b/ VARCHAR/g;
  653.     $req =~s/\bDOUBLE\s+PRECISION\b/ FLOAT /g;
  654.     $req =~s/\bNUMERIC\b/ DEC /g;
  655.     $req =~s/\bREAL\b/ FLOAT /g;
  656.     $req =~s/\bCHARACTER\b/ CHAR /g;
  657.     $req =~s/\bINTEGER\b/ INT /g;
  658.     $req =~s/\bDECIMAL\b/ DEC /g;
  659. #
  660. #    normalize a bit more
  661. #
  662.     $req =~s/\(\s+/\(/g;
  663.     $req =~s/\s+\)/\)/g;
  664.     $req =~s/\((\d+)\s*\,\s*(\d+)\)/\($1\;$2\)/g;
  665.     $req =~s/\s\((\d+)/\($1/g;
  666. #
  667. #    extract each declaration in the list
  668. #
  669.     my @reqdecs = split(',', $req);
  670.     my $decl = '';
  671.     my $typecnt = 0;
  672.     my $decsz = 0;
  673.     my $decscal = 0;
  674.     my $name = '';
  675.     %$cols = ();
  676.     @$typelen = ();
  677.     @$typeary = ();
  678.     @$typescale = ();
  679.     my $i = 0;
  680.     foreach $decl (@reqdecs) {
  681.  
  682.         $_ = $decl;
  683.  
  684.         $DBD::Chart::err = -1,
  685.         $DBD::Chart::errstr = "Column $1 already defined.",
  686.         return undef
  687.             if ((/^\s*(\S+)\s+/) && ($$cols{$1}));
  688.  
  689.         $name = $1;
  690.         $$cols{$name} = $i++;
  691.  
  692.         push(@$typelen, $typeszs{$decl}),
  693.         push(@$typescale, 0),
  694.         push(@$typeary, $typeval{$decl}),
  695.         next
  696.             if (($decl) = /^\s*\S+\s+(TIMESTAMP|SMALLINT|INTERVAL|TINYINT|VARCHAR|FLOAT|CHAR|DATE|TIME|INT|DEC)\s*$/i);
  697.             
  698.         push(@$typelen, $decsz),
  699.         push(@$typescale, 0),
  700.         push(@$typeary, $typeval{$decl}),
  701.         next
  702.             if (($decl, $decsz) = /^\s*\S+\s+(VARCHAR|CHAR)\s*\((\d+)\)\s*$/i);
  703.  
  704.         push(@$typelen, $decsz),
  705.         push(@$typescale, 0),
  706.         push(@$typeary, SQL_DECIMAL),
  707.         next
  708.             if ((($decsz) = /^\s*\S+\s+DEC\s*\((\d+)\)\s*$/i) &&
  709.                 ($decsz < 19) && ($decsz > 0));
  710. #
  711. #    handle scaled decimal declarations
  712. #
  713.         push(@$typelen, $decsz),
  714.         push(@$typescale, $decscal),
  715.         push(@$typeary, SQL_DECIMAL),
  716.         next
  717.             if ((($decsz, $decscal) = 
  718.                 /^\s*\S+\s+DEC\s*\((\d+);(\d+)\)\s*$/i) && 
  719.                 ($decsz < 19) && ($decsz > 0) && ($decscal < $decsz));
  720.  
  721. # if we get here, we've got something bogus
  722.         $DBD::Chart::err = -1;
  723.         $_=~s/;/,/;
  724.         $DBD::Chart::errstr = "Invalid column definition $_"; ;
  725.         return undef;
  726.     }
  727.     return $i;
  728. }
  729.  
  730. sub restore_strings {
  731.     my ($prop, $t, $strlits) = @_;
  732.  
  733.     $DBD::Chart::err = -1,
  734.     $DBD::Chart::errstr = "$prop property requires a string.",
  735.     return undef
  736.         unless ($t=~/^<\d+>/);
  737. #
  738. #    in case it was an empty string, restore the quotes
  739.     my $str = '\'';
  740.     $str .= $$strlits[$1]. '\'',
  741.     $t = $2
  742.         while ($t=~/^<(\d+)>(.*)$/);
  743.  
  744.     $DBD::Chart::err = -1,
  745.     $DBD::Chart::errstr = "$prop property requires a string.",
  746.     return undef
  747.         if ($t ne '');
  748.  
  749.     $str=~s/''/'/g;
  750.     $str=~s/^'(.*)'$/$1/g;
  751.     return $str;
  752. }
  753.  
  754. sub parse_props {
  755.     my ($ctype, $t, $numphs, $is_subquery, $strlits) = @_;
  756.     
  757.     my %props = $is_subquery ? %dfltcomposites : ($ctype eq 'IMAGE' ? %dfltglobals : %dfltprops);
  758.     my ($prop, $op);
  759.     $t=~s/\s*AND\s*/\r/ig;
  760.     my @preds = split("\r", $t);
  761.  
  762.     foreach (@preds) {
  763.  
  764.         $DBD::Chart::err = -1,
  765.         $DBD::Chart::errstr = "Unrecognized property declaration.",
  766.         return (undef, $t)
  767.             unless (($prop, $op, $t)=/^([^\s=]+)\s*(=|IN)\s*(.+)$/i);
  768.  
  769.         $prop = uc $prop;
  770.         $op = uc $op;
  771.         $t=~s/\s*$//;
  772.  
  773.         $DBD::Chart::err = -1,
  774.         $DBD::Chart::errstr = "Unrecognized property $prop.",
  775.         return (undef, $t)
  776.             unless $valid_props{$prop};
  777. #
  778. #    translate the property if it has synonym
  779.         $prop = $trans_props{$prop} if $trans_props{$prop};
  780.  
  781.         $DBD::Chart::err = -1,
  782.         $DBD::Chart::errstr = "Property $prop not valid with valuelist.",
  783.         return (undef, $t)
  784.             if (($op eq 'IN') && ($prop!~/^COLOR|SHAPE|ICON|FONT$/));
  785.  
  786.         $DBD::Chart::err = -1,
  787.         $DBD::Chart::errstr = "Property $prop not valid in subquery.",
  788.         return (undef, $t)
  789.             if ($is_subquery && $global_props{$prop});
  790. #
  791. #    got a placeholder
  792. #
  793.         $props{ $prop } = "?$$numphs",
  794.         $$numphs++,
  795.         next
  796.             if ($t eq '?');
  797.         
  798.         if ($binary_props{$prop}) {
  799. #
  800. #    make sure its zero or 1
  801. #
  802.             $props{ $prop } = $t,
  803.             next
  804.                 if (($t == 1) || ($t == 0));
  805.  
  806.             $DBD::Chart::err = -1;
  807.             $DBD::Chart::errstr = "Invalid value for $prop property.";
  808.             return (undef, $t);
  809.         }
  810.         if ($prop eq 'SHOWVALUES') {
  811.             $props{ $prop } = $t,
  812.             next
  813.                 if (($t=~/^\d+$/) && ($t >= 0) && ($t <= 100));
  814.  
  815.             $DBD::Chart::err = -1;
  816.             $DBD::Chart::errstr = "Invalid value for $prop property.";
  817.             return (undef, $t);
  818.         }
  819.         if ($string_props{$prop}) {
  820.  
  821.             $props{$prop} = restore_strings($prop, $t, $strlits);
  822.             return (undef, $t)
  823.                 unless defined($props{$prop});
  824.             next;
  825.         }
  826.         if (($prop eq 'WIDTH') || ($prop eq 'HEIGHT')) {
  827.  
  828.             $props{ $prop } = $t,
  829.             next
  830.                 if (($t=~/^\d+$/) && ($t >= 10) && ($t <= 100000));
  831.  
  832.             $DBD::Chart::err = -1;
  833.             $DBD::Chart::errstr = "Invalid value for $prop property.";
  834.             return (undef, $t);
  835.         }
  836.  
  837.         if ($prop eq 'LINEWIDTH') {
  838.  
  839.             $props{ $prop } = $t,
  840.             next
  841.                 if (($t=~/^\d+$/) && ($t > 0) && ($t <= 100));
  842.  
  843.             $DBD::Chart::err = -1;
  844.             $DBD::Chart::errstr = 'Invalid value for LINEWIDTH property.';
  845.             return (undef, $t);
  846.         }
  847.  
  848.         $DBD::Chart::err = -1,
  849.         $DBD::Chart::errstr = 
  850.             'Y_MAX and Y_MIN deprecated as of release 0.50.',
  851.         next
  852.             if (($prop eq 'Y_MAX') || ($prop eq 'Y_MIN'));
  853.  
  854.         if (($prop eq 'BACKGROUND') || ($prop eq 'GRIDCOLOR') || 
  855.             ($prop eq 'TEXTCOLOR')) { 
  856.  
  857.             $t = restore_strings($prop, $t, $strlits)
  858.                 if ($t=~/<\d+>/);
  859.             $t = lc $t;
  860.             $props{$prop} = $t,
  861.             next
  862.                 if (check_color($t) || 
  863.                     (($prop eq 'BACKGROUND') && ($t eq 'transparent')));
  864.  
  865.             $DBD::Chart::err = -1;
  866.             $DBD::Chart::errstr = "Invalid value for $prop property.";
  867.             return (undef, $t);
  868.         }
  869.  
  870.          if (($prop eq 'COLOR') || ($prop eq 'SHAPE') || ($prop eq 'FONT')) {
  871.              my @colors = ();
  872.             $props{ $prop } = \@colors;
  873.  
  874.             $t = restore_strings($prop, $t, $strlits)
  875.                 if ($t=~/^<\d+>$/);
  876.             push(@colors, $t),
  877.             next
  878.                  unless ($t=~/^\(([^\)]+)\)$/);
  879.  
  880.             $t = lc $1;
  881.             $t=~s/\s+//g;
  882.             @colors = split(',', $t);
  883.             for (my $i = 0; $i <= $#colors; $i++) {
  884.                 next if (uc $colors[$i] eq 'NULL');
  885.                 $colors[$i] = "?$$numphs",
  886.                 $$numphs++,
  887.                 next
  888.                     if ($colors[$i] eq '?');
  889.  
  890.                 next unless ($colors[$i]=~/^<\d+>$/);
  891.                 $colors[$i] = restore_strings($prop, $colors[$i], $strlits);
  892.             }
  893.             next;
  894.          }
  895.          if ($prop eq 'ICON') {
  896.              my @icons = ();
  897.             $props{ $prop } = \@icons;
  898.  
  899.             $t = restore_strings($prop, $t, $strlits)
  900.                  if ($t=~/^<\d+>$/);
  901.  
  902.             $icons[0] = $t,
  903.             next
  904.                  unless ($t=~/^\(([^\)]+)\)$/);
  905.  
  906.             $t = $1;
  907.             $t=~s/\s+//g;
  908.             @icons = split(',', $t);
  909.             for (my $i = 0; $i <= $#icons; $i++) {
  910.                 next if (uc $icons[$i] eq 'NULL');
  911.                 $icons[$i] = "?$$numphs",
  912.                 $$numphs++,
  913.                 next
  914.                     if ($icons[$i] eq '?');
  915.                 next unless ($icons[$i]=~/^<\d+>$/);
  916.                 $icons[$i] = restore_strings($prop, $icons[$i], $strlits);
  917.              }
  918.          }
  919.     } # end while
  920.  
  921.     if (defined($props{COLOR})) {
  922.         my $colors = $props{COLOR};
  923.         foreach $prop (@$colors) {
  924.             next unless defined($prop);
  925.             next if check_color($prop);
  926.             $DBD::Chart::err = -1,
  927.             $DBD::Chart::errstr = "Unknown color $prop.",
  928.             return (undef, $t)
  929.         }
  930.     }
  931.     if (defined($props{SHAPE})) {
  932.         my $shapes = $props{SHAPE};
  933.         foreach $prop (@$shapes) {
  934.             next unless defined($prop);
  935.             next if ($valid_shapes{$prop} || ($prop eq 'null'));
  936.             $DBD::Chart::err = -1;
  937.             $DBD::Chart::errstr = "Unknown point shape $prop.";
  938.             return (undef, $t);
  939.         }
  940.     }
  941.     $DBD::Chart::err = -1,
  942.     $DBD::Chart::errstr = "Invalid value for 'X_ORIENT' property.",
  943.     return (undef, $t)
  944.         if (($props{X_ORIENT}) && 
  945.             ($props{X_ORIENT}!~/^(HORIZONTAL|VERTICAL|DEFAULT)$/i));
  946.  
  947.     $DBD::Chart::err = -1,
  948.     $DBD::Chart::errstr = "Invalid value for 'MAPTYPE' property.",
  949.     return (undef, $t)
  950.         if (($props{MAPTYPE}) && ($props{MAPTYPE}!~/^(HTML|PERL)$/i));
  951.  
  952.     $DBD::Chart::err = -1,
  953.     $DBD::Chart::errstr = "Only alphanumerics and _ allowed for 'MAPNAME' property.",
  954.     return (undef, $t)
  955.         if (($props{MAPNAME}) && ($props{MAPNAME}=~/\W/));
  956.  
  957.     return (\%props, $t);
  958. }
  959.  
  960. sub parse_predicate {
  961.     my ($collist, $predcol, $predop, $predval, $numphs, $ccols, $ctypes) = @_;
  962.  
  963.     $DBD::Chart::err = -1,
  964.     $DBD::Chart::errstr = 'Invalid predicate.',
  965.     return undef
  966.         unless ($collist=~/^([^\s\=<>]+)\s*(<>|<=|>=|=|>|<)\s*(.*)$/);
  967.  
  968.     my $tname = uc $1;
  969.     $$predop = $2;
  970.     $collist = $3;
  971.     $$predcol = $$ccols{$tname};
  972.  
  973.     $DBD::Chart::err = -1,
  974.     $DBD::Chart::errstr = "Unknown column $tname.",
  975.     return undef
  976.         unless defined($$predcol);
  977.  
  978.     $$predval = '?',
  979.     $$numphs++,
  980.     return 1
  981.         if ($collist=~/^\s*\?\s*$/i);
  982. #
  983. #    start pessimistically
  984.     $DBD::Chart::err = -1;
  985.     $DBD::Chart::errstr = "Invalid value for column $tname.";
  986.     
  987.     return undef
  988.         if ((($$ctypes[$$predcol] == SQL_FLOAT) ||
  989.             ($$ctypes[$$predcol] == SQL_DECIMAL)) &&
  990.             ($collist!~/^[\+\-]?\d+(\.\d+(E[+|-]?\d+)?)$/i));
  991.  
  992.     return undef
  993.         if ((($$ctypes[$$predcol] == SQL_INTEGER) ||
  994.             ($$ctypes[$$predcol] == SQL_SMALLINT) ||
  995.             ($$ctypes[$$predcol] == SQL_TINYINT))&&
  996.             ($collist!~/^[\+\-]?\d+$/));
  997.  
  998.     return undef
  999.         if (($$ctypes[$$predcol] == SQL_DATE) &&
  1000.             ($collist!~/^'\d+[\-\/\.](\d+|JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)[\-\/\.]\d+'$/i));
  1001.  
  1002.     return undef
  1003.         if (($$ctypes[$$predcol] == SQL_TIMESTAMP) &&
  1004.             ($collist!~/^'\d+[\-\/\.](\d+|JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)[\-\/\.]\d+\s+\d+:\d+:\d+(.\d+)?'$/i));
  1005.  
  1006.     return undef
  1007.         if (($$ctypes[$$predcol] == SQL_TIME) &&
  1008.             ($collist!~/^'\d+:\d+:\d+(.\d+)?'$/));
  1009.  
  1010.     return undef
  1011.         if (($$ctypes[$$predcol] == SQL_INTERVAL_HR2SEC) &&
  1012.             ($collist=~/^'[\+\-]?\d+:\d+:\d+(.\d+)?'$/));
  1013.  
  1014.     $DBD::Chart::err = 0,
  1015.     $DBD::Chart::errstr = '',
  1016.     $$predval = $collist,
  1017.     return 1
  1018.         if (($$ctypes[$$predcol] != SQL_CHAR) && 
  1019.             ($$ctypes[$$predcol] != SQL_VARCHAR));
  1020.         
  1021.     return undef
  1022.         unless ($collist=~/^('[^']*')(.*)$/);
  1023.  
  1024.     $$predval = $1;
  1025.     $collist = $2;
  1026.  
  1027.     $$predval .= $1,
  1028.     $collist= $2
  1029.         while ($collist=~/^('[^']*')(.*)$/);
  1030.  
  1031.     $DBD::Chart::err = 0;
  1032.     $DBD::Chart::errstr = '';
  1033.     return 1;
  1034. }
  1035.  
  1036. sub validate_time {
  1037.     my ($time) = @_;
  1038.     my ($hr, $min, $sec) = split(':', $time);
  1039.     return (($hr >= 0) && ($hr < 24) && ($min >= 0) && ($min < 60) && ($sec >= 0) && ($sec < 60));
  1040. }
  1041.  
  1042. sub validate_interval {
  1043. #
  1044. #    eventually support full intervals (years, months, days...)
  1045. #
  1046.     my ($hr, $min, $sec, $subsec) = @_;
  1047.     return undef if (defined($hr) && ($min > 60));
  1048.     return undef if (defined($min) && ($sec > 60));
  1049. #
  1050. #    convert to seconds only float value
  1051. #
  1052.     $sec += $hr * 3600 if $hr;
  1053.     $sec += $min * 60 if $min;
  1054.     $sec .= $subsec if $subsec;
  1055.     return $sec;
  1056. }
  1057.  
  1058. sub validate_value {
  1059.     my ($coltype, $remnant, $cprec, $errstr) = @_;
  1060.  
  1061.     $$remnant = $4,
  1062.     return $1
  1063.         if ((($coltype == SQL_FLOAT) ||
  1064.             ($coltype == SQL_DECIMAL)) &&
  1065.             ($$remnant=~/^([\+\-]?\d+(\.\d+(E[+|-]?\d+)?)?)\s*,\s*(.*)$/i));
  1066.  
  1067.     $$remnant = $2,
  1068.     return $1
  1069.         if ((($coltype == SQL_INTEGER) ||
  1070.             ($coltype == SQL_SMALLINT) ||
  1071.             ($coltype == SQL_TINYINT)) &&
  1072.             ($$remnant=~/^([\+\-]?\d+)\s*,\s*(.*)$/i));
  1073.  
  1074.     if ($coltype == SQL_DATE) {
  1075.         $DBD::Chart::err = -1,
  1076.         $DBD::Chart::errstr = $errstr,
  1077.         return undef
  1078.             unless ($$remnant=~/^'((\d+)([\-\.\/])(\w+)([\-\.\/])(\d+))'\s*,\s*(.*)$/i);
  1079.  
  1080.         my ($date, $yr, $sep1, $mo, $sep2, $day) = ($1, $2, $3, uc $4, $5, $6);
  1081.         $$remnant = $7;
  1082.         $DBD::Chart::err = -1,
  1083.         $DBD::Chart::errstr = $errstr,
  1084.         return undef
  1085.             unless (((($mo=~/^\d+$/) && ($mo > 0) && ($mo < 13)) ||
  1086.                 ($mo=~/^(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)$/i)) &&
  1087.                 ($day < 32) && ($day > 0));
  1088. #
  1089. #    should probably verify date is valid!
  1090. #
  1091.         return $date;
  1092.     }
  1093.     if ($coltype == SQL_INTERVAL_HR2SEC) {
  1094. #
  1095. #    currently only support intervals up to hourly precision
  1096. #
  1097.         $DBD::Chart::err = -1,
  1098.         $DBD::Chart::errstr = $errstr,
  1099.         return undef
  1100.             unless ($$remnant=~/^'([\-\+]?(\d+:)?(\d+:)?(\d+)(\.\d+)?)'\s*,\s*(.*)$/);
  1101.         my ($time, $hr, $min, $sec, $subsec) = ($2, $3, $4, $5);
  1102.         $$remnant = $6;
  1103.         
  1104.         $DBD::Chart::err = -1,
  1105.         $DBD::Chart::errstr = $errstr,
  1106.         return undef
  1107.             unless defined(validate_interval($hr, $min, $sec, $subsec));
  1108.         return $time;
  1109.     }
  1110.     if ($coltype == SQL_TIME) {
  1111.         $DBD::Chart::err = -1,
  1112.         $DBD::Chart::errstr = $errstr,
  1113.         return undef
  1114.             unless ($$remnant=~/^'(\d\d?:\d\d:\d\d(\.\d+)?)'\s*,\s*(.*)$/i);
  1115.         my ($time, $subsec) = ($1, $2);
  1116.         $$remnant = $3;
  1117.         $DBD::Chart::err = -1,
  1118.         $DBD::Chart::errstr = $errstr,
  1119.         return undef
  1120.             unless validate_time($time);
  1121. #
  1122. #    NOTE: we discard subseconds here
  1123. #    should we permit AM/PM indications ?
  1124. #
  1125.         return $time;
  1126.     }
  1127.     if ($coltype == SQL_TIMESTAMP) {
  1128.         $DBD::Chart::err = -1,
  1129.         $DBD::Chart::errstr = $errstr,
  1130.         return undef
  1131.             unless ($$remnant=~/^'((\d+)([\-\.\/])(\w+)([\-\.\/])(\d+)\s+(\d\d?:\d\d:\d\d(\.\d+)?))'\s*,\s*(.*)$/i);
  1132.         my ($tmstamp, $yr, $sep1, $mo, $sep2, $day, $time, $subsec) = ($1, $2, $3, uc $4, $5, $6, $7, $8);
  1133.         $$remnant = $9;
  1134.         $DBD::Chart::err = -1,
  1135.         $DBD::Chart::errstr = $errstr,
  1136.         return undef
  1137.             unless (((($mo=~/^\d+$/) && ($mo > 0) && ($mo < 13)) ||
  1138.                 ($mo=~/^(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)$/i)) &&
  1139.                 ($day < 32) && ($day > 0) && validate_time($time));
  1140. #
  1141. #    should probably verify date is valid!
  1142. #    and convert to seconds since epoc (or some other baseline value)
  1143. #    NOTE: we discard subseconds here
  1144. #
  1145.         return $tmstamp;
  1146.     }
  1147.     if (($coltype == SQL_CHAR) || ($coltype == SQL_VARCHAR)) {
  1148.         $DBD::Chart::err = -1,
  1149.         $DBD::Chart::errstr = $errstr,
  1150.         return undef
  1151.             unless ($$remnant=~/^'([^']*)'(.*)$/);
  1152.  
  1153.         my $str = $1;
  1154.         $$remnant= $2;
  1155.  
  1156.         $str .= '\'' . $1,
  1157.         $$remnant= $2
  1158.             while ($$remnant=~/^'([^']*)'(.*)$/);
  1159.  
  1160.         $$remnant=~s/^\s*,\s*//;
  1161.         $DBD::Chart::err = -1,
  1162.         $DBD::Chart::errstr = 
  1163.             "String value exceeds defined length.",
  1164.         return undef
  1165.             if (length($str) > $cprec);
  1166.  
  1167.         return $str;
  1168.     }
  1169.     $DBD::Chart::err = -1;
  1170.     $DBD::Chart::errstr = $errstr;
  1171.     return undef;
  1172. }
  1173.  
  1174. sub prepare {
  1175.     my($dbh, $statement, $attrs)= @_;
  1176.     my $i;
  1177.     my $tstmt = $statement;
  1178.     $tstmt=~s/^\s*(.+);?\s*$/$1/;
  1179.     $tstmt=~s/\n/ /g;
  1180. #
  1181. #    validate that its a CREATE, DROP, INSERT, or SELECT
  1182. #
  1183.     $DBD::Chart::err = -1,
  1184.     $DBD::Chart::errstr = 
  1185.         'Only CREATE { TABLE | CHART }, DROP { TABLE | CHART }, ' .
  1186.             'SELECT, INSERT, UPDATE, or DELETE statements supported.',
  1187.     return undef
  1188.         if ($tstmt!~/^(SELECT|CREATE|INSERT|UPDATE|DELETE|DROP)\s+(.+)$/i);
  1189.  
  1190.     my ($cmd, $remnant) = ($1, $2);
  1191.     $cmd = uc $cmd;
  1192.     my ($filenm, $collist, $tcols);
  1193.     if ($cmd=~/(CREATE|DROP)/) {
  1194.         $DBD::Chart::err = -1,
  1195.         $DBD::Chart::errstr = 
  1196.             'Only CREATE { TABLE | CHART }, DROP { TABLE | CHART }, ' .
  1197.             'SELECT, INSERT, UPDATE, or DELETE statements supported.',
  1198.         return undef
  1199.             if ($remnant!~/^(TABLE|CHART)\s+(CHART\.)?(\w+)\s*(.*)$/i);
  1200.  
  1201.         ($filenm, $remnant) = ($3, $4);
  1202.         $filenm = uc $filenm;
  1203.  
  1204.         $DBD::Chart::err = -1,
  1205.         $DBD::Chart::errstr = 
  1206.             'Unrecognized DROP statement.',
  1207.         return undef
  1208.             if (($cmd eq 'DROP') && ($remnant ne ''));
  1209.  
  1210.         $DBD::Chart::err = -1,
  1211.         $DBD::Chart::errstr = 
  1212.             'Cannot CREATE/DROP COLORMAP table.',
  1213.         return undef
  1214.             if ($filenm eq 'COLORMAP');
  1215.     }
  1216.     elsif ($cmd eq 'UPDATE') {
  1217.         $DBD::Chart::err = -1,
  1218.         $DBD::Chart::errstr = 'Invalid UPDATE statement.',
  1219.         return undef
  1220.             unless ($remnant=~/^(CHART\.)?(\w+)\s+SET\s+(.+)$/i);
  1221.  
  1222.         ($filenm, $remnant) = ($2, $3);
  1223.         $filenm = uc $filenm;
  1224.     }
  1225.     elsif ($cmd eq 'DELETE') {
  1226.         $DBD::Chart::err = -1,
  1227.         $DBD::Chart::errstr = 'Invalid DELETE statement.',
  1228.         return undef
  1229.             unless ($remnant=~/^FROM\s+(CHART\.)?(\w+)\s*(.*)$/i);
  1230.  
  1231.         ($filenm, $remnant) = ($2, $3);
  1232.         $filenm = uc $filenm;
  1233.         if ($remnant ne '') {
  1234.             $DBD::Chart::err = -1,
  1235.             $DBD::Chart::errstr = 'Invalid DELETE statement.',
  1236.             return undef
  1237.                 unless ($remnant=~/^WHERE\s+(.+)$/i);
  1238.  
  1239.             $remnant = $1;
  1240.         }
  1241.     }
  1242.     elsif ($cmd eq 'INSERT') {
  1243.         $DBD::Chart::err = -1,
  1244.         $DBD::Chart::errstr = 'Invalid INSERT statement.',
  1245.         return undef
  1246.             if ($remnant!~/^INTO\s+(CHART\.)?(\w+)\s+VALUES\s*\(\s*(.+)\s*\)$/i);
  1247.         ($filenm, $remnant) = ($2, $3);
  1248.         $filenm = uc $filenm;
  1249.     }
  1250.  
  1251.     my $chart;
  1252.     if (($cmd ne 'CREATE') && ($cmd ne 'SELECT')) {
  1253.         $chart = $DBD::Chart::charts{$filenm};
  1254.         $DBD::Chart::err = -1,
  1255.         $DBD::Chart::errstr = $filenm . ' does not exist.',
  1256.         return undef
  1257.             unless $chart;
  1258.     }
  1259.  
  1260.     my ($ccols, $ctypes, $cprecs, $cscales);
  1261.     $ccols = $$chart{columns},    # a hashref (name, position)
  1262.     $ctypes = $$chart{types},    # an arrayref of types
  1263.     $cprecs = $$chart{precisions}, # an arrayref of precisions
  1264.     $cscales = $$chart{scales}, # an arrayref of scales
  1265.         if (($cmd eq 'UPDATE') || ($cmd eq 'INSERT') || ($cmd eq 'DELETE'));
  1266.  
  1267.     my %cols = ();
  1268.     my @typeary = ();
  1269.     my @typelens = ();
  1270.     my @typescale = ();
  1271.  
  1272.     my $numphs = 0;
  1273.     my @dtypes = ();    # list of chart types
  1274.     my @dcharts = ();    # list of per-chart datasources
  1275.     my @dnames = ();    # list of per-chart names
  1276.     my @dprops = ();    # list of per-chart properties
  1277.     my @dcols = ();        # list of per-chart datasource column names
  1278.     my %dversions = (); # list of per-chart datasource versions
  1279.     my %setcols = ();
  1280.     my @parmcols = ();
  1281.     my ($tname, $props, $cnum, $predicate, $ctype);
  1282.     my $imagemap = undef;
  1283.     my ($predcol, $predop, $predval) = ('','','');
  1284.  
  1285.     if ($cmd eq 'CREATE') {
  1286.         $DBD::Chart::err = -1,
  1287.         $DBD::Chart::errstr = 
  1288.             $filenm . ' has already been CREATEd.',
  1289.         return undef
  1290.             if ($chart);
  1291.  
  1292.         $DBD::Chart::err = -1,
  1293.         $DBD::Chart::errstr = 
  1294.             'Unrecognized CREATE statement.',
  1295.         return undef
  1296.             if ($remnant!~/^\((.+)\)$/);
  1297.  
  1298.         $remnant = $1;
  1299.         my $colcnt = parse_col_defs($remnant, \%cols, \@typeary, 
  1300.             \@typelens, \@typescale);
  1301.         return undef if (! $colcnt);
  1302.     }
  1303.     elsif ($cmd eq 'DROP') { }
  1304.     elsif ($cmd eq 'INSERT') {
  1305. #
  1306. #    normalize valuelist so we can count ph's
  1307. #
  1308.         $remnant .= ',';
  1309.         $cnum = -1;
  1310.         while ($remnant ne '') {
  1311.             $cnum++;
  1312.  
  1313.             $remnant = $1,
  1314.             push(@parmcols, $cnum),
  1315.             $numphs++,
  1316.             next
  1317.                 if ($remnant=~/^\?\s*,\s*(.*)$/);
  1318.  
  1319.             $remnant = $1,
  1320.             $setcols{$cnum} = undef,
  1321.             next
  1322.                 if ($remnant=~/^NULL\s*,\s*(.*)$/i);
  1323.  
  1324.             $setcols{$cnum} = validate_value($$ctypes[$cnum], \$remnant, 
  1325.                 $$cprecs[$cnum], "Invalid value for column at position $cnum.");
  1326.             return undef
  1327.                 unless defined($setcols{$cnum});
  1328.         }
  1329.         $DBD::Chart::errstr = 
  1330.             'Value list does not match column definitions.',
  1331.         $DBD::Chart::err = -1,
  1332.         return undef
  1333.             if ($cnum+1 != scalar(keys(%$ccols)));
  1334.     }
  1335.     elsif ($cmd eq 'UPDATE') {
  1336.         $DBD::Chart::err = -1,
  1337.         $DBD::Chart::errstr = 'Unrecognized UPDATE statement.',
  1338.         return undef
  1339.             if ($remnant!~/^(.+)\s+WHERE\s+(.+)$/i);
  1340.  
  1341.         $collist = $1;
  1342.         $predicate = $2;
  1343. #
  1344. #    scan SET list to count ph's and validate literals
  1345. #
  1346.         $collist .= ',';
  1347.         $tname = '';
  1348.         while ($collist ne '') {
  1349.             $DBD::Chart::err = -1,
  1350.             $DBD::Chart::errstr = 'Invalid SET clause.',
  1351.             return undef
  1352.                 if ($collist!~/^([^\s\=]+)\s*\=\s*(.+)$/);
  1353.  
  1354.             $tname = uc $1;
  1355.             $collist = $2;
  1356.             $cnum = $$ccols{$tname};
  1357.             $DBD::Chart::err = -1,
  1358.             $DBD::Chart::errstr = 
  1359.                 "Unknown column $tname in UPDATE statement.",
  1360.             return undef
  1361.                 unless defined($cnum);
  1362.  
  1363.             $collist = $1,
  1364.             push(@parmcols, $cnum),
  1365.             $numphs++,
  1366.             next
  1367.                 if ($collist=~/^\?\s*,\s*(.*)$/);
  1368.  
  1369.             $collist = $1,
  1370.             $setcols{$cnum} = undef,
  1371.             next
  1372.                 if ($collist=~/^NULL\s*,\s*(.*)$/i);
  1373.  
  1374.             $setcols{$cnum} = validate_value($$ctypes[$cnum], \$collist,
  1375.                 $$cprecs[$cnum], "Invalid value for column $tname.");
  1376.             return undef
  1377.                 unless defined($setcols{$cnum});
  1378.         }
  1379. #
  1380. #    get predicate; only 1 allowed
  1381. #
  1382.         if ($predicate ne '') {
  1383.             return undef unless
  1384.                 parse_predicate($predicate, \$predcol, \$predop, \$predval,
  1385.                     \$numphs, $ccols, $ctypes);
  1386.         }
  1387.     }
  1388.     elsif ($cmd eq 'DELETE') {
  1389. #
  1390. #    get predicate; only 1 allowed
  1391. #
  1392.         return undef unless
  1393.             parse_predicate($remnant, \$predcol, \$predop, \$predval, 
  1394.                 \$numphs, $ccols, $ctypes);
  1395.     }
  1396.     else {    # must be SELECT
  1397.         if ($remnant=~/^\*\s+FROM\s+(CHART\.)?COLORMAP\s+(WHERE\s+NAME\s*=\s*(.+))?$/i) {
  1398. #
  1399. #    its a COLORMAP query, handle special
  1400. #
  1401.             my $charttype = 'COLORMAP';
  1402.             my $flds = '*';
  1403.             my $pred = 'NAME = ' . uc $3;
  1404.             my($outer, $sth) = DBI::_new_sth($dbh, {
  1405.                 'Statement'     => $statement,
  1406.             });
  1407.             $dversions{COLORMAP} = 1;
  1408.             $sth->{chart_dbh} = $dbh;
  1409.             $sth->{chart_cmd} = $cmd;
  1410.             $sth->{chart_name} = 'COLORMAP';
  1411.             $sth->{chart_qnames} = undef;
  1412.             $sth->{chart_charttypes} = [ 'COLORMAP' ];
  1413.             $sth->{chart_sources} = [ 'COLORMAP' ];
  1414.             $sth->{chart_properties} = [ $pred ];
  1415.             $sth->{chart_version} = \%dversions;
  1416.             $sth->{chart_imagemap} = undef;
  1417.             $sth->STORE('NUM_OF_FIELDS', 4);
  1418.             $sth->STORE('NUM_OF_PARAMS', 1)
  1419.                 if ($pred=~/^\s*\?\s*$/);
  1420.             $sth->{NAME} = [ 'Name', 'RedValue', 'BlueValue', 'GreenValue' ];
  1421.             $sth->{TYPE} = [ SQL_VARCHAR, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER ];
  1422.             $sth->{PRECISION} = [ 30, 4, 4, 4 ];
  1423.             $sth->{SCALE} = [ 0, 0, 0, 0 ];
  1424.             $sth->{NULLABLE} = [ undef, undef, undef, undef ];
  1425.             return $outer;
  1426.         }
  1427. #
  1428. #    normalize the query to isolate subqueries
  1429. #    replace all literal strings before processing
  1430. #
  1431.         my @strlits = ();
  1432.         my $num = 0;
  1433.         push(@strlits, $1),
  1434.         $remnant=~s/'.*?'/<$num>/,
  1435.         $num++
  1436.             while ($remnant=~/'(.*?)'/);
  1437.  
  1438.         $remnant=~s/\)\s+WHERE\s+/\rWHERE /i;
  1439.         $remnant=~s/\)(\s+(\w+))\s+WHERE\s+/$1\rWHERE /i;
  1440.         $remnant=~s/\s+FROM\s+\(\s*SELECT\s*/\r/i;    # isolate first subquery
  1441.         $remnant=~s/\s*\)\s*,\s*\(\s*SELECT\s*/\r/ig;    # isolate individual queries
  1442.         $remnant=~s/\s*\)(\s+(\w+))\s*,\s*\(\s*SELECT\s*/$1\r/ig;    # isolate individual queries
  1443.         my @queries = split("\r", $remnant);
  1444.  
  1445.         if ($#queries > 0) {
  1446. #
  1447. #    accumulate subquery names
  1448.             foreach $i (1..$#queries) {
  1449.                 next
  1450.                     unless ($queries[$i]=~/\s+(\w+)$/);
  1451.                 $dnames[$i] = uc $1;
  1452.                 $queries[$i]=~s/\s+(\w+)$//;
  1453.             }
  1454.         }
  1455.         $DBD::Chart::err = -1,
  1456.         $DBD::Chart::errstr = 'Invalid composite chart specification.',
  1457.         return undef
  1458.             unless (($#queries == 0) || 
  1459.                 (($queries[0]=~/^IMAGE(\s*,\s*IMAGEMAP)?$/i) && ($queries[1]!~/^WHERE/i)));
  1460.  
  1461.         $DBD::Chart::err = -1,
  1462.         $DBD::Chart::errstr = 'No subqueries provided for composite chart.',
  1463.         return undef
  1464.             if (($#queries == 0) &&
  1465.                 ($queries[0]=~/^IMAGE(\s*,\s*IMAGEMAP)?$/i));
  1466.  
  1467.         my $is_composite = 1 if $#queries;
  1468.         if ($is_composite) {
  1469. #
  1470. #    get global properties
  1471. #
  1472.             $imagemap = 1 if ($queries[0]=~/^IMAGE(\s*\(\s*\*\s*\))?\s*,\s*IMAGEMAP$/i);
  1473.             push @dtypes, 'IMAGE';
  1474.             push @dcharts, undef;
  1475.             push @dcols, undef;
  1476.             shift @queries;
  1477.             $remnant = ($queries[$#queries]=~/^WHERE/i) ? pop(@queries) : undef;
  1478.             $dprops[0] = \%dfltglobals;
  1479.             if (($remnant) && ($remnant=~/^WHERE\s+(.+)$/i)) {
  1480. #
  1481. #    process format properties
  1482. #
  1483.                 ($props, $remnant) = parse_props('IMAGE', $1, \$numphs, undef, \@strlits);
  1484.                 return undef if (! $props);
  1485.                 $dprops[0] = $props;
  1486.             }
  1487.         }
  1488.         foreach $remnant (@queries) {
  1489.             $DBD::Chart::err = -1,
  1490.             $DBD::Chart::errstr = 'Unrecognized SELECT statement.',
  1491.             return undef
  1492.                 unless ($remnant=~/^(CANDLESTICK|SURFACEMAP|POINTGRAPH|HISTOGRAM|LINEGRAPH|AREAGRAPH|PIECHART|BARCHART|BOXCHART|QUADTREE|GANTT)(\s*\(\s*([^\)]+)\))?(\s*,\s*IMAGEMAP)?\s+FROM\s+(\?|\w+)\s*(.*)$/i);
  1493.  
  1494.             $ctype = uc $1;
  1495.             my $colnames = uc $3;
  1496.             $imagemap = uc $4 unless ($imagemap || (! $4));
  1497.             $filenm = uc $5;
  1498.             $remnant = $6;
  1499.  
  1500.             $DBD::Chart::err = -1,
  1501.             $DBD::Chart::errstr = 'IMAGEMAP not valid in subquery.',
  1502.             return undef
  1503.                 if ($is_composite && $4);
  1504.  
  1505.             $DBD::Chart::err = -1,
  1506.             $DBD::Chart::errstr = 'Incompatible chart types in composite image.',
  1507.             return undef
  1508.                 if (($is_composite) && ($#dtypes > 0) && 
  1509.                     (! $compatibility{$dtypes[1]}->{$ctype}));
  1510. #
  1511. #    collect any column-list values
  1512. #
  1513.             my $cols = [ '*' ];
  1514.             $colnames=$1 
  1515.                 if ($colnames && ($colnames=~/^\s*(.+)\s*$/));
  1516.             @$cols = split(',', $colnames)
  1517.                 if ($colnames && ($colnames ne '*'));
  1518.             $$cols[$_]=~s/^\s*(.+)\s*$/$1/ foreach (0..$#$cols);
  1519.                 
  1520.             if ($filenm ne '?') {
  1521.                 $chart = $DBD::Chart::charts{$filenm};
  1522.                 $DBD::Chart::err = -1,
  1523.                 $DBD::Chart::errstr = $filenm . ' does not exist.',
  1524.                 return undef
  1525.                     unless $chart;
  1526.  
  1527.                 $ctypes = $$chart{types};
  1528.                 $DBD::Chart::err = -1,
  1529.                 $DBD::Chart::errstr = $ctype . 
  1530.                     ' chart requires at least ' .
  1531.                     $mincols{$ctype} . ' columns.',
  1532.                 return undef
  1533.                     if (scalar(@$ctypes) < $mincols{$ctype});
  1534. #
  1535. #    validate any column list
  1536. #
  1537.                 $DBD::Chart::err = -1,
  1538.                 $DBD::Chart::errstr = $ctype . 
  1539.                     ' chart requires at least ' .
  1540.                     $mincols{$ctype} . ' columns.',
  1541.                 return undef
  1542.                     if (scalar(@$ctypes) < $mincols{$ctype});
  1543.  
  1544.                 $dversions{$filenm} = $$chart{version};
  1545.             }
  1546.             else {
  1547.                 $filenm = "?$numphs";
  1548.                 $numphs++;
  1549.             }
  1550.             $imagemap = 1
  1551.                 if ($imagemap);
  1552.             push(@dtypes, $ctype);
  1553.             push(@dcharts, $filenm);
  1554.             push(@dcols, $cols);
  1555.             if ($remnant=~/^WHERE\s+(.+)$/i) {
  1556. #
  1557. #    process format properties
  1558. #
  1559.                 ($props, $remnant) = parse_props($ctype, $1, \$numphs, $is_composite, \@strlits);
  1560.                 return undef if (! $props);
  1561.                 push(@dprops, $props);
  1562.             }
  1563.             else {
  1564.                 push(@dprops, ($is_composite ? \%dfltcomposites : \%dfltprops));
  1565.             }
  1566.         }    # end foreach query
  1567.     }
  1568.  
  1569.     my($outer, $sth) = DBI::_new_sth($dbh, {
  1570.         'Statement'     => $statement,
  1571.     });
  1572.  
  1573.     $sth->STORE('NUM_OF_PARAMS', $numphs);
  1574.     $sth->{chart_dbh} = $dbh;
  1575.     $sth->{chart_cmd} = $cmd;
  1576.     $sth->{chart_name} = $filenm;
  1577.  
  1578.     $sth->{chart_precisions} = \@typelens,
  1579.     $sth->{chart_types} = \@typeary,
  1580.     $sth->{chart_scales} = \@typescale,
  1581.     $sth->{chart_columns} = \%cols
  1582.         if ($cmd eq 'CREATE');
  1583.  
  1584.     $sth->{chart_predicate} = [ $predcol, $predop, $predval ]
  1585.         if ((($cmd eq 'UPDATE') || ($cmd eq 'DELETE')) && 
  1586.             (defined($predcol)));
  1587.  
  1588.     $sth->{chart_version} = $$chart{version},
  1589.     $sth->{chart_param_cols} = \@parmcols
  1590.         if (($cmd eq 'UPDATE') || ($cmd eq 'DELETE') || ($cmd eq 'INSERT'));
  1591.  
  1592.     $sth->{chart_columns} = \%setcols
  1593.         if (($cmd eq 'UPDATE') || ($cmd eq 'INSERT'));
  1594.  
  1595.     if ($cmd eq 'SELECT') {
  1596.         $sth->{chart_charttypes} = \@dtypes;
  1597.         $sth->{chart_sources} = \@dcharts;
  1598.         $sth->{chart_columns} = \@dcols;
  1599.         $sth->{chart_properties} = \@dprops;
  1600.         $sth->{chart_version} = \%dversions;
  1601.         $sth->{chart_imagemap} = $imagemap;
  1602.         $sth->{chart_qnames} = \@dnames;
  1603.         $sth->{chart_map_modifier} = $attrs->{chart_map_modifier}
  1604.             if ($attrs && $attrs->{chart_map_modifier} &&
  1605.                 ref $attrs->{chart_map_modifier} &&
  1606.                 (ref $attrs->{chart_map_modifier} eq 'CODE'));
  1607. #
  1608. #    added external name/type/precision/scale mapping
  1609. #    app will provide [ { NAME => [ ], TYPE => [ ], PRECISION => [ ], SCALE => [ ] }, ... ]
  1610. #     (one hashref per param'd datasource)
  1611. #    this is mostly to support DBD::CSV, DBD::File
  1612. #
  1613.         $sth->{chart_type_map} = $attrs->{chart_type_map}
  1614.             if ($attrs && $attrs->{chart_type_map} &&
  1615.                 ref $attrs->{chart_type_map} &&
  1616.                 (ref $attrs->{chart_type_map} eq 'ARRAY'));
  1617.  
  1618.         if ($imagemap) {
  1619.             $sth->STORE('NUM_OF_FIELDS', 2);
  1620.             $sth->{NAME} = [ '', '' ];
  1621.             $sth->{TYPE} = [ SQL_VARBINARY, SQL_VARCHAR ];
  1622.             $sth->{PRECISION} = [ undef, undef ];
  1623.             $sth->{SCALE} = [ 0, 0 ];
  1624.             $sth->{NULLABLE} = [ undef, undef ];
  1625.         }
  1626.         else {
  1627.             $sth->STORE('NUM_OF_FIELDS', 1);
  1628.             $sth->{NAME} = [ '' ];
  1629.             $sth->{TYPE} = [ SQL_VARBINARY ];
  1630.             $sth->{PRECISION} = [ undef ];
  1631.             $sth->{SCALE} = [ 0 ];
  1632.             $sth->{NULLABLE} = [ undef ];
  1633.         }
  1634.     }
  1635.  
  1636.     $outer;
  1637. }
  1638.  
  1639. sub FETCH {
  1640.     my ($dbh, $attrib) = @_;
  1641.     return $dbh->{$attrib} if ($attrib=~/^chart_/);
  1642.     return 1 if $attrib eq 'AutoCommit';
  1643.     return $dbh->DBD::_::db::FETCH($attrib);
  1644. }
  1645.  
  1646. sub STORE {
  1647.     my ($dbh, $attrib, $value) = @_;
  1648.     $dbh->{$attrib} = $value and return 1 if ($attrib=~/^chart_/);
  1649.     if ($attrib eq 'AutoCommit') {
  1650.         return 1 if $value; # is already set
  1651.         croak("Can't disable AutoCommit");
  1652.     }
  1653.     
  1654.     return $dbh->DBD::_::db::STORE($attrib, $value);
  1655. }
  1656.  
  1657. sub disconnect {
  1658.     my $dbh = shift;
  1659.  
  1660.     $dbh->STORE(Active => 0);
  1661.     my $fname = $dbh->{chart_name};
  1662.     return 1 if (! $fname);
  1663.     delete $DBD::Chart::charts{$fname};
  1664.  
  1665.     1;
  1666. }
  1667.  
  1668. sub DESTROY {
  1669. #
  1670. #    close any open file here
  1671. #
  1672.     my $dbh = shift;
  1673.     $dbh->disconnect if ($dbh->{Active});
  1674.     1;
  1675. }
  1676.  
  1677. 1;
  1678. }
  1679.  
  1680. {
  1681. package DBD::Chart::st; # ====== STATEMENT ======
  1682. use DBI qw(:sql_types);
  1683. use Carp;
  1684. use Time::Local;
  1685.  
  1686. $DBD::Chart::st::imp_data_size = 0;
  1687.  
  1688. use GD;
  1689. use DBD::Chart::Plot;
  1690.  
  1691. use constant SQL_INTERVAL_HR2SEC => 110;
  1692.  
  1693. my %strpredops = (
  1694. '=', 'eq',
  1695. '<>', 'ne',
  1696. '<', 'lt',
  1697. '<=', 'le',
  1698. '>', 'gt',
  1699. '>=', 'ge'
  1700. );
  1701.  
  1702. my %numpredops = (
  1703. '=', '==',
  1704. '<>', '!=',
  1705. '<', '<',
  1706. '<=', '<=',
  1707. '>', '>',
  1708. '>=', '>='
  1709. );
  1710.  
  1711. my %numtype = (
  1712. SQL_INTEGER, 1,
  1713. SQL_SMALLINT, 1,
  1714. SQL_TINYINT, 1,
  1715. SQL_DECIMAL, 1,
  1716. SQL_FLOAT, 1
  1717. );
  1718.  
  1719. my %symboltype = (
  1720. SQL_CHAR, 1,
  1721. SQL_VARCHAR, 1
  1722. );
  1723.  
  1724. my %timetype = (
  1725. SQL_DATE, 'YYYY-MM-DD',
  1726. SQL_TIME, 'HH:MM:SS',
  1727. SQL_TIMESTAMP, 'YYYY-MM-DD HH:MM:SS',
  1728. SQL_INTERVAL_HR2SEC, '+HH:MM:SS'
  1729. );
  1730.  
  1731. my %month = ( 'JAN', 0, 'FEB', 1, 'MAR', 2, 'APR', 3, 'MAY', 4, 'JUN', 5, 
  1732. 'JUL', 6, 'AUG', 7, 'SEP', 8, 'OCT', 9, 'NOV', 10, 'DEC', 11);
  1733.  
  1734. my @quadcolors = qw(
  1735. black blue purple green red orange yellow white
  1736. );
  1737.  
  1738. sub check_color {
  1739.     my ($color) = @_;
  1740.     
  1741.     my $table = $DBD::Chart::charts{COLORMAP};
  1742.     my $col1 = $table->{data}->[0];
  1743.     my $c;
  1744.     foreach $c (@$col1) {
  1745.         return 1 if ($color eq $c);
  1746.     }
  1747.     return undef;
  1748. }
  1749.  
  1750. sub get_colormap {
  1751.     my $table = $DBD::Chart::charts{COLORMAP};
  1752.     my ($color, $r, $g, $b) = @{$table->{data}};
  1753.     my %map;
  1754.     for (my $i = 0; $i <= $#$color; $i++) {
  1755.         $map{$$color[$i]} = [ $$r[$i], $$g[$i], $$b[$i] ];
  1756.     }
  1757.     return \%map;
  1758. }
  1759.  
  1760. sub validate_value {
  1761.     my ($p, $ttype, $parmsts, $k, $i) = @_;
  1762.  
  1763.     return 1
  1764.         if (($ttype == SQL_CHAR) || ($ttype == SQL_VARCHAR));
  1765.  
  1766.     return 1
  1767.         if (($p=~/^[\-\+]?\d+$/) &&
  1768.             (($ttype == SQL_INTEGER) || 
  1769.              (($ttype == SQL_SMALLINT) && ($p > -32768) && ($p < 32768)) ||
  1770.              (($ttype == SQL_TINYINT) && ($p > -128) && ($p < 128)))
  1771.             );
  1772.         
  1773.     return 1
  1774.         if ((($ttype == SQL_FLOAT) || ($ttype == SQL_DECIMAL)) && 
  1775.             ($p=~/^[\-\+]?\d+(\.\d+(E[\-\+]?\d+)?)?$/i));
  1776.  
  1777.     if (($ttype == SQL_DATE) &&
  1778.         ($p=~/^(\d+)[\-\.\/](\w+)[\-\.\/](\d+)$/i)) {
  1779.  
  1780.         my ($yr, $mo, $day) = ($1, uc $2, $3);
  1781.         return 1
  1782.             if (((($mo=~/^\d+$/) && ($mo > 0) && ($mo < 13)) ||
  1783.                 ($mo=~/^(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)$/i)) &&
  1784.                 ($day < 32) && ($day > 0));
  1785.     }
  1786.     if (($ttype == SQL_INTERVAL_HR2SEC) &&
  1787.         ($p=~/^[\-\+]?((\d+):)?((\d+):)?(\d+)(\.\d+)?/)) {
  1788.         my ($hr, $min, $sec, $subsec) = ($2, $4, $5, $6);
  1789.         return 1
  1790.             if (((! $min) || ($min < 60)) && ($sec < 60));
  1791.     }
  1792.     if (($ttype == SQL_TIME) &&
  1793.         ($p=~/^(\d+):(\d+):(\d+)(\.\d+)?$/)) {
  1794.         my ($hr, $min, $sec, $subsec) = ($1, $2, $3, $4);
  1795.         return 1
  1796.             if (($hr < 24) && ($min < 60) && ($sec < 60));
  1797.     }
  1798.     if (($ttype == SQL_TIMESTAMP) &&
  1799.         ($p=~/^(\d+)[\-\.\/](\w+)[\-\.\/](\d+)\s+(\d+):(\d+):(\d+)(\.\d+)?$/i)) {
  1800.         my ($yr, $mo, $day, $hr, $min, $sec, $subsec) = ($1, $2, uc $3, $4, $5, $6, $7);
  1801.         return 1
  1802.             if (((($mo=~/^\d+$/) && ($mo > 0) && ($mo < 13)) ||
  1803.                 ($mo=~/^(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)$/i)) &&
  1804.                 ($day < 32) && ($day > 0) &&
  1805.                 ($hr < 24) && ($min < 60) && ($sec < 60));
  1806.     }
  1807.  
  1808.     $DBD::Chart::err = -1;
  1809.     $DBD::Chart::errstr = 
  1810.     "Supplied value not compatible with target field at parameter $i.";
  1811.     if ($parmsts) {
  1812.         $$parmsts[$k] =
  1813.     "Supplied value not compatible with target field at parameter $i.",
  1814.         return undef 
  1815.             if (ref $parmsts eq 'ARRAY');
  1816.         $$parmsts{$k} = 
  1817.     "Supplied value not compatible with target field at parameter $i."
  1818.     }
  1819.     return undef;
  1820. }
  1821.  
  1822. sub validate_properties {
  1823.     my ($props, $parms) = @_;
  1824.     foreach my $prop (keys(%$props)) {
  1825.         next if ((! $$props{$prop}) || ($$props{$prop} !~/^\?(\d+)$/));
  1826.         my $phnum = $1;
  1827.         my $t = $$parms[$phnum];
  1828.         $DBD::Chart::err = -1,
  1829.         $DBD::Chart::errstr = 'Insufficient parameters provided.',
  1830.         return undef
  1831.             if ($phnum > scalar(@$parms));
  1832.  
  1833.         $$props{$prop} = $$parms[$phnum];
  1834.  
  1835.         next if (($binary_props{$prop}) && ($t=~/^(0|1)$/));
  1836.  
  1837.         next if ($string_props{$prop});
  1838.  
  1839.         next if ((($prop eq 'WIDTH') || ($prop eq 'HEIGHT')) &&
  1840.             (($t=~/^\d+$/) && ($t >= 10) && ($t <= 100000)));
  1841.  
  1842.         next if ((($prop eq 'BACKGROUND') || ($prop eq 'GRIDCOLOR') ||
  1843.             ($prop eq 'TEXTCOLOR')) && (check_color($t)));
  1844.  
  1845.         next if (($prop eq 'X_ORIENT') && 
  1846.             ($t=~/^(HORIZONTAL|VERTICAL|DEFAULT)$/i));
  1847.  
  1848.          next if (($prop eq 'COLOR') && (check_color($t)));
  1849.          
  1850.          next if (($prop eq 'SHAPE') && ($valid_shapes{$t}));
  1851. #
  1852. #    invalid property parameter value
  1853. #
  1854.         $DBD::Chart::err = -1;
  1855.         $DBD::Chart::errstr = "Invalid value for $prop property.";
  1856.         return undef;
  1857.     }
  1858.     return 1;
  1859. }
  1860. #
  1861. #    official DBI array binding i/f
  1862. #
  1863. sub execute_array {
  1864.     my($sth, $attribs, @bind_values) = @_;
  1865.     
  1866.     $sth->bind_param_status($$attribs{ArrayTupleStatus}) if $$attribs{ArrayTupleStatus};
  1867.     
  1868.     if (@bind_values) {
  1869.         $sth->bind_param_array($_, $bind_values[$_])
  1870.             foreach (1..@bind_values);
  1871.     }
  1872.         
  1873.     return $sth->execute();
  1874. }
  1875.  
  1876. sub execute {
  1877.     my($sth, @bind_values) = @_;
  1878.     my $parms = (@bind_values) ?
  1879.         \@bind_values : $sth->{chart_params};
  1880.  
  1881.     my ($i, $j, $k, $p, $t);
  1882.     my ($predval, $is_parmref, $data, $pctype, $is_parmary, $ttype);
  1883.     my ($paramcols, $maxary, $chart, $props, $predtype);
  1884.     my ($columns, $types, $precs, $scales, $verify, $numcols);
  1885.  
  1886.     my $cmd = $sth->{chart_cmd};
  1887.     my $dbh = $sth->{chart_dbh};
  1888.     my $name = $sth->{chart_name};
  1889.     my $typeary = $sth->{chart_types};
  1890.     $precs = $sth->{chart_precisions};
  1891.     $scales = $sth->{chart_scales};
  1892.     
  1893.     my $cols = $sth->{chart_columns}
  1894.         if ($cmd eq 'CREATE');
  1895.         
  1896.     my $setcols = $sth->{chart_columns}
  1897.         if (($cmd eq 'UPDATE') || ($cmd eq 'INSERT'));
  1898.         
  1899.     my $predicate = $sth->{chart_predicate}
  1900.         if (($cmd eq 'UPDATE') || ($cmd eq 'DELETE'));
  1901.         
  1902.     if ($cmd eq 'CREATE') {
  1903. #
  1904. #    save the description info
  1905. #
  1906.         my @ary;
  1907.         for ($i = 0; $i < scalar(keys(%$cols)); $i++) {
  1908.             my @colary = ();
  1909.             push(@ary, \@colary);
  1910.         }
  1911.  
  1912.         $DBD::Chart::charts{$name} = {
  1913.             'columns' => $cols,
  1914.             'types' => $typeary,
  1915.             'precisions' => $precs,
  1916.             'scales' => $scales,
  1917.             'version' => $DBD::Chart::seqno++,
  1918.             'data' => \@ary
  1919.         };
  1920.         return -1;
  1921.     }
  1922.  
  1923.     if ($cmd eq 'DROP') {
  1924.         $chart = $DBD::Chart::charts{$name};
  1925.         delete $$chart{columns};
  1926.         delete $$chart{types};
  1927.         delete $$chart{precisions};
  1928.         delete $$chart{scales};
  1929.         my $ary = $$chart{data};
  1930.         if ($ary) {
  1931.             foreach my $g (@$ary) {
  1932.                 @$g = ();
  1933.             }
  1934.         }
  1935.         delete $$chart{data};
  1936.         delete $DBD::Chart::charts{$name};
  1937.         return -1;
  1938.     }
  1939.  
  1940.     my $parmsts = $sth->{chart_parmsts};
  1941.     if ($cmd ne 'SELECT') {
  1942. #
  1943. #    validate our chart info in case a DROP was executed
  1944. #    between prepare and execute
  1945. #
  1946.         $chart = $DBD::Chart::charts{$name};
  1947.         $DBD::Chart::errstr = "Chart $name does not exist.",
  1948.         $DBD::Chart::err = -1,
  1949.         return undef
  1950.             unless $chart;
  1951. #
  1952. #    verify that the chart versions are identical
  1953. #
  1954.         $DBD::Chart::errstr = 
  1955.             "Prepared version of $chart differs from current version.",
  1956.         $DBD::Chart::err = -1,
  1957.         return undef
  1958.             unless ($$chart{version} == $sth->{chart_version});
  1959. #
  1960. #    get the record description
  1961. #
  1962.         $columns = $$chart{columns};
  1963.         $types = $$chart{types};
  1964.         $precs = $$chart{precisions};
  1965.         $scales = $$chart{scales};
  1966.         $data = $$chart{data};
  1967. #
  1968. #    check for param arrays or inout params
  1969. #
  1970.         ($is_parmref, $is_parmary, $maxary) = (0, 0, 1);
  1971.         $verify = ($sth->{chart_noverify}) ? 0 : 1;
  1972.  
  1973.         $DBD::Chart::errstr = 
  1974.             'Number of parameters supplied does not match number required.',
  1975.         $DBD::Chart::err = -1,
  1976.         return undef
  1977.             if (($sth->{NUM_OF_PARAMS}) && ((! $parms) ||
  1978.                 (scalar(@$parms) != $sth->{NUM_OF_PARAMS})));
  1979.  
  1980.         $parmsts = $sth->{chart_parmsts};
  1981.         $predicate = $sth->{chart_predicate};
  1982.         $predtype = $$types[$$predicate[0]] if ($predicate);
  1983.         $paramcols = $sth->{chart_param_cols};
  1984.         $numcols = scalar(@$paramcols);
  1985.         if (($verify) && ($parms)) {
  1986.             $p = $$parms[0];
  1987.             $is_parmref = 1 if ((ref $$parms[0]));
  1988.             $is_parmary = 1 
  1989.                 if (($is_parmref) && (ref $$parms[0] eq 'ARRAY'));
  1990.             $maxary = scalar(@$p) if ($is_parmary);
  1991.             for ($i = 1; $i < $sth->{NUM_OF_PARAMS}; $i++) {
  1992.                 my $p = $$parms[$i];
  1993.                 $DBD::Chart::errstr = 
  1994.     'All parameters must be of same type (scalar, scalarref, or arrayref).',
  1995.                 $DBD::Chart::err = -1,
  1996.                 return undef
  1997.                 if ( (($is_parmref) && (! (ref $p) ) ) ||
  1998.                     ((! $is_parmref) && (ref $p)));
  1999.  
  2000.             
  2001.                 $DBD::Chart::errstr = 
  2002.     'All parameters must be of same type (scalar, scalarref, or arrayref).',
  2003.                 $DBD::Chart::err = -1,
  2004.                 return undef
  2005.                 if ((($is_parmary) && ((! (ref $p)) || (ref $p ne 'ARRAY'))) ||
  2006.                     ((! $is_parmary) && (ref $p) && (ref $p eq 'ARRAY')));
  2007. #
  2008. #    validate param arrays are consistent
  2009. #
  2010.                 $DBD::Chart::errstr = 
  2011.                     'All parameter arrays must be the same size.',
  2012.                 $DBD::Chart::err = -1,
  2013.                 return undef
  2014.                     if (($is_parmary) && (scalar(@$p) != $maxary));
  2015.             }
  2016. #
  2017. #    validate param values before we apply them
  2018. #
  2019.             for ($k = 0; $k < $maxary; $k++) {
  2020.                 for ($i = 0; $i < $numcols; $i++) {
  2021.                     $ttype = $$types[$$paramcols[$i]];
  2022.                     $p = $$parms[$i];
  2023.                     $p = (($is_parmary) ? $$p[$k] : $$p) if ($is_parmref);
  2024.                     next if (! defined($p));
  2025. #
  2026. #    verify param types and literals are compatible with target fields
  2027. #
  2028.                     return undef unless validate_value($p, $ttype, $parmsts, $k, $i);
  2029.                 }
  2030. #
  2031. #    predicates always come last, so they'll be last param
  2032. #
  2033.                 if (($predicate) && ($$predicate[2] eq '?')) {
  2034.                     $ttype = $$types[$$predicate[0]];
  2035.                     $p = $$parms[$i];
  2036.                     $p = (($is_parmary) ? $$p[$k] : $$p) if ($is_parmref);
  2037. #
  2038. #    verify param types and literals are compatible with target fields
  2039. #
  2040.                     if (! defined($p))
  2041.                     {
  2042.                         $DBD::Chart::err = -1;
  2043.                         $DBD::Chart::errstr = 
  2044.                             'NULL values not allowed in predicates.';
  2045.                         if ($parmsts) {
  2046.                             $$parmsts[$k] = 
  2047.                             'NULL values not allowed in predicates.',
  2048.                             return undef
  2049.                                 if (ref $parmsts eq 'ARRAY');
  2050.                             $$parmsts{$k} = 
  2051.                             'NULL values not allowed in predicates.';
  2052.                         }
  2053.                         return undef;
  2054.                     }
  2055.  
  2056.                     return undef unless validate_value($p, $ttype, $parmsts, $k, $i);
  2057.                 }
  2058.             }
  2059.         }
  2060.     }
  2061. #
  2062. #    for COLORMAP, we need to validate before applying
  2063. #
  2064.     if ($name eq 'COLORMAP') {
  2065. #
  2066. #    check literals
  2067. #
  2068.         foreach $i (keys(%$setcols)) {
  2069.             my $v = $$setcols{$i};
  2070.             $DBD::Chart::err = -1,
  2071.             $DBD::Chart::errstr = 
  2072.                 'NULL values not valid for COLORMAP fields.',
  2073.             return undef
  2074.                 unless defined($v);
  2075.  
  2076.             next unless $i;    # only proceed for RGB values
  2077.                 
  2078.             $DBD::Chart::err = -1,
  2079.             $DBD::Chart::errstr = 
  2080.                 'Invalid value for COLORMAP component field.',
  2081.             return undef
  2082.                 if (($v < 0) || ($v > 255)); 
  2083.         }
  2084. #
  2085. #    then check params
  2086. #
  2087.         for ($j = 0; $j < scalar(@$paramcols); $j++) {
  2088.             $i = $$paramcols[$j];
  2089.  
  2090.             for ($k = 0; $k < $maxary; $k++) {
  2091.  
  2092.                 $p = $$parms[$j];
  2093.                 $p = (($is_parmary) ? $$p[$k] : $$p) if ($is_parmref);
  2094.  
  2095.                 $DBD::Chart::err = -1,
  2096.                 $DBD::Chart::errstr = 
  2097.                     'NULL values not valid for COLORMAP fields.',
  2098.                 return undef
  2099.                     unless defined($p);
  2100. #
  2101. #    need to push this error on the param status list (if one exists)
  2102. #
  2103.                 next unless $i; # only proceed for RGB components
  2104.  
  2105.                 $DBD::Chart::err = -1,
  2106.                 $DBD::Chart::errstr = 
  2107.             "Invalid value for COLORMAP component field.",
  2108.                 return undef
  2109.                     if (($p!~/^\d+$/) || ($p > 255));
  2110.             }
  2111.         }
  2112.     }
  2113.  
  2114.     if ($cmd eq 'INSERT') {
  2115. #
  2116. #    apply any literals
  2117. #
  2118.         foreach $i (keys(%$setcols)) {
  2119.             $t = $$data[$i];
  2120.             my $v = $$setcols{$i};
  2121.             push(@$t, (($v) x $maxary));
  2122.         }
  2123. #
  2124. #    then apply the params
  2125. #
  2126.         $k = 1;
  2127.         for ($j = 0; $j < scalar(@$paramcols); $j++) {
  2128.             $i = $$paramcols[$j];
  2129.             $t = $$data[$i];
  2130.             $ttype = $$types[$i];
  2131.             for ($k = 0; $k < $maxary; $k++) {
  2132. #
  2133. #    merge input params and statement literals
  2134. #
  2135.                 $p = $$parms[$j];
  2136.                 $p = (($is_parmary) ? $$p[$k] : $$p) if ($is_parmref);
  2137.  
  2138.                 if (defined($p) &&
  2139.                     (($ttype == SQL_CHAR) || ($ttype == SQL_VARCHAR)) &&
  2140.                     (length($p) > $$precs[$i])) {
  2141. #
  2142. #    need to push this error on the param status list (if one exists)
  2143. #
  2144.                     $DBD::Chart::err = -1;
  2145.                     $DBD::Chart::errstr = 
  2146.                 "Supplied value truncated at parameter $j.";
  2147.  
  2148.                     $p = substr($p, 0, $$precs[$i]);
  2149.  
  2150.                     $$parmsts[$k] = 
  2151.                 "Supplied value truncated at parameter $j."
  2152.                         if ($parmsts && (ref $parmsts eq 'ARRAY'));
  2153.                     $$parmsts{$k} = 
  2154.                 "Supplied value truncated at parameter $j."
  2155.                         if ($parmsts && (ref $parmsts ne 'ARRAY'));
  2156.                 }
  2157.                 push(@$t, $p);
  2158.             }
  2159.         } # end foreach value
  2160.         return $k;
  2161.     }
  2162.     
  2163.     if ($cmd eq 'UPDATE') {
  2164. #
  2165. #    check predicate to determine row numbers to update
  2166. #
  2167.         if (! $predicate) {
  2168.             $DBD::Chart::err = -1,
  2169.             $DBD::Chart::errstr = 
  2170.             'Parameter arrays not allowed for unqualified UPDATE.',
  2171.             return undef
  2172.                 if ($is_parmary);
  2173. #
  2174. #    apply any literals
  2175. #
  2176.             foreach $i (keys(%$setcols)) {
  2177.                 $t = $$data[$i];
  2178.                 my $v = $$setcols{$i};
  2179.                 $j = scalar(@$t);
  2180.                 @$t = ($v) x $j;
  2181.             }
  2182. #
  2183. #    then apply params
  2184. #
  2185.             for ($j = 0; $j < scalar(@$paramcols); $j++) {
  2186.                 $i = $$paramcols[$j];
  2187.                 $t = $$data[$i];
  2188.                 $k = scalar(@$t);
  2189.                 $ttype = $$types[$i];
  2190.                 $p = $$parms[$j];
  2191.                 $p = $$p if ($is_parmref);
  2192.  
  2193.                 if (defined($p) &&
  2194.                     (($ttype == SQL_CHAR) || ($ttype == SQL_VARCHAR)) &&
  2195.                     (length($p) > $$precs[$i])) {
  2196. #
  2197. #    need to push this error on the param status list (if one exists)
  2198. #
  2199.                     $DBD::Chart::err = -1;
  2200.                     $DBD::Chart::errstr = 
  2201.                 "Supplied value truncated at parameter $j.";
  2202.  
  2203.                     $p = substr($p, 0, $$precs[$i]);
  2204.  
  2205.                     $$parmsts[$k] = 
  2206.                 "Supplied value truncated at parameter $j."
  2207.                         if ($parmsts && (ref $parmsts eq 'ARRAY'));
  2208.                     $$parmsts{$k} = 
  2209.                 "Supplied value truncated at parameter $j."
  2210.                         if ($parmsts && (ref $parmsts ne 'ARRAY'));
  2211.                 }
  2212.                 @$t = ($p) x $k;
  2213.             }
  2214.             return 1;
  2215.         } # end if no predicate
  2216. #
  2217. #    build ary of rownums based on predicate
  2218. #
  2219.         $predval = $$predicate[2];
  2220.         $DBD::Chart::err = -1,
  2221.         $DBD::Chart::errstr = 
  2222.             'Parameter arrays not allowed for literally qualified UPDATE.',
  2223.         return undef
  2224.             if (($predval ne '?') && ($is_parmary));
  2225.  
  2226.         my %rowmap = eval_predicate($$predicate[0], $$predicate[1], 
  2227.             $predval, $types, $data, $parms, $is_parmary, $is_parmref, 
  2228.             $maxary);
  2229.  
  2230.         return 0 unless scalar(%rowmap);
  2231. #
  2232. #    apply any literals
  2233. #
  2234.         my ($x, $y);
  2235.         foreach $i (keys(%$setcols)) {
  2236.             $t = $$data[$i];
  2237.             while (($x, $y) = each(%rowmap)) {
  2238.                 $$t[$x] = $$setcols{$i};
  2239.             }
  2240.         }
  2241. #
  2242. #    then apply params
  2243. #
  2244.         for ($j = 0; $j < scalar(@$paramcols); $j++) {
  2245.             $i = $$paramcols[$j];
  2246.             $t = $$data[$i];
  2247.             $ttype = $$types[$i];
  2248.             while (($x, $y) = each(%rowmap)) {
  2249.                 $p = $$parms[$j];
  2250.                 $p = (($is_parmary) ? $$p[$y] : $$p) if ($is_parmref);
  2251.                 if ((($ttype == SQL_CHAR) || ($ttype == SQL_VARCHAR) ||
  2252.                     ($ttype == SQL_BINARY) || ($ttype == SQL_VARBINARY)) &&
  2253.                     (length($p) > $$precs[$i])) {
  2254. #
  2255. #    need to push this error on the param status list (if one exists)
  2256. #
  2257.                     $DBD::Chart::err = -1;
  2258.                     $DBD::Chart::errstr = 
  2259.                     "Supplied value truncated at parameter $j.";
  2260.  
  2261.                     $p = substr($p, 0, $$precs[$i]);
  2262.                 }
  2263.                 $$t[$x] = $p;
  2264.             }
  2265.         }
  2266.         return scalar(keys(%rowmap));
  2267.     }
  2268.  
  2269.     if ($cmd eq 'DELETE') {
  2270.         if (! $predicate) {
  2271. #
  2272. #    apply any literals
  2273. #
  2274.             $k = scalar(@{$$data[0]});
  2275.             foreach $t (@$data) {
  2276.                 @$t = ();
  2277.             }
  2278.             return $k;
  2279.         } # end if no predicate
  2280. #
  2281. #    build ary of rownums based on predicate
  2282. #
  2283.         my %rowmap = eval_predicate($$predicate[0], $$predicate[1], 
  2284.             $$predicate[2], $types, $data, $parms, $is_parmary, 
  2285.             $is_parmref, $maxary);
  2286.  
  2287.         return 0 unless scalar(%rowmap);
  2288.  
  2289.         my @rownums = sort(keys(%rowmap));
  2290.         $j = scalar(@rownums);
  2291.         while ($k = pop(@rownums)) {
  2292.             for ($i = 0; $i < scalar(@$data); $i++) {
  2293.                 $t = $$data[$i];
  2294.                 splice(@$t, $k, 1);
  2295.             }
  2296.         }
  2297.         return $j;
  2298.     }
  2299. #
  2300. #    must be SELECT, so render the chart
  2301. #
  2302.     my $dtypes = $sth->{chart_charttypes};
  2303.     my $dcharts = $sth->{chart_sources};
  2304.     my $dprops = $sth->{chart_properties};
  2305.     my $dversions = $sth->{chart_version};
  2306.     my $dcols = $sth->{chart_columns};
  2307.     my $dnames = $sth->{chart_qnames};
  2308.     my $srcsth;
  2309.     my @dcolidxs = ();
  2310. #
  2311. #    if COLORMAP, just fetch and return
  2312. #
  2313.     if ($$dcharts[0] && ($$dcharts[0] eq 'COLORMAP')) {
  2314.         my $table = $DBD::Chart::charts{COLORMAP};
  2315.         my $col1 = $table->{data}->[0];
  2316.         if (defined($$props{NAME})) {
  2317. #
  2318. #    selecting single color, setup for the fetch
  2319. #
  2320.             if ($$props{NAME}=~/^\?(\d+)$/) {
  2321.                 my $phnum = $1;
  2322.  
  2323.                 $DBD::Chart::err = -1,
  2324.                 $DBD::Chart::errstr = 'Insufficient parameters provided.',
  2325.                 return undef
  2326.                     if ($phnum > scalar(@$parms));
  2327.  
  2328.                 $sth->{chart_colormap} = $$parms[$phnum];
  2329.             }
  2330.             else {
  2331.                 $sth->{chart_colormap} = $$props{NAME};
  2332.             }
  2333.             my $color;
  2334.             foreach $color (@$col1) {
  2335.                 last if ($color eq $sth->{chart_colormap});
  2336.             }
  2337.             return '0E0' if ($color ne $sth->{chart_colormap});
  2338.             $sth->{chart_1_color} = 1;
  2339.             return 1;
  2340.         }
  2341. #
  2342. #    selecting all colors
  2343. #
  2344.         delete $sth->{chart_1_color};
  2345.         $sth->{chart_colormap} = 0;
  2346.         return scalar @$col1;
  2347.     }
  2348.  
  2349.     for ($i = 0; $i <= $#$dcharts; $i++) {
  2350.         $name = $$dcharts[$i];
  2351.         next unless (($i > 0) || $name); # for composite images
  2352.         $srcsth = undef;
  2353.         if ($name!~/^\?(\d+)$/) {
  2354.             $chart = $DBD::Chart::charts{$name};
  2355.  
  2356.             $DBD::Chart::errstr = "Chart $name does not exist.",
  2357.             $DBD::Chart::err = -1,
  2358.             return undef
  2359.                 unless $chart;
  2360.  
  2361.             $DBD::Chart::errstr = 
  2362.             "Prepared version of $name differs from current version.",
  2363.             $DBD::Chart::err = -1,
  2364.             return undef
  2365.                 if ($$chart{version} != $$dversions{$name});
  2366.  
  2367.         }
  2368.         else {    # its a parameterized chartsource
  2369.             my $phn = $1;
  2370.  
  2371.             $DBD::Chart::err = -1,
  2372.             $DBD::Chart::errstr = 'Parameterized chartsource not provided.',
  2373.             return undef
  2374.                 unless $$parms[$phn];
  2375.  
  2376.             $srcsth = $$parms[$phn];
  2377.             $DBD::Chart::err = -1,
  2378.             $DBD::Chart::errstr = 
  2379.     'Parameterized chartsource value must be a prepared and executed DBI statement handle.',
  2380.             return undef
  2381.                 if ((ref $srcsth ne 'DBI::st') && (ref $srcsth ne 'DBIx::Chart::st'));
  2382.  
  2383.             my $ctype = $$dtypes[$i];
  2384.             $DBD::Chart::err = -1,
  2385.             $DBD::Chart::errstr = $ctype . ' chart requires at least ' .
  2386.                 $mincols{$ctype} . ' columns.',
  2387.             return undef
  2388.                 if ($srcsth->{NUM_OF_FIELDS} < $mincols{$ctype});
  2389.  
  2390.             $DBD::Chart::err = -1,
  2391.             $DBD::Chart::errstr = 
  2392.                 'CANDLESTICK chart requires 2N + 1 columns.',
  2393.             return undef
  2394.                 if (($ctype eq 'CANDLESTICK') && (! $$dprops[$i]->{STACK}) &&
  2395.                     (($srcsth->{NUM_OF_FIELDS} - 1) & 1));
  2396. #
  2397. #    collect and validate the column specification
  2398. #
  2399.             my $cols = $$dcols[$i];
  2400.             my $colidxs = [ ];
  2401.             $dcolidxs[$i] = $colidxs;
  2402.             @$colidxs = (0..($srcsth->{NUM_OF_FIELDS} - 1)),
  2403.             next 
  2404.                 if ($$cols[0] eq '*');
  2405.             
  2406.             my ($d, $idx);
  2407.             $columns = get_ext_type_info($sth, $srcsth, 'NAME', ($i ? $i-1 : 0) );
  2408.             foreach $d (0..$#$columns) {
  2409.                 $$columns[$d] = uc $$columns[$d] ;
  2410.             }
  2411.             foreach my $c (@$cols) {
  2412.                 foreach $d (0..$#$columns) {
  2413.                     $idx = $d,
  2414.                     last if ($c eq $$columns[$d]);
  2415.                 }
  2416.                 $DBD::Chart::err = -1,
  2417.                 $DBD::Chart::errstr = 'Column ' . $c . ' not found in datasource.',
  2418.                 return undef
  2419.                     unless ($c eq $$columns[$idx]);
  2420.                 push @$colidxs, $idx;
  2421.             }
  2422.         }
  2423.     }
  2424. #
  2425. #    now we can safely process and render
  2426. #
  2427.     my $img;
  2428.     my $xdomain;
  2429.     my $ydomain;
  2430.     my $zdomain;
  2431.     my @legends = ();
  2432. #
  2433. #    need to determine domain type prior to adding points
  2434.     my $is_symbolic = undef;
  2435.     for ($i = 0; $i < scalar(@$dtypes); $i++) {
  2436.         $is_symbolic = 1, last
  2437.             if (($$dtypes[$i] eq 'BARCHART') ||
  2438.                 ($$dtypes[$i] eq 'HISTOGRAM') ||
  2439.                 ($$dtypes[$i] eq 'CANDLESTICK'));
  2440.     }
  2441.  
  2442.     for ($i = 0; $i < scalar(@$dtypes); $i++) {
  2443.  
  2444.         if ($$dtypes[$i] ne 'IMAGE') {
  2445.             if ($$dcharts[$i]=~/^\?(\d+)$/) {
  2446. #
  2447. #    synthesize a chart structure from the stmt handle
  2448. #    NOTE: we should eventually support array binding here!!!
  2449. #
  2450.                 my $srcsth = $$parms[$1];
  2451.                 $columns = get_ext_type_info($sth, $srcsth, 'NAME', ($i ? $i-1 : 0) );
  2452.                 $types = get_ext_type_info($sth, $srcsth, 'TYPE', ($i ? $i-1 : 0));
  2453. #                $precs = get_ext_type_info($sth, $srcsth, 'PRECISION', $i-1);
  2454. #                $scales = get_ext_type_info($sth, $srcsth, 'SCALE', $i-1);
  2455.                 $DBD::Chart::err = -1,
  2456.                 $DBD::Chart::errstr = 
  2457.         'Datasource does not provide one of NAME or TYPE information.',
  2458.                 $srcsth->finish,
  2459.                 return undef
  2460.                     unless ($types || $columns);
  2461.  
  2462.                 $data = [];
  2463.                 my $rowcnt = 0;
  2464.                 my $row;
  2465.                 my $colidxs = $dcolidxs[$i];
  2466.  
  2467.                 push(@$data, [ ])
  2468.                     foreach (@$colidxs);
  2469.  
  2470.                 $row = $srcsth->fetchall_arrayref(undef, 10000);
  2471.                 foreach my $r (@$row) {
  2472.                     push(@{$$data[$_]}, $$r[$$colidxs[$_]])
  2473.                         foreach (0..$#$colidxs);
  2474.                 }
  2475.             }
  2476.             else {
  2477.                 $chart = $DBD::Chart::charts{$$dcharts[$i]};
  2478. #
  2479. #    get the record description
  2480. #
  2481.                 $columns = $$chart{columns};
  2482.                 $types = $$chart{types};
  2483.                 $precs = $$chart{precisions};
  2484.                 $scales = $$chart{scales};
  2485.                 $data = $$chart{data};
  2486.             }
  2487.         }
  2488.  
  2489.         $props = $$dprops[$i];
  2490. #
  2491. #    validate and copy in any placeholder values
  2492. #
  2493.         return undef unless validate_properties($props, $parms);
  2494.  
  2495.         if ($i == 0) {
  2496. #
  2497. #    create plot object
  2498. #
  2499.             $img = DBD::Chart::Plot->new($$props{WIDTH}, $$props{HEIGHT}, 
  2500.                 get_colormap());
  2501.             return undef unless $img;
  2502. #
  2503. #    set global properties
  2504. #
  2505.             $img->setOptions( bgColor => $$props{BACKGROUND},
  2506.                 textColor => $$props{TEXTCOLOR},
  2507.                 gridColor => $$props{GRIDCOLOR},
  2508.                 threed => $$props{THREE_D});
  2509.  
  2510.             $img->setOptions( title => $$props{TITLE})
  2511.                 if $$props{TITLE};
  2512.                 
  2513.             $img->setOptions( signature => $$props{SIGNATURE})
  2514.                 if $$props{SIGNATURE};
  2515.                 
  2516.             $img->setOptions( 
  2517.                 genMap => ($$props{MAPNAME}) ? $$props{MAPNAME} : 'plot', 
  2518.                 mapType => $sth->{chart_imagemap},
  2519.                 mapURL => $$props{MAPURL},
  2520.                 mapScript => $$props{MAPSCRIPT},
  2521.                 mapType => ($$props{MAPTYPE}) ? $$props{MAPTYPE} : 'HTML',
  2522.                 mapModifier => $sth->{chart_map_modifier},
  2523.                 border => $$props{BORDER}
  2524.             )
  2525.                 if $sth->{chart_imagemap};
  2526.  
  2527.             $img->setOptions( logo => $$props{LOGO}) if $$props{LOGO};
  2528.  
  2529.             $img->setOptions( 'xAxisLabel' => $$props{X_AXIS})
  2530.                 if $$props{X_AXIS};
  2531.             $img->setOptions( 'yAxisLabel' => $$props{Y_AXIS})
  2532.                 if $$props{Y_AXIS};
  2533.             $img->setOptions( 'zAxisLabel' => $$props{Z_AXIS})
  2534.                 if $$props{Z_AXIS};
  2535.             
  2536.             $img->setOptions( 'xAxisVert' => ($$props{X_ORIENT} eq 'VERTICAL'))
  2537.                 if $$props{X_ORIENT};
  2538.             
  2539.             $img->setOptions( 'horizGrid' => 1, 
  2540.                 'vertGrid' => ($$dtypes[$i] ne 'BARCHART'))
  2541.                 if $$props{SHOWGRID};
  2542.  
  2543.             $img->setOptions( 'xLog' => 1)
  2544.                 if $$props{X_LOG};
  2545.             
  2546.             $img->setOptions( 'yLog' => 1)
  2547.                 if $$props{Y_LOG};
  2548.             
  2549.             $img->setOptions( 'keepOrigin' => 1)
  2550.                 if $$props{KEEPORIGIN};
  2551.  
  2552.             $img->setOptions( 'font' => $$props{FONT})
  2553.                 if $$props{FONT};
  2554.         }
  2555.  
  2556.         next if ($$dtypes[$i] eq 'IMAGE');    # specific chart processing from here on
  2557. #
  2558. #    establish color list
  2559. #
  2560.         my @colors = ();
  2561.         my $clist = ($$props{COLOR}) ? $$props{COLOR} : \@dfltcolors;
  2562.         if ($$dtypes[$i] eq 'QUADTREE') {
  2563.             @colors = $$props{COLOR} ? @{$$props{COLOR}} : @quadcolors;
  2564.         }
  2565.         else {
  2566.             $t = ($$dtypes[$i] eq 'PIECHART') ? scalar @{$$data[0]} : scalar @$data;
  2567.             $t-- unless (($$dtypes[$i] eq 'BOXCHART') || # ($$dtypes[$i] eq 'HISTOGRAM') || 
  2568.                 ($$dtypes[$i] eq 'PIECHART'));
  2569.             $t /= 2 if ($$dtypes[$i] eq 'CANDLESTICK');
  2570.             $t = 1 if ($$props{Z_AXIS});
  2571.             $t = scalar @{$$data[0]}
  2572.                 if ((($$dtypes[$i] eq 'BARCHART') || ($$dtypes[$i] eq 'HISTOGRAM')) && 
  2573.                 (scalar @$clist > 1) && (scalar @$data == 2));
  2574.             for ($k = 0, $j = 0; $k < $t; $k++) {
  2575.                 push(@colors, $$clist[$j++]);
  2576.                 $j = 0 if ($j >= scalar(@$clist));
  2577.             }
  2578.         }
  2579.  
  2580.         my $propstr = '';
  2581. #
  2582. #    select domain type: numeric, symbolic, or temporal
  2583. #    and make sure every chart adheres to compatible types
  2584. #
  2585.         $DBD::Chart::err = -1,
  2586.         $DBD::Chart::errstr = 'Incompatible domain types for composite image.',
  2587.         return undef
  2588.             unless ((! $xdomain) || 
  2589.                 ($numtype{$xdomain} && $numtype{$$types[0]}) ||
  2590.                 ($timetype{$xdomain} && $timetype{$$types[0]} &&
  2591.                     ($timetype{$xdomain} eq $timetype{$$types[0]})) ||
  2592.                 ($symboltype{$xdomain} && $symboltype{$$types[0]}));
  2593.         $xdomain = $$types[0] unless $xdomain;
  2594.  
  2595.         $DBD::Chart::err = -1,
  2596.         $DBD::Chart::errstr = 'Incompatible range types for composite image.',
  2597.         return undef
  2598.             unless ((! $ydomain) || ($$dtypes[$i] eq 'BOXCHART') ||
  2599.                 ($numtype{$ydomain} && $numtype{$$types[1]}) ||
  2600.                 ($timetype{$ydomain} && $timetype{$$types[1]} &&
  2601.                     ($timetype{$ydomain} eq $timetype{$$types[1]})));
  2602.         $ydomain = $$types[1] 
  2603.             unless ($ydomain || ($$dtypes[$i] eq 'BOXCHART'));
  2604.  
  2605.         $DBD::Chart::err = -1,
  2606.         $DBD::Chart::errstr = 'Incompatible Z axis types for composite image.',
  2607.         return undef
  2608.             unless ((! $zdomain) || 
  2609.                 ($numtype{$zdomain} && $numtype{$$types[2]}) ||
  2610.                 ($timetype{$zdomain} && $timetype{$$types[2]} &&
  2611.                     ($timetype{$zdomain} eq $timetype{$$types[2]})) ||
  2612.                 ($symboltype{$zdomain} && $symboltype{$$types[2]}));
  2613.  
  2614.         $zdomain = $$types[2] if ((! $zdomain) && $$props{Z_AXIS});
  2615.         $img->setOptions( 'symDomain' => 1)
  2616.             if (($$dtypes[$i] ne 'GANTT') && ($$dtypes[$i] ne 'QUADTREE') && 
  2617.                 ($is_symbolic || $symboltype{$xdomain}));
  2618.         $img->setOptions( 'timeDomain' => $timetype{$xdomain})
  2619.             if (defined($xdomain) && $timetype{$xdomain});
  2620.         $img->setOptions( 'timeRange' => $timetype{$ydomain})
  2621.             if (defined($ydomain) && $timetype{$ydomain});
  2622. #
  2623. #    we need to support temporal Z-axis!!!
  2624. #
  2625. #    Piechart:
  2626. #    first data array is domain names, the 2nd is the 
  2627. #    datasets. If more than 1 dataset is supplied, the
  2628. #    rest are ignored
  2629. #
  2630.         if ($$dtypes[$i] eq 'PIECHART') {
  2631.             $propstr = 'pie ' . join(' ', @colors);
  2632.             $DBD::Chart::err = -1,
  2633.             $DBD::Chart::errstr = $img->{errmsg},
  2634.             return undef 
  2635.                 unless $img->setPoints($$data[0], $$data[1], $propstr);
  2636.             next;
  2637.         }
  2638. #
  2639. #    Quadtree:
  2640. #    1st N-2 data arrays are categories, in a category hierarchy, 
  2641. #    data array N-1 is the values assigned to the individual items,
  2642. #    data array N is the intensity values of individual items
  2643. #
  2644.         if ($$dtypes[$i] eq 'QUADTREE') {
  2645.             $propstr = 'quadtree ' . join(' ', @colors);
  2646.             $DBD::Chart::err = -1,
  2647.             $DBD::Chart::errstr = $img->{errmsg},
  2648.             return undef
  2649.                 unless $img->setPoints(@$data, $propstr);
  2650.             next;
  2651.         }
  2652. #
  2653. #    Gantt chart:
  2654. #    first data array is task names, 2nd is the start date,
  2655. #    3rd is end date. Add'l optionals are assignee, pct. complete,
  2656. #    and any number of dependent tasks
  2657. #
  2658.         if ($$dtypes[$i] eq 'GANTT') {
  2659.             $propstr = "gantt $colors[0]";
  2660.             $DBD::Chart::err = -1,
  2661.             $DBD::Chart::errstr = $img->{errmsg},
  2662.             return undef 
  2663.                 unless $img->setPoints(@$data, $propstr);
  2664.             next;
  2665.         }
  2666. #
  2667. #    need column names in defined order
  2668. #
  2669.         my @colnames = ();
  2670.         if (! $srcsth) {
  2671.             $colnames[$$columns{$_}] = $_
  2672.                 foreach (keys(%$columns));
  2673.         }
  2674.         else { 
  2675.             @colnames = @$columns;
  2676.         }
  2677.         shift @colnames unless ($$dtypes[$i] eq 'BOXCHART');
  2678.  
  2679.         $propstr .= ' showvalues:' . (($$props{SHOWVALUES} == 1) ? 5 : $$props{SHOWVALUES}) . ' '
  2680.             if ($$props{SHOWVALUES});
  2681.         $propstr .= ' stack '
  2682.             if ($$props{STACK});
  2683. #
  2684. #    default x-axis label orientation is vertical for candlesticks
  2685. #    and symbollic domains
  2686. #
  2687.         $img->setOptions( 'xAxisVert' => ($$props{X_ORIENT} ne 'HORIZONTAL'))
  2688.             if ((! $numtype{$$types[0]}) || ($$dtypes[$i] eq 'CANDLESTICK'));
  2689. #
  2690. #    force a legend if more than 1 range or plot
  2691. #    complicated algorithm here;
  2692. #        if multirange or composite {
  2693. #            if multirange {
  2694. #                push each column name onto legends array, prepended with
  2695. #                    current query name if available
  2696. #            }
  2697. #        } else { must be a composite
  2698. #            push query name (default PLOTn) onto legends array
  2699. #        }
  2700. #
  2701.         if (! $$props{Z_AXIS}) {
  2702.             if ((($$dtypes[$i] ne 'CANDLESTICK') && (scalar(@$data) > 2)) || 
  2703.                 (($$dtypes[$i] eq 'BOXCHART') && (scalar(@$data) > 1)) ||
  2704.                 (scalar(@$data) > 3)) {
  2705. #    its multirange
  2706.                 my $incr = ($$dtypes[$i] ne 'CANDLESTICK') ? 1 : 2;
  2707. #    if stacked, we need an arrayref of legends
  2708.                 my $legary = ($$props{STACK}) ? [ ] : \@legends;
  2709.                 push(@legends, $legary) if ($$props{STACK});
  2710.                 for (my $c = 0; $c <= $#colnames; $c += $incr) {
  2711. #
  2712. #    if floating bar/histo, ignore last column name
  2713.                     last if ((! $$props{ANCHORED}) && ($c == $#colnames) &&
  2714.                         (($$dtypes[$i] eq 'BARCHART') ||
  2715.                         ($$dtypes[$i] eq 'HISTOGRAM')));
  2716. #
  2717. #    prepend query names if provided for composites
  2718.                     push(@$legary, ($$dnames[$i] . '.' . $colnames[$c])),
  2719.                     next
  2720.                         if ($$dnames[$i]);
  2721.                     push(@$legary, $colnames[$c]);
  2722.                 }
  2723.             }
  2724.             elsif ($#$dtypes > 1) {
  2725. #
  2726. #    single range, composite
  2727.                 push(@legends, ($$dnames[$i] ? $$dnames[$i] : "PLOT$i"));
  2728.             }
  2729.         }
  2730. #
  2731. #    establish icon list if any
  2732. #
  2733.         my @icons = ();
  2734.         my $iconlist = $$props{ICON};
  2735.         if ($$props{ICON}) {
  2736.             for ($k = 1, $j = 0; $k <= $#$data; $k++) {
  2737.                 push(@icons, $$iconlist[$j++]);
  2738.                 $j = 0 if ($j > $#$iconlist);
  2739.             }
  2740.             $img->setOptions( icons => \@icons );
  2741.         }
  2742.  
  2743.         if (($$dtypes[$i] eq 'BARCHART') ||
  2744.             ($$dtypes[$i] eq 'HISTOGRAM')) {
  2745. #
  2746. #    first data array is domain names, the rest are
  2747. #    datasets. If more than 1 dataset is supplied, then
  2748. #    bars are grouped
  2749. #
  2750.             $propstr .= ($$dtypes[$i] eq 'HISTOGRAM') ? 'histo ' : 'bar ';
  2751.             if ($$props{Z_AXIS}) {
  2752.                 $DBD::Chart::err = -1,
  2753.                 $DBD::Chart::errstr = $img->{errmsg},
  2754.                 return undef
  2755.                     unless $img->setPoints($$data[0], $$data[1], $$data[2], 
  2756.                         $propstr . $colors[0]),
  2757.                 next;
  2758.             }
  2759. #
  2760. #    if single domain and multiple colors, then push all colors into
  2761. #    the property string
  2762.             $propstr.= ' float' unless $$props{ANCHORED};
  2763.             if (($#$data == 1) && (! $$props{ICON})) {
  2764.                 $DBD::Chart::err = -1,
  2765.                 $DBD::Chart::errstr = $img->{errmsg},
  2766.                 return undef
  2767.                     unless $img->setPoints($$data[0], $$data[1],
  2768.                         $propstr . ' ' . join(' ', @colors)),
  2769.                 next;
  2770.             }
  2771. #
  2772. #    if stacked, send all the data at the same time
  2773. #
  2774.             if ($$props{STACK}) {
  2775.                 $propstr .= ' ' . ($$props{ICON} ? 'icon:' . join(' icon:', @icons) : join(' ', @colors));
  2776.                 $DBD::Chart::err = -1,
  2777.                 $DBD::Chart::errstr = $img->{errmsg},
  2778.                 return undef
  2779.                     unless $img->setPoints(@$data, $propstr);
  2780.                 next;
  2781.             }
  2782.  
  2783.             for ($i=1; $i <= $#$data; $i++) {
  2784.                 $DBD::Chart::err = -1,
  2785.                 $DBD::Chart::errstr = $img->{errmsg},
  2786.                 return undef
  2787.                     unless $img->setPoints($$data[0], $$data[$i],
  2788.                         $propstr . ($$props{ICON} ? 'icon:' . $icons[$i-1] : $colors[$i-1]));
  2789.             }
  2790.             next;
  2791.         }
  2792. #
  2793. #    establish shape list, and merge with icon list if needed
  2794. #
  2795.         my @shapes = ();
  2796.         my $shapelist = ($$props{SHAPE}) ? $$props{SHAPE} : 
  2797.             [ 'fillcircle' ];
  2798.         $$props{SHOWPOINTS} = 1 if $$props{SHAPE};
  2799.         for ($k = 1, $j = 0, my $n = 0; $k <= $#$data; $k++) {
  2800.             push(@shapes, ($$shapelist[$j] eq 'icon') ? 'icon:' . $$iconlist[$n++] : $$shapelist[$j]);
  2801.             $n = 0 if ($n > $#$iconlist);
  2802.             $j++;
  2803.             $j = 0 if ($j > $#$shapelist);
  2804.         }
  2805.  
  2806.         if ($$dtypes[$i] eq 'CANDLESTICK') {
  2807. #
  2808. #    first data array is domain symbols, the rest are
  2809. #    datasets, consisting of 2-tuples (y-min, y-max).
  2810. #    If more than 1 dataset is supplied, then sticks are grouped
  2811. #
  2812.             if ($$props{STACK}) {
  2813.                 $propstr .= ' candle ' . join(' ', @colors);
  2814.                 $propstr .= ' ' . $shapes[0]
  2815.                     if ($$props{SHOWPOINTS});
  2816.                 $propstr .= ' width:' . ($$props{LINEWIDTH} ? $$props{LINEWIDTH} : 2);
  2817.                 $DBD::Chart::err = -1,
  2818.                 $DBD::Chart::errstr = $img->{errmsg},
  2819.                 return undef
  2820.                     unless $img->setPoints(@$data, $propstr);
  2821.                 next;
  2822.             }
  2823.             for (my $n = 0, $k = 1; $k <= $#$data; $k += 2, $n++) {
  2824.                 $propstr .= ' candle ' . $colors[$n];
  2825.                 $propstr .= ' ' . $shapes[$n]
  2826.                     if ($$props{SHOWPOINTS});
  2827.                 $DBD::Chart::err = -1,
  2828.                 $DBD::Chart::errstr = $img->{errmsg},
  2829.                 return undef
  2830.                     unless $img->setPoints($$data[0], $$data[$k], $$data[$k+1], $propstr);
  2831.             }
  2832.             next;
  2833.         }
  2834.  
  2835.         if ($$dtypes[$i] eq 'BOXCHART') {
  2836. #
  2837. #    each data array is a distinct domain to be plotted
  2838. #
  2839.             for (my $n = 0, $k = 0; $k <= $#$data; $k++, $n++) {
  2840.                 $propstr .= ' box ' . $colors[$n];
  2841.                 $propstr .= ' ' . $shapes[$n]
  2842.                     if ($$props{SHOWPOINTS});
  2843.                 $DBD::Chart::err = -1,
  2844.                 $DBD::Chart::errstr = $img->{errmsg},
  2845.                 return undef
  2846.                     unless $img->setPoints($$data[$k], $propstr);
  2847.             }
  2848.             next;
  2849.         }
  2850. #
  2851. #    line, point, or area graph
  2852. #
  2853.         $img->setOptions( lineWidth => ($$props{LINEWIDTH} ? $$props{LINEWIDTH} : 1));
  2854.         if (($$dtypes[$i] eq 'AREAGRAPH') && ($$props{STACK})) {
  2855.             $propstr .= ' fill ' . join(' ', @colors) ;
  2856.             $propstr .= ' ' . join(' ', @shapes) 
  2857.                 if ($$props{SHOWPOINTS} || $$props{SHAPE});
  2858.             $propstr .= ' float' unless $$props{ANCHORED};
  2859.             $DBD::Chart::err = -1,
  2860.             $DBD::Chart::errstr = $img->{errmsg},
  2861.             return undef
  2862.                 unless $img->setPoints(@$data, $propstr);
  2863.             next;
  2864.         }
  2865.         for ($k = 1; $k <= $#$data; $k++) {
  2866.             my $tprops = $propstr . ' ';
  2867.             $tprops .= ($$dtypes[$i] eq 'POINTGRAPH') ?
  2868.                 'noline ' . $colors[$k-1] . ' ' . $shapes[$k-1] :
  2869.                 ($$dtypes[$i] eq 'LINEGRAPH') ? 
  2870.                     $colors[$k-1] :
  2871.                     'fill ' . $colors[$k-1] ;
  2872.             $tprops .= ' ' . $shapes[$k-1] 
  2873.                 if ($$props{SHOWPOINTS} || $$props{SHAPE});
  2874.             $tprops .= ' width:' . ($$props{LINEWIDTH} ? $$props{LINEWIDTH} : 1);
  2875.             $tprops .= ' float' unless $$props{ANCHORED};
  2876.             $DBD::Chart::err = -1,
  2877.             $DBD::Chart::errstr = $img->{errmsg},
  2878.             return undef
  2879.                 unless $img->setPoints($$data[0], $$data[$k], $tprops);
  2880.         }
  2881.     }
  2882. #
  2883. #    if we have a legend, add it before plotting
  2884.     $img->setOptions( legend => \@legends)
  2885.         if ($#legends >= 0);
  2886. #
  2887. #    all the image data loaded, now plot it
  2888. #
  2889.     $sth->{chart_image} = $img->plot($dprops->[0]->{FORMAT});
  2890.  
  2891.     $DBD::Chart::err = -1,
  2892.     $DBD::Chart::errstr = $img->{errmsg},
  2893.     return undef
  2894.         unless $sth->{chart_image};
  2895.  
  2896.     $sth->{chart_imagemap} = 
  2897.         ($sth->{chart_imagemap}) ? $img->getMap() : undef;
  2898.  
  2899.     $DBD::Chart::err = -1,
  2900.     $DBD::Chart::errstr = $img->{errmsg},
  2901.     return undef
  2902.         unless $sth->{chart_image};
  2903. #
  2904. #    update precision values
  2905.     $precs = $sth->{PRECISION};
  2906.     $$precs[0] = length($sth->{chart_image});
  2907.     $$precs[1] = length($sth->{chart_imagemap}) if $sth->{chart_imagemap};
  2908.     return 1;
  2909. }
  2910.  
  2911. sub convert_time {
  2912.     my ($value, $type) = @_;
  2913. #
  2914. #    use Perl funcs to compute seconds from date
  2915.     return timegm(0, 0, 0, $3, $2 - 1, $1)
  2916.         if (($type == SQL_DATE) &&
  2917.             ($value=~/^(\d+)[\-\.\/](\d+)[\-\.\/](\d+)$/));
  2918.  
  2919.     return timegm(0, 0, 0, $3, $month{uc $2}, $1)
  2920.         if (($type == SQL_DATE) &&
  2921.             ($value=~/^(\d+)[\-\.\/](\w+)[\-\.\/](\d+)$/));
  2922.  
  2923.     return timegm($6, $5, $4, $3, $2 - 1, $1) + ($7 ? $7 : 0)
  2924.         if (($type == SQL_TIMESTAMP) &&
  2925.             ($value=~/^(\d+)[\-\.\/](\d+)[\-\.\/](\d+)\s+(\d+):(\d+):(\d+)(\.\d+)?$/));
  2926.  
  2927.     return timegm($6, $5, $4, $3, $month{uc $2}, $1) + ($7 ? $7 : 0)
  2928.         if (($type == SQL_TIMESTAMP) &&
  2929.             ($value=~/^(\d+)[\-\.\/](\w+)[\-\.\/](\d+)\s+(\d+):(\d+):(\d+)(\.\d+)?$/));
  2930.  
  2931.     return (($1 ? (($1 eq '-') ? -1 : 1) : 1) * 
  2932.         (($3 ? ($3 * 3600) : 0) + ($5 ? ($5 * 60) : 0) + $6 + ($7 ? $7 : 0)))
  2933.         if ((($type == SQL_INTERVAL_HR2SEC) || ($type == SQL_TIME)) && 
  2934.             ($value=~/^([\-\+])?((\d+):)?((\d+):)?(\d+)(\.\d+)?$/));
  2935.  
  2936.     return undef; # for completeness, shouldn't get here
  2937. }
  2938.  
  2939. sub test_predicate {
  2940.     my ($rowmap, $pctype, $pc, $predop, $predval, $rownum) = @_;
  2941.     for (my $i = 0; $i <= $#$pc; $i++) {
  2942.         $$rowmap{$i} = -1, next
  2943.             if ((($pctype == SQL_CHAR) || ($pctype == SQL_VARCHAR)) &&
  2944.                 (eval "\'$$pc[$i]\' $strpredops{$predop} \'$predval\'"));
  2945.  
  2946.         $$rowmap{$i} = -1, next
  2947.             if (($numtype{$pctype}) &&
  2948.                 (eval "$$pc[$i] $numpredops{$predop} $predval"));
  2949.  
  2950.         if ($timetype{$pctype}) {
  2951.             my ($col, $operand) = (convert_time($$pc[$i], $pctype), convert_time($predval, $pctype));
  2952.             $$rowmap{$i} = -1
  2953.                 if (eval "$col $numpredops{$predop} $operand");
  2954.         }
  2955.     }
  2956.     return 1;
  2957. }
  2958.  
  2959. sub eval_predicate {
  2960.     my ($predcol, $predop, $predval, $types, $data, $parms, $is_ary, 
  2961.         $is_ref, $maxary) = @_;
  2962.     my %rowmap = ();
  2963.     my $pc = $$data[$predcol];
  2964.     my $pctype = $$types[$predcol];
  2965.     my ($k, $p);
  2966.     
  2967.     $predval=~s/^'(.+)'$/$1/,    # trim any quotes
  2968.     test_predicate(\%rowmap, $pctype, $pc, $predop, $predval, -1),
  2969.     return %rowmap
  2970.         if ($predval ne '?');
  2971. #
  2972. #    must be parameterized predicate
  2973. #
  2974.     my $parmnum = $#$parms;
  2975.     for ($k = 0; $k < $maxary; $k++) {
  2976.         $p = $$parms[$parmnum];
  2977.         $p = (($is_ary) ? $$p[$k] : $$p) if ($is_ref);
  2978.         test_predicate(\%rowmap, $pctype, $pc, $predop, $p, $k);
  2979.     }
  2980.     return %rowmap;
  2981. }
  2982.  
  2983.  
  2984. sub fetch {
  2985.     my($sth) = @_;
  2986.  
  2987.     if ($sth->{chart_colormap}) {
  2988.         my $i = uc $sth->{chart_colormap};
  2989.         my $table = $DBD::Chart::charts{COLORMAP};
  2990.         my $ary = $table->{data};
  2991.         my ($col1, $col2, $col3, $col4) = ($$ary[0], $$ary[1], $$ary[2], $$ary[3]) ;
  2992.         if ($sth->{chart_1_color}) {
  2993.             my $color;
  2994.             foreach $color (@$col1) {
  2995.                 last if ($i eq uc $color);
  2996.             }
  2997.             return '0E0' if ($i ne uc $color);
  2998.             $sth->{chart_colormap} = undef;
  2999.         }
  3000.  
  3001.         my @row = ($$col1[$i], $$col2[$i], $$col3[$i], $$col4[$i]);
  3002.         $sth->{chart_colormap}++;
  3003.         return $sth->_set_fbav(\@row);
  3004.     }
  3005.     my $buf = $sth->{chart_image};
  3006.     return 0 if (! $buf);
  3007.     my @row = ($buf);
  3008.     push(@row, $sth->{chart_imagemap})
  3009.         if ($sth->{NUM_OF_FIELDS} > 1);
  3010.     return $sth->_set_fbav(\@row);
  3011. }
  3012.  
  3013. sub finish {
  3014.     my($sth) = @_;
  3015. }
  3016.  
  3017. sub bind_param {
  3018.     my ($sth, $pNum, $val, $attr) = @_;
  3019. #
  3020. #    data type for placeholders is taken from field definitions
  3021. #
  3022.     $DBD::Chart::err = -1,
  3023.     $DBD::Chart::errstr = 'Statement does not contain placeholders.',
  3024.     return undef
  3025.         unless $sth->{NUM_OF_PARAMS};
  3026.  
  3027.     my $params = $sth->{chart_params};
  3028.     $params = [ ],
  3029.     $sth->{chart_params} = $params
  3030.         unless defined($params);
  3031.     
  3032.     $$params[$pNum-1] = $val;
  3033.     1;
  3034. }
  3035. *chart_bind_param_array = \&bind_param;
  3036. *bind_param_array = \&bind_param;
  3037.  
  3038. sub chart_bind_param_status {
  3039.     my ($sth, $stsary) = @_;
  3040.     $DBD::Chart::err = -1,
  3041.     $DBD::Chart::errstr = 
  3042.         'bind_param_status () requires arrayref or hashref parameter.',
  3043.     return undef
  3044.         if ((ref $stsary ne 'ARRAY') && (ref $stsary ne 'HASH'));
  3045.  
  3046.     $sth->{chart_paramsts} = $stsary;
  3047.     return 1;
  3048. }
  3049. *bind_param_status = \&chart_bind_param_status;
  3050.  
  3051. sub bind_param_inout {
  3052.     my ($sth, $pNum, $val, $maxlen, $attr) = @_;
  3053. #
  3054. #    what do I need maxlen for ???
  3055. #
  3056.     return bind_param($sth, $pNum, $val, $attr);
  3057. }
  3058. #
  3059. #    get externally provided name/type/prec/scale info
  3060. #
  3061. sub get_ext_type_info {
  3062.     my ($sth, $srcsth, $item, $entry) = @_;
  3063.  
  3064.     my $t;
  3065. #
  3066. #    if srcsth provides it, use it
  3067. #
  3068.     return $srcsth->{$item}
  3069.         if eval { $t = $srcsth->{$item}; };
  3070. #
  3071. #    if chart type map, and requested item
  3072. #    exists in the type map, return it
  3073. #
  3074.     return undef
  3075.         unless (ref $sth->{chart_type_map} &&
  3076.             (ref $sth->{chart_type_map} eq 'ARRAY') &&
  3077.             $sth->{chart_type_map}->[$entry] &&
  3078.             ref $sth->{chart_type_map}->[$entry] &&
  3079.                 (($entry == 0) && 
  3080.                 ((ref $sth->{chart_type_map}->[$entry] eq 'HASH') &&
  3081.                 $sth->{chart_type_map}->[$entry]->{$item}) ||
  3082.             ((ref $sth->{chart_type_map}->[$entry] eq 'ARRAY') &&
  3083.             $sth->{chart_type_map}->[$entry]->[0]->{$item})));
  3084. #
  3085. #    if its single src form, collect the items into an arrayref
  3086. #
  3087.     my $srcary = (($entry == 0) && (ref $sth->{chart_type_map}->[$entry] eq 'HASH')) ?
  3088.         $sth->{chart_type_map} : $sth->{chart_type_map}->[$entry];
  3089.     my @outary = ();
  3090.     push @outary, $_->{$item}
  3091.         foreach (@$srcary);
  3092.     return \@outary;
  3093. }
  3094.  
  3095. sub STORE {
  3096.     my ($sth, $attr, $val) = @_;
  3097.     return $sth->SUPER::STORE($attr, $val) unless ($attr=~/^chart_/) ;
  3098.     $sth->{$attr} = $val;
  3099.     return 1;
  3100. }
  3101.  
  3102. sub FETCH {
  3103.     my($sth, $attr) = @_;
  3104.     return $sth->{$attr} if ($attr =~ /^chart_/);
  3105.     return $sth->SUPER::FETCH($attr);
  3106. }
  3107.  
  3108. sub DESTROY { undef }
  3109.  
  3110. 1;
  3111. }
  3112.     __END__
  3113.  
  3114. =head1 NAME
  3115.  
  3116. DBD::Chart - DBI driver abstraction for Rendering Charts and Graphs
  3117.  
  3118. =head1 SYNOPSIS
  3119.  
  3120.     $dbh = DBI->connect('dbi:Chart:')
  3121.         or die "Cannot connect: " . $DBI::errstr;
  3122.     #
  3123.     #    create file if it deosn't exist, otherwise, just open
  3124.     #
  3125.     $dbh->do('CREATE TABLE mychart (name CHAR(10), ID INTEGER, value FLOAT)')
  3126.         or die $dbh->errstr;
  3127.  
  3128.     #    add data to be plotted
  3129.     $sth = $dbh->prepare('INSERT INTO mychart VALUES (?, ?, ?)');
  3130.     $sth->bind_param(1, 'Values');
  3131.     $sth->bind_param(2, 45);
  3132.     $sth->bind_param(3, 12345.23);
  3133.     $sth->execute or die 'Cannot execute: ' . $sth->errstr;
  3134.  
  3135.     #    and render it
  3136.     $sth = $dbh->prepare('SELECT BARCHART FROM mychart');
  3137.     $sth->execute or die 'Cannot execute: ' . $sth->errstr;
  3138.     @row = $sth->fetchrow_array;
  3139.     print $row[0];
  3140.  
  3141.     # delete the chart
  3142.     $sth = $dbh->prepare('DROP TABLE mychart')
  3143.         or die "Cannot prepare: " . $dbh->errstr;
  3144.     $sth->execute or die 'Cannot execute: ' . $sth->errstr;
  3145.  
  3146.     $dbh->disconnect;
  3147.  
  3148. =head1 WARNING
  3149.  
  3150. THIS IS BETA SOFTWARE.
  3151.  
  3152. =head1 DESCRIPTION
  3153.  
  3154. The DBD::Chart provides a DBI abstraction for rendering pie charts,
  3155. bar charts, box&whisker charts (aka boxcharts), histograms,
  3156. Gantt charts, and line, point, and area graphs.
  3157.  
  3158. For detailed usage information, see the included L<dbdchart.html>
  3159. webpage.
  3160. See L<DBI(3)> for details on DBI.
  3161.  
  3162. =head2 Prerequisites
  3163.  
  3164. =over 4
  3165.  
  3166. =item Perl 5.6.0 minimum
  3167.  
  3168. =item DBI 1.14 minimum
  3169.  
  3170. =item DBD::Chart::Plot 0.80 (included with this package)
  3171.  
  3172. =item GD X.XX minimum
  3173.  
  3174. =item GD::Text X.XX minimum
  3175.  
  3176. =item Time::HiRes
  3177.  
  3178. =item libpng
  3179.  
  3180. =item zlib
  3181.  
  3182. =item libgd
  3183.  
  3184. =item jpeg-6b
  3185.  
  3186. =back
  3187.  
  3188.  
  3189. =head2 Installation
  3190.  
  3191. For Windows users, use WinZip or similar to unpack the file, then copy
  3192. Chart.pm to wherever your site-specific modules are kept (usually
  3193. \Perl\site\lib\DBD for ActiveState Perl installations). Also create a
  3194. 'Chart' directory in the DBD directory, and copy the Plot.pm module
  3195. to the new directory.
  3196. Note that you won't be able to execute the install test with this, but you need
  3197. a copy of 'nmake' and all its libraries to run that anyway. I may
  3198. whip up a PPM in the future.
  3199.  
  3200. For Unix, extract it with
  3201.  
  3202.     gzip -cd DBD-Chart-0.80.tar.gz | tar xf -
  3203.  
  3204. and then enter the following:
  3205.  
  3206.     cd DBD-Chart-0.80
  3207.     perl Makefile.PL
  3208.     make
  3209.  
  3210. You can test the installation by running
  3211.  
  3212.     make test
  3213.  
  3214. this will render a bunch of charts and an HTML page to view
  3215. them with. Assuming the test completes successfully, you should
  3216. use a web browser to view the file t/plottest.html and verify
  3217. the images look reasonable.
  3218.  
  3219. If tests succeed, proceed with installation via 
  3220.  
  3221.     make install
  3222.  
  3223. Note that you probably need root or administrator permissions.
  3224. If you don't have them, read the ExtUtils::MakeMaker man page for details
  3225. on installing in your own directories. L<ExtUtils::MakeMaker>.
  3226.  
  3227. =head1 FOR MORE INFO
  3228.  
  3229. Check out http://www.presicient.com/dbdchart with your
  3230. favorite browser.  It includes all the usage information.
  3231.  
  3232. =head1 AUTHOR AND COPYRIGHT
  3233.  
  3234. This module is Copyright (C) 2001, 2002 by Presicient Corporation
  3235.  
  3236.     Email: darnold@presicient.com
  3237.  
  3238. You may distribute this module under the terms of the Artistic
  3239. License, as specified in the Perl README file.
  3240.  
  3241. =head1 SEE ALSO
  3242.  
  3243. L<DBI(3)>
  3244.  
  3245. For help on the use of DBD::Chart, see the DBI users mailing list:
  3246.  
  3247.   dbi-users-subscribe@perl.org
  3248.  
  3249. For general information on DBI see
  3250.  
  3251.   http://dbi.perl.org
  3252.  
  3253. =cut
  3254.