← Back to branch summary

~ubuntu-branches/ubuntu/edgy/libdbi-perl/edgy

« back to all changes in this revision

Viewing changes to lib/DBI/PurePerl.pm

  • Committer: Bazaar Package Importer
  • Author(s): Christian Hammers
  • Date: 2006-01-09 22:09:07 UTC
  • mfrom: (0.2.8 upstream)
  • Revision ID: james.westby@ubuntu.com-20060109220907-pxxc985dyxgm7qha
Tags: 1.50-1
New upstream release

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/DBI/PurePerl.pm
38
38
open $DBI::tfh, ">&STDERR" or warn "Can't dup STDERR: $!";
39
39
select( (select($DBI::tfh), $| = 1)[0] );  # autoflush
40
40
 
 
41
# check for weaken support, used by ChildHandles
 
42
my $HAS_WEAKEN = eval { 
 
43
    require Scalar::Util;
 
44
    # this will croak() if this Scalar::Util doesn't have a working weaken().
 
45
    Scalar::Util::weaken(my $test = \"foo"); 
 
46
    1;
 
47
};
41
48
 
42
49
%DBI::last_method_except = map { $_=>1 } qw(DESTROY _set_fbav set_err);
43
50
 
143
150
        Attribution
144
151
        BegunWork
145
152
        CachedKids
 
153
        Callbacks
 
154
        ChildHandles
146
155
        CursorName
147
156
        Database
148
157
        DebugDispatch
169
178
        SCALE
170
179
        Statement
171
180
        TYPE
 
181
        Type
172
182
        TraceLevel
173
183
        Username
174
184
        Version
440
450
            $h_inner->{Driver} = $parent;
441
451
        }
442
452
        $h_inner->{_parent} = $parent;
 
453
 
 
454
        # add to the parent's ChildHandles
 
455
        if ($HAS_WEAKEN) {
 
456
            my $handles = $parent->{ChildHandles} ||= [];
 
457
            push @$handles, $h;
 
458
            Scalar::Util::weaken($handles->[-1]);
 
459
            # purge destroyed handles occasionally
 
460
            if (@$handles % 120 == 0) {
 
461
                @$handles = grep { defined } @$handles;
 
462
                Scalar::Util::weaken($_) for @$handles; # re-weaken after grep
 
463
            }
 
464
        }   
443
465
    }
444
466
    else {      # setting up a driver handle
445
467
        $h_inner->{Warn}                = 1;
449
471
        $h_inner->{CompatMode}          = (1==0);
450
472
        $h_inner->{FetchHashKeyName}    ||= 'NAME';
451
473
        $h_inner->{LongReadLen}         ||= 80;
 
474
        $h_inner->{ChildHandles}        ||= [] if $HAS_WEAKEN;
452
475
    }
453
476
    $h_inner->{"_call_depth"} = 0;
454
477
    $h_inner->{ErrCount} = 0;
645
668
        return ($h->FETCH('TaintIn') && $h->FETCH('TaintOut')) if $key eq'Taint';
646
669
        return (1==0) if $is_flag_attribute{$key}; # return perl-style sv_no, not undef
647
670
        return $DBI::dbi_debug if $key eq 'TraceLevel';
 
671
        return [] if $key eq 'ChildHandles';
 
672
        if ($key eq 'Type') {
 
673
            return "dr" if $h->isa('DBI::dr');
 
674
            return "db" if $h->isa('DBI::db');
 
675
            return "st" if $h->isa('DBI::st');
 
676
            Carp::carp( sprintf "Can't get determine Type for %s",$h );
 
677
        }
648
678
        if (!$is_valid_attribute{$key} and $key =~ m/^[A-Z]/) {
649
679
            local $^W; # hide undef warnings
650
680
            Carp::carp( sprintf "Can't get %s->{%s}: unrecognised attribute (@{[ %$h ]})",$h,$key )