#!/usr/bin/perl # # $Header: /Users/claude/fuzz/lib/Genezzo/Havok/RCS/SQLScalar.pm,v 1.24 2007/11/18 08:16:56 claude Exp claude $ # # copyright (c) 2005, 2006, 2007 Jeffrey I Cohen, all rights reserved, worldwide # # package Genezzo::Havok::SQLScalar; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(&sql_func_chomp &sql_func_chop &sql_func_chr &sql_func_crypt &sql_func_index &sql_func_lc &sql_func_lcfirst &sql_func_length &sql_func_ord &sql_func_pack &sql_func_reverse &sql_func_rindex &sql_func_sprintf &sql_func_substr &sql_func_uc &sql_func_ucfirst &sql_func_abs &sql_func_atan2 &sql_func_cos &sql_func_exp &sql_func_hex &sql_func_int &sql_func_log10 &sql_func_oct &sql_func_rand &sql_func_sin &sql_func_sqrt &sql_func_srand &sql_func_perl_join &sql_func_concat &sql_func_greatest &sql_func_initcap &sql_func_least &sql_func_lower &sql_func_lpad &sql_func_ltrim &sql_func_replace &sql_func_rpad &sql_func_rtrim &sql_func_soundex &sql_func_translate &sql_func_upper &sql_func_cosh &sql_func_ceil &sql_func_floor &sql_func_ln &sql_func_logn &sql_func_mod &sql_func_power &sql_func_round &sql_func_sign &sql_func_sinh &sql_func_tan &sql_func_tanh &sql_func_trunc &sql_func_ascii &sql_func_instr &sql_func_nvl &sql_func_quurl &sql_func_quurl2 &sql_func_unquurl ); use Genezzo::Util; use Genezzo::Havok::Utils; use strict; use warnings; use Carp; our $VERSION; our $MAKEDEPS; BEGIN { $VERSION = do { my @r = (q$Revision: 1.24 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker my $pak1 = __PACKAGE__; $MAKEDEPS = { 'NAME' => $pak1, 'ABSTRACT' => ' ', 'AUTHOR' => 'Jeffrey I Cohen (jcohen@cpan.org)', 'LICENSE' => 'gpl', 'VERSION' => $VERSION, }; # end makedeps $MAKEDEPS->{'PREREQ_HAVOK'} = { 'Genezzo::Havok::UserFunctions' => '0.0', }; # DML is an array, not a hash my $now = do { my @r = (q$Date: 2007/11/18 08:16:56 $ =~ m|Date:(\s+)(\d+)/(\d+)/(\d+)(\s+)(\d+):(\d+):(\d+)|); sprintf ("%04d-%02d-%02dT%02d:%02d:%02d", $r[1],$r[2],$r[3],$r[5],$r[6],$r[7]); }; my %tabdefs = (); $MAKEDEPS->{'TABLEDEFS'} = \%tabdefs; my @perl_funcs = qw( chomp chop chr crypt index lc lcfirst length ord pack reverse rindex sprintf substr uc ucfirst abs atan2 cos exp hex int log10 oct rand sin sqrt srand perl_join ); my @sql_funcs = qw( concat greatest initcap least lower lpad ltrim replace rpad rtrim soundex translate upper cosh ceil floor ln logn mod power round sign sinh tan tanh trunc ascii instr nvl ); my @gnz_funcs = qw( quurl quurl2 unquurl ); # NOTE: should really use "select add_user_function", not # _build_sql_for_user_function, but the parsing and dynamic load # dramatically slows the db init. my @ins1; my $ccnt = 6; # skip util functions and syshelp for my $pfunc (@perl_funcs) { my %attr = (module => $pak1, function => "sql_func_" . $pfunc, creationdate => $now, xid => $ccnt); my $bigstr = Genezzo::Havok::Utils::_build_sql_for_user_function(%attr); push @ins1, $bigstr; $ccnt++; } for my $pfunc (@sql_funcs) { my %attr = (module => $pak1, function => "sql_func_" . $pfunc, creationdate => $now, xid => $ccnt); if ($pfunc =~ m/^(greatest|least)$/i) { $attr{argstyle} = "HASH"; } else { delete $attr{argstyle} if (exists($attr{argstyle})); } my $bigstr = Genezzo::Havok::Utils::_build_sql_for_user_function(%attr); push @ins1, $bigstr; $ccnt++; } for my $pfunc (@gnz_funcs) { my %attr = (module => $pak1, function => "sql_func_" . $pfunc, creationdate => $now, xid => $ccnt); my $bigstr = Genezzo::Havok::Utils::_build_sql_for_user_function(%attr); push @ins1, $bigstr; $ccnt++; } # add help for all functions push @ins1, "select add_help(\'$pak1\') from dual"; # register havok module push @ins1, "select register_havok_package(" . "\'modname=" . $pak1 . "\', ". "\'creationdate=" . $now . "\', ". "\'version=" . $VERSION . "\'". ") from dual"; # if check returns 0 rows then proceed with install $MAKEDEPS->{'DML'} = [ { check => [ "select * from user_functions where xname = \'$pak1\'" ], install => \@ins1 } ]; # print Data::Dumper->Dump([$MAKEDEPS]); } sub MakeYML { use Genezzo::Havok; my $makedp = $MAKEDEPS; return Genezzo::Havok::MakeYML($makedp); } sub getpod { my $bigHelp; ($bigHelp = <. # #=head2 replace : replace(char_str, search_str [, replace_str]) # #Returns char_str with all occurrences of the search_str replaced by #replace_str. If the replace_str is unspecified or null, it removes #all occurrences of the search_str. # #=head2 rpad : rpad(char_str1, n [, char_str2]) # #Returns the string char_str1 padded out on the right to length n with #copies of char_str2. If char_str2 is not specified blanks are used. #If char_str1 is larger than length n it is truncated to fit. # #=head2 rtrim : rtrim(char_str [, set]) # #Returns the string which is trimmed on the right up to the first #character which is not in the specified set. If set is unspecified, #blanks are trimmed. # #=head2 translate : translate(char_str, search_str, replace_str) # #Similar to perl transliteration tr/ (see L ), returns a #string where all occurrences of a character in the search string are #replaced with the corresponding character in the replace string. # #=head2 upper : upper(char_str) # #Returns the string with all characters uppercase. # #=head2 cosh : cosh(n) # #Hyperbolic cosine # #=head2 ceil : ceil(n) # #Returns the smallest integer greater than or equal to n # #=head2 floor : floor(n) # #Returns the largest integers less than or equal to n # #=head2 ln : ln(n) # #Natural log. # #=head2 log10 : log10(n) # #Log base 10. # #=head2 logN : logN(base_N, num) # #Returns the Log base base_N on num. # #=head2 mod : mod(m,n) # #Returns the remainder of m divided by n. # #=head2 power : power(m,n) # #Returns m**n # #=head2 round : round(num [, m]) # #Return num rounded to m places to the right of the decimal point. M=0 #if not specified. If m is negative num is rounded to the left of the #decimal point. # # #=head2 sign : sign(n) # #Similar to "spaceship", returns -1 for N < 0, 0 for N==0, and 1 for N > 0. # #=head2 sinh : sinh(n) # #Hyperbolic sine. # #=head2 tan : tan(n) # #tangent # #=head2 tanh : tanh(n) # #Hyperbolic tangent. # #=head2 trunc : trunc(num [, m]) # #Return num truncated to m places to the right of the decimal point. #M=0 if not specified. If m is negative num is truncated to the left #of the decimal point. # #=head2 ascii : ascii(char_str) # #Return the ascii value of the first char of the string. # #=head2 instr : instr(char_str, substring [, position [, occurrence]]) # #Returns the index (1 based, not zero based) of the substring in the #char_str, starting at position. If occurrence and position are not #specified they default to one: instr returns the index of the first #occurrence of the substring. If occurrence is specified instr returns #the index of the Nth occurrence. If position is negative instr begins #the search from the tail end of char_str. # #=head2 nvl : nvl(char_str1, char_str2) # #Returns char_str2 if char_str1 is NULL, else returns char_str1 # #=head2 quurl : quurl(char_str) # #"Quote URL" - Replace all non-alphanumeric chars in a string with #'%hex' values, similar to the standard URL-style quoting. # #=head2 quurl2 : quurl2(char_str) # #"Quote URL" - Replace most non-alphanumeric chars in a string with #'%hex' values, leaving spaces and most punctuation (with the exception #of '%') untouched. # #=head2 unquurl : unquurl(char_str) # #Convert a "quoted url" string back. # #=head2 now : now() # #Return the current date in ISO 8601 format. # #=head2 sysdate : sysdate() # #Return the current date in ISO 8601 format. # EOF_HELP my $msg = $bigHelp; return $msg; } # end getpod # perl scalar functions # CHAR sub sql_func_chomp { # can't have full chomp semantics in sql... my $foo = shift; chomp($foo); return $foo; } sub sql_func_chop { # can't have full chop semantics in sql... my $foo = shift; chop($foo); return $foo; } sub sql_func_chr { my $num = shift; return chr($num); } sub sql_func_crypt { my ($plain, $salt) = @_; # XXX XXX return undef unless (defined($salt)); return crypt $plain, $salt; } sub sql_func_index { my $str = shift; my $substr = shift; my $pos = shift; $pos = 0 unless (defined($pos)); return index $str, $substr, $pos; } sub sql_func_lc { my $str = shift; return lc($str); } sub sql_func_lcfirst { my $str = shift; return lcfirst($str); } sub sql_func_length { my $str = shift; return length($str); } sub sql_func_ord { my $str = shift; return ord($str); } sub sql_func_pack { # Note: pack prototype expects a scalar for first arg, so # supplying an array causes it to get evaluated in the scalar # context, which is wrong. Shift off the format first. my $fformat = shift @_; my $foo = pack($fformat, @_); return $foo; } sub sql_func_reverse { return reverse(@_); } sub sql_func_rindex { my $str = shift; my $substr = shift; my $pos = shift; $pos = length($str) unless (defined($pos)); return rindex $str, $substr, $pos; } sub sql_func_sprintf { # Note: sprintf prototype expects a scalar for first arg, so # supplying an array causes it to get evaluated in the scalar # context, which is wrong. Shift off the format first. my $fformat = shift @_; my $foo = sprintf($fformat, @_); return $foo; } sub sql_func_substr { my ($exp1, $off1, $len1) = @_; return substr $exp1, $off1, $len1 if (defined($len1)); return substr $exp1, $off1; } sub sql_func_uc { my $str = shift; return uc($str); } sub sql_func_ucfirst { my $str = shift; return ucfirst($str); } # perl scalar functions # NUM sub sql_func_abs { my $num = shift; return abs($num); } sub sql_func_atan2 { my $yval = shift; my $xval = shift; return atan2 $yval, $xval; } sub sql_func_cos { my $num = shift; return cos($num); } # natural log base e sub sql_func_exp { my $num = shift; return exp($num); } sub sql_func_hex { my $num = shift; return hex($num); } # XXX XXX: bad name? sub sql_func_int { my $num = shift; return int($num); } # Note: need to disambiguate, because perl "log" is natural log, # but sql "log" is log10 sub sql_func_log10 { my $n = shift; return log($n)/log(10); } sub sql_func_logn { my ($base, $num) = @_; return undef unless (defined($base) && defined($num)); return log($num)/log($base); } sub sql_func_oct { my $num = shift; return oct($num); } sub sql_func_rand { my $num = shift; return rand($num); } sub sql_func_sin { my $num = shift; return sin($num); } sub sql_func_sqrt { my $num = shift; return sqrt($num); } sub sql_func_srand { my $num = shift; return srand($num); } # more perl sub sql_func_perl_join { my $p1 = shift; return join($p1, @_); } # SQL scalar functions # CHAR sub sql_func_concat { return join('',@_); } sub sql_func_greatest { my $maxval = shift; for my $val (@_) { if ($val gt $maxval) { $maxval = $val; } } return $maxval; } sub sql_func_initcap { my $str = shift; # find all the words in the string, and capitalize the first # letter of each one (add underscore to non-word chars) my @foo = split(/\W|_/, $str); for my $val (@foo) { next unless (defined($val)); # shouldn't need to use quotemeta because split should extra # only valid words -- no metachars my $ucfval = ucfirst($val); # replace each word (bounded by end of line, underscore, or # some non-word char) with its titlecase equivalent $str =~ s/(^|\W|_)($val)(\W|_|$)/$1$ucfval$3/gm; } return ($str); } sub sql_func_least { my $minval = shift; for my $val (@_) { if ($val lt $minval) { $minval = $val; } } return $minval; } sub sql_func_lower { my $str = shift; return lc($str); } sub sql_func_lpad { my ($str, $len, $pattern) = @_; # error return undef unless (defined($str) && defined($len)); my $outi = $str; if (defined($pattern) && length($pattern)) { my $repeat = 0; my $orig_len = length($str); if ($orig_len < $len) { $repeat = 1 + ($len - $orig_len)/ length($pattern); } $outi = reverse($str); my $revpat = reverse($pattern); $outi .= ($revpat x $repeat) ; $outi = reverse(substr($outi, 0, $len)); } else { # blank pad my $tmplate = "A$len"; my $revstr = reverse($str); $outi = reverse(pack($tmplate, $revstr)); } return $outi; } sub sql_func_ltrim { my ($str, $pattern) = @_; # error return undef unless (defined($str)); my $outi = $str; if (defined($pattern)) { # pattern is a set of individual matching characters my @foo = split(/ */, $pattern); my $qmp = join('|', map(quotemeta, @foo)); my $tmplate = '^(' . $qmp. ')*'; $outi =~ s/$tmplate// ; } else { my $tmplate = '^\s*'; $outi =~ s/$tmplate// ; } return $outi; } sub sql_func_replace { my ($str, $search_str, $replace_str) = @_; # error return undef unless (defined($str) && defined($search_str)); my $outi = $str; if (defined($replace_str)) { my $qmp1 = quotemeta($search_str); my $qmp2 = quotemeta($replace_str); $outi =~ s/$qmp1/$qmp2/gm ; } else { my $qmp1 = quotemeta($search_str); $outi =~ s/$qmp1//gm ; } return $outi; } sub sql_func_rpad { my ($str, $len, $pattern) = @_; # error return undef unless (defined($str) && defined($len)); my $outi = $str; if (defined($pattern) && length($pattern)) { my $repeat = 0; my $orig_len = length($str); if ($orig_len < $len) { $repeat = 1 + ($len - $orig_len)/ length($pattern); } $outi .= ($pattern x $repeat); $outi = substr($outi, 0, $len); } else { # blank pad my $tmplate = "A$len"; $outi = pack($tmplate, $str); } return $outi; } sub sql_func_rtrim { my ($str, $pattern) = @_; # error return undef unless (defined($str)); my $outi = $str; if (defined($pattern)) { # pattern is a set of individual matching characters my @foo = split(/ */, $pattern); my $qmp = join('|', map(quotemeta, @foo)); my $tmplate = '(' . $qmp. ')*$'; $outi =~ s/$tmplate// ; } else { my $tmplate = '\s*$'; $outi =~ s/$tmplate// ; } return $outi; } sub sql_func_soundex { my $str = shift; use Text::Soundex; return soundex($str); } sub sql_func_translate { my ($str, $search_str, $replace_str) = @_; # error return undef unless (defined($str) && defined($search_str) && defined($replace_str)); my $outi = $str; # my $qmp1 = quotemeta($search_str); # my $qmp2 = quotemeta($replace_str); # translate is built at compile time, not subject to # double quote interpolation, so must use eval eval "\$outi =~ tr/$search_str/$replace_str/" ; return $outi; } sub sql_func_upper { my $str = shift; return uc($str); } # SQL scalar functions # num sub sql_func_ceil { return POSIX::ceil(@_); } sub sql_func_cosh { # from Math::Complex - hyperbolic cosine cosh(z) = (exp(z) + exp(-z))/2. my $num = shift; return ((exp($num) + exp((-1) * $num))/2); } sub sql_func_floor { return POSIX::floor(@_); } sub sql_func_ln { my $n = shift; return log($n); } sub sql_func_mod { my ($mm, $nn) = @_; return undef unless (defined($mm) && defined($nn)); return $mm if ($nn == 0); return $mm % $nn; # XXX XXX: what about negative mod? } sub sql_func_power { my ($mm, $nn) = @_; return undef unless (defined($mm) && defined($nn)); return $mm ** $nn; } # XXX XXX sub sql_func_round { my ($num, $decplace) = @_; return undef unless (defined($num)); # XXX XXX: just call trunc($num+0.5, $decplace) ?? $decplace = 0 unless (defined($decplace)); if (0 == $decplace) { # add 1/2 then take the "floor" to get round up/round down behavior return POSIX::floor($num + 0.5); } if ($decplace > 0) { return ((sql_func_round($num * (10**$decplace))) / (10**$decplace) ); } # negative decimal places round the left side of the decimal point $decplace *= -1; return ((sql_func_round($num / (10**$decplace))) * (10**$decplace) ); } # XXX XXX sub sql_func_sign { my $num = shift; return undef unless (defined($num)); # 0 if num == 0, 1 if num > 0, -1 if num < 0 return ($num <=> 0); } sub sql_func_sinh { # from Math::Complex - hyperbolic sine sinh(z) = (exp(z) - exp(-z))/2. my $num = shift; return ((exp($num) - exp((-1) * $num))/2); } sub sql_func_tan { my $num = shift; return (sin($num)/cos($num)); } sub sql_func_tanh { # from Math::Complex - hyperbolic tangent tanh(z) = sinh(z) / cosh(z). my $num = shift; return (sql_func_sinh($num) / sql_func_cosh($num)); } # XXX XXX sub sql_func_trunc { my ($num, $decplace) = @_; return undef unless (defined($num)); $decplace = 0 unless (defined($decplace)); if (0 == $decplace) { return POSIX::floor($num); } if ($decplace > 0) { return ( (POSIX::floor(($num) * (10**$decplace))) / (10**$decplace)); } # negative decimal places round the left side of the decimal point $decplace *= -1; return ( (POSIX::floor(($num) / (10**$decplace))) * (10**$decplace)); } # SQL scalar functions # CONVERSION sub sql_func_ascii { my $str = shift; return ord($str); } sub sql_func_instr { # XXX XXX: need to handle occurrence!! my ($str, $substr, $pos, $occurrence) = @_; $pos = 0 unless (defined($pos)); $occurrence = 1 unless (defined($occurrence)); # XXX XXX return undef unless ($occurrence > 0); if ($pos >= 0) { # instr starts at 1, and index starts at zero $pos-- if ($pos); my $foundit = (index $str, $substr, $pos); while (($occurrence > 1) && ($foundit > -1)) { $pos = $foundit + 1; $foundit = (index $str, $substr, $pos); $occurrence--; } return ($foundit + 1); } else { # oof! weird semantics... $str = reverse($str); $substr = reverse($substr); # instr starts at 1, and index starts at zero $pos++; $pos *= -1; my $foundit = (index $str, $substr, $pos); while (($occurrence > 1) && ($foundit > -1)) { $pos = $foundit + 1; $foundit = (index $str, $substr, $pos); $occurrence--; } # going backwards, so we are positioned at end of substr, not # the beginning. Need to subtract the length return 0 if ($foundit < 0); # return (($foundit - length($substr)) + 1); return (((length($str) - $foundit) - length($substr)) + 1); } } sub sql_func_nvl { my $s1 = shift; my $s2 = shift; if (defined($s1)) { return $s1; } return $s2; } # Genezzo custom functions # only allow alphanums, and quote all other chars as hex string sub sql_func_quurl { my $str = shift; $str =~ s/([^a-zA-Z0-9])/uc(sprintf("%%%02lx", ord $1))/eg; return $str; } # more "relaxed" version of quurl function -- allow basic punctuation # with the exception of "%" and quote characters sub sql_func_quurl2 { my $str = shift; my $pat1 = '[^a-zA-Z0-9' . quotemeta(' ~!@#$^&*()-_=+{}|[]:;<>,.?/') . ']'; $str =~ s/($pat1)/uc(sprintf("%%%02lx", ord $1))/eg; return $str; } # unconvert quoted strings sub sql_func_unquurl { my $str = shift; $str =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg; return $str; } sub HavokInit { # whoami; my %optional = (phase => "init"); my %required = (dict => "no dictionary!", flag => "no flag" ); my %args = (%optional, @_); # my @stat; # push @stat, 0, $args{flag}; push @stat, 1, $args{flag}; # whoami (%args); return @stat unless (Validate(\%args, \%required)); return @stat; } sub HavokCleanup { # whoami; return HavokInit(@_, phase => "cleanup"); } END { } # module clean-up code here (global destructor) ## YOUR CODE GOES HERE 1; # don't forget to return a true value from the file __END__ # Below is stub documentation for your module. You better edit it! =head1 NAME Genezzo::Havok::SQLScalar - scalar SQL functions =head1 SYNOPSIS HavokUse("Genezzo::Havok::SQLScalar") =head1 DESCRIPTION =head1 ARGUMENTS =head1 FUNCTIONS =head2 perl functions See L for descriptions. =over 4 =item chomp(char_str) Return the string with the trailing newline removed. =item chop(char_str) Return the string with the last character removed. =item chr(number) Returns the character represented by the number in the character set. =item crypt(plaintext, salt) Returns the plaintext string encrypted with the C crypt routine. =item index(char_str, substr[, start_position]) Returns the position (0-based) of the first character of the substring in the string, or -1 if not found, starting at start_position. Start_position defaults to zero if not specified. =item lc(char_str) Returns the lowercased char_str. =item lcfirst(char_str) Returns char_str with only the first character lowercased. =item length(char_str) Returns the number of characters in char_str. =item ord(char_str) Returns the numeric encoding of the first character of char_str. =item pack(template_str, list_of_values) Converts a list of values into a string using the perl pack function. =item reverse(char_str) Returns the string in reverse order. =item rindex(char_str, substr[, start_position]) Like index, but backwards: finds the last occurrence of the substr in char_str. =item sprintf(format_str, list_of_values) Returns a string formatted using the C sprintf. Note that the sprintf format string must be single-quoted (SQL-style), not double-quoted. =item substr(char_str, offset_position[, length]) Returns the substring of char_str, starting at the offset, of the specified length. If length is omitted the it returns from the offset to the end of the string. Special rules for negative offset, length. =item uc(char_str) Returns the uppercased char_str. =item ucfirst(char_str) Returns char_str with only the first character uppercased. =item abs(number) Absolute value =item atan2(numberY, numberX) Arctangent (in radians) =item cos(number) Cosine (in radians). =item exp(n) Returns e**n =item hex(char_str) Treats char_str as a hexadecimal value and converts to number. =item int(number) Returns the integer portion of number. =item oct(char_str) Treats char_str as a octal value and converts to number. =item rand(number) Returns returns a random number N, where 0 <= N < number. Note that N is not an integer, so use an expression like int(rand(Max_N)) to obtain integer values where 0 <= N <= (Max_N - 1). =item sin(number) Sine (in radians) =item sqrt(number) Square root. =item srand(number) Set the random seed. =item perl_join(join_expr, char_str1, char_str2[, char_str3...]) The perl string join, renamed to avoid conflict with the SQL relational join. Concatenates the strings with the join_expr. Example: perl_join(':', 'foo', 'bar', 'baz') returns 'foo:bar:baz'. =back =head2 SQL string functions =over 4 =item concat(char_str1, char_str2...) Concatenate strings =item greatest(item1, item2...) Find the greatest element in a list =item initcap(char_str) Return the string with the initial letter of each word capitalized, where words are defined as contiguous groups of alphanumeric chars separated by non-word chars. =item least(item1, item2...) Find the smallest element in a list =item lower(char_str) Return the string with all letters lowercase =item lpad(char_str1, n [, char_str2]) Returns the string char_str1 padded out on the left to length n with copies of char_str2. If char_str2 is not specified blanks are used. If char_str1 is larger than length n it is truncated to fit. =item ltrim(char_str [, set]) Returns the string which is trimmed on the left up to the first character which is not in the specified set. If set is unspecified, blanks are trimmed. =item soundex(char_str) Knuth's soundex from L. =item replace(char_str, search_str [, replace_str]) Returns char_str with all occurrences of the search_str replaced by replace_str. If the replace_str is unspecified or null, it removes all occurrences of the search_str. =item rpad(char_str1, n [, char_str2]) Returns the string char_str1 padded out on the right to length n with copies of char_str2. If char_str2 is not specified blanks are used. If char_str1 is larger than length n it is truncated to fit. =item rtrim(char_str [, set]) Returns the string which is trimmed on the right up to the first character which is not in the specified set. If set is unspecified, blanks are trimmed. =item translate(char_str, search_str, replace_str) Similar to perl transliteration tr/ (see L ), returns a string where all occurrences of a character in the search string are replaced with the corresponding character in the replace string. =item upper(char_str) Returns the string with all characters uppercase. =back =head2 SQL math functions =over 4 =item cosh(n) Hyperbolic cosine =item ceil(n) Returns the smallest integer greater than or equal to n =item floor(n) Returns the largest integers less than or equal to n =item ln(n) Natural log. =item log10(n) Log base 10. =item logN(base_N, num) Returns the Log base base_N on num. =item mod(m,n) Returns the remainder of m divided by n. =item power(m,n) Returns m**n =item round(num [, m]) Return num rounded to m places to the right of the decimal point. M=0 if not specified. If m is negative num is rounded to the left of the decimal point. =item sign(n) Similar to "spaceship", returns -1 for N < 0, 0 for N==0, and 1 for N > 0. =item sinh(n) Hyperbolic sine. =item tan(n) tangent =item tanh(n) Hyperbolic tangent. =item trunc(num [, m]) Return num truncated to m places to the right of the decimal point. M=0 if not specified. If m is negative num is truncated to the left of the decimal point. =back =head2 SQL conversion functions These functions return a value of a different type than their operands. =over 4 =item ascii(char_str) Return the ascii value of the first char of the string. =item instr(char_str, substring [, position [, occurrence]]) Returns the index (1 based, not zero based) of the substring in the char_str, starting at position. If occurrence and position are not specified they default to one: instr returns the index of the first occurrence of the substring. If occurrence is specified instr returns the index of the Nth occurrence. If position is negative instr begins the search from the tail end of char_str. =item nvl(char_str1, char_str2) Returns char_str2 if char_str1 is NULL, else returns char_str1 =back =head2 Genezzo functions =over 4 =item quurl(char_str) "Quote URL" - Replace all non-alphanumeric chars in a string with '%hex' values, similar to the standard URL-style quoting. =item quurl2(char_str) "Quote URL" - Replace most non-alphanumeric chars in a string with '%hex' values, leaving spaces and most punctuation (with the exception of '%') untouched. =item unquurl(char_str) Convert a "quoted url" string back. =back =head2 EXPORT =over 4 =back =head1 LIMITATIONS In Perl, "log" is a natural log, but the standard SQL log function is log base N. To prevent confusion in usage, Genezzo supplies a natural log function "ln", a base 10 function "log10", and a log of variable base called "logN". The current implementation does not do any compile-time type checking of arguments for any functions. =head1 AUTHOR Jeffrey I. Cohen, jcohen@genezzo.com =head1 SEE ALSO L. Copyright (c) 2005, 2006, 2007 Jeffrey I Cohen. All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Address bug reports and comments to: jcohen@genezzo.com For more information, please visit the Genezzo homepage at L =cut