This file is indexed.

/usr/share/perl5/SQL/Statement/Functions.pm is in libsql-statement-perl 1.405-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

   1
   2
   3
   4
   5
   6
   7
   8
   9
  10
  11
  12
  13
  14
  15
  16
  17
  18
  19
  20
  21
  22
  23
  24
  25
  26
  27
  28
  29
  30
  31
  32
  33
  34
  35
  36
  37
  38
  39
  40
  41
  42
  43
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195
 196
 197
 198
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 210
 211
 212
 213
 214
 215
 216
 217
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275
 276
 277
 278
 279
 280
 281
 282
 283
 284
 285
 286
 287
 288
 289
 290
 291
 292
 293
 294
 295
 296
 297
 298
 299
 300
 301
 302
 303
 304
 305
 306
 307
 308
 309
 310
 311
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322
 323
 324
 325
 326
 327
 328
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338
 339
 340
 341
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356
 357
 358
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375
 376
 377
 378
 379
 380
 381
 382
 383
 384
 385
 386
 387
 388
 389
 390
 391
 392
 393
 394
 395
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407
 408
 409
 410
 411
 412
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434
 435
 436
 437
 438
 439
 440
 441
 442
 443
 444
 445
 446
 447
 448
 449
 450
 451
 452
 453
 454
 455
 456
 457
 458
 459
 460
 461
 462
 463
 464
 465
 466
 467
 468
 469
 470
 471
 472
 473
 474
 475
 476
 477
 478
 479
 480
 481
 482
 483
 484
 485
 486
 487
 488
 489
 490
 491
 492
 493
 494
 495
 496
 497
 498
 499
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515
 516
 517
 518
 519
 520
 521
 522
 523
 524
 525
 526
 527
 528
 529
 530
 531
 532
 533
 534
 535
 536
 537
 538
 539
 540
 541
 542
 543
 544
 545
 546
 547
 548
 549
 550
 551
 552
 553
 554
 555
 556
 557
 558
 559
 560
 561
 562
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584
 585
 586
 587
 588
 589
 590
 591
 592
 593
 594
 595
 596
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616
 617
 618
 619
 620
 621
 622
 623
 624
 625
 626
 627
 628
 629
 630
 631
 632
 633
 634
 635
 636
 637
 638
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655
 656
 657
 658
 659
 660
 661
 662
 663
 664
 665
 666
 667
 668
 669
 670
 671
 672
 673
 674
 675
 676
 677
 678
 679
 680
 681
 682
 683
 684
 685
 686
 687
 688
 689
 690
 691
 692
 693
 694
 695
 696
 697
 698
 699
 700
 701
 702
 703
 704
 705
 706
 707
 708
 709
 710
 711
 712
 713
 714
 715
 716
 717
 718
 719
 720
 721
 722
 723
 724
 725
 726
 727
 728
 729
 730
 731
 732
 733
 734
 735
 736
 737
 738
 739
 740
 741
 742
 743
 744
 745
 746
 747
 748
 749
 750
 751
 752
 753
 754
 755
 756
 757
 758
 759
 760
 761
 762
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 840
 841
 842
 843
 844
 845
 846
 847
 848
 849
 850
 851
 852
 853
 854
 855
 856
 857
 858
 859
 860
 861
 862
 863
 864
 865
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 902
 903
 904
 905
 906
 907
 908
 909
 910
 911
 912
 913
 914
 915
 916
 917
 918
 919
 920
 921
 922
 923
 924
 925
 926
 927
 928
 929
 930
 931
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
##################################
package SQL::Statement::Functions;
##################################

use strict;
use warnings;
# no warnings 'uninitialized';  # please don't bother me with these useless warnings...

use Params::Util qw(_ARRAY0 _HASH0 _INSTANCE);
use Scalar::Util qw(looks_like_number);
use List::Util qw(max);      # core module since Perl 5.8.0
use Time::HiRes qw(time);    # core module since Perl 5.7.2
use Encode;                  # core module since Perl 5.7.1
use Math::Trig;              # core module since Perl 5.004
use Math::BigInt             # core modules since forever
  upgrade => 'Math::BigFloat';
use Math::BigFloat;

=pod

=head1 NAME

SQL::Statement::Functions - built-in & user-defined SQL functions

=head1 SYNOPSIS

 SELECT Func(args);
 SELECT * FROM Func(args);
 SELECT * FROM x WHERE Funcs(args);
 SELECT * FROM x WHERE y < Funcs(args);

=head1 DESCRIPTION

This module contains the built-in functions for L<SQL::Parser> and L<SQL::Statement>.  All of the functions are also available in any DBDs that subclass those modules (e.g. DBD::CSV, DBD::DBM, DBD::File, DBD::AnyData, DBD::Excel, etc.).

This documentation covers built-in functions and also explains how to create your own functions to supplement the built-in ones.  It's easy.  If you create one that is generally useful, see below for how to submit it to become a built-in function.

=head1 Function syntax

When using L<SQL::Statement>/L<SQL::Parser> directly to parse SQL, functions (either built-in or user-defined) may occur anywhere in a SQL statement that values, column names, table names, or predicates may occur.  When using the modules through a DBD or in any other context in which the SQL is both parsed and executed, functions can occur in the same places except that they can not occur in the column selection clause of a SELECT statement that contains a FROM clause.

 # valid for both parsing and executing

     SELECT MyFunc(args);
     SELECT * FROM MyFunc(args);
     SELECT * FROM x WHERE MyFuncs(args);
     SELECT * FROM x WHERE y < MyFuncs(args);

 # valid only for parsing (won't work from a DBD)

     SELECT MyFunc(args) FROM x WHERE y;

=head1 User-Defined Functions

=head2 Loading User-Defined Functions

In addition to the built-in functions, you can create any number of your own user-defined functions (UDFs).  In order to use a UDF in a script, you first have to create a perl subroutine (see below), then you need to make the function available to your database handle with the CREATE FUNCTION or LOAD commands:

 # load a single function "foo" from a subroutine
 # named "foo" in the current package

      $dbh->do(" CREATE FUNCTION foo EXTERNAL ");

 # load a single function "foo" from a subroutine
 # named "bar" in the current package

      $dbh->do(" CREATE FUNCTION foo EXTERNAL NAME bar");


 # load a single function "foo" from a subroutine named "foo"
 # in another package

      $dbh->do(' CREATE FUNCTION foo EXTERNAL NAME "Bar::Baz::foo" ');

 # load all the functions in another package

      $dbh->do(' LOAD "Bar::Baz" ');

