libtbsetup.pm 2.32 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh Stoller's avatar
Leigh Stoller committed
2 3 4

#
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{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/>.
# 
# }}}
Leigh Stoller's avatar
Leigh Stoller committed
24 25
#

Leigh Stoller's avatar
Leigh Stoller committed
26
use POSIX;
27

28 29 30 31 32 33
package libtbsetup;
use Exporter;
@ISA = "Exporter";
@EXPORT =
    qw ( tbs_initdbi tbs_initlog tbs_prefix tbs_out tbs_exec );

34 35 36 37 38 39 40 41 42 43
# This has the common functionality for tbprerun/tbrun/tbend.

# tbs_initdbi(dbname) - Initializes a DBI connection to the testbed database
#                       Returns the database handle.
# tbs_prefix(s) - Returns the file prefix.  I.e. strips off \..+$ from the end.
# tbs_out(s) - Spits s out to stdout and LOGFILE.
# tbs_exec(s) - Acts like system except STDOUT and STDERR are both spat out
#               through tbs_out.  Returns 1 on failure and 0 on success.

my $LOGFILE;
44
my $logging = 0;
45
my $dostamp = 0;
46 47 48 49 50 51 52 53 54 55

sub tbs_initdbi {
    my($dbname) = $_[0];
    return DBI->connect("DBI:mysql:database=$dbname;host=localhost") 
	|| die "Could not connect to DB.\n";
};

sub tbs_initlog {
    my($logfile) = $_[0];

56 57 58
    # Turn off line buffering.
    $| = 1; 

59
    open(LOGFILE,">>$logfile") || do {
60 61 62
	print STDERR "Could not open $logfile for writing.\n";
	exit(1);
    };
63
    $logging = 1;
64 65 66 67 68 69 70 71 72 73 74
}

sub tbs_prefix {
    my($s) = $_[0];
    my($prefix);
    ($prefix) = ($s =~ /^(.+)\.[^.]+$/);
    return $prefix;
};

sub tbs_out {
    my($s) = $_[0];
75 76 77 78 79 80 81
    if ($dostamp) {
	my $t = ctime(time);
	print $t;
	if ($logging) {
	    print LOGFILE $t;
	}
    }
82
    print $s;
83 84 85
    if ($logging) {
	print LOGFILE $s;
    }
86 87 88 89 90 91 92 93
};

sub tbs_exec {
    my($cmd) = $_[0];
    open(EXEC,"$cmd 2>&1|") || return 1;
    while (<EXEC>) {
	&tbs_out($_);
    }
94 95 96
    close(EXEC) or
	return $! ? $! : $?;

97 98 99 100
    return 0;
};

1;