Update of /cvsroot/leaf/src/The_UnNamed_One/buildtool/buildtool
In directory sc8-pr-cvs6.sourceforge.net:/tmp/cvs-serv15949/buildtool/buildtool
Added Files:
Clean.pm Config.pm Download.pm buildtool.pm
Log Message:
initial import
--- NEW FILE: Download.pm ---
# $Id: Download.pm,v 1.1 2008/03/01 16:24:15 hejl Exp $
package buildtool::Download;
use buildtool::DownloadTypes::ViewCVS;
use buildtool::DownloadTypes::Http;
use buildtool::DownloadTypes::Ftp;
use buildtool::DownloadTypes::File;
use buildtool::Common::Object;
use Carp;
use strict;
use vars qw(@ISA);
@ISA = qw(buildtool::Common::Object);
############################################################################
sub setServer ($$) {
my $self = shift;
my $servref = shift;
confess "no server hash given" if (ref($servref) ne "HASH");
$self->{'SERVER'} = $servref;
}
############################################################################
sub setDlroot ($$) {
my $self = shift;
my $dlroot = shift;
confess("no dlroot given") if ($dlroot eq "" or !$dlroot);
$self->debug("setting dlroot to : $dlroot");
$self->{'DLROOT'} = $dlroot;
}
############################################################################
sub setFiles ($$) {
my $self = shift;
my $filesref = shift;
confess "no files hash given" if (ref($filesref) ne "HASH");
$self->{'FILES'} = $filesref;
}
############################################################################
# make the actual download,
# needs the folowing arguments:
# server (hashref) as from Config::General
# file (hashref) as from Config::General
# dlroot (string)
sub download () {
my $self = shift;
my %myconf = %{$self->{'CONFIG'}};
my $dir = "";
my $server = $self->{'SERVER'};
my %files = %{$self->{'FILES'}} ;
my $dlroot = $self->{'DLROOT'};
if ( -d $dlroot) {
# do nothing right now
} else {
# mkdir
system("mkdir", "-p", "$dlroot") == 0
or confess "mkdir $dlroot failed";
}
confess "no server set" if (ref($server) ne "HASH");
foreach my $file (keys %files) {
$self->debug("file key: $file");
my $dlserver = $files{$file}{'server'} ;
confess "empty entry for server in file section for $file"
if ($dlserver eq "");
#check for server:
if (ref($server->{$dlserver}) ne "HASH") {
$self->die("maybe config error:","unknown server $dlserver");
}
my $dltype = $server->{$dlserver}{'type'};
$self->die("Error in Config:","no server type given for server $dlserver")
if ((! $dltype) or ($dltype eq ""));
print "downloading: $file from server $dlserver type $dltype ";
if ($myconf{'nodownload'}) {
$self->debug("not downloading anything as requested by commandline");
print $self->make_text_green("[skipped]") . "\n";
return;
}
# check if there is a directory entry in the section else use nothing
my $spath = "";
if (exists $files{$file}{'directory'} and $files{$file}{'directory'}) {
$dir = $files{$file}{'directory'}
} else {
$dir = "";
}
$spath = $self->strip_slashes($server->{$dlserver}{'serverpath'});
# first add to conf what we need all:_
my %allconf = ('config' => \%myconf,
'dlroot' => $dlroot,
'serverpath' => $spath,
'filename' => $file,
'dir' => $dir
);
my $dlpath;
if (exists $files{$file}{'dlpath'} and $files{$file}{'dlpath'}) {
$dlpath = $files{$file}{'dlpath'}
} else {
$dlpath = undef;
}
if ($dltype eq "http") {
# download via http
my $object = buildtool::DownloadTypes::Http->new(%allconf,(
'server'
=> $server->{$dlserver}->{'name'},
)
);
$self->die("download failed", $object->getErrorMsg() . " \n") if
($object->download()== 0);
} elsif ($dltype eq "ftp") {
# download via ftp
my $object = buildtool::DownloadTypes::Ftp->new(%allconf,(
'server' =>
$server->{$dlserver}->{'name'},
)
);
$self->die("download failed", $object->getErrorMsg() . " \n") if
($object->download()== 0);
} elsif ($dltype eq "file") {
# local file
$allconf{'dlpath'} = $dlpath if defined($dlpath);
my $object = buildtool::DownloadTypes::File->new(%allconf);
# check if download was successful, if not, die with an error message:
$self->die("download failed", $object->getErrorMsg() . " \n") if
($object->download()== 0);
} elsif ($dltype eq "viewcvs") {
my $revision = $files{$file}{'revision'};
if (!$revision || $revision eq "") {
# something wrong
$self->die("error in config","revision is missing for file $file,
required for type viewcvs");
}
# else everything is alright
# download via viecvs.
my $object = buildtool::DownloadTypes::ViewCVS->new(%allconf,(
'server'
=> $server->{$dlserver}->{'name'},
'revision'
=> $revision
)
);
$self->die("download failed", $object->getErrorMsg() . " \n") if
($object->download()== 0);
} elsif ($dltype eq "cvspserver") {
# try to load pserver:
eval "use buildtool::DownloadTypes::CvsPserver";
if ($@) {
$self->die("loading buildtool::DownloadTypes::CvsPserver
failed!", "if you want to use pserver support install libcvs-perl(>=1.001)
from: https://libcvs.cvshome.org/";);
}
my $revision = $files{$file}{'revision'};
if (!$revision || $revision eq "") {
# something wrong
$self->die("error in config","revision is missing for file $file,
required for type viewcvs");
}
# else everything is alright
# download via viecvs.
my $object = buildtool::DownloadTypes::CvsPserver->new(%allconf,(
'server'
=> $server->{$dlserver}->{'name'},
'revision'
=> $revision,
'cvsroot'
=> $server->{$dlserver}->{'cvsroot'},
'username'
=> $server->{$dlserver}{'username'},
'password'
=>$server->{$dlserver}{'password'}
)
);
$self->die("download failed", $object->getErrorMsg() . " \n") if
($object->download()== 0);
} elsif ($dltype eq "cvsext") {
# try to load :
eval "use buildtool::DownloadTypes::CvsExt";
if ($@) {
$self->die("loading buildtool::DownloadTypes::CvsPserver
failed!", "if you want to use pserver support install libcvs-perl(>=1.001)
from: https://libcvs.cvshome.org/";);
}
my $revision = $files{$file}{'revision'};
if (!$revision || $revision eq "") {
# something wrong
$self->die("error in config","revision is missing for file $file,
required for type viewcvs");
}
# else everything is alright
# download via viecvs.
my $object = buildtool::DownloadTypes::CvsExt->new(%allconf,(
'server'
=> $server->{$dlserver}->{'name'},
'revision'
=> $revision,
'cvsroot'
=> $server->{$dlserver}->{'cvsroot'},
'username'
=> $server->{$dlserver}{'username'},
'password'
=>$server->{$dlserver}{'password'}
)
);
$self->die("download failed", $object->getErrorMsg() . " \n") if
($object->download()== 0);
} else {
confess("unknown type $dltype");
}
# not died, so everything seems to be o.k.
$self->printOk();
print "\n";
}
}
1;
--- NEW FILE: Clean.pm ---
# $Id: Clean.pm,v 1.1 2008/03/01 16:24:14 hejl Exp $
# This file is the base to be used for clean functions.
#
package buildtool::Clean;
use buildtool::Common::InstalledFile;
use buildtool::Clean::Buildclean;
use buildtool::Clean::Remove;
use buildtool::Clean::Distclean;
use buildtool::Clean::Srcclean;
use Config::General 2.15;
use Carp;
use strict;
use vars qw(@ISA);
@ISA = qw(buildtool::Common::InstalledFile);
###############################################################################
# remove the package file list
sub _removeFile() {
my $self = shift;
my $file = shift || return;
my $ret = system("rm", "-f", "$file");
if ($ret != 0) {
$self->debug("removing $file failed:$! ");
return 0;
} else {
$self->debug("file $file removed");
return 1;
}
}
##########################################################################
# remove the package file list
sub _removeDir() {
my $self = shift;
my $dir = shift || return;
my $ret = system("rmdir", "$dir");
if ($ret != 0) {
$self->debug("removing $dir failed:$! ");
return 0;
} else {
$self->debug("dir $dir removed");
return 1;
}
}
##########################################################################
# force remove of dir
sub _forceRemoveDir() {
my $self = shift;
my $dir = shift || return;
my $ret = system("rm", "-rf", "$dir");
if ($ret != 0) {
$self->debug("force mode removing $dir failed:$! ");
return 0;
} else {
$self->debug("dir $dir removed in force mode");
return 1;
}
}
###############################################################################
# remove the files of a package
sub _removeFiles () {
my $self = shift;
my @filelist = @_;
my $dirlist = [];
foreach my $file (@filelist) {
if (-d $file && ! -l $file) {
push(@{$dirlist}, $file)
} else {
die("removing file $file failed:") unless $self->_removeFile($file);
}
}
# reverse sort the dirlist by length - that way, we delete the child dirs
# before trying to delete the parents
foreach my $dir (sort { length($b) <=> length($a)} @{$dirlist}) {
die("removing directory $dir failed:") unless $self->_removeDir($dir);
}
}
# END OF FILE
1;
--- NEW FILE: Config.pm ---
#$Id: Config.pm,v 1.1 2008/03/01 16:24:15 hejl Exp $
package buildtool::Config;
use buildtool::Common::Object;
use Config::General 2.15;
use Carp;
use strict;
use vars qw(@ISA);
@ISA = qw(buildtool::Common::Object);
sub new($$) {
# my new function
my $type = shift || confess("no Type given");
my $globConf = shift || confess("no globConf given");
my $fileConf = shift || confess("no fileConf given");
my $self = $type->SUPER::new($globConf);
# add fileconf to myself
$self->setFileConfig($fileConf);
# don't use _initialize here!
return $self;
}
######################################################
# gets back file config ref
sub getFileConfigRef () {
my $self = shift;
return $self->{'FILECONF'};
}
######################################################
# sets the File config
sub setFileConfig () {
my $self = shift;
$self->{'FILECONF'} = shift;
}
######################################################
# checks if source or package files are named correctly
sub adjustFileConfig {
my $self = shift;
my $cfg = $self->{'FILECONF'};
my (%oldconf, %newconf, %defconf);
$self->debug("check_config starting");
confess("config is not a hash ref") if (ref($cfg) ne "HASH");
my %list;
# now have a look at source and package, there should not be
# the same name in both...
if (exists $cfg->{'package'} and ref($cfg->{'package'}) eq "HASH") {
%list = %{$cfg->{'package'}};
} else {
logme("check_confignames:something wrong with config hash...");
}
foreach my $name (keys(%list)) {
$self->debug("name:$name");
die make_text_red("$name is a name for a package AND a source, this can not
be, please change in "
.make_absolute_path($self->{'CONFIG'}{'globalconffile'})) if (exists
$cfg->{'source'}{$name}) ;
}
# check for duplicate entries in the sections resulting in an array which may
break things:
foreach my $type (("server", "package", "source")) {
foreach my $key (keys %{$cfg->{$type}}) {
# die if array found (should be hash!)
die("\n". $self->makeTextRed("Error in global.cfg: ").
"duplicate entry $key in section $type \n\n") if (ref($cfg->{$type}{$key}) eq
"ARRAY");
}
}
# adjust config and include the default settings to each section
foreach my $type ("package", "source") {
if (exists $cfg->{$type}{'default'}) {
# add the default to each package
foreach my $key (keys %{$cfg->{$type}}) {
next if($key eq "default");
# check for nodefault switch!
next if($cfg->{$type}{$key}{'nodefault'});
%oldconf = %{$cfg->{$type}{$key}};
# copy the default in:
%newconf = %{$cfg->{$type}{'default'}};
#dump_hash(\%newconf,0);
# set the new values over the defaults!
foreach my $oldkey (keys %oldconf) {
$newconf{$oldkey} = $oldconf{$oldkey};
}
%{$cfg->{$type}{$key}} = %newconf;
#dump_hash(\%newconf,0);
}
}
}
return 1;
}
#########################################################
# shows the desciption tag of one or more sources/packages
# or all if no name is given...
sub showDescription {
my $self = shift;
my $cfg = $self->{'FILECONF'} ;
my @pkglist = ();
my @srclist = ();
my $pkg;
my $maxlen = 0;
my $all = 0;
confess("fileconf is not a hash reference") if (ref($cfg) ne "HASH");
if (@_) {
foreach $pkg (@_) {
if (exists $cfg->{'package'}{$pkg}) {
push @pkglist , $pkg;
} elsif (exists $cfg->{'source'}{$pkg}) {
push @srclist, $pkg;
} else {
print $self->make_text_red("$pkg is not a source or package"). "\n";
}
}
} else {
$all = 1;
# get a list of all pkg/srces
foreach $pkg (keys %{$cfg->{'package'}}) {
push @pkglist, $pkg;
}
foreach $pkg (keys %{$cfg->{'source'}}) {
push @srclist, $pkg;
}
}
# get the max length of the strings:
$maxlen = 0;
foreach my $item (@srclist, @pkglist) {
if (length($item) > $maxlen) {
$maxlen = length($item);
}
}
if ($all) {
print "\nThe following packages and sources are available:\n";
}
if (scalar(@srclist) > 0) {
print
"\nSources:\n---------------------------------------------------------\n";
}
foreach $pkg (sort @srclist) {
# don't print packages or sources that are named default,
# cause they are only pseudo packages for setting default values
next if $pkg eq "default";
printf ("%-${maxlen}s\t\t", $pkg);
# look if this is a package:
if (exists $cfg->{'source'}{$pkg}) {
if (exists $cfg->{'source'}{$pkg}{'description'}) {
print $cfg->{'source'}{$pkg}{'description'};
}
} else {
print "not existing source !!";
}
print "\n";
}
if (scalar(@pkglist) > 0) {
print
"\nPackages:\n---------------------------------------------------------\n";
}
foreach $pkg (sort @pkglist) {
# don't print packages or sources that are named default,
# cause they are only pseudo packages for setting default values
next if $pkg eq "default";
printf ("%-${maxlen}s\t\t", $pkg);
# look if this is a package:
if (exists $cfg->{'package'}{$pkg}) {
if (exists $cfg->{'package'}{$pkg}{'description'}) {
print $cfg->{'package'}{$pkg}{'description'};
}
} else {
print "not existing package!!";
}
print "\n";
}
print "\n";
}
1;
--- NEW FILE: buildtool.pm ---
# $Id: buildtool.pm,v 1.1 2008/03/01 16:24:15 hejl Exp $
# functions for buildtool2 for uclibc-bering
# (C) 2003 Arne Bernin
# This software is distributed under the GNU General Public Licence,
# please see the file COPYING
@EXPORT = qw(debug logme);
use vars qw(@EXPORT);
#############################################################################
# example:
# server :http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi
use strict;
use buildtool::Download;
use buildtool::Common::InstalledFile;
use buildtool::Common::Object;
use vars ('%globConf');;
######################################################################
# a debug routine for later purposes...
#
sub debug {
if ($globConf{'debugtoconsole'}) {
print join("",@_) . "\n" ;
}
if ($globConf{'debugtologfile'}) {
my $logfile = &make_absolute_path($globConf{'logfile'});
open LOGFILE , ">> $logfile";
print LOGFILE join("",@_) . "\n" ;
}
}
######################################################################
# print something to the logfile
#
sub logme {
if ($globConf{'debugtologfile'}) {
# open log
open LOGFILE , ">> $globConf{'logfile'}" or die "cannot open logfile" .
$globConf{'logfile'};
print LOGFILE join("",@_) . "\n" ;
}
}
##################################################################
# make the log directory if needed
sub log_dir_make {
# check if logfile is there
#( ! -e $globConf{'logfile'}) or die $globConf{'logfile'} ." is there, seems
to be another problem with it";
# if not, get the dirname:
my $dirname = $globConf{'logfile'};
$dirname =~ s,^(.*)/.*,$1,;
# create the dir
system ("mkdir -p $dirname") == 0
or die "mkdir $dirname failed!";
}
########################################################
# adds the buildroot path to a given path if path is not
# absolute
sub make_absolute_path {
my $path = shift;
$path = strip_slashes($path);
if ($path =~ /^\//) {
# starts with slash so absolute
return $path;
}
# else
return strip_slashes($globConf{'root_dir'} . "/" . $path);
}
################################################
# checks the build environment (dirs and...)
sub check_env {
logme("checking build environment");
my @dirs = @{$globConf{'buildenv_dir'}};
foreach my $dir (@dirs) {
my $dir1 = strip_slashes(make_absolute_path($dir));
if (! -d $dir1) {
debug("making directory $dir1");
system("mkdir -p $dir1") == 0
or die "makedir $dir1 failed! " . $!;
} elsif (! -w $dir1) {
die "cannot write to dir $dir1";
}
}
#check_lib_link();
# check if we should trace:
if($globConf{'usetracing'}) {
# disable it until it is found in the path:
$globConf{'usetracing'} = 0;
# try to load tracer
eval "use buildtool::Common::FileTrace";
if ($@) {
die("loading buildtool::Common::FileTrace failed!", "if you
want to use file tracing support install File::Find");
}
$globConf{'usetracing'} = 1;
logme("enabling file tracing support");
} else {
logme("trace support not enabled in configfile");
}
}
# checks if the link from /lib/ld-uclibc.so to stagingdir/lib exists
sub check_lib_link {
my $linktarget;
my $linkdest = make_absolute_path("staging/lib/ld-uClibc.so.0");
logme("checking link /lib/ld-uClibc.so");
if ($linktarget=readlink("/lib/ld-uClibc.so.0")) {
# check if pointing to right location
if ($linktarget eq $linkdest) {
return 1;
}
}
# else
print "\n\n" .buildtool::Common::Object::make_text_red('','Warning:');
print "The symlink from /lib/ld-uClibc.so.0 --> $linkdest does not exist,
this may cause problems with some configure scripts that try to run a compiled
program\n\nShould i create this link for you (Y/n)?";
my $ask = <STDIN>;
chop $ask;
if ($ask eq "" or $ask eq "y" or $ask eq "Y" or $ask eq "j" or $ask eq
"J" ) {
print "please enter root ";
if (system("su -c \"ln -f -s $linkdest /lib/ld-uClibc.so.0 \"") !=
0) {
die "cannot create symlink";
}
}
return 1;
}
####################################################
# print a colored o.k.
sub print_ok {
# just print a colored o.k.
print buildtool::Common::Object::make_text_green('','[0.K.]');
}
####################################################
# print a colored failed
sub print_failed {
# just print a colored failed
print buildtool::Common::Object::make_text_red('','[FAILED]');
}
#############################################################################
# strip all unneaded double slashes from an url,
# but leave the starting :// alone...
sub strip_slashes {
my $string = shift || "";
$string =~ s,//,/,g ;
# put in the *tp:// back again:
$string =~ s,^([a-zA-Z]+tp:)/(.*)$,$1//$2,;
return $string;
}
1;
-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2008.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/
_______________________________________________
leaf-cvs-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/leaf-cvs-commits
