# The following code comes from the debian/perl-common file in the
# source.  I've done it this way because the package isn't guaranteed
# to be unpacked at configuration time, so it can't be isolated into a
# module.

# First things first: let's try to load the XML modules.  If we can't,
# then we have to dumb down the support we provide.

BEGIN
{
    eval
    {
	require XML::Parser;
	require XML::Parser::PerlSAX;
	require XML::Grove;
	require XML::Grove::Builder;
    };
}

if (${XML::Grove::Builder::}{"new"})
{
    $no_xml = 0;
}
else
{
    $no_xml = 1;
}

# Parse a sources.list line, with the "deb" and so on.  Add the fields
# to the source entry passed.

sub parse_sources_line
{
    my $line = shift;
    my $src = shift;
    my $suite;

    chomp $line;

    if ($line =~ /^\s*\#\s*(deb.*)/)
    {
	$src->{"disabled"} = 1;
	$line = $1;
    }

    if ($line =~ /^deb-src/)
    {
	$src->{"repotype"} = "source";
    }
    else
    {
	$src->{"repotype"} = "binary";
    }

    if ($line =~ /(cdrom:\[.*?\]\S*)\s+(.*)/)
    {
	my @rest;
	$src->{"baseurl"} = $1;
	@rest = split(/\s+/, $2, 2);
	$suite = $rest[0];
	$src->{"suite"} = $suite;
	$src->{"components"} = $rest[1] if $#rest > 0;
    }
    else
    {
	my @rest = split(/\s+/, $line, 4);
	$src->{"baseurl"} = $rest[1];
	$suite = $rest[2];
	$src->{"suite"} = $suite;
	$src->{"components"} = $rest[3] if $#rest > 2;
    }
    
    $src->{"suite"} = $1 if $suite =~ /(.*)\/$/;
}

# Parse a sources.list file, and return an array of hashes.  This will
# either contain comments or repository information.  This code will
# do its best to try and recognize valid commented lines and mark them
# as "disabled" in the resulting hash.

sub parse_sources_list
{
    my $sources_lines = shift;
    my $repo_descriptions;
    if (scalar(@ARGV) >= 0)
    {
	$repo_descriptions = shift;
    }

    my $state = 0;
    my $accumulator;
    my ($repo_info, $comment_info);
    my @repo_list;
    my ($name, $value);
    my ($dump_accumulator, $dump_repo);

    foreach $_ (@$sources_lines)
    {
	$dump_accumulator = 0;
	$dump_repo = 0;
	if (/^\s*\#*\s*deb(-src)?\s+/)
	{
	    # Found a repository description.

	    $$repo_info{"type"} = "repository";

	    parse_sources_line($_, $repo_info);

	    $dump_accumulator = 1;
	    $dump_repo = 1;
	}
	elsif (/^\s*\#+\s*X-AptConf-/)
	{
	    # Found an aptconf directive.
	    my $dir_line = $1 if /X-AptConf-(.*)$/;
	    ($name, $value) = split(/:\s*/, $dir_line, 2);
	    $$repo_info{$name} = $value;
	    $dump_accumulator = 1;
	}
	else
	{
	    # Everything else is just a comment; tack it on to the
            # accumulator.
	    push(@$accumulator, $_);
	}

	# If a new element was detected and the accumulator has
	# something in it, make sure to save it.
	if ($dump_accumulator and scalar(@$accumulator))
	{
	    $$comment_info{"comments"} = $accumulator;
	    $$comment_info{"type"} = "comments";
	    push(@repo_list, $comment_info);
	    $comment_info = {};
	    $accumulator = ();
	}

	# Is it time to dump the new repository description?
	if ($dump_repo)
	{
	    push(@repo_list, $repo_info);
	    $repo_info = {};
	}
    }

    return @repo_list;
}

# Parse an XML repository description file.  Return an empty array
# if XML support couldn't be loaded previously.

sub parse_repo_description
{
    return () if $no_xml;

    my $filepath = shift;

    my $builder = XML::Grove::Builder->new;
    my $parser = XML::Parser::PerlSAX->new(Handler => $builder);

    my $grove = $parser->parse(Source => { SystemId => $filepath });

    my $repos = $grove->root;

    my ($repoinfo, $repo);
    my @repolist;

    foreach $repo (@{$repos->{"Contents"}})
    {
	next if ref($repo) !~ /::Element/;

	$repoinfo = {};

	foreach $attribute (keys %{$repo->{"Attributes"}})
	{
	    $$repoinfo{$attribute} = $repo->{"Attributes"}->{$attribute};
	}

	foreach $repo_element (@{$repo->{"Contents"}})
	{
	    next if ref($repo_element) !~ /::Element/;

	    if ($repo_element->{"Name"} eq "description")
	    {
		my $desc_lang = $repo_element->{"Attributes"}->{"lang"};
		my $desc_text = ${$repo_element->{"Contents"}}[0]->{"Data"};
		$$repoinfo{"description-$desc_lang"} = $desc_text;
	    }
	    elsif ($repo_element->{"Name"} eq "source")
	    {
		$$repoinfo{"source"} = "yes";
	    }
	    elsif ($repo_element->{"Name"} eq "binary")
	    {
		$$repoinfo{"binary"} = "yes";
	    }
	    elsif ($repo_element->{"Name"} eq "mirror")
	    {
		my $mirror_loc = $repo_element->{"Attributes"}->{"location"};
		my $mirror_url = $repo_element->{"Contents"}->[0]->{"Data"};
		push(@{$repoinfo->{"mirrors"}->{$mirror_loc}}, $mirror_url);
	    }
	    elsif ($repo_element->{"Name"} eq "component")
	    {
		push(@{$repoinfo->{"components"}}, 
		     $repo_element->{"Contents"}->[0]->{"Data"});
	    }
	    else
	    {
		$$repoinfo{$repo_element->{"Name"}} = 
		    $repo_element->{"Contents"}->[0]->{"Data"};
	    }
	}

	push(@repolist, $repoinfo);
    }

    return @repolist;
}

# Parse all of the repository descriptions in a given set of 
# directories.

sub parse_all_repo_descriptions
{
    return () if $no_xml;

    my @repo_desc_locations = shift;
    my @repolist;
    my $repo_loc;
    foreach $repo_loc (@repo_desc_locations)
    {
	next if !(-d $repo_loc);
	opendir(DESCLIST, $repo_loc);
	while (my $repo_file = readdir DESCLIST)
	{
	    next if $repo_file =~ /^\./;
	    push @repolist, parse_repo_description($repo_loc . "/" . $repo_file);
	}
	closedir DESCLIST;
    }

    return @repolist;
}

# Match repo descriptions with sources.list entries.  If an entry
# matches a repository, put a "repo-name" attribute in the entry.
# Also provide "repo-mirror-url" and "repo-mirror-loc" for the
# currently chosen mirror country and location.

sub match_entry_to_repo
{
    my $entries = shift;
    my $repos = shift;
    my $match;
    my ($mirror_loc, $mirror_url);
    my $repo;
    my ($found_repo, $found_loc, $found_url);

    # This can be done several ways: by matching name attributes with
    # X-Aptconf-Name fields, or by matching baseurl with a mirror and
    # suite with suite.

    foreach $src (@$entries)
    {
	next if $src->{"type"} ne "repository";

	$match = 0;
	$found_repo = "";
	$found_loc = "";
	$found_url = "";
	
      repocheck:
	foreach $repo (@$repos)
	{
	    if ($src->{"Name"})
	    {
		if ($repo->{"name"} eq $src->{"Name"})
		{
		    $match = 1;
		    $found_repo = $repo;
		    $found_loc = $mirror_loc;
		    $found_url = $mirror_url;
		    last repocheck;
		}
	    }
	    elsif (($src->{"suite"} eq $repo->{"suite"}) or
		   ($src->{"suite"} eq $repo->{"dir"}))
	    {
		foreach $mirror_loc (keys %{$repo->{"mirrors"}})
		{
		    foreach $mirror_url (@{$repo->{"mirrors"}->{$mirror_loc}})
		    {
			if ($mirror_url eq $src->{"baseurl"})
			{
			    $match = 1;
			    $found_repo = $repo;
			    $found_loc = $mirror_loc;
			    $found_url = $mirror_url;
			    last repocheck;
			}
		    }
		}
	    }
	    last if $match;
	}

	if ($match)
	{
	    $src->{"repo-desc"} = $found_repo;
	    $src->{"repo-mirror-loc"} = $found_loc if $found_loc;
	    $src->{"repo-mirror-url"} = $found_url if $found_url;
	}
    }
}

# Go through a list of sources.list entries, find deb and deb-src
# lines that match, and merge them.

sub match_source_entries
{
    my $entries = shift;
    my $index;
    my $index2;
    my $src1;
    my $src2;

  entry:
    for ($index = 0; $index < $#{$entries}; $index++)
    {
	$src1 = $$entries[$index];
	next if $src1->{"type"} ne "repository";
	next if $src1->{"repotype"} eq "both";

	for ($index2 = $index + 1; $index2 <= $#{$entries}; $index2++)
	{
	    $src2 = $$entries[$index2];
	    next if $src2->{"type"} ne "repository";
	    next if $src2->{"repotype"} eq "both";

	    if (($src1->{"repotype"} ne $src2->{"repotype"}) and
		($src1->{"baseurl"} eq $src2->{"baseurl"}) and
		($src1->{"suite"} eq $src2->{"suite"}))
	    {
		my ($src, $srcindex, $bin);
		if ($src1->{"repotype"} eq "binary")
		{
		    $bin = $src1;
		    $src = $src2;
		    $srcindex = $index2;
		}
		else
		{
		    $bin = $src2;
		    $src = $src1;
		    $srcindex = $index;
		}

		foreach $srckey (keys %$src)
		{
		    $bin->{$srckey} = $src->{$srckey} if !$bin->{$srckey};
		}

		$bin->{"repotype"} = "both";
		$src->{"type"} = "disabled";

		next entry;
	    }
	}
    }
}

# Generate an ID for a sources.list entry.  It looks for a previously
# stored ID first, then for a repository description ID.  If neither
# of those are available, it generates an ID based off the entry's
# fields, making sure it doesn't repeat an ID.

sub gen_id
{
    my $src = shift;
    my $idlist = shift;

    if (!$src->{"id"})
    {
	if ($src->{"repo-desc"})
	{
	    $src->{"id"} = $src->{"repo-desc"}->{"name"};
	}
	elsif ($src->{"Name"})
	{
	    $src->{"id"} = $src->{"Name"};
	}
	else
	{
	    my $id = $src->{"baseurl"} . "-" . $src->{"suite"};
	    $id =~ s|[:/\[\]]+|_|g;
	    $id =~ s/\s+/_/g;
	    $matchid = quotemeta($id);
	    if (grep(/$matchid/, @$idlist))
	    {
		my $testid = $id;
		my $num = 2;
		while (grep(/$testid/, @$idlist))
		{
		    $testid = $id . "-$num";
		    $num++;
		}
	    }

	    $src->{"id"} = $id;
	}

	push(@$idlist, $src->{"id"});
    }

    return $src->{"id"};
}

# Get the path to the sources.list file from apt's configuration.

sub get_list_path
{
    my @conflines = `apt-config dump`;
    my @fieldpath = ["Dir", "Etc", "sourcelist"];
    my %confhash;
    my $config_str;

    foreach $line (@conflines)
    {
        my ($name, $value) = split(/\s+/, $line, 2);
        $value =~ s/"(.*)";/\1/g;
        $confhash{$name} = $value;
    }

    do
    {
        $config_str = $confhash{join("::", @fieldpath)};
        pop(@fieldpath);
    } while (($config_str !~ m|^/|) && (scalar(@fieldpath) > 0));

    return $config_str;
}

# End of imported perl-common code.
