Solaris::InstallDB - Manages Solaris package information

#!/usr/local/bin/perl

# Solaris::InstallDB
# Management of the /var/sadm/pkg directory
# And the contents file
#
# Chris Josephes 200001003
#

#
# Package Definition
#

package Solaris::InstallDB;

use strict;
use vars qw($VERSION $DefaultPkgDir);

$VERSION=0.9;

#
# Includes
#

use Solaris::Package;
use Solaris::Contents;

#
# Global Variables
#

$DefaultPkgDir="/var/sadm/pkg";

#
# Constructor Method
#

sub new
{
my (@args)=@_;
my ($object)={};
bless ($object);
$object->_init(@args);
return($object);
}

sub version
{
return($VERSION);
}

#
# Object Methods
#

# Return the operating system release level (uname output)
sub release
{
my ($self)=@_;
return($self->{"os"}->{"release"});
}

# Return the commercial "Solaris XXX" release name
sub releaseAlias
{
my ($self)=@_;
return($self->{"os"}->{"alias"} || $self->{"os"}->{"release"});
}

# Return the hardware Instruction Set Architecture
sub isa
{
my ($self)=@_;
return($self->{"hw"}->{"isa"});
}

# Return the processor name
sub processor
{
my ($self)=@_;
return($self->{"hw"}->{"processor"});
}

# Return the hardware class
sub hardwareClass
{
my ($self)=@_;
return($self->{"hw"}->{"class"});
}

# Return the ISA and hardware class together
sub arch
{
my ($self)=@_;
return($self->{"hw"}->{"isa"}.".".$self->{"hw"}->{"class"});
}

# Return a list of packages
sub packages
{
my ($self)=@_;
return(keys(%{$self->{"db"}}));
}

# Return a list of supported architectures for a package
sub arches
{
my ($self,$pkg)=@_;
return(keys(%{$self->{"db"}->{$pkg}}));
}

# Return the contents file object
sub contents
{
my ($self)=@_;
return ($self->{"contents"} || undef);
}

sub pkgFile
{
my ($self,@args)=@_;
my ($x,$name,$arch);
while (@args)
{
	$x=shift(@args);
	if ($x eq "-name")
	{
		$name=shift(@args);
	} elsif ($x eq "-arch")
	{
		$arch=shift(@args);
	}
}
$arch=$self->arch() unless ($arch);
if ($name && $arch)
{
	return($self->{"db"}->{$name}->{$arch} || undef);
} else {
	return(undef);
}
}

sub package
{
my ($self,@args)=@_;
my ($x,$name,$arch,$debug,$object);
while (@args)
{
	($x)=shift(@args);
	if ($x eq "-name")
	{
		$name=shift(@args);
	} elsif ($x eq "-arch")
	{
		$arch=shift(@args);
	} elsif ($x eq "-debug")
	{
		$debug=1;
	}
}
unless ($name)
{
	print("No name specified\n") if ($debug);
	return(undef);
}
unless ($arch)
{
	my ($isa,$test);
	$isa=$self->isa();
	$test=$self->arch();
	if ($self->{"db"}->{$name}->{$test})
	{
		$arch=$test;
	} elsif ($self->{"db"}->{$name}->{$isa})
	{
		$arch=$isa;
	} else {
		print("Architecture must be specified") if ($debug);
		return(undef);
	}
} else {
	unless ($self->{"db"}->{$name}->{$arch})
	{
		print("Package $name, not found for arch $arch\n") 
		if ($debug);
		return(undef);
	}
}
$object=Solaris::Package::new(-directory => $self->{"pkgDir"}, 
	-file => $self->{"db"}->{$name}->{$arch},
	-installDB => $self); 
return($object);
}

sub directory
{
my ($self)=@_;
return($self->{"pkgDir"});
}

#
# Hidden Methods
#

# Parse the arguements passed to the constructor method
sub _init
{
my ($self,@args)=@_;
my ($a);
while (@args)
{
	$a=shift(@args);
	if ($a eq "-loadContents")
	{
		$self->{"contents"}=Solaris::Contents::new();
	} elsif ($a eq "-directory")
	{
		$self->{"pkgDir"}=shift(@args);
	}
}
$self->{"pkgDir"}=$DefaultPkgDir unless ($self->{"pkgDir"});
# Get the OS data
$self->_hostInfo();
# Find all of the installed packages
$self->_scanPkgDir();
return();
}

sub _hostInfo
{
my ($self)=@_;
my ($und,$test);
# Get the OS data
open (UN, "/usr/bin/uname -rpim |");
$und=<UN>;
chop($und);
close(UN);
($self->{"os"}->{"release"},$self->{"hw"}->{"class"},
        $self->{"hw"}->{"isa"},$self->{"hw"}->{"processor"})=split(/\s/,$und);
# Determine an alias for our operating system release
$test=chop($self->{"os"}->{"release"});
if ($test >= 7)
{
	$self->{"os"}->{"alias"}=$test;
}
if ($self->{"hw"}->{"arch"} eq "i386")
{
	if ($self->{"os"}->{"alias"})
	{
		$self->{"os"}->{"alias"}.="_x86";
	} else {
		$self->{"os"}->{"alias"}=$self->{"os"}->{"release"}."_x86";
	}
}
return();
}

# Scan the package directory, and find the name of every package
# in it.
sub _scanPkgDir
{
my ($self)=@_;
my ($dir,$entry,$ecount);
$dir=$self->{"pkgDir"};
$self->{"db"}={};
opendir (D, $dir) || return(undef);
while ($entry=readdir(D))
{
	if (-d $dir."/".$entry)
	{
		next if ($entry eq "." || $entry eq "..");
		if (-e $dir."/".$entry."/pkginfo")
		{
			$self->_getPkgName($dir,$entry);
			$ecount++;
		}
	}
}
closedir(D);
return();
}

# Read a pkginfo file to determine the package name
sub _getPkgName
{
my ($self,$dir,$entry)=@_;
my ($param,$value,$x,$pkg,$arch);
open (F, $dir."/".$entry."/pkginfo");
while ($x=<F>)
{
	($param,$value)=split(/=/,$x);
	if ($param eq "PKG")
	{
		chop($value);
		$pkg=$value;
	} elsif ($param eq "ARCH")
	{
		chop($value);
		$arch=$value;
	} 
	last if ($pkg && $arch);
}
close(F);
$self->{"db"}->{$pkg}->{$arch}=$entry;
return();
}

#
# Exit Block
#
1;

#
# POD Block
#