Show COEdb.pm.in syntax highlighted
package COEdb;
##############################################################################################
# File: COEdb.pm
# Description: MySQL calling functions for Munging the LinuxCOE files
# Author: Lee Mayes ( email leem@atl.hp.com )
# Created: Jan 31 2001 ( LinuxCOE System Designer )
# Language: perl
# Package: LinuxCOE
##############################################################################################
# © Copyright 2000-2006 Hewlett-Packard Development Company, L.P
#
# This program is free software; you can redistribute it and/or modify it under the terms of
# the GNU General Public License as published by the Free Software Foundation; either version
# 2 of the License, or (at your option) any later version.
#
# This program 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 General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with this program;
# if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##############################################################################################
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(show_os);
use strict;
my $RCS= '@(#) $Header: /cvsroot/linuxcoe/SystemDesigner/lib/COEdb.pm.in,v 1.5 2007/06/28 01:29:09 lmayes Exp $';
$RCS =~ s/\@\(#\) \$Header: //;
$RCS =~ s/,v//;
$RCS =~ s/[0-9][0-9]\/.*//;
my ($procname,$VERSION) = split(' ',$RCS);
my @procs = split('/',$procname);
$procname = pop(@procs);
use DBI;
use vars qw ($dbh);
sub LockIt {
my $self = shift;
my $parent = caller;
# Connect to the database
my $db = $parent->def('DB_NAME');
my $user = $parent->def('DB_USER');
my $pass = $parent->def('DB_PASS');
my $host = $parent->def('DB_HOST');
my $connect = "DBI:mysql:$db";
if ( $host ) { $connect .= ";host=$host" }
unless ( $dbh = DBI->connect("$connect","$user","$pass", {RaiseError => 1}) ) {
$self->errmsg("Cannot connect to $db : $DBI::errstr");
return;
}
} # End of LockIt
sub DESTROY {
# Catastrohpic Error!
$dbh->disconnect;
}
sub show_os {
my ($self,$indist,$inver,$inarch,$inmeth,$inway) = @_;
#print STDERR "Called as show_os($indist,$inver,$inarch,$inmeth,$inway)\n";
my %os;
# If called w/no args, return @array of OS's
my $qarch = $dbh->quote($inarch);
unless ($indist) {
my $sql = "select distinct distro,version,arch from osvend";
my $sth = $dbh->prepare($sql);
$sth->execute;
while ( my $row = $sth->fetch ) {
$os{"$$row[0] $$row[1] - $$row[2]"} = 1;
}
$sth->finish;
return(sort(keys(%os)));
}
# If called w/dist & ver, return @array of methods we support
my $qdist = $dbh->quote($indist);
my $qver = $dbh->quote($inver);
unless ( $inmeth ) {
my $sql = "select method from osvend where distro = $qdist and version = $qver and arch = $qarch";
my $sth = $dbh->prepare($sql);
#print STDERR "$sql\n";
$sth->execute;
while ( my $row = $sth->fetch ) {
$os{"$$row[0]"} = 1;
}
$sth->finish;
return(sort(keys(%os)));
}
# If called w/dist, ver, method, return hostnames that support it
my $qmeth = $dbh->quote($inmeth);
my @os;
unless ( $inway ) {
my $sql = "select hostname,location from osvend where distro = $qdist and version = $qver and method = $qmeth and arch = $qarch order by location";
my $sth = $dbh->prepare($sql);
$sth->execute;
while ( my $row = $sth->fetch ) {
push(@os,"$$row[0] $$row[1]");
}
$sth->finish;
return(@os);
}
# If called w/everything, return PATH to bits
my $qway = $dbh->quote($inway);
my $sql = "select path from osvend where distro = $qdist and version = $qver and method = $qmeth ";
$sql .= "and hostname = $qway and arch = $qarch";
#print STDERR "$sql\n";
my $sth = $dbh->prepare($sql);
$sth->execute;
my $row = $sth->fetch;
$sth->finish;
return($$row[0]);
}
__END__
# This is the old 1.X code where everything lived in MySQL - no longer referenced
sub check_passwd {
# Check password provided with password in the database
my $self = shift;
my ($profile,$distro,$ver,$passwd) = @_;
my $qfunc = $dbh->quote($profile);
my $qver = $dbh->quote($ver);
my $qdist = $dbh->quote($distro);
my $sql = "select password,owner from profiles where distro = $qdist and ";
$sql .= "version = $qver and function = $qfunc";
my $sth = $dbh->prepare($sql);
$sth->execute;
my $row = $sth->fetch;
$sth->finish;
if ( $passwd ne $$row[0] ) {
$self->errmsg($$row[1]);
return;
} else {
return(1);
}
}
sub show_profiles {
# Generate a list of valid profiles for this OS
my $self = shift;
my ($dist,$ver,$arch) = @_;
my $qdist = $dbh->quote($dist);
my $qver = $dbh->quote($ver);
my $qarch = $dbh->quote($arch);
my $sql = "select function from profiles where distro = $qdist and version = $qver and arch = $qarch ";
$sql .= " order by function";
my $sth = $dbh->prepare($sql);
$sth->execute;
my @profiles;
while(my $row = $sth->fetch) {
push(@profiles,$$row[0]);
}
return(@profiles);
}
sub profile_details {
# return owner/passwd/filename for profile
my ($self,$dist,$ver,$arch,$profile) = @_;
my $qdist = $dbh->quote($dist);
my $qver = $dbh->quote($ver);
my $qarch = $dbh->quote($arch);
my $qfunc = $dbh->quote($profile);
my $sql = "select owner,password,filename from profiles where distro = $qdist and version = $qver ";
$sql .= "and arch = $qarch and function = $qfunc";
my $sth = $dbh->prepare($sql);
$sth->execute;
my $row = $sth->fetch;
$sth->finish;
return($$row[0],$$row[1],$$row[2]);
}
sub delete_profile {
my ($self,$dist,$ver,$arch,$profile) = @_;
my $qdist = $dbh->quote($dist);
my $qver = $dbh->quote($ver);
my $qarch = $dbh->quote($arch);
my $qfunc = $dbh->quote($profile);
my $sql = "delete from profiles where distro = $qdist and version = $qver ";
$sql .= "and arch = $qarch and function = $qfunc";
my $sth = $dbh->prepare($sql);
$sth->execute;
$sth->finish;
}
sub add_profile {
my ($self,$dist,$ver,$arch,$profile,$owner,$passwd,$filename) = @_;
#print STDERR "Called with ($dist,$ver,$arch,$profile,$owner,$passwd,$filename)\n";
my $qdist = $dbh->quote($dist);
my $qver = $dbh->quote($ver);
my $qarch = $dbh->quote($arch);
my $qfunc = $dbh->quote($profile);
my $qown = $dbh->quote($owner);
my $qpass = $dbh->quote($passwd);
my $qfile = $dbh->quote($filename);
my $sql = "insert into profiles values($qfunc,$qfile,$qdist,$qver,$qown,$qpass,$qarch)";
#print STDERR "$sql\n";
my $sth = $dbh->prepare($sql);
$sth->execute;
$sth->finish;
}
sub valid_entries {
# Pull a list of valid entries distro/rev/arch
my ($self,$os,$arch,$what,$match) = @_;
my ($dist,$ver) = split(' ',$os);
my $qdist = $dbh->quote($dist);
my $qver = $dbh->quote($ver);
my $qarch = $dbh->quote($arch);
my $qm = $dbh->quote($match);
my $sql = "select entry";
if ( $what eq 'langs' ) { $sql .= ',description' };
$sql .= " from $what where distro = $qdist and version = $qver and arch = $qarch";
if ( $match ) { $sql .= " and task = $qm " }
my $sth = $dbh->prepare($sql);
$sth->execute;
my $count = $sth->rows;
unless ( $count ) { # RALPH! There are NO bundles registered. Something went terribly wrong...
$sth->finish;
$self->errmsg("Major Malfunction!<P>I found no $what for $dist $ver $arch!!!<P>Probable database corruption!");
return;
}
if ( $what ne 'langs' ) {
my @entries;
while(my $row = $sth->fetch) {
push(@entries,$$row[0]);
}
$sth->finish;
return(sort(@entries));
} else {
my %entries;
while(my $row = $sth->fetch) {
$entries{$$row[0]} = $$row[1] || $$row[0];
}
$sth->finish;
return(%entries);
}
}
See more files for this project here