libdbix-xml-rdb-perl-0.05.orig/ 0042775 0001750 0000146 00000000000 07221666240 015261 5 ustar ardo debian libdbix-xml-rdb-perl-0.05.orig/Changes 0100664 0001750 0000146 00000001164 07221656140 016547 0 ustar ardo debian Revision history for Perl extension DBI::XML.
0.05 Wed Dec 13 2000
- XML Encode better
0.04 Fri Dec 01 2000
- Updated to work with MySQL (Kip Hampton)
- Driver now specified in an attribute (Kip Hampton)
0.03 Fri Jan 08 1999
- Fixed test.pl to "use DBIx::XML_RDB;" (thanks Randal!)
- Use UTF-8 encoding, rather than MIME::Base64
0.02 Mon Jan 04 1999
- Added xml2sql.pl
- Updated to more Unixish install
- minor fixes
0.01 Thu Oct 22 09:58:13 1998
- original version; created by h2xs 1.18
- actually not quite original. Converted from sql2xls and then
converted from Win32::ODBC to DBI
libdbix-xml-rdb-perl-0.05.orig/MANIFEST 0100664 0001750 0000146 00000000127 07121235202 016372 0 ustar ardo debian Changes
MANIFEST
Makefile.PL
README
sql2xml.pl
xml2sql.pl
XML_RDB.pm
XMLDB.sct
test.pl
libdbix-xml-rdb-perl-0.05.orig/Makefile.PL 0100775 0001750 0000146 00000000605 07121235202 017217 0 ustar ardo debian #!/usr/bin/perl
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'DBIx::XML_RDB',
'VERSION_FROM' => 'XML_RDB.pm', # finds $VERSION
'EXE_FILES' => ['sql2xml.pl', 'xml2sql.pl'],
'PREREQ_PM' => { DBI => "1.00" },
'dist' => {'COMPRESS' => 'gzip', suffix => 'gz' },
);
libdbix-xml-rdb-perl-0.05.orig/README 0100664 0001750 0000146 00000002001 07221655517 016132 0 ustar ardo debian DBIx::XML_RDB creates XML from select statements to DBI datasources.
It also includes an import utility xml2sql that allows you to copy
data from one database to another.
SYNOPSIS
use DBIx::XML_RDB;
my $xmlout = DBIx::XML_RDB->new($datasource,
"ODBC", $userid, $password, $dbname) || die "Failed to make new xmlout";
$xmlout->DoSql("select * from MyTable");
print $xmlout->GetData;
The format of the XML output is something like this:
Data
Data
...
...
...
Matt Sergeant, matt@sergeant.org
libdbix-xml-rdb-perl-0.05.orig/XMLDB.sct 0100664 0001750 0000146 00000001472 07121235202 016626 0 ustar ardo debian
libdbix-xml-rdb-perl-0.05.orig/XML_RDB.pm 0100664 0001750 0000146 00000013072 07221656140 016742 0 ustar ardo debian package DBIx::XML_RDB;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %XMLCHARS $REXMLCHARS);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(); # Not exporting anything - this is OO.
$VERSION = '0.05';
use DBI;
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = {};
bless $self, $class;
$self->Initialise(@_) || return undef;
return $self;
}
%XMLCHARS = (
'&' => '&',
'<' => '<',
'>' => '>',
'"' => '"',
);
sub xmlenc {
my $str = shift;
$str =~ s/([&<>"])/$XMLCHARS{$1}/ge;
return $str;
}
sub Initialise {
my $self = shift;
$self->{datasource} = shift;
my $driver = shift;
my $userid = shift;
my $password = shift;
my $dbname = shift;
$self->{verbose} = shift;
$self->{dbh} = DBI->connect("dbi:$driver:". $self->{datasource}, $userid, $password);
if (!$self->{dbh}) {
print STDERR "Connection failed\n";
return 0;
}
if ($dbname) {
if(!$self->{dbh}->do("use $dbname")) {
print STDERR "USE $dbname failed\n";
return 0;
}
}
$self->{output} = "\n";
$self->{output} .= "{datasource}) . "\">\n";
return 1;
}
sub DESTROY {
my $self = shift;
$self->{dbh}->disconnect;
}
sub DoSql {
my $self = shift;
my $sql = shift;
$self->{sth} = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr;
$self->{sth}->execute || die $self->{sth}->errstr;
$self->_CreateOutput;
$self->{sth}->finish;
}
sub _CreateOutput {
my $self = shift;
my $fields = $self->{sth}->{NAME};
# Now insert the actual data.
$self->{output} .= "\t{sth}->{Statement}) ."\">\n";
my $row = 0;
my @data;
while (@data = $self->{sth}->fetchrow_array) {
print STDERR "Row: ", $row++, "\n" if $self->{verbose};
my $i = 0;
$self->{output} .= "\t\t\n";
foreach my $f (@data) {
if (defined $f) {
$self->{output} .= "\t\t\t<" . $fields->[$i] . '>' . xmlenc($f) . '[$i] . ">\n";
}
$i++;
}
$self->{output} .= "\t\t
\n";
}
$self->{output} .= "\t\n";
}
sub GetData {
my $self = shift;
my $output = $self->{output} . "\n";
# Return output to starting state, in case we want to do more...
$self->{output} = "\n";
$self->{output} .= "{datasource}) . "\">\n";
return $output;
}
1;
__END__
=head1 NAME
DBIx::XML_RDB - Perl extension for creating XML from existing DBI datasources
=head1 SYNOPSIS
use DBIx::XML_RDB;
my $xmlout = DBIx::XML_RDB->new($datasource,
"ODBC", $userid, $password, $dbname) || die "Failed to make new xmlout";
$xmlout->DoSql("select * from MyTable");
print $xmlout->GetData;
=head1 DESCRIPTION
This module is a simple creator of XML data from DBI datasources. It allows you to
easily extract data from a database, and manipulate later using XML::Parser.
One use of this module might be (and will be soon from me) to extract data on the
web server, and send the raw data (in XML format) to a client's browser, and then
use either XML::Parser from PerlScript, or MSXML from VBScript/JavaScript on the
client's machine to generate HTML (obviously this relies upon using MS IE for their
Active Scripting Engine, and MSXML comes with IE5beta).
Another use is a simple database extraction tool, which is included, called sql2xml.
This tool simply dumps a table in a database to an XML file. This can be used in
conjunction with xml2sql (part of the XML::DBI(?) package) to transfer databases
from one platform or database server to another.
Binary data is encoded using UTF-8. This is automatically decoded when parsing
with XML::Parser.
Included with the distribution is a "Scriptlet" - this is basically a Win32 OLE
wrapper around this class, allowing you to call this module from any application
that supports OLE. To install it, first install the scriptlets download from
microsoft at http://msdn.microsoft.com/scripting. Then right-click on XMLDB.sct
in explorer and select "Register". Create your object as an instance of
"XMLDB.Scriptlet".
=head1 FUNCTIONS
=head2 new
new ( $datasource, $dbidriver, $userid, $password [, $dbname] )
See the DBI documentation for what each of these means, except for $dbname which
is for support of Sybase and MSSQL server database names (using "use $dbname").
=head2 DoSql
DoSql ( $sql )
Takes a simple Sql command string (either a select statement or on some DBMS's can be
a stored procedure call that returns a result set - Sybase and MSSql support this,
I don't know about others).
This doesn't do any checking if the sql is valid, if it fails, the procedure will "die",
so if you care about that, wrap it in an eval{} block.
The result set will be appended to the output. Subsequent calls to DoSql don't overwrite
the output, rather they append to it. This allows you to call DoSql multiple times before
getting the output (via GetData()).
=head2 GetData
Simply returns the XML generated from this SQL call. Unfortunately it doesn't stream out
as yet. I may add this in sometime in the future (this will probably mean an IO handle
being passed to new()).
The format of the XML output is something like this:
Data
Data
...
...
...
This is quite easy to parse using XML::Parser.
=head1 AUTHOR
Matt Sergeant, matt@sergeant.org
=head1 SEE ALSO
XML::Parser
=cut
libdbix-xml-rdb-perl-0.05.orig/sql2xml.pl 0100775 0001750 0000146 00000003162 07121235202 017205 0 ustar ardo debian #!/usr/bin/perl -w
require 5.004;
use strict;
use DBIx::XML_RDB;
use Getopt::Long;
use vars qw($datasource $driver $userid $password $table $outputfile $help $dbname $verbose @fields);
sub usage;
# Options to variables mapping
my %optctl = (
'sn' => \$datasource,
'uid' => \$userid,
'pwd' => \$password,
'table' => \$table,
'output' => \$outputfile,
'help' => \$help,
'db' => \$dbname,
'driver' => \$driver,
'verbose' => \$verbose );
# Option types
my @options = (
"sn=s",
"uid=s",
"pwd=s",
"table=s",
"output=s",
"db=s",
"driver=s",
"help",
"verbose"
);
GetOptions(\%optctl, @options) || die "Get Options Failed";
usage if $help;
unless ($datasource && $userid && $table && $outputfile) {
usage;
}
$driver = $driver || "ODBC"; # ODBC is the default. Change this if you wish.
my $xmlout = DBIx::XML_RDB->new($datasource, $driver, $userid, $password, $dbname)
|| die "Failed to make new xmlout";
$xmlout->DoSql("SELECT * FROM $table ORDER BY 1");
use IO::File;
my $output = IO::File->new(">". $outputfile);
print $output $xmlout->GetData;
# End
sub usage {
print <SUPER::new(@_);
my $driver = shift;
my $datasource = shift;
my $userid = shift;
my $passwd = shift;
$table = shift; # Not sure if we want to limit to individual tables yet
my $dbname = shift;
bless($self, $class);
$self->setHandlers('Start' => $self->can('Start'),
'Init' => $self->can('Init'),
'End' => $self->can('End'),
'Char' => $self->can('Char'),
'Proc' => $self->can('Proc'),
'Final' =>$self->can('Final'),
);
# Setup the DB Connection
$dbh = DBI->connect("dbi:$driver:$datasource", $userid, $passwd) or die "Can't connect to datasource";
if ($dbname) {
$dbh->do("use $dbname") || die $dbh->errstr;
}
return($self);
}
sub execute {
my ($self, $sql) = @_;
$dbh->do($sql);
}
sub Init {
my $expat = shift;
# OK, here we setup the insert statement.
# We use the prepare method because it offers us _very_ fast inserts.
$sth = $dbh->prepare("select * from $table where 1=2") || die $dbh->errstr;
$sth->execute() || die $dbh->errstr; # Get column names
my $names = $sth->{NAME};
my $sql = "insert into $table ( " . (join ", ", @$names) . " ) values ( ";
my $colnum = 1;
eval {
$sql .= (join ", ",
(map {
$expat->{ __PACKAGE__ . "columns"}->{uc($_)} = $colnum++;
'?';
} @{$names})
);
};
if ($@) {
die $@;
}
$sql .= " )";
# print $sql, "\n\n";
$sth = $dbh->prepare($sql) || die;
# my $count = 1;
# foreach my $f (keys(%{$expat->{ __PACKAGE__ . "columns"}})) {
# $sth->bind_param( $count++ , undef );
# }
# Possibly add begin transaction code here.
}
sub Start {
my ($expat, $element, %attrs) = @_;
# Structure goes: DSN->Table->Column
if ($expat->within_element("ROW")) {
# OK, got a column, reset the data within that column
undef $expat->{ __PACKAGE__ . "currentData"};
}
}
sub End {
my ($expat, $element) = @_;
if ($element eq "ROW") {
# Found the end of a row
print "Inserting a row...\n";
shift @col_vals;
#kip: handy for debugging.
#DBI->trace(5);
#print "colvals are @col_vals\n";
$sth->execute(@col_vals) || die;
@col_vals = ();
# kip:
# the following is no longer needed but I'll leave it just in case I'm wrong.
# Re-bind to undef (makes sure things are NULL)
#my $count = 1;
#foreach my $f (keys(%{$expat->{ __PACKAGE__ . "columns"}})) {
# $sth->bind_param( $count++ , undef );
#}
}
elsif ($expat->within_element("ROW")) {
$element = uc($element);
return unless $expat->{ __PACKAGE__ . "columns"}->{$element};
$col_vals[$expat->{ __PACKAGE__ . "columns"}->{$element}] =
$expat->{ __PACKAGE__. "currentData"};
}
}
sub Char {
my ($expat, $string) = @_;
# The only Char is the data. (AFAIK) Otherwise this will break (sorry!)
my @context = $expat->context;
my $column = pop @context;
my $curtable = pop @context;
if (($curtable) && ($curtable eq "ROW")) {
$expat->{ __PACKAGE__ . "currentData"} .= $string;
}
}
sub Proc {
my $expat = shift;
my $target = shift;
my $text = shift;
}
sub Final {
my $expat = shift;
# Possibly put commit code here.
}
1;
#########################################################################################
package main;
use strict;
use Getopt::Long;
use vars qw($datasource $userid $password $table $inputfile $help
$dbname $verbose $truncate $driver);
sub usage;
sub quote;
sub IsNumber;
# Options to variables mapping
my %optctl = (
'sn' => \$datasource,
'uid' => \$userid,
'pwd' => \$password,
'table' => \$table,
'input' => \$inputfile,
'help' => \$help,
'db' => \$dbname,
'verbose' => \$verbose,
'x' => \$truncate,
'driver' => \$driver,
);
# Option types
my @options = (
"sn=s",
"uid=s",
"pwd=s",
"table=s",
"input=s",
"db=s",
"driver=s",
"help",
"verbose",
"x"
);
GetOptions(\%optctl, @options) || die "Get Options Failed";
usage if $help;
unless ($datasource and $userid and $table and $inputfile) {
usage;
}
$driver = $driver || "ODBC"; # ODBC is the default driver. Change this if you want.
my $xmldb = XMLDBI->new($driver, $datasource, $userid, $password, $table, $dbname);
if ($truncate) {
$xmldb->execute("DELETE FROM $table");
}
open(FILE, $inputfile) or die $!;
my $file = join "", ;
$xmldb->parsestring($file);
# End
####################################################################
### subs ###
sub usage {
print <