Rose-DBx-MoreConfig
view release on metacpan or search on metacpan
lib/Rose/DBx/MoreConfig.pm view on Meta::CPAN
#!perl
use strict;
use warnings;
package Rose::DBx::MoreConfig;
use parent 'Rose::DB';
use File::Basename qw(dirname);
use File::Spec;
use Scalar::Util qw(blessed);
our ($VERSION) = '1.01';
sub auto_load_fixups {
my ( $self, @args ) = @_;
my $tried = 0;
my $home = eval {
require File::HomeDir;
File::HomeDir->my_home;
}
|| $ENV{HOME}
|| $ENV{LOGDIR}
|| eval { ( getpwuid($<) )[7] }
|| '__ALAS_NO_IDEA__';
$home = File::Spec->catfile( $home, '.rosedbrc' );
my $classpm = blessed($self);
if ($classpm) {
# Clear the suffix Rose::DB adds to make a generated implementation class
$classpm =~ s[::__RoseDBPrivate__::.*\.pm$][.pm];
$classpm =~ s[::][/]g;
$classpm = $INC{$classpm} || $classpm;
}
else {
$classpm = (caller)[1];
}
$classpm = File::Spec->catfile( dirname($classpm), '.rosedbrc' );
# Hush warnings from Rose::DB::load_yaml_fixup_file() about data
# sources the current class doesn't implement
my $warnhook = $SIG{__WARN__};
local $SIG{__WARN__} = sub {
my $msg = $_[0];
return if $msg =~ /^No \S+ data source found/;
if ( defined $warnhook ) { return $warnhook => (@_); }
else { warn @_; }
};
# First, give Rose::DB (or other parent) a chance to do its thing,
# so ROSEDB_DEVINIT is handled.
$self->SUPER::auto_load_fixups(@args);
foreach my $cand ( '/etc/rosedbrc',
File::Spec->catfile( dirname( $INC{'Rose/DB.pm'} ), '.rosedbrc' ),
$home, $classpm, $ENV{ROSEDBRC} )
{
next unless defined($cand) && -r $cand;
$tried++;
$self->load_yaml_fixup_file( $cand, @args );
}
return $tried;
}
1;
__END__
=head1 NAME
Rose::DBx::MoreConfig - Rose::DB base class with extra configuration options
=head1 SYNOPSIS
package My::Data::Source;
use parent 'Rose::DBx::MoreConfig';
... define data sources ...
__PACKAGE__->auto_load_fixups;
...
=head1 DESCRIPTION
( run in 2.639 seconds using v1.01-cache-2.11-cpan-75ffa21a3d4 )