pkgrepotool

#!/usr/bin/perl -Tw
#
# pkgrepotool -- Tool for managing package repositories
# 
# Copyright (C) 2007, Michael Jennings
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies of the Software, its documentation and marketing & publicity
# materials, and acknowledgment shall be given in the documentation, materials
# and software packages that this Software was used.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
# IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
# $Id: pkgrepotool,v 1.9 2011/02/25 03:14:58 mej Exp $
#

use strict;

# Include the Perl Modules we need
use POSIX;
use Mezzanine::Util;
use Mezzanine::Config;
use Mezzanine::PkgVars;
use Mezzanine::Pkg;
use Mezzanine::PkgRepo;
use Mezzanine::RPM;

# Configuration data.
my $config;

my @config_vars = ("DEBUG", "DIRS", "INTERACTIVE", "NEWEST", "OLD",
                   "OLDEST", "SCM", "SPAN", "TEST");

# Print usage information
sub
print_usage_info
{
    my ($leader, $underbar);

    print "\n";
    $leader = "$PROGNAME $VERSION Usage Information";
    $underbar = $leader;
    $underbar =~ s/./-/g;
    print "$leader\n$underbar\n";
    print "\n";
    print "  Syntax:   pkgrepotool [ options ]\n";
    print "\n";
    print "    -h --help                        Show this usage information\n";
    print "    -d --debug                       Turn on debugging\n";
    print "    -v --version                     Show version and copyright\n";
    print "    -s --scan                        Scan and list packages in repository\n";
    print "    -a --add                         Add package(s) to one or more repos\n";
    print "    -r --remove --rm                 Remove package(s) from one or more repos\n";
    print "    -c --compare                     Compare repos\n";
    print "    -C --closure                     Verify repository dependency closure\n";
    print "    -i --interactive                 Prompt before taking action\n";
    print "    -t --test                        Test only; do not take action\n";
    print "    -S --scm                         Use Mezzanine SCM commands to add/remove\n";
    print "    -D --directories --dirs <dirs>   Directories to use as repositories\n";
    print "       --newest                      Select only the newest version of each package\n";
    print "       --oldest                      Select only the oldest version of each package\n";
    print "       --old                         Select only outdated packages\n";
    print "       --span                        Treat all repositories as one\n";
    print "       --diffonly --do               When comparing, show only differences\n";
    #print "    -M --metadata <type>             Metadata type to generate\n";
    #print "                                     \n";
    print "       --savecfg                     Preserve current settings for future use\n";
    print "\n";
    exit(MEZZANINE_SUCCESS);
}

