use strict;
use vars qw(
@ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
- $conf_dir $secrets $datasrc $db_user $db_pass %callback $driver_name
- $AutoCommit
+ $conf_dir $secrets $datasrc $db_user $db_pass %callback @callback
+ $driver_name $AutoCommit
);
use subs qw(
getsecrets cgisetotaker
@ISA = qw(Exporter);
@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
- getotaker dbh datasrc getsecrets driver_name );
+ getotaker dbh datasrc getsecrets driver_name myconnect );
$freeside_uid = scalar(getpwnam('freeside'));
$ENV{'BASH_ENV'} = '';
croak "Not running uid freeside!" unless checkeuid();
- getsecrets;
- $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
- 'AutoCommit' => 0,
- #'ChopBlanks' => 1,
- } ) or die "DBI->connect error: $DBI::errstr\n";
+
+ $dbh = &myconnect;
foreach ( keys %callback ) {
&{$callback{$_}};
# breaks multi-database installs # delete $callback{$_}; #run once
}
+ &{$_} foreach @callback;
+
$dbh;
}
+sub myconnect {
+ $dbh = DBI->connect( getsecrets, {'AutoCommit' => 0, 'ChopBlanks' => 1, } )
+ or die "DBI->connect error: $DBI::errstr\n";
+}
+
+=item install_callback
+
+A package can install a callback to be run in adminsuidsetup by passing
+a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
+run already, the callback will also be run immediately.
+
+ $coderef = sub { warn "Hi, I'm returning your call!" };
+ FS::UID->install_callback($coderef);
+
+ install_callback FS::UID sub {
+ warn "Hi, I'm returning your call!"
+ };
+
+=cut
+
+sub install_callback {
+ my $class = shift;
+ my $callback = shift;
+ push @callback, $callback;
+ &{$callback} if $dbh;
+}
+
=item cgisuidsetup CGI_object
Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
=cut
sub getotaker {
- $user;
+ #$user;
+ #stupid kludge until schema otaker fields are not 8 chars
+ substr($user,0,8);
}
=item cgisetotaker
=head1 CALLBACKS
-Warning: this interface is likely to change in future releases.
+Warning: this interface is (still) likely to change in future releases.
-A package can install a callback to be run in adminsuidsetup by putting a
-coderef into the hash %FS::UID::callback :
+New (experimental) callback interface:
+
+A package can install a callback to be run in adminsuidsetup by passing
+a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
+run already, the callback will also be run immediately.
$coderef = sub { warn "Hi, I'm returning your call!" };
- $FS::UID::callback{'Package::Name'};
+ FS::UID->install_callback($coderef);
-=head1 VERSION
+ install_callback FS::UID sub {
+ warn "Hi, I'm returning your call!"
+ };
-$Id: UID.pm,v 1.21 2002-09-27 12:14:12 ivan Exp $
+Old (deprecated) callback interface:
+
+A package can install a callback to be run in adminsuidsetup by putting a
+coderef into the hash %FS::UID::callback :
+
+ $coderef = sub { warn "Hi, I'm returning your call!" };
+ $FS::UID::callback{'Package::Name'} = $coderef;
=head1 BUGS
Goes through contortions to support non-OO syntax with multiple datasrc's.
-Callbacks are inelegant.
+Callbacks are (still) inelegant.
=head1 SEE ALSO