Functions themselves should follow SQL identifier naming rules.  Subroutines loaded with CREATE FUNCTION can have any valid perl subroutine name.  Subroutines loaded with LOAD must start with SQL_FUNCTION_ and then the actual function name.  For example:

 package Qux::Quimble;
 sub SQL_FUNCTION_FOO { ... }
 sub SQL_FUNCTION_BAR { ... }
 sub some_other_perl_subroutine_not_a_function { ... }
 1;

 # in another package
 $dbh->do("LOAD Qux::Quimble");

 # This loads FOO and BAR as SQL functions.

=head2 Creating User-Defined Functions

User-defined functions (UDFs) are perl subroutines that return values appropriate to the context of the function in a SQL statement.  For example the built-in CURRENT_TIME returns a string value and therefore may be used anywhere in a SQL statement that a string value can.  Here' the entire perl code for the function:

 # CURRENT_TIME
 #
 # arguments : none
 # returns   : string containing current time as hh::mm::ss
 #
 sub SQL_FUNCTION_CURRENT_TIME {
     sprintf "%02s::%02s::%02s",(localtime)[2,1,0]
 }

More complex functions can make use of a number of arguments always passed to functions automatically.  Functions always receive these values in @_:

 sub FOO {
     my($self,$sth,@params);
 }

The first argument, $self, is whatever class the function is defined in, not generally useful unless you have an entire module to support the function.

The second argument, $sth is the active statement handle of the current statement.  Like all active statement handles it contains the current database handle in the {Database} attribute so you can have access to the database handle in any function:

 sub FOO {
     my($self,$sth,@params);
     my $dbh = $sth->{Database};
     # $dbh->do( ...), etc.
 }

In actual practice you probably want to use $sth->{Database} directly rather than making a local copy, so $sth->{Database}->do(...).

The remaining arguments, @params, are arguments passed by users to the function, either directly or with placeholders; another silly example which just returns the results of multiplying the arguments passed to it:

 sub MULTIPLY {
     my($self,$sth,@params);
     return $params[0] * $params[1];
 }

 # first make the function available
 #
 $dbh->do("CREATE FUNCTION MULTIPLY");

 # then multiply col3 in each row times seven
 #
 my $sth=$dbh->prepare("SELECT col1 FROM tbl1 WHERE col2 = MULTIPLY(col3,7)");
 $sth->execute;
 #
 # or
 #
 my $sth=$dbh->prepare("SELECT col1 FROM tbl1 WHERE col2 = MULTIPLY(col3,?)");
 $sth->execute(7);

=head2 Creating In-Memory Tables with functions

A function can return almost anything, as long is it is an appropriate return for the context the function will be used in.  In the special case of table-returning functions, the function should return a reference to an array of array references with the first row being the column names and the remaining rows the data.  For example:

B<1. create a function that returns an AoA>,

  sub Japh {[
      [qw( id word   )],
      [qw( 1 Hacker  )],
      [qw( 2 Perl    )],
      [qw( 3 Another )],
      [qw( 4 Just    )],
  ]}

