package MyDBI;
use DBIx::DWIW 'safe';
@ISA = 'DBIx::DWIW';
use strict;

=head1 NAME

C<MyDBI> -- example sub-class of C<DBIx::DWIW>

=head1 SYNOPSIS

  use MyDBI;

  my $db = MyDBI->Connect();

  ## do stuff

See C<DBIx::DWIW> for the functions available to the C<$db> object.

This is the sample C<MyDBI.pm> distributed with C<DBIx::DWIW>.

=head1 DESCRIPTION

This package knows many named database configurations (they're like
ODBC DSNs in the Windows world, if that helps you at all). They have
names like C<Finance>, C<Games>, C<Homer>, etc., with C<Homer> being
the default. To access another, use something like:

  my $db = MyDBI->Connect('Games');

Note that if you use the single argument form of C<Connect()>, which
we highly recommend, you are specifying a B<configuration name>, not
necessarily a database name.  That is, configuration names and
database names may not necessarily be related.  You might have a
database called C<Homer> on two servers, test and production.  You
might defined a configuration named C<Homer-test> and one called
C<Homer-prod> to make things clear.  The two may only differ in the
host they connect to.

The configuration name internally supplies a host, user, password, and
database name. Using these gives us the flexability to move/rename
databases, servers, and make other changes without having to update
lots of code.

=cut

my $default_user = 'db_user';
my $default_pass = 'db_pass';
my $default_host = 'db.foobar.org';
my $default_db   = 'Homer';
my $slave_user   = 'readonly';
my $slave_pass   = 'ImAslave';

my @defaults = ( Host   => $default_host,
		 User   => $default_user,
		 Pass   => $default_pass );


my %Config =
(
 Finance =>
  {
  @defaults,
  DB => 'Finance'
  },

 'Games' =>
 {
  @defaults,
  DB   => 'test',
  User => 'gamer',
  Pass => 'IlikeDOOM',
 },

'Homer' =>
 {
  @defaults,
  DB   => 'Homer',
  Host => 'homer-db.foobar.org',
 },

);

##
## Given a DB name, return the configuration for it.
##
sub LocalConfig($$)
{
    my ($class, $name) = @_;

    if ($name)
    {
	return $Config{$name};
    }
    else
    {
	return $Config{$default_db};
    }
}

##
## Default Host, User, and Password for users of this package
##
sub DefaultDB      { return $default_db   }
sub RawDefaultUser { return $default_user }
sub RawDefaultPass { return $default_pass }
sub RawDefaultHost { return $default_host }

##
## How long to sleep between checks of a down database.
## Elements are either a number in seconds, or a control item.
## Control items are references to hashes, with the following elements:
##     Mail -- address to send a "database is down" message.
##
## Once all elements have been cycled through, the original function
## (connect, database access, etc.) will return failed.
##
my @RetryCycleSleep =
  ( 0, 5, 10,                                                    # back-off
    { Mail => 'db-admin@foobar.org' },                           # mail
    30,30,30,30,30,30,30,30,30,30,                               # 5 minutes
    { Mail => 'page-db-admin@foobar.org' },                      # page
    30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30,30, # 10 minutes
  );

##
## Returns true if the action should be retried, false if the it
## should bail.
##
sub RetryWait($$)
{
    my $db   = shift;
    my $error = shift;

    if (not $db->{RetryStart})
    {
	$db->{RetryStart} = time;
	$db->{RetryCommand} = $0;
	$0 = "(waiting on db) $0";
    }

    ## If we "know" the dbi is down, then just retry.  Will enhance
    ## this logic later to bitch if things have been down too long.

    if (-e '/tmp/.dbi_down')
    {
        sleep 30;
        return 1;
    }

    my $item = $RetryCycleSleep[ $db->{RetryCount}++ ];

    if (not defined $item)
    {
	## Ran off the end of the list -- bail
	warn scalar(localtime). ": giving up\n";
	return 0;
    }

    if (not ref $item)
    {
	## Just a number of seconds to sleep
	if ($item)
	{
	    my $now = localtime;
	    warn "$now: sleeping for $item [$error]\n";
	    sleep $item;
	}
	return 1;
    }
    else
    {
	if ($item->{Mail} and open MAIL, "|/usr/sbin/sendmail $item->{Mail}")
	{
	    warn "sending mail to $item->{Mail}\n";
	    print MAIL "$db->{DESC} is down\nError: $error\nProgram: $0\n";
	    close MAIL;

            $db->{RetryMailed}->{$item->{Mail}} = 1;
	}
	return $db->RetryWait($error);
    }
}

1;


__END__