gbootroot/gbootroot_pkg

#!/usr/bin/perl

###########################################################################
##
##  gbootroot_pkg 
##  Copyright (C) 2001 by Jonathan Rosenbaum <freesource@users.sourceforge.net>
##
##  This program is free software; you may 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.
##
##############################################################################

use File::Basename;
use File::Find;

# The Lazy Guy's packaging tool for gBootRoot.
# This program sets-up the archive which will be turned into a package and 
# needs to be run as root.  The advantage of this program is that the 
# archive will always represent the Makefile which is being tested
# when development isn't being done with perl -I . ./gbootroot.
# This program can be adapted for other packages.

# This program uses dh-make, and copies your own defaults to 
# $packaging_place/debian from your $packaging_defaults, and updates
# to the proper date/times and data in changelog and copyright.  
# After this debuild from devscripts (this uses lintian) runs. 
# Now all you do is finish stuff off with dpkg-scanpackages ..
# something like this:
# dpkg-scanpackages . override | gzip > Packages.gz

# User defined variables for directories and package
# Makefile.pkg in $gbootroot_cvs in used as the packages Makefile.

my $user_home = "/home/mttrader";
my $prog = "gbootroot";
my $prog_real_name = "gbootroot";
my $revision = 1;
my $dist = "unstable";
my $urgency = "low";
#my $arch = "all";
#my $group = "utils";
#my $priority = "optional";
my $gbootroot_cvs =  "$user_home/gbootroot/gbootroot";
my $packaging_place = "$user_home/gbootroot/PACKAGING";
my $packaging_defaults = "$gbootroot_cvs/pkg/dpkg";
my $email = "freesource\@users.sourceforge.net";
my $name = "Jonathan Rosenbaum";
my $makefile = "Makefile.pkg";

# Other vars
my ($real_uid, $real_gid) = (stat($user_home))[4,5];

# Find the version

my $version;
open(CVS, "$gbootroot_cvs/$prog_real_name") or 
	die "Couldn't find $prog_real_name in $gbootroot_cvs: $!\n";
	while (<CVS>) {
		if (/\my \$version/) {
			$version = (split(/=/,$_))[1];
			chomp $version;
			$version =~ s/ //;
			$version =~ s/"//g;
			$version =~ s/;//;
		}			

	}
close(CVS);


$packaging_place = "$packaging_place/$prog-$version";

# Make sure the directory exists.

home_builder($packaging_place);

# Because I am too lazy to clean out CVS, I only want the stuff copied over
# which is in the Makefile, I'll also have to clean out any CVS directories.

$/  = "";
my @make_paragraph;
open(CVS, "$gbootroot_cvs/Makefile") or 
	die "Couldn't find Makefile in $gbootroot_cvs: $!\n";

	while (<CVS>) {
		push(@make_paragraph,$_);				
	}
close(CVS);
$/ = "\n";

chomp $make_paragraph[1];
my @make_lines = split(/\n/,$make_paragraph[1]);
shift(@make_lines);

chdir($gbootroot_cvs) or die "Couldn't change to $gbootroot_cvs: $!\n";

# Basically we are just concerned with the first part of cp and will
# use home_builder to make sure the directory exists.

foreach (@make_lines) {
	s/\t//;
	if (/cp/) {
	 my $dir = ((split))[2];
	 my $base;
         	if ($dir =~ m,/,) {
	 	$base = dirname($dir);
		home_builder("$packaging_place/$base");
		}
	 system "cp -fa $dir $packaging_place/$base";
	}
	else {
               if (!/mknod|dev/) {
		    system "$_";
               }
        }
}

system "cp -fa $makefile $packaging_place/Makefile";

# Now we get to clean out any CVS directories and make sure that the 
# permissions are all for the user who will be creating the package.
if (-d $packaging_place) {
        finddepth sub {  

                 my($uid,$gid) = (stat($File::Find::name))[4,5];
                 if ($real_uid != $uid) {
                    system "chown $real_uid $File::Find::name";
                 }
                 if ($real_gid != $gid) {
                    system "chgrp $real_gid $File::Find::name";
                 }  
                 if (/CVS/) {
                     chdir(dirname($File::Find::name));
                     system "rm -rf CVS";
                 }
               
         } , $packaging_place ;
}