B<2. make your database handle aware of the function>

  $dbh->do("CREATE FUNCTION 'Japh');

B<3. Access the data in the AoA from SQL>

  $sth = $dbh->prepare("SELECT word FROM Japh ORDER BY id DESC");

Or here's an example that does a join on two in-memory tables:

  sub Prof  {[ [qw(pid pname)],[qw(1 Sue )],[qw(2 Bob)],[qw(3 Tom )] ]}
  sub Class {[ [qw(pid cname)],[qw(1 Chem)],[qw(2 Bio)],[qw(2 Math)] ]}
  $dbh->do("CREATE FUNCTION $_) for qw(Prof Class);
  $sth = $dbh->prepare("SELECT * FROM Prof NATURAL JOIN Class");

The "Prof" and "Class" functions return tables which can be used like any SQL table.

More complex functions might do something like scrape an RSS feed, or search a file system and put the results in AoA.  For example, to search a directory with SQL:

 sub Dir {
     my($self,$sth,$dir)=@_;
     opendir D, $dir or die "'$dir':$!";
     my @files = readdir D;
     my $data = [[qw(fileName fileExt)]];
     for (@files) {
         my($fn,$ext) = /^(.*)(\.[^\.]+)$/;
         push @$data, [$fn,$ext];
     }
     return $data;
 }
 $dbh->do("CREATE FUNCTION Dir");
 printf "%s\n", join'   ',@{ $dbh->selectcol_arrayref("
     SELECT fileName FROM Dir('./') WHERE fileExt = '.pl'
 ")};

Obviously, that function could be expanded with File::Find and/or stat to provide more information and it could be made to accept a list of directories rather than a single directory.

Table-Returning functions are a way to turn *anything* that can be modeled as an AoA into a DBI data source.

=head1 Built-in Functions

=head2 SQL-92/ODBC Compatibility

All ODBC 3.0 functions are available except for the following: 

 ### SQL-92 / ODBC Functions
 
 # CONVERT / CAST - Complex to implement, but a draft is in the works.
 # DIFFERENCE     - Function is not clearly defined in spec and has very limited applications
 # EXTRACT        - Contains a FROM keyword and requires rather freeform datetime/interval expression
 
 ### ODBC 3.0 Time/Date Functions only
 
 # DAYOFMONTH, DAYOFWEEK, DAYOFYEAR, HOUR, MINUTE, MONTH, MONTHNAME, QUARTER, SECOND, TIMESTAMPDIFF, 
 #    WEEK, YEAR - Requires freeform datetime/interval expressions.  In a later release, these could
 #                    be implemented with the help of Date::Parse.

ODBC 3.0 functions that are implemented with differences include:

 # SOUNDEX  - Returns true/false, instead of a SOUNDEX code
 # RAND     - Seed value is a second parameter with a new first parameter for max limit
 # LOG      - Returns base X (or 10) log of number, not natural log.  LN is used for natural log, and
 #               LOG10 is still available for standards compatibility.
 # POSITION - Does not use 'IN' keyword; cannot be fixed as previous versions of SQL::Statement defined
 #               the function as such.
 # REPLACE / SUBSTITUTE - Uses a regular expression string for the second parameter, replacing the last two
 #                           parameters of the typical ODBC function

=cut

use vars qw($VERSION);
$VERSION = '1.405';

=pod

=head2 Aggregate Functions

=head3 MIN, MAX, AVG, SUM, COUNT

Aggregate functions are handled elsewhere, see L<SQL::Parser> for documentation.

=pod

=head2 Date and Time Functions

These functions can be used without parentheses.

=head3 CURRENT_DATE aka CURDATE

 # purpose   : find current date
 # arguments : none
 # returns   : string containing current date as yyyy-mm-dd

=cut

sub SQL_FUNCTION_CURRENT_DATE
{
    my ( $sec, $min, $hour, $day, $mon, $year ) = localtime;
    return sprintf( '%4s-%02s-%02s', $year + 1900, $mon + 1, $day );
}
no warnings 'once';
*SQL_FUNCTION_CURDATE = \&SQL_FUNCTION_CURRENT_DATE;
use warnings 'all';

=pod

=head3 CURRENT_TIME aka CURTIME

 # purpose   : find current time
 # arguments : optional seconds precision
 # returns   : string containing current time as hh:mm:ss (or ss.sss...)

=cut

sub SQL_FUNCTION_CURRENT_TIME
{
    return substr( SQL_FUNCTION_CURRENT_TIMESTAMP( @_[ 0 .. 2 ] ), 11 );
}
no warnings 'once';
*SQL_FUNCTION_CURTIME = \&SQL_FUNCTION_CURRENT_TIME;
use warnings 'all';

=pod

=head3 CURRENT_TIMESTAMP aka NOW

 # purpose   : find current date and time
 # arguments : optional seconds precision
 # returns   : string containing current timestamp as yyyy-mm-dd hh:mm:ss (or ss.sss...)

=cut

sub SQL_FUNCTION_CURRENT_TIMESTAMP
{
    my $prec;

    my $curtime = time;
    my ( $sec, $min, $hour, $day, $mon, $year ) = localtime($curtime);

    my $sec_frac;
    if ( $_[2] )
    {
        $prec     = int( $_[2] );
        $sec_frac = sprintf( '%.*f', $prec, $curtime - int($curtime) );
        $sec_frac = substr( $sec_frac, 2 );                               # truncate 0. from decimal
    }

    return
      sprintf( '%4s-%02s-%02s %02s:%02s:%02s' . ( $prec ? '.%s' : '' ),
               $year + 1900,
               $mon + 1, $day, $hour, $min, $sec, $sec_frac );
}
no warnings 'once';
*SQL_FUNCTION_NOW = \&SQL_FUNCTION_CURRENT_TIMESTAMP;
use warnings 'all';

=pod

=head3 UNIX_TIMESTAMP

 # purpose   : find the current time in UNIX epoch format
 # arguments : optional seconds precision (unlike the MySQL version)
 # returns   : a (64-bit) number, possibly with decimals

=cut

sub SQL_FUNCTION_UNIX_TIMESTAMP { return sprintf( "%.*f", $_[2] ? int( $_[2] ) : 0, time ); }

=pod

=head2 String Functions

=head3 ASCII & CHAR

 # purpose   : same as ord and chr, respectively (NULL for any NULL args)
 # arguments : string or character (or number for CHAR); CHAR can have any amount of numbers for a string

=cut

sub SQL_FUNCTION_ASCII { return defined $_[2] ? ord( $_[2] ) : undef; }

sub SQL_FUNCTION_CHAR
{
    my ( $self, $owner, @params ) = @_;
    ( defined || return undef ) for (@params);
    return join '', map { chr } @params;
}

=pod

=head3 BIT_LENGTH

 # purpose   : length of the string in bits
 # arguments : string

=cut

sub SQL_FUNCTION_BIT_LENGTH
{
    my @v   = @_[ 0 .. 1 ];
    my $str = $_[2];
    # Number of bits on first character = INT(LOG2(ord($str)) + 1) + rest of string = OCTET_LENGTH(substr($str, 1)) * 8
    return
      int( SQL_FUNCTION_LOG( @v, 2, ord($str) ) + 1 ) +
      SQL_FUNCTION_OCTET_LENGTH( @v, substr( $str, 1 ) ) * 8;
}

=pod

=head3 CHARACTER_LENGTH aka CHAR_LENGTH

 # purpose   : find length in characters of a string
 # arguments : a string
 # returns   : a number - the length of the string in characters

=cut

sub SQL_FUNCTION_CHAR_LENGTH
{
    my ( $self, $owner, $str ) = @_;
    return length($str);
}
no warnings 'once';
*SQL_FUNCTION_CHARACTER_LENGTH = \&SQL_FUNCTION_CHAR_LENGTH;
use warnings 'all';

=pod
 
=head3 COALESCE aka NVL aka IFNULL
 
 # purpose   : return the first non-NULL value from a list
 # arguments : 1 or more expressions
 # returns   : the first expression (reading left to right)
 #             which is not NULL; returns NULL if all are NULL
 #
 
=cut

sub SQL_FUNCTION_COALESCE
{
    my ( $self, $owner, @params ) = @_;

    #
    #	eval each expr in list until a non-null
    #	is encountered, then return it
    #
    foreach (@params)
    {
        return $_
          if defined($_);
    }
    return undef;
}
no warnings 'once';
*SQL_FUNCTION_NVL    = \&SQL_FUNCTION_COALESCE;
*SQL_FUNCTION_IFNULL = \&SQL_FUNCTION_COALESCE;
use warnings 'all';

=pod

=head3 CONCAT

 # purpose   : concatenate 1 or more strings into a single string;
 #			an alternative to the '||' operator
 # arguments : 1 or more strings
 # returns   : the concatenated string
 #
 # example   : SELECT CONCAT(first_string, 'this string', ' that string')
 #              returns "<value-of-first-string>this string that string"
 # note      : if any argument evaluates to NULL, the returned value is NULL

=cut

sub SQL_FUNCTION_CONCAT
{
    my ( $self, $owner, @params ) = @_;
    ( defined || return undef ) for (@params);
    return join '', @params;
}

=pod

=head3 CONV

 # purpose   : convert a number X from base Y to base Z (from base 2 to 92)
 # arguments : X (can by a number or string depending on the base), Y, Z (Z defaults to 10)
 # returns   : either a string or number, in base Z
 # notes     : 
 #    * Supports negative and decimal numbers
 #    * Will use big numbers if it has to, so accuracy is at near absolute levels
 #    * Letters are case-sensitive after base 36
 #    * Base character sets are: (second set is for compatibility with base 64)
 #          2 to 62 = 0-9, A-Z, a-z
 #         62 to 92 = A-Z, a-z, 0-9, +/_=~|,;:?!@#$%^&*()<>{}[]\`'"

=cut

sub SQL_FUNCTION_CONV
{
    my ( $self, $owner, $num, $sbase, $ebase ) = @_;
    $ebase ||= 10;

    die "Invalid base $sbase!" unless ( $sbase >= 2 && $sbase <= 92 );
    die "Invalid base $ebase!" unless ( $ebase >= 2 && $ebase <= 92 );

    my ( $i, $new ) = ( 0, '' );

    # number clean up
    $num =~ s/\s+//g;
    $new = '-' if ( $num =~ s/^\-// );    # negative
    $num =~ s/^0+// if ( $sbase <= 62 );
    $num =~ s/^A+// if ( $sbase > 62 );

    my $is_dec = ( $num =~ /\./ ) ? 1 : 0;
    $num =~ s/0+$// if ( $sbase <= 62 && $is_dec );
    $num =~ s/A+$// if ( $sbase > 62  && $is_dec );

    # short-circuits
    return $new . $num if ( $sbase == $ebase );
    return $new . $num if ( length($num) == 1 && $sbase < $ebase && $sbase <= 62 && $ebase <= 62 );

    # num of digits (power)
    my $poten_digits = int( length($num) * ( log($sbase) / log(10) ) );
    $i = length($num) - 1;
    $i = length($1) - 1 if ( $num =~ s/^(.+)\.(.+)$/$1$2/ );    # decimal digits

    # might have large digits
    my $use_big =
      $poten_digits <= 14
      ? 0
      : 1;    # Perl's number limits are probably closer to 16 digits, but just to be safe...
    $use_big = 1;
    my ( @digits, %digits, $dnum );

    # upgrade doesn't work as well as it should...
    no strict 'subs';
    my $big_class = $is_dec ? Math::BigFloat : Math::BigInt;

    # convert base Y to base 10 (with short-circuits)
    if    ( !$is_dec && !$use_big && $sbase == 16 ) { $dnum = oct( '0x' . $num ); }
    elsif ( !$is_dec && !$use_big && $sbase == 8 )  { $dnum = oct( '0' . $num ); }
    elsif ( !$is_dec && !$use_big && $sbase == 2 )  { $dnum = oct( '0b' . $num ); }
    elsif ( $sbase == 10 )
    {
        no warnings 'numeric';    # what?  you think I'm adding zero on accident?
        $dnum = $use_big ? $big_class->new($num) : $num + 0;
        $dnum->accuracy( $poten_digits + 16 ) if ($use_big);
    }
    else
    {
        my $dstr =
          ( $sbase <= 62 )
          ? '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
          : 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/_=~|,;:?!@#$%^&*()<>{}[]\`'
          . "'\"";
        $num = uc $num if ( $sbase <= 36 );

        @digits = split //, $dstr;
        %digits = map { $digits[$_] => $_ } ( 0 .. $sbase - 1 );

        $dnum = $use_big ? $big_class->new(0) : 0;
        $dnum->accuracy( $poten_digits + 16 ) if ($use_big);
        foreach my $d ( $num =~ /./g )
        {
            die "Invalid character $d in string!" unless ( exists $digits{$d} );
            my $v = $digits{$d};

            my $exp;
            if ($use_big)
            {
                $exp = $big_class->new($sbase);
                $exp->accuracy( $poten_digits + 16 );
                $dnum = $exp->bpow($i)->bmul($v)->badd($dnum);
            }
            else
            {
                $exp = $sbase**$i;
                $dnum += $v * $exp;
            }
            $i--;    # may go into the negative for non-ints
        }
    }

    # convert base 10 to base Z (with short-circuits)
    if    ( !$is_dec && !$use_big && $ebase == 16 ) { $new .= sprintf( '%X', $dnum ); }
    elsif ( !$is_dec && !$use_big && $ebase == 8 )  { $new .= sprintf( '%o', $dnum ); }
    elsif ( !$is_dec && !$use_big && $ebase == 2 )  { $new .= sprintf( '%b', $dnum ); }
    elsif ( $ebase == 10 ) { $new .= $dnum; }
    else
    {
        my $dstr =
          ( $ebase <= 62 )
          ? '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
          : 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/_-=~|,;:?!@#$%^&*()<>{}[]\`'
          . "'\"";
        @digits = split //, $dstr;

        # get the largest power of Z (the highest digit)
        $i = $use_big
          ? $dnum->copy()->blog(
            $ebase,
            int( $dnum->length() / 9 ) +
              2   # (an accuracy that is a little over the potential # of integer digits within log)
          )->bfloor()->bstr()
          : int( log($dnum) / log($ebase) );

        while ( $dnum != 0 && length($new) < 255 )
        {
            if ( $i == -1 )
            {     # time to go pro...
                $use_big = 1;
                $dnum    = $big_class->new($dnum);
                $dnum->accuracy( length($dnum) + 255 + 16 );
            }

            my ( $exp, $v );
            if ($use_big)
            {
                $exp = $big_class->new($ebase)->bpow($i);
                $v   = $dnum->copy()->bdiv($exp)->bfloor();
            }
            else
            {
                $exp = $ebase**$i;
                $v   = int( $dnum / $exp );
            }
            $dnum -= $v * $exp;    # this method is safer for fractionals

            $new .= '.' if ( $i == -1 );    # decimal point
            $new .= $digits[$v];

            $i--;                           # may go into the negative for non-ints
        }
    }

    # Final cleanup
    $new =~ s/^(-?)0+/$1/ if ( $ebase <= 62 );
    $new =~ s/^(-?)A+/$1/ if ( $ebase > 62 );
    $new =~ s/0+$//       if ( $ebase <= 62 && $is_dec );
    $new =~ s/A+$//       if ( $ebase > 62 && $is_dec );

    return $new;
}

=pod

=head3 DECODE

 # purpose   : compare the first argument against
 #             succeding arguments at position 1 + 2N
 #             (N = 0 to (# of arguments - 2)/2), and if equal,
 #				return the value of the argument at 1 + 2N + 1; if no
 #             arguments are equal, the last argument value is returned
 # arguments : 4 or more expressions, must be even # of arguments
 # returns   : the value of the argument at 1 + 2N + 1 if argument 1 + 2N
 #             is equal to argument1; else the last argument value
 #
 # example   : SELECT DECODE(some_column,
 #                    'first value', 'first value matched'
 #                    '2nd value', '2nd value matched'
 #                    'no value matched'
 #                    )

=cut

#
#	emulate Oracle DECODE; behaves same as
#	CASE expr WHEN <expr2> THEN expr3
#	WHEN expr4 THEN expr5
#	...
#	ELSE exprN END
#
sub SQL_FUNCTION_DECODE
{
    my ( $self, $owner, @params ) = @_;

    #
    #	check param list size, must be at least 4,
    #	and even in length
    #
    no warnings 'precedence';
    die 'Invalid DECODE argument list!' unless ( ( scalar @params > 3 ) && ( $#params & 1 == 1 ) );

    #
    #	eval first argument, and last argument,
    #	then eval and compare each succeeding pair of args
    #	be careful about NULLs!
    #
    my $lhs     = shift @params;
    my $default = pop @params;
    return $default unless defined($lhs);
    my $lhs_isnum = looks_like_number($lhs);

    while (@params)
    {
        my $rhs = shift @params;
        shift @params, next
          unless defined($rhs);
        return shift @params
          if (    ( looks_like_number($rhs) && $lhs_isnum && ( $lhs == $rhs ) )
               || ( $lhs eq $rhs ) );
        shift @params;
    }
    return $default;
}

=pod

=head3 INSERT

 # purpose   : string where L characters have been deleted from STR1, beginning at S,
 #             and where STR2 has been inserted into STR1, beginning at S.  NULL for any NULL args.
 # arguments : STR1, S, L, STR2

=cut

sub SQL_FUNCTION_INSERT
{    # just like a 4-parameter substr in Perl
    ( defined || return undef ) for ( @_[ 2 .. 5 ] );
    my $str = $_[2];
    no warnings 'void';
    substr( $str, $_[3] - 1, $_[4], $_[5] );
    return $str;
}

=pod

=head3 HEX & OCT & BIN

 # purpose   : convert number X from decimal to hex/octal/binary; equiv. to CONV(X, 10, 16/8/2)
 # arguments : X

=cut

sub SQL_FUNCTION_HEX { return SQL_FUNCTION_CONV( @_[ 0 .. 2 ], 10, 16 ); }
sub SQL_FUNCTION_OCT { return SQL_FUNCTION_CONV( @_[ 0 .. 2 ], 10, 8 ); }
sub SQL_FUNCTION_BIN { return SQL_FUNCTION_CONV( @_[ 0 .. 2 ], 10, 2 ); }

=pod

=head3 LEFT & RIGHT

 # purpose   : leftmost or rightmost L characters in STR, or NULL for any NULL args
 # arguments : STR1, L

=cut

sub SQL_FUNCTION_LEFT {
    ( defined || return undef )
      for ( @_[ 2 .. 3 ] );
    return substr( $_[2], 0, $_[3] );
}
sub SQL_FUNCTION_RIGHT {
    ( defined || return undef )
      for ( @_[ 2 .. 3 ] );
    return substr( $_[2], -$_[3] );
}

=pod

=head3 LOCATE aka POSITION

 # purpose   : starting position (one-based) of the first occurrence of STR1
               within STR2; 0 if it doesn't occur and NULL for any NULL args
 # arguments : STR1, STR2, and an optional S (starting position to search)

=cut

sub SQL_FUNCTION_LOCATE
{
    ( defined || return undef ) for ( @_[ 2 .. 3 ] );
    my ( $self, $owner, $substr, $str, $s ) = @_;
    $s = int( $s || 0 );
    my $pos = index( substr( $str, $s ), $substr ) + 1;
    return $pos && $pos + $s;
}
no warnings 'once';
*SQL_FUNCTION_POSITION = \&SQL_FUNCTION_LOCATE;
use warnings 'all';

=pod

=head3 LOWER & UPPER aka LCASE & UCASE

 # purpose   : lower-case or upper-case a string
 # arguments : a string
 # returns   : the sting lower or upper cased

=cut

sub SQL_FUNCTION_LOWER
{
    my ( $self, $owner, $str ) = @_;
    return lc($str);
}

sub SQL_FUNCTION_UPPER
{
    my ( $self, $owner, $str ) = @_;
    return uc($str);
}

no warnings 'once';
*SQL_FUNCTION_UCASE = \&SQL_FUNCTION_UPPER;
*SQL_FUNCTION_LCASE = \&SQL_FUNCTION_LOWER;
use warnings 'all';

=pod

=head3 LTRIM & RTRIM

 # purpose   : left/right counterparts for TRIM
 # arguments : string

=cut

sub SQL_FUNCTION_LTRIM
{
    my $str = $_[2];
    $str =~ s/^\s+//;
    return $str;
}

sub SQL_FUNCTION_RTRIM
{
    my $str = $_[2];
    $str =~ s/\s+$//;
    return $str;
}

=pod

=head3 OCTET_LENGTH

 # purpose   : length of the string in bytes (not characters)
 # arguments : string

=cut

sub SQL_FUNCTION_OCTET_LENGTH { return length( Encode::encode_utf8( $_[2] ) ); }    # per Perldoc

=pod

=head3 REGEX

 # purpose   : test if a string matches a perl regular expression
 # arguments : a string and a regex to match the string against
 # returns   : boolean value of the regex match
 #
 # example   : ... WHERE REGEX(col3,'/^fun/i') ... matches rows
 #             in which col3 starts with "fun", ignoring case

=cut

sub SQL_FUNCTION_REGEX
{
    my ( $self, $owner, @params ) = @_;
    ( defined || return 0 ) for ( @params[ 0 .. 1 ] );
    my ( $pattern, $modifier ) = $params[1] =~ m~^/(.+)/([a-z]*)$~;
    $pattern = "(?$modifier:$pattern)" if ($modifier);
    return ( $params[0] =~ qr($pattern) ) ? 1 : 0;
}

=pod

=head3 REPEAT

 # purpose   : string composed of STR1 repeated C times, or NULL for any NULL args
 # arguments : STR1, C

=cut

sub SQL_FUNCTION_REPEAT {
    ( defined || return undef )
      for ( @_[ 2 .. 3 ] );
    return $_[2] x int( $_[3] );
}

=pod

=head3 REPLACE aka SUBSTITUTE

 # purpose   : perform perl subsitution on input string
 # arguments : a string and a substitute pattern string
 # returns   : the result of the substitute operation
 #
 # example   : ... WHERE REPLACE(col3,'s/fun(\w+)nier/$1/ig') ... replaces
 #			all instances of /fun(\w+)nier/ in col3 with the string
 #			between 'fun' and 'nier'

=cut

sub SQL_FUNCTION_REPLACE
{
    my ( $self, $owner, @params ) = @_;
    return undef unless defined $params[0] and defined $params[1];

    eval "\$params[0]=~$params[1]";
    return $@ ? undef : $params[0];
}
no warnings 'once';
*SQL_FUNCTION_SUBSTITUTE = \&SQL_FUNCTION_REPLACE;
use warnings 'all';

=pod

=head3 SOUNDEX

 # purpose   : test if two strings have matching soundex codes
 # arguments : two strings
 # returns   : true if the strings share the same soundex code
 #
 # example   : ... WHERE SOUNDEX(col3,'fun') ... matches rows
 #             in which col3 is a soundex match for "fun"

=cut

sub SQL_FUNCTION_SOUNDEX
{
    my ( $self, $owner, @params ) = @_;
    exists $INC{'Text/Soundex.pm'} or require Text::Soundex;
    my $s1 = Text::Soundex::soundex( $params[0] ) or return 0;
    my $s2 = Text::Soundex::soundex( $params[1] ) or return 0;
    return ( $s1 eq $s2 ) ? 1 : 0;
}

=pod

=head3 SPACE

 # purpose   : a string of spaces
 # arguments : number of spaces

=cut

sub SQL_FUNCTION_SPACE { return ' ' x int( $_[2] ); }

=pod

=head3 SUBSTRING

  SUBSTRING( string FROM start_pos [FOR length] )

Returns the substring starting at start_pos and extending for
"length" character or until the end of the string, if no
"length" is supplied.  Examples:

  SUBSTRING( 'foobar' FROM 4 )       # returns "bar"

  SUBSTRING( 'foobar' FROM 4 FOR 2)  # returns "ba"

Note: The SUBSTRING function is implemented in L<SQL::Parser> and L<SQL::Statement> and, at the current time, can not be over-ridden.

=head3 SUBSTR

 # purpose   : same as SUBSTRING, except with comma-delimited params, instead of
               words (NULL for any NULL args)
 # arguments : string, start_pos, [length]

=cut

sub SQL_FUNCTION_SUBSTR
{
    my ( $self, $owner, @params ) = @_;
    ( defined || return undef ) for ( @params[ 0 .. 2 ] );
    my $string = $params[0] || '';
    my $start  = $params[1] || 0;
    my $offset = $params[2] || length $string;
    my $value  = '';
    $value = substr( $string, $start - 1, $offset )
      if length $string >= $start - 2 + $offset;
    return $value;
}

=pod

=head3 TRANSLATE

 # purpose   : transliteration; replace a set of characters in a string with another
               set of characters (a la tr///), or NULL for any NULL args
 # arguments : string, string to replace, replacement string

=cut

sub SQL_FUNCTION_TRANSLATE
{
    my ( $self, $owner, $str, $oldlist, $newlist ) = @_;
    $oldlist =~ s{(/\-)}{\\$1}g;
    $newlist =~ s{(/\-)}{\\$1}g;
    eval "\$str =~ tr/$oldlist/$newlist/";
    return $str;
}

=pod

=head3 TRIM

  TRIM ( [ [LEADING|TRAILING|BOTH] ['trim_char'] FROM ] string )

Removes all occurrences of <trim_char> from the front, back, or
both sides of a string.

 BOTH is the default if neither LEADING nor TRAILING is specified.

 Space is the default if no trim_char is specified.

 Examples:

 TRIM( string )
   trims leading and trailing spaces from string

 TRIM( LEADING FROM str )
   trims leading spaces from string

 TRIM( 'x' FROM str )
   trims leading and trailing x's from string

Note: The TRIM function is implemented in L<SQL::Parser> and L<SQL::Statement> and, at the current time, can not be over-ridden.

=pod

=head3 UNHEX

 # purpose   : convert each pair of hexadecimal digits to a byte (or a Unicode character)
 # arguments : string of hex digits, with an optional encoding name of the data string

=cut

sub SQL_FUNCTION_UNHEX
{
    my ( $self, $owner, $hex, $encoding ) = @_;
    return undef unless ( defined $hex );

    $hex =~ s/\s+//g;
    $hex =~ s/[^0-9a-fA-F]+//g;

    my $str = '';
    foreach my $i ( 0 .. int( ( length($hex) - 1 ) / 2 ) )
    {
        $str .= pack( 'C', SQL_FUNCTION_CONV( $self, $owner, substr( $hex, $i * 2, 2 ), 16, 10 ) );
    }
    return $encoding ? Encode::decode( $encoding, $str, Encode::FB_WARN ) : $str;
}

=head2 Numeric Functions

=head3 ABS

 # purpose   : find the absolute value of a given numeric expression
 # arguments : numeric expression

=cut

sub SQL_FUNCTION_ABS { return abs( $_[2] ); }

=pod

=head3 CEILING (aka CEIL) & FLOOR

 # purpose   : rounds up/down to the nearest integer
 # arguments : numeric expression

=cut

sub SQL_FUNCTION_CEILING
{
    my $i = int( $_[2] );
    return $i == $_[2] ? $i : SQL_FUNCTION_ROUND( @_[ 0 .. 1 ], $_[2] + 0.5, 0 );
}

sub SQL_FUNCTION_FLOOR
{
    my $i = int( $_[2] );
    return $i == $_[2] ? $i : SQL_FUNCTION_ROUND( @_[ 0 .. 1 ], $_[2] - 0.5, 0 );
}
no warnings 'once';
*SQL_FUNCTION_CEIL = \&SQL_FUNCTION_CEILING;
use warnings 'all';

=pod

=head3 EXP

 # purpose   : raise e to the power of a number
 # arguments : numeric expression

=cut

sub SQL_FUNCTION_EXP { return ( sinh(1) + cosh(1) )**$_[2]; }    # e = sinh(X)+cosh(X)

=pod

=head3 LOG

 # purpose   : base B logarithm of X
 # arguments : B, X or just one argument of X for base 10

=cut

sub SQL_FUNCTION_LOG { return $_[3] ? log( $_[3] ) / log( $_[2] ) : log( $_[2] ) / log(10); }

=pod

=head3 LN & LOG10

 # purpose   : natural logarithm (base e) or base 10 of X
 # arguments : numeric expression

=cut

sub SQL_FUNCTION_LN    { return log( $_[2] ); }
sub SQL_FUNCTION_LOG10 { return SQL_FUNCTION_LOG( @_[ 0 .. 2 ] ); }

=pod

=head3 MOD

 # purpose   : modulus, or remainder, left over from dividing X / Y
 # arguments : X, Y

=cut

sub SQL_FUNCTION_MOD { return $_[2] % $_[3]; }

=pod

=head3 POWER aka POW

 # purpose   : X to the power of Y
 # arguments : X, Y

=cut

sub SQL_FUNCTION_POWER { return $_[2]**$_[3]; }
no warnings 'once';
*SQL_FUNCTION_POW = \&SQL_FUNCTION_POWER;
use warnings 'all';

=pod

=head3 RAND

 # purpose   : random fractional number greater than or equal to 0 and less than the value of X
 # arguments : X (with optional seed value of Y)

=cut

sub SQL_FUNCTION_RAND { $_[3] && srand( $_[3] ); return rand( $_[2] ); }

=pod

=head3 ROUND

 # purpose   : round X with Y number of decimal digits (precision)
 # arguments : X, optional Y defaults to 0

=cut

sub SQL_FUNCTION_ROUND { return sprintf( "%.*f", $_[3] ? int( $_[3] ) : 0, $_[2] ); }

=pod

=head3 SIGN

 # purpose   : returns -1, 0, 1, NULL for negative, 0, positive, NULL values, respectively
 # arguments : numeric expression

=cut

sub SQL_FUNCTION_SIGN { return defined( $_[2] ) ? ( $_[2] <=> 0 ) : undef; }

=pod

=head3 SQRT

 # purpose   : square root of X
 # arguments : X

=cut

sub SQL_FUNCTION_SQRT { return sqrt( $_[2] ); }

=pod

=head3 TRUNCATE aka TRUNC

 # purpose   : similar to ROUND, but removes the decimal
 # arguments : X, optional Y defaults to 0

=cut

sub SQL_FUNCTION_TRUNCATE
{
    my $c = int( $_[3] || 0 );
    my $d = 10**$c;
    return sprintf( "%.*f", $c, int( $_[2] * $d ) / $d );
}
no warnings 'once';
*SQL_FUNCTION_TRUNC = \&SQL_FUNCTION_TRUNCATE;
use warnings 'all';

=pod

=head2 Trigonometric Functions

All of these functions work exactly like their counterparts in L<Math::Trig>; go there for documentation.

=cut

=over

=item ACOS

=item ACOSEC

=item ACOSECH

=item ACOSH

=item ACOT

=item ACOTAN

=item ACOTANH

=item ACOTH

=item ACSC

=item ACSCH

=item ASEC

=item ASECH

=item ASIN

=item ASINH

=item ATAN

=item ATANH

=item COS

=item COSEC

=item COSECH

=item COSH

=item COT

=item COTAN

=item COTANH

=item COTH

=item CSC

=item CSCH

=item SEC

=item SECH

=item SIN

=item SINH

=item TAN

=item TANH

Takes a single parameter.  All of L<Math::Trig>'s aliases are included.

=item ATAN2

The y,x version of arc tangent.

=item DEG2DEG

=item DEG2GRAD

=item DEG2RAD

Converts out-of-bounds values into its correct range.

=item GRAD2DEG

=item GRAD2GRAD

=item GRAD2RAD

=item RAD2DEG

=item RAD2GRAD

=item RAD2RAD

Like their L<Math::Trig>'s counterparts, accepts an optional 2nd boolean parameter (like B<TRUE>) to keep prevent range wrapping.

=item DEGREES

=item RADIANS

B<DEGREES> and B<RADIANS> are included for SQL-92 compatibility, and map to B<RAD2DEG> and B<DEG2RAD>, respectively.

=item PI

B<PI> can be used without parentheses. 

=back

=cut

sub SQL_FUNCTION_ACOS    { return acos( $_[2]    || 0 ); }
sub SQL_FUNCTION_ACOSEC  { return acosec( $_[2]  || 0 ); }
sub SQL_FUNCTION_ACOSECH { return acosech( $_[2] || 0 ); }
sub SQL_FUNCTION_ACOSH   { return acosh( $_[2]   || 0 ); }
sub SQL_FUNCTION_ACOT    { return acot( $_[2]    || 0 ); }
sub SQL_FUNCTION_ACOTAN  { return acotan( $_[2]  || 0 ); }
sub SQL_FUNCTION_ACOTANH { return acotanh( $_[2] || 0 ); }
sub SQL_FUNCTION_ACOTH   { return acoth( $_[2]   || 0 ); }
sub SQL_FUNCTION_ACSC    { return acsc( $_[2]    || 0 ); }
sub SQL_FUNCTION_ACSCH   { return acsch( $_[2]   || 0 ); }
sub SQL_FUNCTION_ASEC    { return asec( $_[2]    || 0 ); }
sub SQL_FUNCTION_ASECH   { return asech( $_[2]   || 0 ); }
sub SQL_FUNCTION_ASIN    { return asin( $_[2]    || 0 ); }
sub SQL_FUNCTION_ASINH   { return asinh( $_[2]   || 0 ); }
sub SQL_FUNCTION_ATAN    { return atan( $_[2]    || 0 ); }
sub SQL_FUNCTION_ATAN2 { return atan2( $_[2] || 0, $_[3] || 0 ); }
sub SQL_FUNCTION_ATANH { return atanh( $_[2] || 0 ); }
sub SQL_FUNCTION_COS   { return cos( $_[2]   || 0 ); }
sub SQL_FUNCTION_COSEC { return cosec( $_[2] || 0 ); }
sub SQL_FUNCTION_COSECH    { return cosech( $_[2]    || 0 ); }
sub SQL_FUNCTION_COSH      { return cosh( $_[2]      || 0 ); }
sub SQL_FUNCTION_COT       { return cot( $_[2]       || 0 ); }
sub SQL_FUNCTION_COTAN     { return cotan( $_[2]     || 0 ); }
sub SQL_FUNCTION_COTANH    { return cotanh( $_[2]    || 0 ); }
sub SQL_FUNCTION_COTH      { return coth( $_[2]      || 0 ); }
sub SQL_FUNCTION_CSC       { return csc( $_[2]       || 0 ); }
sub SQL_FUNCTION_CSCH      { return csch( $_[2]      || 0 ); }
sub SQL_FUNCTION_DEG2DEG   { return deg2deg( $_[2]   || 0 ); }
sub SQL_FUNCTION_RAD2RAD   { return rad2rad( $_[2]   || 0 ); }
sub SQL_FUNCTION_GRAD2GRAD { return grad2grad( $_[2] || 0 ); }
sub SQL_FUNCTION_DEG2GRAD  { return deg2grad( $_[2]  || 0, $_[3] || 0 ); }
sub SQL_FUNCTION_DEG2RAD   { return deg2rad( $_[2]   || 0, $_[3] || 0 ); }
sub SQL_FUNCTION_DEGREES   { return rad2deg( $_[2]   || 0, $_[3] || 0 ); }
sub SQL_FUNCTION_GRAD2DEG  { return grad2deg( $_[2]  || 0, $_[3] || 0 ); }
sub SQL_FUNCTION_GRAD2RAD  { return grad2rad( $_[2]  || 0, $_[3] || 0 ); }
sub SQL_FUNCTION_PI       { return pi; }
sub SQL_FUNCTION_RAD2DEG  { return rad2deg( $_[2] || 0, $_[3] || 0 ); }
sub SQL_FUNCTION_RAD2GRAD { return rad2grad( $_[2] || 0, $_[3] || 0 ); }
sub SQL_FUNCTION_RADIANS  { return deg2rad( $_[2] || 0, $_[3] || 0 ); }
sub SQL_FUNCTION_SEC  { return sec( $_[2]  || 0 ); }
sub SQL_FUNCTION_SECH { return sech( $_[2] || 0 ); }
sub SQL_FUNCTION_SIN  { return sin( $_[2]  || 0 ); }
sub SQL_FUNCTION_SINH { return sinh( $_[2] || 0 ); }
sub SQL_FUNCTION_TAN  { return tan( $_[2]  || 0 ); }
sub SQL_FUNCTION_TANH { return tanh( $_[2] || 0 ); }

=head2 System Functions

=head3 DBNAME & USERNAME (aka USER)

 # purpose   : name of the database / username
 # arguments : none

=cut

sub SQL_FUNCTION_DBNAME   { return $_[1]->{Database}{Name}; }
sub SQL_FUNCTION_USERNAME { return $_[1]->{Database}{CURRENT_USER}; }
no warnings 'once';
*SQL_FUNCTION_USER = \&SQL_FUNCTION_USERNAME;
use warnings 'all';

=head2 Special Utility Functions

=head3 IMPORT

 CREATE TABLE foo AS IMPORT(?)    ,{},$external_executed_sth
 CREATE TABLE foo AS IMPORT(?)    ,{},$AoA

=cut

sub SQL_FUNCTION_IMPORT
{
    my ( $self, $owner, @params ) = @_;
    if ( _ARRAY0( $params[0] ) )
    {
        return $params[0] unless ( _HASH0( $params[0]->[0] ) );
        my @tbl = ();
        for my $row ( @{ $params[0] } )
        {
            my @cols = sort keys %{$row};
            push @tbl, \@cols unless @tbl;
            push @tbl, [ @$row{@cols} ];
        }
        return \@tbl;
    }
    elsif ( _INSTANCE( $params[0], 'DBI::st' ) )
    {

        my @cols;
        @cols = @{ $params[0]->{NAME} } unless @cols;

        #    push @{$sth->{org_names}},$_ for @cols;
        my $tbl = [ \@cols ];
        while ( my @row = $params[0]->fetchrow_array() )
        {
            push @$tbl, \@row;
        }

        return $tbl;
    }
}

=head3 RUN

Takes the name of a file containing SQL statements and runs the statements; see
L<SQL::Parser> for documentation.

=cut

sub SQL_FUNCTION_RUN
{
    my ( $self, $owner, $file ) = @_;
    my @params = $owner->{sql_stmt}->params();
    @params = () unless @params;
    local *IN;
    open( IN, '<', $file ) or die "Couldn't open SQL File '$file': $!\n";
    my @stmts = split /;\s*\n+/, join '', <IN>;
    $stmts[-1] =~ s/;\s*$//;
    close IN;
    my @results = ();

    for my $sql (@stmts)
    {
        my $tmp_sth = $owner->{Database}->prepare($sql);
        $tmp_sth->execute(@params);
        next unless $tmp_sth->{NUM_OF_FIELDS};
        push @results, $tmp_sth->{NAME} unless @results;
        while ( my @r = $tmp_sth->fetchrow_array() ) { push @results, \@r }
    }

    #use Data::Dumper; print Dumper \@results and exit if @results;
    return \@results;
}

=pod

=head1 Submitting built-in functions

If you make a generally useful UDF, why not submit it to me and have it (and your name) included with the built-in functions?  Please follow the format shown in the module including a description of the arguments and return values for the function as well as an example.  Send them to the dbi-dev@perl.org mailing list (see L<http://dbi.perl.org>).

Thanks in advance :-).

=head1 ACKNOWLEDGEMENTS

Dean Arnold supplied DECODE, COALESCE, REPLACE, many thanks!
Brendan Byrd added in the Numeric/Trig/System functions and filled in the SQL92/ODBC gaps for the date/string functions.

=head1 AUTHOR & COPYRIGHT

Copyright (c) 2005 by Jeff Zucker: jzuckerATcpan.org
Copyright (c) 2009,2010 by Jens Rehsack: rehsackATcpan.org

All rights reserved.

The module may be freely distributed under the same terms as
Perl itself using either the "GPL License" or the "Artistic
License" as specified in the Perl README file.

=cut

1;