File Coverage

blib/lib/JDBC.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package JDBC;

use warnings;
use strict;

=head1 NAME

JDBC - Perl 5 interface to Java JDBC (via Inline::Java)

=head1 VERSION

Version 0.02

=cut

our $VERSION = '0.02';

=head1 SYNOPSIS

    use JDBC;

    JDBC->load_driver("org.apache.derby.jdbc.EmbeddedDriver");

    my $con = JDBC->getConnection($url, "test", "test");

    my $s = $con->createStatement();

    $s->executeUpdate("create table foo (foo int, bar varchar(200), primary key (foo))");
    $s->executeUpdate("insert into foo (foo, bar) values (42,'notthis')");
    $s->executeUpdate("insert into foo (foo, bar) values (43,'notthat')");

    my $rs = $s->executeQuery("select foo, bar from foo");
    while ($rs->next) {
	my $foo = $rs->getInt(1);
	my $bar = $rs->getString(2);
	print "row: foo=$foo, bar=$bar\n";
    }

=head1 DESCRIPTION

This JDBC module provides an interface to the Java C and
C JDBC APIs.

=cut

our @ISA = qw(Exporter java::sql::DriverManager);

{   # the Inline package needs to be use'd in main in order to
    # get the studied classes to be rooted in main
    package main;
    use Inline ( Java => q{ }, AUTOSTUDY => 1 );
}

use Inline::Java qw(cast caught study_classes);

our @EXPORT_OK = qw(cast caught study_classes);

our $debug = $ENV{PERL_JDBC_DEBUG} || 0;

#java.sql.ParameterMetaData
my @classes = (qw(
    java.sql.Array
    java.sql.BatchUpdateException
    java.sql.Blob
    java.sql.CallableStatement
    java.sql.Clob
    java.sql.Connection
    java.sql.DataTruncation
    java.sql.DatabaseMetaData
    java.sql.Date
    java.sql.Driver
    java.sql.DriverManager
    java.sql.DriverPropertyInfo
    java.sql.PreparedStatement
    java.sql.Ref
    java.sql.ResultSet
    java.sql.ResultSetMetaData
    java.sql.SQLData
    java.sql.SQLException
    java.sql.SQLInput
    java.sql.SQLOutput
    java.sql.SQLPermission
    java.sql.SQLWarning
    java.sql.Savepoint
    java.sql.Statement
    java.sql.Struct
    java.sql.Time
    java.sql.Timestamp
    java.sql.Types
    javax.sql.ConnectionEvent
    javax.sql.ConnectionEventListener
    javax.sql.ConnectionPoolDataSource
    javax.sql.DataSource
    javax.sql.PooledConnection
    javax.sql.RowSet
    javax.sql.RowSetEvent
    javax.sql.RowSetInternal
    javax.sql.RowSetListener
    javax.sql.RowSetMetaData
    javax.sql.RowSetReader
    javax.sql.RowSetWriter
    javax.sql.XAConnection
    javax.sql.XADataSource
));

warn "studying classes\n" if $debug;
study_classes(\@classes, 'main');

#Fix a long-standing bug due to changes in @ISA caching introduced in perl 5.10.0.
#See  http://perldoc.perl.org/perl5100delta.html (search for "mro").
#RT 1/5/14.
#
#force a reset of the @ISA cache after injecting java.sql.DriverManager, which we inherit from:
@ISA = @ISA;

# Driver => java.sql.Driver, RowSet => javax.sql.RowSet etc
my %class_base   = map { m/^(.*\.(\w+))$/ or die; (  $2  => $1) } @classes;

# :Driver => java::sql::Driver, :RowSet => javax::sql::RowSet etc
my %import_class = map {
    (my $pkg = $class_base{$_}) =~ s/\./::/g;
    (":$_" => $pkg)
} keys %class_base;


sub import {
    my $pkg = shift;
    my $callpkg = caller($Exporter::ExportLevel);

    # deal with :ClassName imports as a special case
    my %done;
    for my $symbol (@_) {
	# is it a valid JDBC class?
	next unless my $java_pkg = $import_class{$symbol};

	no strict 'refs';
	# get list of "constants" which I've defined as symbols with
	# all-uppercase names that also have defined scalar values
	# (which also avoids perl baggage like ISA, TIEHASH, DESTROY)
	my @const = grep {
	    /^[A-Z][_A-Z0-9]*$/ and defined ${$java_pkg.'::'.$_}
	} keys %{ $java_pkg.'::' };

	# now export those as real perl constants
	warn "import $symbol ($java_pkg): @const" if $debug;
	for my $const (@const) {
	    no strict 'refs';
	    my $scalar = ${"$java_pkg\::$const"};
	    *{"$callpkg\::$const"} = sub () { $scalar };
	}
	++$done{$symbol};
    }
    @_ = grep { !$done{$_} } @_; # remove symbols we've now dealt with

    return if !@_ and %done; # we've dealt with all there was
    # else call standard import to handle anything else
    local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
    return $pkg->SUPER::import(@_);
}

=head1 METHODS

=head2 load_driver

The load_driver() method is used to load a driver class.

  JDBC->load_driver($driver_class)

is equivalent to the Java:

  java.lang.Class.forName(driver_class).newInstance();

=cut

sub load_driver {
    my ($self, $class) = @_;
    study_classes([$class], 'main');
}

# override getDrivers to return an Enumeration (not private class)

sub getDrivers {
    return cast('java.util.Enumeration', shift->SUPER::getDrivers)
}

=head1 FUNCTIONS

=head2 cast

=head2 caught

=head2 study_classes

The cast(), caught(), and study_classes() functions of Inline::Java are also
optionally exported by the JDBC module.

=cut

=head1 IMPORTING CONSTANTS

Java JDBC makes use of constants defined in

  import java.sql.*;
  ...
  stmt = con.prepareStatement(PreparedStatement.SELECT);

the package can also be specified with the C which then avoids the need
to prefix the constant with the class:

  import java.sql.PreparedStatement;
  ...
  stmt = con.prepareStatement(SELECT);

In Perl the corresponding code can be either:

  use JDBC;
  ...
  $stmt = $con->prepareStatement($java::sql::PrepareStatement::SELECT);

or, the rather more friendly:

  use JDBC qw(:PreparedStatement);
  ...
  $stmt = $con->prepareStatement(SELECT);

When importing a JDBC class in this way the JDBC module only imports defined
scalars with all-uppercase names, and it turns them into perl constants so the
C<$> is no longer needed.

All constants in all the java.sql and javax.sql classes can be imported in this way.

=cut

warn "running\n" if $debug;

1; # End of JDBC

__END__