# main() here is basically the same as main() in C
sub
main
{
    my ($err, $msg, $mode, $scan);
    my @dirlist;

    # For taint checks
    delete @ENV{("IFS", "CDPATH", "ENV", "BASH_ENV")};
    $ENV{"PATH"} = "/bin:/usr/bin:/sbin:/usr/sbin";
    foreach my $shell ("/bin/bash", "/usr/bin/ksh", "/bin/ksh", "/bin/sh", "/sbin/sh") {
        if (-f $shell) {
            $ENV{"SHELL"} = $shell;
            last;
        }
    }

    $err = 0;
    &mezz_init("pkgrepotool", "1.0", "help|h", "version|v", "debug|d!", "savecfg|save-config!",
               "scan|s", "closure|C", "add|a", "remove|rm|r", "compare|c",
               "newest", "old", "oldest", "interactive|i!", "test|t!", "scm|S!", "span!", "diffonly|do!",
               "dirs|directories|D=s@", "metadata|M=s@");

    if ($OPTION{"version"}) {
        # Do not edit this.  It is updated automatically by CVS when you commit.
        &print_version($PROGNAME, $VERSION, "Michael Jennings",
                       'CVS Revision $Revision: 1.9 $ created on $Date: 2011/02/25 03:14:58 $ by $Author: mej $ ');
    } elsif ($OPTION{"help"} || (!scalar(@ARGV) && !scalar(%OPTION) && &basename($0) !~ /^mz/)) {
        &print_usage_info();
    }
    $config = Mezzanine::Config->new("repo/config");
    if (!scalar($config->keys())) {
        $OPTION{"savecfg"} = 1;
    }

    # Set config based on options
    &debug_set(&bool_config_opt($config, "DEBUG", "debug"));
    &bool_config_opt($config, "NEWEST", "newest");
    &bool_config_opt($config, "OLDEST", "oldest");
    &bool_config_opt($config, "OLD", "old");
    &bool_config_opt($config, "DIFFONLY", "diffonly");
    &bool_config_opt($config, "INTERACTIVE", "interactive");
    &bool_config_opt($config, "TEST", "test");
    &bool_config_opt($config, "SCM", "scm");
    &bool_config_opt($config, "SPAN", "span");

    if (($0 =~ /scan$/) || ($OPTION{"scan"})) {
        $mode = "scan";
    } elsif (($0 =~ /closure$/) || ($OPTION{"closure"})) {
        $mode = "closure";
    } elsif (($0 =~ /(compare|comp|cmp|diff)$/) || ($OPTION{"compare"})) {
        $mode = "compare";
    } elsif (($0 =~ /add$/) || ($OPTION{"add"})) {
        $mode = "add";
    } elsif (($0 =~ /(rm|remove)$/) || ($OPTION{"remove"})) {
        $mode = "remove";
    } else {
        $mode = "scan";
    }

    # Get directory list from config, options, or command line.
    @dirlist = split(':', $config->get("DIRS"));
    if ($OPTION{"dirs"} && ref($OPTION{"dirs"}) && (ref($OPTION{"dirs"}) eq "ARRAY")) {
        @dirlist = @{$OPTION{"dirs"}};
    } elsif (scalar(@ARGV)) {
        @dirlist = grep { -d $_ || ($_ =~ /^(ht|f)tps?:\/\//) } @ARGV;
        @ARGV = grep { ! -d $_ || ($_ !~ /^(ht|f)tps?:\/\//) } @ARGV;
    }
    $config->set("DIRS", join(':', @dirlist));
    dprint "Using directory list:  ", join(', ', @dirlist), "\n";

    # Save configuration if needed.
    if ($OPTION{"savecfg"}) {
        $config->save();
    }

    if ($mode =~ /^(scan|closure|compare|add|remove)$/) {
        $scan = &rpm_scan_files(@dirlist);
        if ($config->get("SPAN")) {
            &span_dirs($scan);
        }
        if ($OPTION{"old"}) {
            &filter_old($scan);
        }
        if ($OPTION{"newest"}) {
            &filter_newest($scan);
        } elsif ($OPTION{"oldest"}) {
            &filter_oldest($scan);
        }
    }

    # Check for directory list stupidity
    if ($mode eq "compare") {
        if (scalar(@dirlist) <= 1) {
            if ($config->get("SPAN")) {
                eprint "Cannot use SPAN and $mode together.\n";
            } else {
                eprint "Two or more directories required for $mode.\n";
            }
            return MEZZANINE_SYNTAX_ERROR;
        }
    }

    if ($mode eq "scan") {
        foreach my $dir (sort(keys(%{$scan}))) {
            foreach my $pkg (&rpm_sort(keys(%{$scan->{$dir}}))) {
                print "$pkg\n";
                if ($OPTION{"add"}) {
                    if ($OPTION{"scm"}) {

                    } else {

                    }
                } elsif ($OPTION{"remove"}) {
                    if ($OPTION{"scm"}) {

                    } else {
                        &nuke_tree($pkg);
                    }
                }
            }
        }
    } elsif ($mode eq "closure") {
    } elsif ($mode eq "compare") {
        my $pkgs;
        my $maindir = shift @dirlist;

        $pkgs = &build_package_hash($scan);
        foreach my $dir (@dirlist) {
            my @results;

            @results = &compare_dirs($pkgs->{$maindir}, $pkgs->{$dir});
            #dprint &examine_object(\@results);
            print "*** Comparing $maindir with $dir\n";
            print map { "$_->[0] $_->[1]\n" } @results;
        }
    } elsif ($mode eq "add") {
    } elsif ($mode eq "remove") {
    }
    return $err;
}

exit &main();