File Coverage

lib/DBSchema/Sample.pm

Criterion	Covered	Total	%
statement	15	93	16.1
branch	0	24	0.0
condition	0	9	0.0
subroutine	5	10	50.0
pod	0	4	0.0
total	20	140	14.2

package DBSchema::Sample;


use strict;
use warnings;

use DBIx::AnyDBD;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use DBSchema::Sample ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(load

);

our $VERSION = '2.0.a';


# Preloaded methods go here.


# Building Makefile for DBSchame::Sample



# Ignore the following DBD Drivers

my %drivers;

my %ignore = ('ExampleP' => 1,
           'NullP'    => 1,
           'Sponge'   => 1,
           'Proxy'   => 1,
	   'File'     => 1) ;

my %datasource = ('Pg'     => 'dbi:Pg:dbname=test',
               'SQLite' => 'dbi:SQLite:test',
               'mysql'  => 'dbi:mysql:dbname=test',
	       ) ;

## ----------------------------------------------------------------------------

sub MY::test_via_script
	{
	my ($txt) = shift -> MM::test_via_script (@_) ;

	$txt =~ s/\$\(TEST_FILE\)/\$(TEST_FILE) \$(TESTARGS)/g ;

	return $txt ;
	}


## ----------------------------------------------------------------------------

sub GetString
	{
	my ($prompt, $default) = @_ ;

	printf ("%s [%s]", $prompt, $default) ;
	chop ($_ = ) ;
	if (!/^\s*$/)
	    {return $_ ;}
	else
    	{
        if ($_ eq "")
	        {return $default ;}
	    else
            { return "" ; }

        }
    }

## ----------------------------------------------------------------------------

sub GetYesNo
	{
	my ($prompt, $default) = @_ ;
	my ($value) ;

	do
	    {
	    $value = lc (GetString ($prompt . "(y/n)", ($default?"y":"n"))) ;
	    }
	until (($value cmp "j") == 0 || ($value cmp "y") == 0 || ($value cmp "n" ) == 0) ;

	return ($value cmp "n") != 0 ;
	}

## ----------------------------------------------------------------------------

sub load {

  print "\n";

  my @prereq = qw(DBI DBIx::AnyDBD);

  for my $prereq (@prereq) {

    eval "use $prereq" ;

    die "\nPlease install $prereq before installing DBSchema::Sample" if ($@) ;
    my $v = $prereq->VERSION;
    my $v2 = eval $v;
    print "Found $prereq version $v2\n" ;

  }

  my @drvs = DBI::available_drivers () ;

  my $driversinstalled;

  foreach my $drv (@drvs)
    {
      next if (exists ($ignore{$drv})) ;

      $drivers{$drv}{dsn} = $datasource{$drv} || "dbi:$drv:test" ;

      ++$driversinstalled;
    }

  unless ($driversinstalled)
    {
      die
	"At least one DBD driver must be installed before running load" ;
    }

  print "Found the following DBD drivers:\n" ;

  my @drivers = sort keys %drivers ;
  my $i = 1 ;

  foreach (@drivers)
    {
      print "$i.) $_\n" ;
      $i++ ;
    }

  print "\n" ;
  print "We need an existing datasource for each\n" ;
  print "DBD driver to populate the database.\n" ;
  print "Please enter a valid datasource (or accept the default) for each DBD driver\n" ;
  print "or enter a '.' if you do not want to load the sample schema using this driver\n" ;
  print "\n" ;

  $i = 1 ;
  my ($user, $pass);
  foreach my $drv (@drivers)
    {
      my $dsn = GetString ("$i.) $drv",  $drivers{$drv}{dsn}) ;
      if ($dsn eq '.')
        { delete $drivers{$drv} ; }
      else
        {
	  $drivers{$drv}{dsn} = $dsn ;
	  $user = GetString ("\tUsername", "undef") ;
	  if ($user ne 'undef')
            {
	      $drivers{$drv}{user} = $user ;
	      $pass = GetString ("\tPassword", "undef");
	      $drivers{$drv}{pass} = $pass if ($pass ne 'undef') ;
            }
        }
      $i++ ;
    }

  print "\n" ;
  print "These databases will populated using the following parameters\n" ;

  @drivers = sort keys %drivers ;
  for my $D (@drivers)
    {
      print "$D \t-> $drivers{$D}{dsn}\t" ;
      print "user: $drivers{$D}{user}\t" if (defined ($drivers{$D}{user})) ;
      print "password: $drivers{$D}{pass}"  if (defined ($drivers{$D}{pass})) ;
      print "\n" ;

      print "Access this database and populate? ";
      next unless GetYesNo (" > ", "");

      my $app_handle = app_handle($drivers{$D});

      use Data::Dumper;
      warn Dumper($app_handle);

      my $sql = $app_handle->sql;

      for (@$sql) {
	warn $_;
	$app_handle->get_dbh->do($_);
      }
    }

}

sub app_handle {

  my $c = shift;

  use Data::Dumper;
  warn Dumper($c);

  my $attr = { RaiseError => 1, PrintError => 1 } ;
  my $class = __PACKAGE__;


  DBIx::AnyDBD->connect
	(
	 $c->{dsn},
	 $c->{user},
	 $c->{pass},
	 $attr,
	 $class # The one difference between DBI and DBIx::AnyDBD
	);

}


__END__