Result:
found more than 443 distributions - search limited to the first 2001 files matching your query
( run in 2.287 )
Apache-AuthLDAPBind
view release on metacpan or search on metacpan
lib/Apache/AuthLDAPBind.pm view on Meta::CPAN
use strict;
use Net::LDAP;
use Apache::Constants qw(:common);
=head1 NAME
Apache::AuthLDAPBind - Authentcates a user to Apache by binding to an
LDAP server as that user.
=head1 VERSION
Version 0.02
lib/Apache/AuthLDAPBind.pm view on Meta::CPAN
our $VERSION = '0.02';
=head1 SYNOPSIS
This is an authentication module for Apache 1.3 (and mod_perl) that
authenticates a user to an LDAP server by binding as that user (with
his supplied password). If the bind succeeds, the user is
authenticated. If not, authentication fails.
This is much more secure than the usual method of checking the
password against a hash, since there's no possibility that the hash
will be viewed while in transit (or worse, simply pulled out of the
lib/Apache/AuthLDAPBind.pm view on Meta::CPAN
return AUTH_REQUIRED;
}
my $ok;
eval {
$ok = _bind_ldap($ldap_server, $ldap_port, $base_dn, $uid_attr,
$username, $sent_password);
};
$ok = 0 if $@;
if(!$ok){
lib/Apache/AuthLDAPBind.pm view on Meta::CPAN
return ($ldap_server, $ldap_port, $base_dn, $uid_attr);
}
# returns false if login fails, true if login succeeds. dies on errors.
sub _bind_ldap {
my $ldap_server = shift;
my $ldap_port = shift;
my $base_dn = shift;
my $uid_attr = shift;
my $username = shift;
my $password = shift;
# prevent anonymous binds!
if(!defined $username || !defined $password){
die "null username/password passed to _bind_ldap!";
}
my $ldap = Net::LDAP->new("$ldap_server".
((defined $ldap_port) ? ":$ldap_port" : ""));
my $mesg = $ldap->start_tls();
$mesg = $ldap->bind("$uid_attr=$username,$base_dn",
password=>$password);
$ldap->unbind; # take down session
$mesg->code && return 0; # failed
return 1; # passed
}
lib/Apache/AuthLDAPBind.pm view on Meta::CPAN
Jonathan T. Rockway, C<< <jon-cpan@jrock.us> >>
=head1 BUGS
Please report any bugs or feature requests to
C<bug-apache-authldapbind@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Apache-AuthLDAPBind>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 COPYRIGHT & LICENSE
Apache-AuthNetLDAP
view release on metacpan or search on metacpan
AuthNetLDAP.pm view on Meta::CPAN
return $result if $result;
# change based on version of mod_perl
my $user = MP2 ? $r->user : $r->connection->user;
my $binddn = $r->dir_config('BindDN') || "";
my $bindpwd = $r->dir_config('BindPWD') || "";
my $basedn = $r->dir_config('BaseDN') || "";
my $ldapserver = $r->dir_config('LDAPServer') || "localhost";
my $ldapport = $r->dir_config('LDAPPort') || 389;
my $uidattr = $r->dir_config('UIDAttr') || "uid";
my $allowaltauth = $r->dir_config('AllowAlternateAuth') || "no";
AuthNetLDAP.pm view on Meta::CPAN
or MP2 ? $r->log_error( "Unable to start_tls", $r->uri)
: $r->log_reason("Unable to start_tls", $r->uri);
}
my $mesg;
#initial bind as user in Apache config
if ($bindpwd ne "")
{
$mesg = $ldap->bind($binddn, password=>$bindpwd);
}
else
{
$mesg = $ldap->bind();
}
#each error message has an LDAP error code
if (my $error = $mesg->code())
{
AuthNetLDAP.pm view on Meta::CPAN
}
}
}
else
{
$mesg = $ldap->bind($entry->dn(),password=>$password);
}
if (my $error = $mesg->code())
{
$r->note_basic_auth_failure;
MP2 ? $r->log_error("user $user: failed bind: $error",$r->uri) : $r->log_reason("user $user: failed bind: $error",$r->uri);
return MP2 ? Apache::HTTP_UNAUTHORIZED : Apache::Constants::HTTP_UNAUTHORIZED;
}
my $error = $mesg->code();
my $dn = $entry->dn();
# MP2 ? $r->log_error("AUTHDEBUG user $dn:$password bind: $error",$r->uri) : $r->log_reason("AUTHDEBUG user $dn:$password bind: $error",$r->uri);
return MP2 ? Apache::OK : Apache::Constants::OK;
}
# Autoload methods go after =cut, and are processed by the autosplit program.
AuthNetLDAP.pm view on Meta::CPAN
=head1 SYNOPSIS
AuthName "LDAP Test Auth"
AuthType Basic
#only set the next two if you need to bind as a user for searching
#PerlSetVar BindDN "uid=user1,ou=people,o=acme.com" #optional
#PerlSetVar BindPWD "password" #optional
PerlSetVar BaseDN "ou=people,o=acme.com"
PerlSetVar LDAPServer ldap.acme.com
PerlSetVar LDAPPort 389
AuthNetLDAP.pm view on Meta::CPAN
=item PerlSetVar AlternatePWAttribute
The an alternate attribute with which the $password will be tested.
This allows you to test with another attribute, instead of just
trying to bind the userdn and password to the ldap server.
If this option is used, then a BindDN and BindPWD must be used for the
initial bind.
=item PerlSetVar AllowAlternateAuth
This attribute allows you to set an alternative method of authentication
(Basically, this allows you to mix authentication methods, if you don't have
AuthNetLDAP.pm view on Meta::CPAN
Then in your httpd.conf file or .htaccess file, in either a <Directory> or <Location> section put:
AuthName "LDAP Test Auth"
AuthType Basic
#only set the next two if you need to bind as a user for searching
#PerlSetVar BindDN "uid=user1,ou=people,o=acme.com" #optional
#PerlSetVar BindPWD "password" #optional
PerlSetVar BaseDN "ou=people,o=acme.com"
PerlSetVar LDAPServer ldap.acme.com
PerlSetVar LDAPPort 389
Apache-AuthPerLDAP
view release on metacpan or search on metacpan
AuthPerLDAP.pm view on Meta::CPAN
# Found username in LDAP database, get its DN
my $dn = $entry->getDN();
#
# Try to rebind with the users DN and password.
#
unless (($dn ne "") && ($conn->simpleAuth($dn, $password))) {
$r->note_basic_auth_failure;
$r->log_reason("user $username: invalid password", $r->uri);
Apache-AuthTicket
view release on metacpan or search on metacpan
lib/Apache/AuthTicket/Base.pm view on Meta::CPAN
sub check_credentials {
my ($self, $user, $password) = @_;
my ($table, $user_field, $pass_field) = $self->user_table;
my ($stmt, @bind) =
$self->sql->select($table, $pass_field, {$user_field => $user});
my ($db_pass) = eval {
$self->dbh->selectrow_array($stmt, undef, @bind);
};
if ($@) {
$self->dbh->rollback;
return 0;
}
lib/Apache/AuthTicket/Base.pm view on Meta::CPAN
# generate SQL
my @fields = ($secret_field, $secret_version_field);
my %where = ( $secret_version_field => $version ) if defined $version;
my $order = " $secret_version_field DESC LIMIT 1 ";
my ($stmt, @bind) = $self->sql->select($secret_table, \@fields, \%where, $order);
return eval {
$dbh->selectrow_array($stmt, undef, @bind);
};
if ($@) {
$dbh->rollback;
die $@;
}
lib/Apache/AuthTicket/Base.pm view on Meta::CPAN
my $time = $self->request->request_time;
my $dbh = $self->dbh;
my ($table, $tick_field, $ts_field) = $self->ticket_table;
my ($query, @bind) = $self->sql->update($table,
{$ts_field => $time},
{$tick_field => $hash});
eval {
my $sth = $dbh->do($query, undef, @bind);
$dbh->commit unless $dbh->{AutoCommit};
};
if ($@) {
$dbh->rollback;
die $@;
lib/Apache/AuthTicket/Base.pm view on Meta::CPAN
sub save_hash {
my ($self, $hash) = @_;
my ($table, $tick_field, $ts_field) = $self->ticket_table;
my ($query, @bind) = $self->sql->insert($table, {
$tick_field => $hash,
$ts_field => $self->request->request_time });
my $dbh = $self->dbh;
eval {
my $sth = $dbh->do($query, undef, @bind);
$dbh->commit unless $dbh->{AutoCommit};
};
if ($@) {
$dbh->rollback;
die $@;
lib/Apache/AuthTicket/Base.pm view on Meta::CPAN
sub delete_hash {
my ($self, $hash) = @_;
my ($table, $tick_field) = $self->ticket_table;
my ($query, @bind) = $self->sql->delete($table, { $tick_field => $hash });
my $dbh = $self->dbh;
eval {
my $sth = $dbh->do($query, undef, @bind);
$dbh->commit unless $dbh->{AutoCommit} || 0;
};
if ($@) {
$dbh->rollback;
die $@;
lib/Apache/AuthTicket/Base.pm view on Meta::CPAN
sub is_hash_valid {
my ($self, $hash) = @_;
my ($table, $tick_field, $ts_field) = $self->ticket_table;
my ($query, @bind) = $self->sql->select($table, [$tick_field, $ts_field],
{ $tick_field => $hash });
my $dbh = $self->dbh;
my ($db_hash, $ts) = (undef, undef);
eval {
($db_hash, $ts) = $dbh->selectrow_array($query, undef, @bind);
$self->{DBTicketTimeStamp} = $ts; # cache for later use.
};
if ($@) {
$dbh->rollback;
die $@;
Apache-AuthenLDAP
view release on metacpan or search on metacpan
AuthenLDAP.pm view on Meta::CPAN
$r->log_reason("user $name: LDAP Connection Failed", $r->uri);
return SERVER_ERROR;
}
# Bind anonymously
my $msg = $ld->bind;
unless ($msg->code == LDAP_SUCCESS) {
$r->note_basic_auth_failure;
$r->log_reason("user $name: LDAP Initial Bind Failed: " . $msg->code .
" " . $msg->error, $r->uri);
return SERVER_ERROR;
AuthenLDAP.pm view on Meta::CPAN
# Only want the first if we've received more than one
my $entry = $msg->first_entry;
my $dn = $entry->dn;
# Bind as the user we're authenticating
$msg = $ld->bind($dn, password => $sent_pwd);
unless ($msg->code == LDAP_SUCCESS) {
$r->note_basic_auth_failure;
$r->log_reason("user $name: password mismatch", $r->uri);
return AUTH_REQUIRED;
}
$ld->unbind;
if ($expire eq 'true') {
# Is the password set to expired in LDAP?
if (($entry->get($exp_attrtype))[0] eq 'true') {
$r->log->debug("handler: password flag expired");
Apache-AuthenMSAD
view release on metacpan or search on metacpan
lib/Apache/AuthenMSAD.pm view on Meta::CPAN
$r->note_basic_auth_failure;
$r->log_reason("user - MSAD LDAP Connect Failed",$r->uri);
return Apache::Constants::HTTP_UNAUTHORIZED;
}
my $result= $ldap->bind (dn => "$user\@$domain", password => $pass);
if (!$result || ($result && $result->code)) {
$r->note_basic_auth_failure;
$r->log_reason("user - Active Directory Authen Failed",$r->uri);
return Apache::Constants::HTTP_UNAUTHORIZED;
}
Apache-AuthenPasswdSrv
view release on metacpan or search on metacpan
passwd_srv.pl view on Meta::CPAN
sub spawn; # forward declaration
sub logmsg { syslog(shift @_, shift @_, @_); }
socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!";
unlink($NAME);
bind(Server,$uaddr) or die "bind: $!";
listen(Server,SOMAXCONN) or die "listen: $!";
logmsg('info', "server started on $NAME as $</$>");
$SIG{CHLD} = \&REAPER;
passwd_srv.pl view on Meta::CPAN
if ($rcode == $Net::NIS::ERR_ACCESS) { print "403 Access violation\n"; }
elsif ($rcode == $Net::NIS::ERR_KEY) { print "404 No such key in map\n"; }
elsif ($rcode == $Net::NIS::ERR_BADARGS){ print "501 Args to function are bad\n"; }
elsif ($rcode == $Net::NIS::ERR_BADDB) { print "502 YP data base is bad\n"; }
elsif ($rcode == $Net::NIS::ERR_BUSY) { print "503 Database is busy\n"; }
elsif ($rcode == $Net::NIS::ERR_DOMAIN) { print "504 Can't bind to a server which serves this domain\n"; }
elsif ($rcode == $Net::NIS::ERR_MAP) { print "505 No such map in server's domain\n"; }
elsif ($rcode == $Net::NIS::ERR_NODOM) { print "506 Local domain name not set\n"; }
elsif ($rcode == $Net::NIS::ERR_NOMORE) { print "507 No more records in map database\n"; }
elsif ($rcode == $Net::NIS::ERR_RESRC) { print "508 Local resource allocation failure\n"; }
elsif ($rcode == $Net::NIS::ERR_PMAP) { print "510 Can't communicate with portmapper\n"; }
elsif ($rcode == $Net::NIS::ERR_RPC) { print "511 RPC failure\n"; }
elsif ($rcode == $Net::NIS::ERR_YPBIND) { print "512 Can't communicate with ypbind\n"; }
elsif ($rcode == $Net::NIS::ERR_YPERR) { print "513 Internal yp server or client interface error\n"; }
elsif ($rcode == $Net::NIS::ERR_YPSERV) { print "514 Can't communicate with ypserv\n"; }
elsif ($rcode == $Net::NIS::ERR_VERS) { print "515 YP version mismatch\n"; }
else { print "599 Unknown NIS error\n"; }
Apache-AuthzLDAP
view release on metacpan or search on metacpan
AuthzLDAP.pm view on Meta::CPAN
$r->log_reason("user $username: Authen LDAP Connection Failed",$r->uri);
return SERVER_ERROR;
}
# Bind anonymously
my $msg = $ld->bind;
unless ($msg->code == LDAP_SUCCESS) {
$r->note_basic_auth_failure;
$r->log_reason("user $username: Authen LDAP Initial Bind Failed: " .
$msg->code . " " . $msg->error, $r->uri);
return SERVER_ERROR;
AuthzLDAP.pm view on Meta::CPAN
} else {
$userinfo = ($msg->first_entry->get($memberattrvalue))[0];
}
$r->log->debug("handler: Userinfo is $userinfo ($memberattrvalue)");
$ld->unbind();
$ld = undef;
# Connect to the server
unless ($ld = new Net::LDAP($authzldapserver,port => $authzldapport)) {
$r->note_basic_auth_failure;
$r->log_reason("user $username: Authz LDAP Connection Failed",$r->uri);
return SERVER_ERROR;
}
# Bind anonymously
$msg = $ld->bind;
unless ($msg->code == LDAP_SUCCESS) {
$r->note_basic_auth_failure;
$r->log_reason("user $username: Authz LDAP Initial Bind Failed: " .
$msg->code . " " . $msg->error, $r->uri);
return SERVER_ERROR;
Apache-AuthzNetLDAP
view release on metacpan or search on metacpan
AuthzNetLDAP.pm view on Meta::CPAN
my $username = MP2 ? $r->user : $r->connection->user;
#need to step through each requirement, handle valid-user, return OK once have match , otherwise return failure
my $binddn = $r->dir_config('BindDN') || "";
my $bindpwd = $r->dir_config('BindPWD') || "";
my $basedn = $r->dir_config('BaseDN') || "";
my $ldapserver = $r->dir_config('LDAPServer') || "localhost";
my $ldapport = $r->dir_config('LDAPPort') || 389;
my $uidattr = $r->dir_config('UIDAttr') || "uid";
#first we connect to the LDAP server
my $ldap = new Net::LDAP($ldapserver, port => $ldapport);
#initial bind as user in Apache config
my $mesg = $ldap->bind($binddn, password=>$bindpwd);
#each error message has an LDAP error code
if (my $error = $mesg->code())
{
$r->note_basic_auth_failure;
Apache-AxKit-Provider-OpenOffice
view release on metacpan or search on metacpan
dtds/table.mod view on Meta::CPAN
table:query-name CDATA #REQUIRED
>
<!ELEMENT table:sort (table:sort-by)+>
<!ATTLIST table:sort
table:bind-styles-to-content %boolean; "true"
table:target-range-address %cell-range-address; #IMPLIED
table:case-sensitive %boolean; "false"
table:language CDATA #IMPLIED
table:country CDATA #IMPLIED
table:algorithm CDATA #IMPLIED
dtds/table.mod view on Meta::CPAN
table:order (ascending | descending) "ascending"
>
<!ELEMENT table:subtotal-rules (table:sort-groups? | table:subtotal-rule*)?>
<!ATTLIST table:subtotal-rules
table:bind-styles-to-content %boolean; "true"
table:case-sensitive %boolean; "false"
table:page-breaks-on-group-change %boolean; "false"
>
<!ELEMENT table:sort-groups EMPTY>
<!ATTLIST table:sort-groups
Apache-Bootstrap
view release on metacpan or search on metacpan
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
Apache-BruteWatch
view release on metacpan or search on metacpan
lib/Apache/BruteWatch.pm view on Meta::CPAN
my $sth = $dbh->prepare(
"select count(ID) from bruteattempt where
username = ? and ts > $time - $old"
);
$sth->execute($username);
$sth->bind_columns( \$count );
$sth->fetch;
$sth->finish;
my $forgive = $r->dir_config('BruteForgive');
$sth = $dbh->prepare(
lib/Apache/BruteWatch.pm view on Meta::CPAN
my $sth = $dbh->prepare(
"select count(ID) from brutenotified
where username = ?"
);
$sth->execute($username);
$sth->bind_columns( \$count );
$sth->fetch;
$sth->finish;
return if $count;
Apache-CVS
view release on metacpan or search on metacpan
CVS/File.pm view on Meta::CPAN
}
sub _setup_rcs {
my ($path, $config) = @_;
my $rcs = Rcs->new($path);
Rcs->bindir($config->binary());
Rcs->arcext($config->extension());
$rcs->workdir($config->working());
return $rcs;
}
Apache-ConfigParser
view release on metacpan or search on metacpan
t/httpd02.conf view on Meta::CPAN
# would only count as 1 request towards this limit.
#
MaxRequestsPerChild 1000
#
# Listen: Allows you to bind Apache to specific IP addresses and/or
# ports, in addition to the default. See also the <VirtualHost>
# directive.
#
#Listen 3000
#Listen 12.34.56.78:80
Apache-DBI
view release on metacpan or search on metacpan
lib/Apache/AuthDBI.pm view on Meta::CPAN
Apache::Constants::SERVER_ERROR();
}
my $password;
$sth->execute();
$sth->bind_columns(\$password);
my $cnt = 0;
while ($sth->fetch()) {
$password =~ s/ +$// if $password;
$passwd .= "$password$;";
$cnt++;
Apache-DBILogin
view release on metacpan or search on metacpan
DBILogin.pm view on Meta::CPAN
sub is_member {
my ($r, $dbh, $group) = @_;
my $sth;
eval {
# no, Oracle doesn't support binding in SET ROLE statement
$sth = $dbh->prepare("SET ROLE $group") or die $DBI::errstr;
};
return ( MP2 ? Apache2::Const::HTTP_INTERNAL_SERVER_ERROR
: Apache::Constants::HTTP_INTERNAL_SERVER_ERROR ) if ( $@ );
Apache-EmbeddedPerl-Lite
view release on metacpan or search on metacpan
ApacheSoftwareLicense view on Meta::CPAN
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
Apache-FilteringProxy
view release on metacpan or search on metacpan
lib/Apache/FilteringProxy.pm view on Meta::CPAN
$sth->execute();
# make list of hosts
my @hostname_list;
my $hostname;
$sth->bind_columns(\$hostname);
while ($sth->fetch()) {
push(@hostname_list, $hostname);
}
if (!grep(/^$remote_servername$/,@hostname_list)) {
my $sth = $dbh->prepare("INSERT INTO admin (id, hostname) VALUES (nextval('admin_id_seq'), '$remote_servername');");
Apache-HTTunnel
view release on metacpan or search on metacpan
Client/httunnel.pod view on Meta::CPAN
=over 4
=item local_addr = <hostname or ip address>
Local address to bind to. Default is 'localhost'.
=item local_port = <port nb.>
Local port number to bind to. This directive is mandatory.
=item protocol = <proto>
Protocol for the tunnelled connection. Default is 'tcp', possible values
are 'tcp and 'udp'.
Apache-Imager-Resize
view release on metacpan or search on metacpan
av_store|||
av_undef|||
av_unshift|||
ax|||n
bad_type|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
boolSV|5.004000||p
boot_core_PerlIO|||
Apache-LoggedAuthDBI
view release on metacpan or search on metacpan
$dbh = DBI->connect($data_source, $username, $auth, \%attr);
$rv = $dbh->do($statement);
$rv = $dbh->do($statement, \%attr);
$rv = $dbh->do($statement, \%attr, @bind_values);
$ary_ref = $dbh->selectall_arrayref($statement);
$hash_ref = $dbh->selectall_hashref($statement, $key_field);
$ary_ref = $dbh->selectcol_arrayref($statement);
$hash_ref = $dbh->selectrow_hashref($statement);
$sth = $dbh->prepare($statement);
$sth = $dbh->prepare_cached($statement);
$rc = $sth->bind_param($p_num, $bind_value);
$rc = $sth->bind_param($p_num, $bind_value, $bind_type);
$rc = $sth->bind_param($p_num, $bind_value, \%attr);
$rv = $sth->execute;
$rv = $sth->execute(@bind_values);
$rv = $sth->execute_array(\%attr, ...);
$rc = $sth->bind_col($col_num, \$col_variable);
$rc = $sth->bind_columns(@list_of_refs_to_vars_to_bind);
@row_ary = $sth->fetchrow_array;
$ary_ref = $sth->fetchrow_arrayref;
$hash_ref = $sth->fetchrow_hashref;
clone => { U =>[1,1,''] },
connected => { O=>0x0100 },
begin_work => { U =>[1,2,'[ \%attr ]'], O=>0x0400 },
commit => { U =>[1,1], O=>0x0480|0x0800 },
rollback => { U =>[1,1], O=>0x0480|0x0800 },
'do' => { U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x3200 },
last_insert_id => { U =>[5,6,'$catalog, $schema, $table_name, $field_name [, \%attr ]'], O=>0x2800 },
preparse => { }, # XXX
prepare => { U =>[2,3,'$statement [, \%attr]'], O=>0x2200 },
prepare_cached => { U =>[2,4,'$statement [, \%attr [, $if_active ] ]'], O=>0x2200 },
selectrow_array => { U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
selectrow_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
selectrow_hashref=>{ U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
selectall_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
selectall_hashref=>{ U =>[3,0,'$statement, $keyfield [, \%attr [, @bind_params ] ]'], O=>0x2000 },
selectcol_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
ping => { U =>[1,1], O=>0x0404 },
disconnect => { U =>[1,1], O=>0x0400|0x0800 },
quote => { U =>[2,3, '$string [, $data_type ]' ], O=>0x0430 },
quote_identifier=> { U =>[2,6, '$name [, ...] [, \%attr ]' ], O=>0x0430 },
rows => $keeperr,
type_info_all => { U =>[1,1], O=>0x2200|0x0800 },
type_info => { U =>[1,2,'$data_type'], O=>0x2200 },
get_info => { U =>[2,2,'$info_type'], O=>0x2200|0x0800 },
},
st => { # Statement Class Interface
bind_col => { U =>[3,4,'$column, \\$var [, \%attr]'] },
bind_columns => { U =>[2,0,'\\$var1 [, \\$var2, ...]'] },
bind_param => { U =>[3,4,'$parameter, $var [, \%attr]'] },
bind_param_inout=> { U =>[4,5,'$parameter, \\$var, $maxlen, [, \%attr]'] },
execute => { U =>[1,0,'[@args]'], O=>0x1040 },
bind_param_array => { U =>[3,4,'$parameter, $var [, \%attr]'] },
bind_param_inout_array => { U =>[4,5,'$parameter, \\@var, $maxlen, [, \%attr]'] },
execute_array => { U =>[2,0,'\\%attribs [, @args]'], O=>0x1040 },
execute_for_fetch => { U =>[2,3,'$fetch_sub [, $tuple_status]'], O=>0x1040 },
fetch => undef, # alias for fetchrow_arrayref
fetchrow_arrayref => undef,
my $rows = $sth->rows;
($rows == 0) ? "0E0" : $rows;
}
sub _do_selectrow {
my ($method, $dbh, $stmt, $attr, @bind) = @_;
my $sth = ((ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr))
or return;
$sth->execute(@bind)
or return;
my $row = $sth->$method()
and $sth->finish;
return $row;
}
}
# XXX selectall_arrayref also has C implementation in Driver.xst
# which fallsback to this if a slice is given
sub selectall_arrayref {
my ($dbh, $stmt, $attr, @bind) = @_;
my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr)
or return;
$sth->execute(@bind) || return;
my $slice = $attr->{Slice}; # typically undef, else hash or array ref
if (!$slice and $slice=$attr->{Columns}) {
if (ref $slice eq 'ARRAY') { # map col idx to perl array idx
$slice = [ @{$attr->{Columns}} ]; # take a copy
for (@$slice) { $_-- }
$sth->finish if defined $MaxRows;
return $rows;
}
sub selectall_hashref {
my ($dbh, $stmt, $key_field, $attr, @bind) = @_;
my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr);
return unless $sth;
$sth->execute(@bind) || return;
return $sth->fetchall_hashref($key_field);
}
sub selectcol_arrayref {
my ($dbh, $stmt, $attr, @bind) = @_;
my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr);
return unless $sth;
$sth->execute(@bind) || return;
my @columns = ($attr->{Columns}) ? @{$attr->{Columns}} : (1);
my @values = (undef) x @columns;
my $idx = 0;
for (@columns) {
$sth->bind_col($_, \$values[$idx++]) || return;
}
my @col;
if (my $max = $attr->{MaxRows}) {
push @col, @values while @col<$max && $sth->fetch;
}
{ package # hide from PAUSE
DBD::_::st; # ====== STATEMENT ======
@DBD::_::st::ISA = qw(DBD::_::common);
use strict;
sub bind_param { Carp::croak("Can't bind_param, not implement by driver") }
#
# ********************************************************
#
# BEGIN ARRAY BINDING
#
# Array binding support for drivers which don't support
# array binding, but have sufficient interfaces to fake it.
# NOTE: mixing scalars and arrayrefs requires using bind_param_array
# for *all* params...unless we modify bind_param for the default
# case...
#
# 2002-Apr-10 D. Arnold
sub bind_param_array {
my $sth = shift;
my ($p_id, $value_array, $attr) = @_;
return $sth->set_err(1, "Value for parameter $p_id must be a scalar or an arrayref, not a ".ref($value_array))
if defined $value_array and ref $value_array and ref $value_array ne 'ARRAY';
return $sth->set_err(1, "Can't use named placeholder '$p_id' for non-driver supported bind_param_array")
unless DBI::looks_like_number($p_id); # because we rely on execute(@ary) here
return $sth->set_err(1, "Placeholder '$p_id' is out of range")
if $p_id <= 0; # can't easily/reliably test for too big
# get/create arrayref to hold params
my $hash_of_arrays = $sth->{ParamArrays} ||= { };
# If the bind has attribs then we rely on the driver conforming to
# the DBI spec in that a single bind_param() call with those attribs
# makes them 'sticky' and apply to all later execute(@values) calls.
# Since we only call bind_param() if we're given attribs then
# applications using drivers that don't support bind_param can still
# use bind_param_array() so long as they don't pass any attribs.
$$hash_of_arrays{$p_id} = $value_array;
return $sth->bind_param($p_id, undef, $attr)
if $attr;
1;
}
sub bind_param_inout_array {
my $sth = shift;
# XXX not supported so we just call bind_param_array instead
# and then return an error
my ($p_num, $value_array, $attr) = @_;
$sth->bind_param_array($p_num, $value_array, $attr);
return $sth->set_err(1, "bind_param_inout_array not supported");
}
sub bind_columns {
my $sth = shift;
my $fields = $sth->FETCH('NUM_OF_FIELDS') || 0;
if ($fields <= 0 && !$sth->{Active}) {
return $sth->set_err(1, "Statement has no result columns to bind"
." (perhaps you need to successfully call execute first)");
}
# Backwards compatibility for old-style call with attribute hash
# ref as first arg. Skip arg if undef or a hash ref.
my $attr;
$attr = shift if !defined $_[0] or ref($_[0]) eq 'HASH';
die "bind_columns called with ".@_." refs when $fields needed."
if @_ != $fields;
my $idx = 0;
$sth->bind_col(++$idx, shift, $attr) or return
while (@_);
return 1;
}
sub execute_array {
# get tuple status array or hash attribute
my $tuple_sts = $attr->{ArrayTupleStatus};
return $sth->set_err(1, "ArrayTupleStatus attribute must be an arrayref")
if $tuple_sts and ref $tuple_sts ne 'ARRAY';
# bind all supplied arrays
if (@array_of_arrays) {
$sth->{ParamArrays} = { }; # clear out old params
return $sth->set_err(1,
@array_of_arrays." bind values supplied but $NUM_OF_PARAMS expected")
if defined ($NUM_OF_PARAMS) && @array_of_arrays != $NUM_OF_PARAMS;
$sth->bind_param_array($_, $array_of_arrays[$_-1]) or return
foreach (1..@array_of_arrays);
}
my $fetch_tuple_sub;
if ($fetch_tuple_sub = $attr->{ArrayTupleFetch}) { # fetch on demand
return $sth->set_err(1,
"Can't use both ArrayTupleFetch and explicit bind values")
if @array_of_arrays; # previous bind_param_array calls will simply be ignored
if (UNIVERSAL::isa($fetch_tuple_sub,'DBI::st')) {
my $fetch_sth = $fetch_tuple_sub;
return $sth->set_err(1,
"ArrayTupleFetch sth is not Active, need to execute() it first")
}
else {
my $NUM_OF_PARAMS_given = keys %{ $sth->{ParamArrays} || {} };
return $sth->set_err(1,
"$NUM_OF_PARAMS_given bind values supplied but $NUM_OF_PARAMS expected")
if defined($NUM_OF_PARAMS) && $NUM_OF_PARAMS != $NUM_OF_PARAMS_given;
# get the length of a bound array
my $maxlen;
my %hash_of_arrays = %{$sth->{ParamArrays}};
next unless ref $ary eq 'ARRAY';
$maxlen = @$ary if !$maxlen || @$ary > $maxlen;
}
# if there are no arrays then execute scalars once
$maxlen = 1 unless defined $maxlen;
my @bind_ids = 1..keys(%hash_of_arrays);
my $tuple_idx = 0;
$fetch_tuple_sub = sub {
return if $tuple_idx >= $maxlen;
my @tuple = map {
my $a = $hash_of_arrays{$_};
ref($a) ? $a->[$tuple_idx] : $a
} @bind_ids;
++$tuple_idx;
return \@tuple;
};
}
push @key_indexes, $index;
}
my $rows = {};
my $NAME = $sth->FETCH($hash_key_name);
my @row = (undef) x $num_of_fields;
$sth->bind_columns(\(@row));
while ($sth->fetch) {
my $ref = $rows;
$ref = $ref->{$row[$_]} ||= {} for @key_indexes;
@{$ref}{@$NAME} = @row;
}
Follow the "Full Contents" then "Intergalactic dataspeak" links for the
SQL history.
=head2 Placeholders and Bind Values
Some drivers support placeholders and bind values.
I<Placeholders>, also called parameter markers, are used to indicate
values in a database statement that will be supplied later,
before the prepared statement is executed. For example, an application
might use the following to insert a row of data into the SALES table:
or the following, to select the description for a product:
SELECT description FROM products WHERE product_code = ?
The C<?> characters are the placeholders. The association of actual
values with placeholders is known as I<binding>, and the values are
referred to as I<bind values>.
Note that the C<?> is not enclosed in quotation marks, even when the
placeholder represents a string. Some drivers also allow placeholders
like C<:>I<name> and C<:>I<n> (e.g., C<:1>, C<:2>, and so on)
in addition to C<?>, but their use is not portable.
"SELECT name, age FROM people WHERE name IN (?,?)" # two names
When using placeholders with the SQL C<LIKE> qualifier, you must
remember that the placeholder substitutes for the whole string.
So you should use "C<... LIKE ? ...>" and include any wildcard
characters in the value that you bind to the placeholder.
B<NULL Values>
Undefined values, or C<undef>, are used to indicate NULL values.
You can insert and update columns with a NULL value as you would a
in a hash %h:
for my $col ("age", "phone", "email") {
if (defined $h{$col}) {
push @sql_qual, "$col = ?";
push @sql_bind, $h{$col};
}
else {
push @sql_qual, "$col IS NULL";
}
}
$sql_clause = join(" AND ", @sql_qual);
$sth = $dbh->prepare(qq{
SELECT fullname FROM people WHERE $sql_clause
});
$sth->execute(@sql_bind);
The techniques above call prepare for the SQL statement with each call to
execute. Because calls to prepare() can be expensive, performance
can suffer when an application iterates many times over statements
like the above.
B<Performance>
Without using placeholders, the insert statement shown previously would have to
contain the literal values to be inserted and would have to be
re-prepared and re-executed for each row. With placeholders, the insert
statement only needs to be prepared once. The bind values for each row
can be given to the C<execute> method each time it's called. By avoiding
the need to re-prepare the statement for each row, the application
typically runs many times faster. Here's an example:
my $sth = $dbh->prepare(q{
my ($product_code, $qty, $price) = split /,/;
$sth->execute($product_code, $qty, $price) or die $dbh->errstr;
}
$dbh->commit or die $dbh->errstr;
See L</execute> and L</bind_param> for more details.
The C<q{...}> style quoting used in this example avoids clashing with
quotes that may be used in the SQL statement. Use the double-quote like
C<qq{...}> operator if you want to interpolate variables into the string.
See L<perlop/"Quote and Quote-like Operators"> for more details.
See also the L</bind_columns> method, which is used to associate Perl
variables with the output columns of a C<SELECT> statement.
=head1 THE DBI PACKAGE AND CLASS
In this section, we cover the DBI class methods, utility functions,
These constants are defined by SQL/CLI, ODBC or both.
C<SQL_BIGINT> is (currently) omitted, because SQL/CLI and ODBC provide
conflicting codes.
See the L</type_info>, L</type_info_all>, and L</bind_param> methods
for possible uses.
Note that just because the DBI defines a named constant for a given
data type doesn't mean that drivers will support that data type.
=item C<do>
$rows = $dbh->do($statement) or die $dbh->errstr;
$rows = $dbh->do($statement, \%attr) or die $dbh->errstr;
$rows = $dbh->do($statement, \%attr, @bind_values) or die ...
Prepare and execute a single statement. Returns the number of rows
affected or C<undef> on error. A return value of C<-1> means the
number of rows is not known, not applicable, or not available.
handle (so you can't fetch any data).
The default C<do> method is logically similar to:
sub do {
my($dbh, $statement, $attr, @bind_values) = @_;
my $sth = $dbh->prepare($statement, $attr) or return undef;
$sth->execute(@bind_values) or return undef;
my $rows = $sth->rows;
($rows == 0) ? "0E0" : $rows; # always return true if no error
}
For example:
my $rows_deleted = $dbh->do(q{
DELETE FROM table
WHERE status = ?
}, undef, 'DONE') or die $dbh->errstr;
Using placeholders and C<@bind_values> with the C<do> method can be
useful because it avoids the need to correctly quote any variables
in the C<$statement>. But if you'll be executing the statement many
times then it's more efficient to C<prepare> it once and call
C<execute> many times instead.
=item C<selectrow_array>
@row_ary = $dbh->selectrow_array($statement);
@row_ary = $dbh->selectrow_array($statement, \%attr);
@row_ary = $dbh->selectrow_array($statement, \%attr, @bind_values);
This utility method combines L</prepare>, L</execute> and
L</fetchrow_array> into a single call. If called in a list context, it
returns the first row of data from the statement. The C<$statement>
parameter can be a previously prepared statement handle, in which case
=item C<selectrow_arrayref>
$ary_ref = $dbh->selectrow_arrayref($statement);
$ary_ref = $dbh->selectrow_arrayref($statement, \%attr);
$ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values);
This utility method combines L</prepare>, L</execute> and
L</fetchrow_arrayref> into a single call. It returns the first row of
data from the statement. The C<$statement> parameter can be a previously
prepared statement handle, in which case the C<prepare> is skipped.
=item C<selectrow_hashref>
$hash_ref = $dbh->selectrow_hashref($statement);
$hash_ref = $dbh->selectrow_hashref($statement, \%attr);
$hash_ref = $dbh->selectrow_hashref($statement, \%attr, @bind_values);
This utility method combines L</prepare>, L</execute> and
L</fetchrow_hashref> into a single call. It returns the first row of
data from the statement. The C<$statement> parameter can be a previously
prepared statement handle, in which case the C<prepare> is skipped.
=item C<selectall_arrayref>
$ary_ref = $dbh->selectall_arrayref($statement);
$ary_ref = $dbh->selectall_arrayref($statement, \%attr);
$ary_ref = $dbh->selectall_arrayref($statement, \%attr, @bind_values);
This utility method combines L</prepare>, L</execute> and
L</fetchall_arrayref> into a single call. It returns a reference to an
array containing a reference to an array for each row of data fetched.
=item C<selectall_hashref>
$hash_ref = $dbh->selectall_hashref($statement, $key_field);
$hash_ref = $dbh->selectall_hashref($statement, $key_field, \%attr);
$hash_ref = $dbh->selectall_hashref($statement, $key_field, \%attr, @bind_values);
This utility method combines L</prepare>, L</execute> and
L</fetchall_hashref> into a single call. It returns a reference to a
hash containing one entry, at most, for each row, as returned by fetchall_hashref().
=item C<selectcol_arrayref>
$ary_ref = $dbh->selectcol_arrayref($statement);
$ary_ref = $dbh->selectcol_arrayref($statement, \%attr);
$ary_ref = $dbh->selectcol_arrayref($statement, \%attr, @bind_values);
This utility method combines L</prepare>, L</execute>, and fetching one
column from all the rows, into a single call. It returns a reference to
an array containing the values of the first column from each row.
The DBI defines the following methods for use on DBI statement handles:
=over 4
=item C<bind_param>
$sth->bind_param($p_num, $bind_value)
$sth->bind_param($p_num, $bind_value, \%attr)
$sth->bind_param($p_num, $bind_value, $bind_type)
The C<bind_param> method takes a copy of $bind_value and associates it
(binds it) with a placeholder, identified by $p_num, embedded in
the prepared statement. Placeholders are indicated with question
mark character (C<?>). For example:
$dbh->{RaiseError} = 1; # save having to check each method call
$sth = $dbh->prepare("SELECT name, age FROM people WHERE name LIKE ?");
$sth->bind_param(1, "John%"); # placeholders are numbered from 1
$sth->execute;
DBI::dump_results($sth);
See L</"Placeholders and Bind Values"> for more information.
The C<\%attr> parameter can be used to hint at the data type the
placeholder should have. Typically, the driver is only interested in
knowing if the placeholder should be bound as a number or a string.
$sth->bind_param(1, $value, { TYPE => SQL_INTEGER });
As a short-cut for the common case, the data type can be passed
directly, in place of the C<\%attr> hash reference. This example is
equivalent to the one above:
$sth->bind_param(1, $value, SQL_INTEGER);
The C<TYPE> value indicates the standard (non-driver-specific) type for
this parameter. To specify the driver-specific type, the driver may
support a driver-specific attribute, such as C<{ ora_type =E<gt> 97 }>.
use DBI qw(:sql_types);
See L</"DBI Constants"> for more information.
The data type for a placeholder cannot be changed after the first
C<bind_param> call. In fact the whole \%attr parameter is 'sticky'
in the sense that a driver only needs to consider the \%attr parameter
for the first call, for a given $sth and parameter. After that the driver
may ignore the \%attr parameter for that placeholder.
Perl only has string and number scalar data types. All database types
that aren't numbers are bound as strings and must be in a format the
database will understand except where the bind_param() TYPE attribute
specifies a type that implies a particular format. For example, given:
$sth->bind_param(1, $value, SQL_DATETIME);
the driver should expect $value to be in the ODBC standard SQL_DATETIME
format, which is 'YYYY-MM-DD HH:MM:SS'. Similarly for SQL_DATE, SQL_TIME etc.
As an alternative to specifying the data type in the C<bind_param> call,
you can let the driver pass the value as the default type (C<VARCHAR>).
You can then use an SQL function to convert the type within the statement.
For example:
INSERT INTO price(code, price) VALUES (?, CONVERT(MONEY,?))
and syntax will vary between different databases and is non-portable.
See also L</"Placeholders and Bind Values"> for more information.
=item C<bind_param_inout>
$rc = $sth->bind_param_inout($p_num, \$bind_value, $max_len) or die $sth->errstr;
$rv = $sth->bind_param_inout($p_num, \$bind_value, $max_len, \%attr) or ...
$rv = $sth->bind_param_inout($p_num, \$bind_value, $max_len, $bind_type) or ...
This method acts like L</bind_param>, but also enables values to be
updated by the statement. The statement is typically
a call to a stored procedure. The C<$bind_value> must be passed as a
reference to the actual value to be used.
Note that unlike L</bind_param>, the C<$bind_value> variable is not
copied when C<bind_param_inout> is called. Instead, the value in the
variable is read at the time L</execute> is called.
The additional C<$max_len> parameter specifies the minimum amount of
memory to allocate to C<$bind_value> for the new value. If the value
returned from the database is too
big to fit, then the execution should fail. If unsure what value to use,
pick a generous length, i.e., a length larger than the longest value that would ever be
returned. The only cost of using a larger value than needed is wasted memory.
Undefined values or C<undef> are used to indicate null values.
See also L</"Placeholders and Bind Values"> for more information.
=item C<bind_param_array>
$rc = $sth->bind_param_array($p_num, $array_ref_or_value)
$rc = $sth->bind_param_array($p_num, $array_ref_or_value, \%attr)
$rc = $sth->bind_param_array($p_num, $array_ref_or_value, $bind_type)
The C<bind_param_array> method is used to bind an array of values
to a placeholder embedded in the prepared statement which is to be executed
with L</execute_array>. For example:
$dbh->{RaiseError} = 1; # save having to check each method call
$sth = $dbh->prepare("INSERT INTO staff (first_name, last_name, dept) VALUES(?, ?, ?)");
$sth->bind_param_array(1, [ 'John', 'Mary', 'Tim' ]);
$sth->bind_param_array(2, [ 'Booth', 'Todd', 'Robinson' ]);
$sth->bind_param_array(3, "SALES"); # scalar will be reused for each row
$sth->execute_array( { ArrayTupleStatus => \my @tuple_status } );
The C<%attr> ($bind_type) argument is the same as defined for L</bind_param>.
Refer to L</bind_param> for general details on using placeholders.
(Note that bind_param_array() can I<not> be used to expand a
placeholder into a list of values for a statement like "SELECT foo
WHERE bar IN (?)". A placeholder can only ever represent one value
per execution.)
Scalar values, including C<undef>, may also be bound by
C<bind_param_array>. In which case the same value will be used for each
L</execute> call. Driver-specific implementations may behave
differently, e.g., when binding to a stored procedure call, some
databases may permit mixing scalars and arrays as arguments.
The default implementation provided by DBI (for drivers that have
not implemented array binding) is to iteratively call L</execute> for
each parameter tuple provided in the bound arrays. Drivers may
provide more optimized implementations using whatever bulk operation
support the database API provides. The default driver behaviour should
match the default DBI behaviour, but always consult your driver
documentation as there may be driver specific issues to consider.
Note that the default implementation currently only supports non-data
returning statements (INSERT, UPDATE, but not SELECT). Also,
C<bind_param_array> and L</bind_param> cannot be mixed in the same
statement execution, and C<bind_param_array> must be used with
L</execute_array>; using C<bind_param_array> will have no effect
for L</execute>.
The C<bind_param_array> method was added in DBI 1.22.
=item C<execute>
$rv = $sth->execute or die $sth->errstr;
$rv = $sth->execute(@bind_values) or die $sth->errstr;
Perform whatever processing is necessary to execute the prepared
statement. An C<undef> is returned if an error occurs. A successful
C<execute> always returns true regardless of the number of rows affected,
even if it's zero (see below). It is always important to check the
calling C<execute>. The C<execute> method does I<not> return the number of
rows that will be returned by the query (because most databases can't
tell in advance), it simply returns a true value.
If any arguments are given, then C<execute> will effectively call
L</bind_param> for each value before executing the statement. Values
bound in this way are usually treated as C<SQL_VARCHAR> types unless
the driver can determine the correct type (which is rare), or unless
C<bind_param> (or C<bind_param_inout>) has already been used to
specify the type.
If execute() is called on a statement handle that's still active
($sth->{Active} is true) then it should effectively call finish()
to tidy up the previous execution results before starting this new
execution.
=item C<execute_array>
$rv = $sth->execute_array(\%attr) or die $sth->errstr;
$rv = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr;
Execute the prepared statement once for each parameter tuple
(group of values) provided either in the @bind_values, or by prior
calls to L</bind_param_array>, or via a reference passed in \%attr.
The execute_array() method returns the number of tuples executed,
or C<undef> if an error occured. Like execute(), a successful
execute_array() always returns true regardless of the number of
tuples executed, even if it's zero. See the C<ArrayTupleStatus>
attribute below for how to determine the execution status for each
tuple.
Bind values for the tuples to be executed may be supplied row-wise
by an C<ArrayTupleFetch> attribute, or else column-wise in the
C<@bind_values> argument, or else column-wise by prior calls to
L</bind_param_array>.
Where column-wise binding is used (via the C<@bind_values> argument
or calls to bind_param_array()) the maximum number of elements in
any one of the bound value arrays determines the number of tuples
executed. Placeholders with fewer values in their parameter arrays
are treated as if padded with undef (NULL) values.
If a scalar value is bound, instead of an array reference, it is
so if all bound arrays have zero elements then zero tuples will
be executed. If I<all> bound values are scalars then one tuple
will be executed, making execute_array() act just like execute().
The C<ArrayTupleFetch> attribute can be used to specify a reference
to a subroutine that will be called to provide the bind values for
each tuple execution. The subroutine should return an reference to
an array which contains the appropriate number of bind values, or
return an undef if there is no more data to execute.
As a convienience, the C<ArrayTupleFetch> attribute can also be
used to specify a statement handle. In which case the fetchrow_arrayref()
method will be called on the given statement handle in order to
provide the bind values for each tuple execution.
The values specified via bind_param_array() or the @bind_values
parameter may be either scalars, or arrayrefs. If any C<@bind_values>
are given, then C<execute_array> will effectively call L</bind_param_array>
for each value before executing the statement. Values bound in
this way are usually treated as C<SQL_VARCHAR> types unless the
driver can determine the correct type (which is rare), or unless
C<bind_param>, C<bind_param_inout>, C<bind_param_array>, or
C<bind_param_inout_array> has already been used to specify the type.
See L</bind_param_array> for details.
The mandatory C<ArrayTupleStatus> attribute is used to specify a
reference to an array which will receive the execute status of each
executed parameter tuple.
Support for data returning statements such as SELECT is driver-specific
and subject to change. At present, the default implementation
provided by DBI only supports non-data returning statements.
Transaction semantics when using array binding are driver and
database specific. If C<AutoCommit> is on, the default DBI
implementation will cause each parameter tuple to be inidividually
committed (or rolled back in the event of an error). If C<AutoCommit>
is off, the application is responsible for explicitly committing
the entire set of bound parameter tuples. Note that different
The fetch subroutine, referenced by $fetch_tuple_sub, is expected
to return a reference to an array (known as a 'tuple') or undef.
The execute_for_fetch() method calls $fetch_tuple_sub, without any
parameters, until it returns a false value. Each tuple returned is
used to provide bind values for an $sth->execute(@$tuple) call.
If there were any errors then C<undef> is returned and the @tuple_status
array can be used to discover which tuples failed and with what errors.
If there were no errors then execute_for_fetch() returns the number
of tuples executed. Like execute() and execute_array() a zero is
Fetches the next row of data and returns a reference to an array
holding the field values. Null fields are returned as C<undef>
values in the array.
This is the fastest way to fetch data, particularly if used with
C<$sth-E<gt>bind_columns>.
If there are no more rows or if an error occurs, then C<fetchrow_arrayref>
returns an C<undef>. You should check C<$sth-E<gt>err> afterwards (or use the
C<RaiseError> attribute) to discover if the C<undef> returned was due to an
error.
Note that the same array reference is returned for each fetch, so don't
store the reference and then use it after a later fetch. Also, the
elements of the array are also reused for each row, so take care if you
want to take a reference to an element. See also L</bind_columns>.
=item C<fetchrow_array>
@ary = $sth->fetchrow_array;
}
That can be the fastest way to fetch and process lots of rows using the DBI,
but it depends on the relative cost of method calls vs memory allocation.
A standard C<while> loop with column binding is often faster because
the cost of allocating memory for the batch of rows is greater than
the saving by reducing method calls. It's possible that the DBI may
provide a way to reuse the memory of a previous batch in future, which
would then shift the balance back towards fetchall_arrayref().
One alternative method to get a row count for a C<SELECT> is to execute a
"SELECT COUNT(*) FROM ..." SQL statement with the same "..." as your
query and then fetch the row count from that.
=item C<bind_col>
$rc = $sth->bind_col($column_number, \$var_to_bind);
$rc = $sth->bind_col($column_number, \$var_to_bind, \%attr );
$rc = $sth->bind_col($column_number, \$var_to_bind, $bind_type );
Binds a Perl variable and/or some attributes to an output column
(field) of a C<SELECT> statement. Column numbers count up from 1.
You do not need to bind output columns in order to fetch data.
For maximum portability between drivers, bind_col() should be called
after execute() and not before.
See also C<bind_columns> for an example.
The binding is performed at a low level using Perl aliasing.
Whenever a row is fetched from the database $var_to_bind appears
to be automatically updated simply because it refers to the same
memory location as the corresponding column value. This makes using
bound variables very efficient. Multiple variables can be bound
to a single column, but there's rarely any point. Binding a tied
variable doesn't work, currently.
The L</bind_param> method
performs a similar, but opposite, function for input variables.
B<Data Types for Column Binding>
The C<\%attr> parameter can be used to hint at the data type
formatting the column should have. For example, you can use:
$sth->bind_col(1, undef, { TYPE => SQL_DATETIME });
to specify that you'd like the column (which presumably is some
kind of datetime type) to be returned in the standard format for
SQL_DATETIME, which is 'YYYY-MM-DD HH:MM:SS', rather than the
native formatting the database would normally use.
There's no $var_to_bind in that example to emphasize the point
that bind_col() works on the underlying column value and not just
a particular bound variable.
As a short-cut for the common case, the data type can be passed
directly, in place of the C<\%attr> hash reference. This example is
equivalent to the one above:
$sth->bind_col(1, undef, SQL_DATETIME);
The C<TYPE> value indicates the standard (non-driver-specific) type for
this parameter. To specify the driver-specific type, the driver may
support a driver-specific attribute, such as C<{ ora_type =E<gt> 97 }>.
use DBI qw(:sql_types);
See L</"DBI Constants"> for more information.
The data type for a bind variable cannot be changed after the first
C<bind_col> call. In fact the whole \%attr parameter is 'sticky'
in the sense that a driver only needs to consider the \%attr parameter
for the first call for a given $sth and column.
The TYPE attribute for bind_col() was first specified in DBI 1.41.
=item C<bind_columns>
$rc = $sth->bind_columns(@list_of_refs_to_vars_to_bind);
Calls L</bind_col> for each column of the C<SELECT> statement.
The C<bind_columns> method will die if the number of references does not
match the number of fields.
For maximum portability between drivers, bind_columns() should be called
after execute() and not before.
For example:
$dbh->{RaiseError} = 1; # do this, or check every call for errors
$sth = $dbh->prepare(q{ SELECT region, sales FROM sales_by_region });
$sth->execute;
my ($region, $sales);
# Bind Perl variables to columns:
$rv = $sth->bind_columns(\$region, \$sales);
# you can also use Perl's \(...) syntax (see perlref docs):
# $sth->bind_columns(\($region, $sales));
# Column binding is the most efficient way to fetch data
while ($sth->fetch) {
print "$region: $sales\n";
}
For compatibility with old scripts, the first parameter will be
ignored if it is C<undef> or a hash reference.
Here's a more fancy example that binds columns to the values I<inside>
a hash (thanks to H.Merijn Brand):
$sth->execute;
my %row;
$sth->bind_columns( \( @row{ @{$sth->{NAME_lc} } } ));
while ($sth->fetch) {
print "$row{region}: $row{sales}\n";
}
yet then the driver should return a hash with placeholders names
in the keys but all the values undef, but some drivers may return
a ref to an empty hash.
It is possible that the values in the hash returned by C<ParamValues>
are not I<exactly> the same as those passed to bind_param() or execute().
The driver may have slightly modified values in some way based on the
TYPE the value was bound with. For example a floating point value
bound as an SQL_INTEGER type may be returned as an integer.
The values returned by C<ParamValues> can be passed to another
bind_param() method with the same TYPE and will be seen by the
database as the same value.
It is also possible that the keys in the hash returned by C<ParamValues>
are not exactly the same as those implied by the prepared statement.
For example, DBD::Oracle translates 'C<?>' placeholders into 'C<:pN>'
Apache-MiniWiki
view release on metacpan or search on metacpan
MiniWiki.pm view on Meta::CPAN
# global variables to set thumbnail cutoff
our ($max_width, $max_height) = (600,400);
# This sets the directory where Rcs can find the rcs binaries.
# Set this to something more sensible if they are located elsewhere.
Rcs->bindir('/usr/bin');
# The function fatal_error is called most commonly when the Apache virtual
# host has not had the correlt PerlVar's configured.
sub fatal_error {
Apache-OWA
view release on metacpan or search on metacpan
my $rv;
$sql = 'begin :rv := $proc (:user, :pw); end;';
$sth = $dbh->prepare($sql);
#$sth = $dbh->prepare_cached($sql);
$sth->bind_param(':user', $user);
$sth->bind_param(':pw', $sent_pw);
$sth->bind_param_inout(':rv', \$rv, 2);
$sth->execute || return SERVER_ERROR ;
$sth->finish;
$dbh->disconnect;
return AUTH_REQUIRED if $rv != 0;
}
:version := owa.initialize;
END;
';
$sth = $dbh->prepare($sql);
$sth->bind_param_inout(':version', \$owa_version{$uri}, 1);
$owa_mapping{$uri} = $plsql;
$r->warn("executing: $sql") if ($DEBUG > 1);
$sth->execute || &error($DBI::errstr, $sql);
$r->warn("executed OK") if ($DEBUG > 1);
# setup CGI environment in Oracle
my (@args, @bind_vars, $envVarCount);
my ($declares, $defines);
$declares .= " cgi_var_val owa.vc_arr;\n";
$declares .= " cgi_var_name owa.vc_arr;\n";
foreach (@pass_vars) {
$defines .=
' cgi_var_val(' .++$envVarCount . "):=?;\t" .
' cgi_var_name(' . $envVarCount ."):='". $_ ."';\n";
push @bind_vars, $r->subprocess_env($_) ;
}
push @bind_vars, $envVarCount;
$sql = "\nDECLARE\n" . $declares;
$sql .= "BEGIN\n" . $defines;
$sql .= " owa.init_cgi_env(?, cgi_var_name, cgi_var_val);\n";
$sql .= "END;\n";
$sth = $dbh->prepare($sql);
$r->warn("executing: $sql") if ($DEBUG > 1);
$sth->execute(@bind_vars) || &error($dbh->errstr, $sql);
$r->warn("executed OK") if ($DEBUG > 1);
$sth->finish;
# reusing variables.
@args=(); @bind_vars=(); $declares = ""; $defines = "";
# start putting together procedure arguments, if there are any.
if ( $r->param() ) {
my %arg_name_type = &check_var_types( $plsql )
unless ( $r->dir_config('NEVER_USE_WEIRD_TYPES'));
}
# x or y?
if ($coord =~ /x/i) {
$defines .= " " . $basename . "(1) := ?;\n";
push @bind_vars, $values[0];
} else {
$defines .= " " . $basename . "(2) := ?;\n";
push @bind_vars, $values[0];
}
}
# is it an array?
# the only way to know if it is an array is to do the check
else {
$declares .= " $name varchar2(4096);\n";
push @args, $name .' => '. $name;
$values[0] =~ s/'/''/g;
$defines .= ' ' . $name . " := ?;\n";
push @bind_vars, $values[0];
}
}
}
$sql = "\nDECLARE\n" . $declares;
($sql .= '(' . join(',', @args) . ')') if ( @args );
$sql .= ";\nEND;\n";
$sth = $dbh->prepare($sql);
$r->warn("executing: $sql") if ($DEBUG > 1);
$sth->execute(@bind_vars);
$r->warn("executed OK") if ( ($DEBUG > 1) &! $dbh->err );
if ( $dbh->err && $DEBUG ) {
&helpful_error($dbh->err, $dbh->errstr, $sql, $plsql, \@args, \@bind_vars);
}
elsif ($dbh->err == 6550) {
$r->log_error( $r->subprocess_env('REMOTE_ADDR') . " " . $r->uri . " NOT FOUND");
return NOT_FOUND;
}
my $pos = 1;
my $rows = 0;
my $numgets = 0;
$sth = $dbh->prepare($sql);
$sth->bind_param_inout(':rows', \$rows, 1);
$sth->bind_param_inout(':pos', \$pos, 1);
$sth->bind_param_inout(':content', \$content, { TYPE => 24 } ); # varchar2
$r->content_type('text/html');
$r->warn("executing: $sql") if ($DEBUG > 1);
while ( $pos > 0) {
$r->warn("executing: rows = $rows pos = $pos numgets = $numgets")
$dbh->disconnect;
die;
}
#########################################################################
sub helpful_error {
my ($err,$errstr,$old_sql,$plsql,$args,$bind_vars) = @_;
# funky error checking
#
# error 6550 could mean that
# 1 - the procedure doesn't exist
if ( $r->dir_config('NEVER_USE_WEIRD_TYPES'));
$msg .= "Expected ". $sth->rows ." argument(s):\n" . $exp_args . "\n"
. "Got " . $i ." argument(s):\n" . $got_args . "\n"
. "Sql: \n" . $old_sql . "\n"
. "args: \n" . join("\n", @{$args}) . "\n"
. "vars: \n" . join("\n", @{$bind_vars}) . "\n";
&error($msg,$old_sql);
}
}
#################################################################
Apache-PageKit
view release on metacpan or search on metacpan
lib/Apache/PageKit.pm view on Meta::CPAN
$ENV{LC_MESSAGES} = $config->get_global_attr('default_lang') || 'en';
# ( my $textdomain ) = $config->get_global_attr('model_base_class') =~ m/^([^:]+)/;
my $textdomain = 'PageKit';
Locale::gettext::bindtextdomain($textdomain, $pkit_root . '/locale');
Locale::gettext::textdomain($textdomain);
}
else {
warn "Locale::gettext not installed ($@)";
}
Apache-PrettyPerl
view release on metacpan or search on metacpan
PrettyPerl.pm view on Meta::CPAN
our @KeyWords =
qw(
while until for foreach unless if elsif else do
package use no require import and or eq ne cmp
abs accept alarm atan2 bind binmode bless
caller chdir chmod chomp chop chown chr
chroot close closedir connect continue cos
crypt dbmclose dbmopen defined delete die
dump each endgrent endhostent endnetent
endprotoent endpwent endservent eof eval
Apache-Reload
view release on metacpan or search on metacpan
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
Apache-SPARQL-RDFStore
view release on metacpan or search on metacpan
lib/Apache/SPARQL/RDFStore.pm view on Meta::CPAN
=cut
=head1 NAME
Apache::SPARQL::RDFStore - A mod_perl handler which implements SPARQL HTTP bindings with RDFStore
=head1 SYNOPSIS
<Location /rdfstore>
lib/Apache/SPARQL/RDFStore.pm view on Meta::CPAN
my $res = $ua->request($req);
=head1 DESCRIPTION
Apache::SPARQL::RDFStore is a mod_perl handler which implements SPARQL HTTP bindings with RDFStore...
=head1 MOD_PERL COMPATIBILITY
This handler will work with both mod_perl 1.x and mod_perl 2.x.
Apache-SPARQL
view release on metacpan or search on metacpan
lib/Apache/SPARQL.pm view on Meta::CPAN
=cut
=head1 NAME
Apache::SPARQL - mod_perl handler base class to implement a SPARQL query service using HTTP bindings.
=head1 SYNOPSIS
<Location /rdfstore>
lib/Apache/SPARQL.pm view on Meta::CPAN
my $res = $ua->request($req);
=head1 DESCRIPTION
Apache::SPARQL is a mod_perl handler base class to implement a SPARQL query service using HTTP bindings.
=head1 IMPORTANT
This package is a base class and not expected to be invoked
directly. Please use one of the backends handlers instead.
Apache-SWIT-Security
view release on metacpan or search on metacpan
lib/Apache/SWIT/Security/UI/UserForm.pm view on Meta::CPAN
use base qw(Apache::SWIT::HTPage::Safe);
use Apache::SWIT::Security qw(Hash);
sub swit_startup {
my $rc = shift()->ht_make_root_class('HTML::Tested::ClassDBI');
$rc->ht_add_widget(::HTV."::EditBox", 'username', cdbi_bind => 'name');
$rc->ht_add_widget(::HTV."::PasswordBox", 'password', cdbi_bind => '');
$rc->ht_add_widget(::HTV."::PasswordBox", 'password2'
, check_mismatch => 'password'
, constraints => [ [ 'defined' ] ]);
$rc->bind_to_class_dbi(
$ENV{AS_SECURITY_USER_CLASS}, { PrimaryKey => [] });
}
sub ht_swit_render {
my ($class, $r, $root) = @_;
Apache-SWIT
view release on metacpan or search on metacpan
lib/Apache/SWIT/HTPage/Safe.pm view on Meta::CPAN
my ($iargs) = ($idef->[0] =~ /\((.*)\)$/);
confess "No index args for $idef->[0]" unless $iargs;
my %cols = map { ($_, 1) } split(/, /, $iargs);
my @errs = map { [ $_->[1], "unique" ] } grep { $cols{$_->[0]} }
map { [ ($_->options->{cdbi_bind} || $_->options->{safe_bind}
|| $_->name), $_->name ] }
grep { exists($_->options->{cdbi_bind})
|| exists($_->options->{safe_bind}) }
@{ $root->Widgets_List };
return $class->swit_encode_errors(\@errs);
ORIG_ERROR:
return shift()->SUPER::ht_swit_update_die(@_);
( run in 2.287 seconds using v1.01-cache-2.11-cpan-2398b32b56e )