emdb.pm.in 3.37 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2008-2011 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
23 24 25 26 27
#
package emdb;
use strict;
use File::Basename;
use English;
28
use Carp;
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
use Exporter;
use vars qw(@ISA @EXPORT);
@ISA = "Exporter";

use emdbi;
use libtestbed;
use libtblog_simple;

# Configure variables
my $TB		= "@prefix@";
my $DBNAME	= "@TBDBNAME@";
my $SCRIPTNAME  = "Unknown";
my $TBOPS       = "@TBOPSEMAIL@";

# Untainted scriptname for email below.
if ($PROGRAM_NAME =~ /^([-\w\.\/]+)$/) {
    $SCRIPTNAME = basename($1);
}
else {
    $SCRIPTNAME = "Tainted";
}

@EXPORT = qw(DBQuery DBQueryFatal DBQueryWarn DBWarn DBFatal DBErr
	     NewTBDBHandle DBQueryN DBQueryFatalN DBQueryWarnN DBErrN
	     DBQuerySingleFatal DBQuerySingleFatalN TBDBDisconnect
	     DBTableExists DBSlotExists DBSlotType DBQuoteSpecial
55
	     DBKeyExists TBDBConnect TBDBReconnect);
56 57 58 59 60 61
@EXPORT = (@EXPORT, @emdbi::EXPORT);

sub TBDBConnect($)	{ return emdbi::TBDBConnect($_[0], $DBNAME); }
sub TBDBReconnect($)    { return emdbi::TBDBReconnect($_[0]); }
sub TBDBDisconnect()    { return emdbi::TBDBDisconnect(); }
sub NewTBDBHandle()     { return emdbi::NewTBDBHandle($DBNAME); }
62 63
sub DBHandle()		{ return emdbi::DBHandleN(0); }
sub DBHandleN($)	{ return emdbi::DBHandleN($_[0]); }
64 65 66 67 68 69 70 71 72 73 74 75 76
sub DBQueryN($$)	{ return emdbi::DBQueryN($_[0], $_[1]); }
sub DBQuery($)		{ return emdbi::DBQuery($_[0]); }
sub DBQueryFatalN($$)   { return emdbi::DBQueryFatalN($_[0], $_[1]); }
sub DBQueryFatal($)     { return emdbi::DBQueryFatal($_[0]);}
sub DBQuerySingleFatalN($$) { return emdbi::DBQuerySingleFatalN($_[0], $_[1]);}
sub DBQuerySingleFatal($)   { return emdbi::DBQuerySingleFatal($_[0]);}
sub DBQueryWarnN($$)	{ return emdbi::DBQueryWarnN($_[0], $_[1]); }
sub DBQueryWarn($)      { return emdbi::DBQueryWarn($_[0]);}
sub DBQuoteSpecial($)	{ return emdbi::DBQuoteSpecial($_[0]); }
sub DBErrN($)		{ return emdbi::DBErrN($_[0]); }
sub DBErr()		{ return emdbi::DBErr(); }
sub DBTableExists($)	{ return emdbi::DBTableExists($_[0]); }
sub DBSlotExists($$)	{ return emdbi::DBSlotExists($_[0], $_[1]); }
77
sub DBKeyExists($$)	{ return emdbi::DBKeyExists($_[0], $_[1]); }
78 79 80 81 82 83 84 85 86 87 88
sub DBSlotType($$)	{ return emdbi::DBSlotType($_[0], $_[1]); }
# These are handled differently cause of tblog stuff.
sub DBWarn($;$)		{ DBError(\&tbwarn, $_[0], $_[1]); }
sub DBFatal($;$)	{ DBError(\&tbdie, $_[0], $_[1]); }
sub DBError($$;$) 
{
    my($f, $message, $nomail) = @_;
    
    if (! defined($nomail)) {
	libtestbed::SENDMAIL($TBOPS, "DBError - $message",
			     "$message - In $SCRIPTNAME\n".
89 90
			     "$emdbi::DBErrorString\n" .
			     Carp::longmess() . "\n");
91 92 93 94 95 96 97 98 99
    }

    $f->({cause=>'software'}, "$message:\n$emdbi::DBErrorString");
}

# Default connection.
TBDBConnect(0);

1;