#! /usr/bin/perl -w
##################################################################
#
# $Id: aptate-config.in,v 1.6 2003/01/30 22:40:27 rbos Exp $
#
# XML parser for converting the xml formatted mirrorfile into
# something that aptate can easily process
#
# Originally written by Richard Bos
# Copyright (C) 2002 R Bos
#
# Rewritten based on Richard's aptate.pl by Ralf Corsepius
# Copyright (C) 2002,2003 Ralf Corsepius
#
# aptate-config: convert aptate.dtd-xml formatted aptate.conf files to 
# a data format bash can easily process.
#
# Send suggestions to: apt4rpm-devel@lists.sourceforge.net
# Homepage: http://apt4rpm.sourceforge.net
#
# 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.
#
# For a copy of the GNU General Public License, visit
# http://www.gnu.org or write to the Free Software Foundation, Inc.,
# 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
##################################################################

use strict;
use XML::LibXML;
use Getopt::Long;

sub version ();
sub help ();
sub distros($);
sub distid($);
sub content_yesno($$);

# Global vars
my $PROGRAM = 'aptate-config';
my $VERSION = '0.64.2';
my $BUGS = 'apt4rpm-users@lists.sourceforge.net';
my $updatedir = '';
my $action = '';
my $infile = '' ;
my $dva = '';
my $xpath = '';

Getopt::Long::config ("bundling", "pass_through");
Getopt::Long::GetOptions
  (
    'version'		=> \&version,
    'help'		=> \&help,
    'updatedir=s'       => \$updatedir,
    'action=s'          => \$action,
    'dist=s'            => \$dva,
    'xpath=s'		=> \$xpath
  ) or exit 1;

