Author: timbo
Date: Tue May 27 04:43:55 2008
New Revision: 11328
Added:
dbi/trunk/t/18concathash.t
- copied, changed from r11327, /dbi/trunk/t/ConcatHash.t
Removed:
dbi/trunk/t/ConcatHash.t
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.xs
dbi/trunk/lib/DBI/PurePerl.pm
Log:
Change Newx() to New() as Newx() doesn't exist - not sure what Rudolf was using.
Add Rudolfs pure perl _concat_hash_sorted to lib/DBI/PurePerl.pm
Moved t/ConcatHash.t to t/18concathash.t, added strict and fixed errors that
raised.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Tue May 27 04:43:55 2008
@@ -56,6 +56,8 @@
=head2 Changes in DBI 1.605 XXX
+Add note about _concat_hash_sorted once integrated
+
Fixed the selectall_arrayref, selectrow_arrayref, and selectrow_array
methods that get embedded into compiled drivers to use the
inner sth handle when passed a $sth instead of an sql string.
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Tue May 27 04:43:55 2008
@@ -259,8 +259,8 @@
if (!hv_len)
return 0;
- Newx(keys, hv_len, char *);
- Newx(numbers, hv_len, struct num_srt_info);
+ New(0, keys, hv_len, char *);
+ New(0, numbers, hv_len, struct num_srt_info);
while ((entry = hv_iternext(hash))) {
*(keys+idx) = hv_iterkey(entry, &key_len);
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Tue May 27 04:43:55 2008
@@ -637,6 +637,7 @@
croak("bad hash type $type");
}
}
+
sub looks_like_number {
my @new = ();
for my $thing(@_) {
@@ -672,6 +673,51 @@
sub DBI::st::TIEHASH { bless $_[1] => $_[0] };
+
+sub _concat_hash_sorted {
+ my ( $hash_ref, $kv_separator, $pair_separator, $value_format, $sort_type
) = @_;
+ # $value_format: false=use neat(), true=dumb quotes
+ # $sort_type: 0=lexical, 1=numeric, undef=try to guess
+ Carp::croak("hash is not a hash reference")
+ unless ref $hash_ref eq 'HASH';
+ my $keys = _get_sorted_hash_keys($hash_ref, $sort_type);
+ my $string = '';
+ for my $key (@$keys) {
+ $string .= $pair_separator if length $string > 0;
+ my $value = $hash_ref->{$key};
+ if ($value_format) {
+ $value = (defined $value) ? "'$value'" : 'undef';
+ }
+ else {
+ $value = DBI::neat($value,0);
+ }
+ $string .= $key . $kv_separator . $value;
+ }
+ return $string;
+}
+
+sub _get_sorted_hash_keys {
+ my ($hash_ref, $sort_type) = @_;
+ my $sort_guess = 1;
+ if (not defined $sort_type) {
+ #my $first_key = (each %$hash_ref)[0];
+ #$sort_type = looks_like_number($first_key);
+
+ $sort_guess = (1!=DBI::looks_like_number($_))
+ ? 0 : $sort_guess
+ for keys %$hash_ref;
+ $sort_type = $sort_guess unless (defined $sort_type);
+ }
+
+ my @keys = keys %$hash_ref;
+ no warnings 'numeric';
+ return [ ($sort_type && $sort_guess)
+ ? sort {$a <=> $b} @keys
+ : sort @keys
+ ];
+}
+
+
package
DBI::var;
Copied: dbi/trunk/t/18concathash.t (from r11327, /dbi/trunk/t/ConcatHash.t)
==============================================================================
--- /dbi/trunk/t/ConcatHash.t (original)
+++ dbi/trunk/t/18concathash.t Tue May 27 04:43:55 2008
@@ -5,6 +5,7 @@
# change 'tests => 1' to 'tests => last_test_to_print';
+use strict;
use Test::More tests => 36;
BEGIN { use_ok('DBI') };
no warnings 'uninitialized';
@@ -95,9 +96,9 @@
"Float Hash" => $simple_float
);
-for $sort_type (keys %sort_types){
- for $neat (keys %neats) {
- for $hash(keys %hashes) {
+for my $sort_type (keys %sort_types){
+ for my $neat (keys %neats) {
+ for my $hash (keys %hashes) {
test_concat_hash($hash, $neat, $sort_type);
}
}
@@ -145,7 +146,7 @@
# $value_format: false=use neat(), true=dumb quotes
# $sort_type: 0=lexical, 1=numeric, undef=try to guess
- $keys = _get_sorted_hash_keys($hash_ref, $sort_type);
+ my $keys = _get_sorted_hash_keys($hash_ref, $sort_type);
my $string = '';
for my $key (@$keys) {
$string .= $pair_separator if length $string > 0;
@@ -182,10 +183,4 @@
];
}
-
-
-#########################
-
-# Insert your test code below, the Test::More module is use()ed here so read
-# its man page ( perldoc Test::More ) for help writing this test script.
-
+1;
