view release on metacpan or  search on metacpan

lib/Apache/DBI.pm  view on Meta::CPAN

    1;
}

# Store the default start state of each dbh in the handle
# Note: This uses private_Apache_DBI hash ref to store it in the handle itself
my @attrs = qw(
               AutoCommit Warn CompatMode InactiveDestroy
               PrintError RaiseError HandleError
               ShowErrorStatement TraceLevel FetchHashKeyName
               ChopBlanks LongReadLen LongTruncOk
               Taint Profile
);

sub set_startup_state {
    my $Idx = shift;

    foreach my $key (@attrs) {
        $Connected{$Idx}->{private_Apache_DBI}{$key} =
            $Connected{$Idx}->{$key};
    }

    if ($TaintInOut) {
        foreach my $key ( qw{ TaintIn TaintOut } ) {
            $Connected{$Idx}->{private_Apache_DBI}{$key} = 
                $Connected{$Idx}->{$key};
        }
    }

    1;
}

# Restore the default start state of each dbh
sub reset_startup_state {
    my $Idx = shift;

    # Rollback current transaction if currently in one
    $Connected{$Idx}->{Active}
      and !$Connected{$Idx}->{AutoCommit}
      and eval {$Connected{$Idx}->rollback};

    foreach my $key (@attrs) {
        $Connected{$Idx}->{$key} =
            $Connected{$Idx}->{private_Apache_DBI}{$key};
    }

    if ($TaintInOut) {
        foreach my $key ( qw{ TaintIn TaintOut } ) {
            $Connected{$Idx}->{$key} =
                $Connected{$Idx}->{private_Apache_DBI}{$key};
        }
    }

    1;
}


# This function can be called from other handlers to perform tasks on all
# cached database handles.
sub all_handlers { return \%Connected }

# patch from Tim Bunce: Apache::DBI will not return a DBD ref cursor
@Apache::DBI::st::ISA = ('DBI::st');

# overload disconnect
{
  package Apache::DBI::db;
  no strict;
  @ISA=qw(DBI::db);
  use strict;
  sub disconnect {
      my $prefix = "$$ Apache::DBI            ";
      Apache::DBI::debug(2, "$prefix disconnect (overloaded)");
      1;
  }
  ;
}

# prepare menu item for Apache::Status
sub status_function {
    my($r, $q) = @_;

    my(@s) = qw(<TABLE><TR><TD>Datasource</TD><TD>Username</TD></TR>);
    for (keys %Connected) {
        push @s, '<TR><TD>',
            join('</TD><TD>',
                 (split($;, $_))[0,1]), "</TD></TR>\n";
    }
    push @s, '</TABLE>';

    \@s;
}

if (MP2) {
    if (Apache2::Module::loaded('Apache2::Status')) {
	    Apache2::Status->menu_item(
                                   'DBI' => 'DBI connections',
                                    \&status_function
                                  );
    }
}
else {
   if ($INC{'Apache.pm'}                       # is Apache.pm loaded?
       and Apache->can('module')               # really?
       and Apache->module('Apache::Status')) { # Apache::Status too?
       Apache::Status->menu_item(
                                'DBI' => 'DBI connections',
                                \&status_function
                                );
   }
}

1;

__END__


=head1 NAME

Apache::DBI - Initiate a persistent database connection