die "$0: wrong number of arguments.\n"
  if ( $#ARGV != 0 );
$infile = $ARGV[0] ;

die "$0: input file missing.\n"
  if ( not $infile );
die "$0: input file $infile not found.\n"
  if (not -e $infile);

# Create a parser
my $parser = XML::LibXML->new();
# This is a validating parser
$parser->validation(1);
$parser->expand_entities(1); 
$parser->complete_attributes(1);
$parser->keep_blanks(0); # Don't care about blanks

# Parse the file
my $doc = $parser->parse_file($infile)
  or die "$0; Failed to open $infile.\n";

# Get the root element
my $root = $doc->documentElement()
  or die "$0: Could not get root node";

die "$0: illegal document root node <", $root->nodeName, ">\n"
    if ( $root->nodeName ne 'opt' );

if ( $action eq 'config' ) {
  my %global = (

    BAD_RPMS_MODE	=> sub { $doc->findvalue( 'opt/attribute::bad-rpm-mode')},
    BLOAT 		=> sub { $doc->findvalue( 'opt/attribute::bloat')},
    FOLLOW 		=> sub { $doc->findvalue( 'opt/attribute::follow')},
    UPDATE_RPMS		=> sub { $doc->findvalue( 'opt/attribute::update-rpms')},
    FLAT		=> sub { $doc->findvalue( 'opt/attribute::flat')},
    OLD_HASHFILE	=> sub { $doc->findvalue( 'opt/attribute::old-hashfile')},
    PATCH_RPM_STR	=> sub { $doc->findvalue( 'opt/attribute::patch-rpm-string')},
    VERBOSE		=> sub { $doc->findvalue( 'opt/attribute::verbose')},
    TOPDIR      	=> sub { $doc->findvalue( 'opt/topdir')},
    SHAREDIR      	=> sub { $doc->findvalue( 'opt/sharedir')},
    KEY_NAME		=> sub { $doc->findvalue( 'opt/authorization/name')},
    KEY_EMAIL		=> sub { $doc->findvalue( 'opt/authorization/email')},
    MK_PATCH_RPM_COMP	=> sub { $doc->findvalue( 'opt/attribute::patch-rpm-component')},
    MK_SEC_COMP		=> sub { $doc->findvalue( 'opt/attribute::security-component') },
    SIGN		=> sub { $doc->findvalue( 'opt/attribute::sign-repository') },
    SIGNED_PKGS_ONLY	=> sub { $doc->findvalue( 'opt/attribute::signed-pkgs-only') },

    WGET_TRIES		=> sub { int($doc->findvalue('opt/attribute::wget-tries')) },
    WGET_WAIT		=> sub { int($doc->findvalue('opt/attribute::wget-wait')) },

    PREFIX_FTP		=> sub { $doc->findvalue( 'opt/sources-list-ftp')},
    PREFIX_FILE		=> sub { $doc->findvalue( 'opt/sources-list-file')},
    PREFIX_HTTP		=> sub { $doc->findvalue( 'opt/sources-list-http')}
  );

  foreach my $key ( keys %global )
  {
    print $key, "=", $global{$key}->(), "\n";
  }

} elsif ( $action eq 'distattrs' ) {
  my $distxpath = 'child::opt'
    . '/child::distribution[attribute::id=\'' . $dva . '\']';
  my @dists = $doc->findnodes( $distxpath )
    or die "$0: invalid distribution $dva\n" ;

  my $patch = $dists[0]->findvalue( 'attribute::patch-rpm-component' );
  if ( not $patch ) {
    $patch = $doc->findvalue( 'opt/attribute::patch-rpm-component' );
  }
  my $security = $dists[0]->findvalue( 'attribute::security-component' );
  if ( not $security ) {
    $security = $doc->findvalue( 'opt/attribute::security-component' );
  }

  print "MK_PATCH_RPM_COMP=", $patch, "\n";
  print "MK_SEC_COMP=", $security, "\n";
  print "ARCH_STRUCTURE=",$dists[0]->findvalue( 'attribute::structure' ),"\n";

} elsif ( $action eq 'dist' ) {
  my $distxpath = 'child::opt'
    . '/child::distribution[attribute::id=\'' . $dva . '\']';
  my @dists = $doc->findnodes( $distxpath )
    or die "$0: invalid distribution $dva\n" ;

  print "VERSION=",$dists[0]->findvalue( 'child::version'),"\n";
  print "ARCH=",$dists[0]->findvalue( 'child::architecture'),"\n";
  print "DIST=",$dists[0]->findvalue( 'child::name'),"\n";
  print "LANGUAGE=",$dists[0]->findvalue( 'child::language'),"\n";
  print "ARCHIVE=",$dists[0]->findvalue( 'child::archive'),"\n";

} elsif ( $action eq 'query' ) {
  my $dist = undef ;
  if ( $xpath ne '' )
  {
    $xpath='['. $xpath .']';
  }

  my @dists = $root->findnodes("child::distribution$xpath");
  my @distids = ();
  for my $d ( @dists )
  {
    push @distids, $d->findvalue( 'attribute::id');
  }
  print join( ' ', @distids ),"\n" ;
} elsif ( $action eq 'mirror' ) {
  my $distxpath = 'child::opt'
    . '/child::distribution[attribute::id=\'' . $dva . '\']';
  my @dists = $doc->findnodes( $distxpath )
    or die "$0: invalid distribution $dva\n" ;

  my @confout = ();
  my @ftpdirs;

  my @components = $dists[0]->findnodes( 'child::component' );
  foreach my $c ( @components )
  {
    my $active = lc($c->findvalue( 'attribute::active' ));

    if ( $active eq 'yes' ) {
      my $name = $c->findvalue( 'child::name' );

      my $update_rpms = lc($c->findvalue( 'attribute::update-rpms' ) );
      if ( $update_rpms ne 'yes' ) { $update_rpms = 'no'; }

      my $list_most_recent = lc($c->findvalue( 'attribute::list-most-recent' ) );
      if ( $list_most_recent ne 'no' ) { $list_most_recent = 'yes'; }

      my $add_arg = '';
      my $continue = $c->findvalue( 'wget/attribute::continue' );
      if ( $continue eq 'yes' )
      {
        $add_arg = "-c";
      }

      foreach my $node  ( $c->findnodes( 'wget/child::add-arg' ) )
      {
        $add_arg .= ' ' . $node->textContent(); 
      }

      my $cutdirs = $c->findvalue( 'wget/attribute::cutdirs' );
      if ( $cutdirs eq '' ) {
        $cutdirs = 0;
      } else {
        $cutdirs = int($cutdirs);
      }

      my $url = $c->findvalue( 'child::url' );
      my $method = undef ;
      my @scripts = $c->findnodes( 'script' );
      if ( @scripts )
      {
        $method = 'script';
      }
      else
      {
        $method = $c->findvalue( 'url/attribute::method' );
      }

      my $node;
      my $local_accept = '';
      my $local_reject = '';

      for $node ( $c->findnodes( "child::accept" ) ) {
        if ( $local_accept eq '' ) {
	  $local_accept = $node->textContent;
	} else {
	  $local_accept .= "|" . $node->textContent;
	}
      }

      for my $node ( $c->findnodes( "child::reject" ) ) {
        if ( $local_reject eq '' ) {
	  $local_reject = $node->textContent;
	} else {
	  $local_reject .= "|" . $node->textContent;
	}
      }

      my $srchdir  = '';
      my $excldirs = '';

      if ( $method eq 'ftp' ) {
        # do the equivalent of the bash command:
        #   echo $url | cut -d"/" -f$cutdirs-
        my $n = ( @ftpdirs = split '/', $url );
        $srchdir = join '/', @ftpdirs [$cutdirs+1..$n-1];

        $srchdir = "$updatedir/$srchdir";
        $add_arg = "--no-host-directories --cut-dirs=$cutdirs $add_arg";

        if ( $update_rpms eq 'yes' ) {
          my @excludedirs = $c->findnodes( "wget/child::excludedir" );
          for my $dir (@excludedirs) {
            $excldirs .= $dir->textContent . ",";
          }

          $excldirs =~ s/,+$//;
          if ( $excldirs !~ '^$' ) { $add_arg = '-X '.$excldirs.' '.$add_arg }

        } else {
          $add_arg = '';
        }
      } elsif ( $method eq 'script' ) {
        # $srchdir = "$updatedir/" . $url;
	$srchdir = $url;
      } else {
        # only 2 methods supported: ftp and file
        $srchdir = $url;
        $add_arg = '';
      }

      push @confout, "$name;$method;$update_rpms;$url;$srchdir;$add_arg;$local_accept;$local_reject;$list_most_recent";
    }
  }
  # The $cnt value is used to uniquely identify a record
  my $cnt = 1;
  for my $line (@confout) {
    print $cnt++ .  ";$line\n"
  }
} elsif ( $action ) {
  die ( "non-supported action: $action\n" );
}

exit 0;

sub version ()
{
  print <<EOF;
$PROGRAM $VERSION
EOF

  exit 0;
}

sub help ()
{
  print <<EOF;
Usage: $PROGRAM [options] infile

Aptate's internal xml-parser.

Options:
        --help			print this help, then exit.
        --version		print version number, then exit.

	--action=[
            config
          | mirror --dist=DISTID
          | dist --dist=DISTID
          | distattrs --dist=DISTID
          | query --xpath=XPATH]

		config		print global config.
		mirror		print mirror config for distribution DISTID.
		dist            print local config for distribution DISTID.
		distattrs       print attributes for distribution DISTID.
		query		query for DISTIDs matching xpath XPATH.

Report bugs to <$BUGS>
EOF

  exit 0;
}

sub distros($)
{
  my $root = shift ;
  my @list = () ;
  foreach my $d ( $root->findnodes( "child::distribution") )
  {
    push @list, distid($d);
  }
  return @list ;
}

sub content_yesno($$)
{
  my $node  = shift ;
  my $xpath = shift ;
  my @n = $node->findnodes( $xpath );
  if ( @n ) {
    my $content = uc($node->findvalue( $xpath ));
    if ( $content eq '' ) { $content = 'YES'; };
    return $content ;
  } else {
          return 'NO' ;
  }
};