# Now we to the dh_make thing, and setup the time, version, and defaults. 

chdir($packaging_place) or die "Can't change to $packaging_place: $!\n";
system "dh_make -e $email";

# Here we ask the user what changes to add to the changelog and set the proper
# time using 822-date.  If it is the initial release we don't do anything.

if ( !-e "$packaging_defaults/changelog" ) {
    system 
	"cp -a $packaging_place/debian/changelog $packaging_defaults";
}

open(CHANGELOG,"$packaging_defaults/changelog") 
    or die "Couldn't open $packaging_place/changelog: $!\n";
my @changelog = <CHANGELOG>;
close (CHANGELOG);

my $stop;
foreach (@changelog) {
    if (/$version-$revision/) {
	print "\nThe changelog for $version-$revision already exists, this may mean\n" .
        "that this is the first invocation or that you haven't changed the\n" .
	"version in the $prog program.\n";	
	$stop = 1;
    }
}

# Ask some questions first.
if (!$stop) {
    print "\nWrite what you want to be put in the changelog, and I'll\n" .
	"prettify everything.  End with a newline and .\n";
    print "  * ";
    my $save_doc;
    $save_doc = "  * ";
    $count = 0;
    while (<STDIN>) {
	my $doc_reply = $_;
	if ($doc_reply) {
	    print "    ";
	    $doc_reply = "    $doc_reply" if $count != 0;
	}
	last if $doc_reply =~ /^\s*\.\s*$/;
	if ($doc_reply) {
	    $save_doc = $save_doc . $doc_reply;
	}
	$count++;
    }

    open(CHANGELOG,">$packaging_defaults/changelog") 
	or die "Couldn't open check: $!\n";
    for my $ct (0 .. ($#changelog - 3)) {
	print CHANGELOG $changelog[$ct];
    }			
    print CHANGELOG "$prog ($version-$revision) $dist; urgency=$urgency\n\n";
    print CHANGELOG "$save_doc\n";
    print CHANGELOG " -- $name <$email>  " . `822-date`;
    for my $ct (($#changelog - 3) .. $#changelog) {
	print CHANGELOG $changelog[$ct];
    }			
    close(CHANGELOG);
    print "\n";

system "chown $real_uid $packaging_defaults/changelog";
system "chgrp $real_gid $packaging_defaults/changelog";

} # end if !$stop

# Set-up the copyright
open(COPYRIGHT,">$packaging_defaults/copyright") 
    or die "Couldn't open up $packaging_defaults/copyright: $!\n";
print COPYRIGHT "This package was debianized by $name\n";
print COPYRIGHT "$email on " , `822-date`, ".\n";
print COPYRIGHT "Author: \n$name <$email>\n\n";
print COPYRIGHT "Copyright:\n\n" .
"On Debian GNU/Linux systems, the complete text of the GNU General Public\n" .
    "License can be found in /usr/share/common-licenses/GPL\n";
close(COPYRIGHT);
system "chown $real_uid $packaging_defaults/copyright";
system "chgrp $real_gid $packaging_defaults/copyright";

system "rm $packaging_place/debian/*";
system "cp -fa $packaging_defaults/* $packaging_place/debian";

chdir($packaging_place);
system "debuild";

sub home_builder {

    my ($home_builder) = @_; 

    if (!-d $home_builder) {
	if (-e $home_builder) {
	    print "ERROR: A file exists where $home_builder should be.\n";
	}	 
	else {
	    my @directory_parts = split(m,/,,$home_builder);
	    my $placement = "/";
	    for (1 .. $#directory_parts) {
		$_ == 1 ? ($placement = "/$directory_parts[$_]")
		    : ($placement = $placement . "/" . $directory_parts[$_]);
		-d $placement or mkdir $placement;
		system "chown $real_uid $placement";
		system "chgrp $real_gid $placement";
	    }
	}
    }

} # end home_builder