[Debtags-commits] [svn] r1625 - tagdb

[Enrico Zini]

Author: enrico
Date: Thu Mar  2 14:30:04 2006
New Revision: 1625

Modified:
   tagdb/sectdispatch
Log:
Implemented compression of tags from the same facet

Modified: tagdb/sectdispatch
==============================================================================
--- tagdb/sectdispatch	(original)
+++ tagdb/sectdispatch	Thu Mar  2 14:30:04 2006
@@ -21,27 +21,68 @@
 	close (IN);
 }
 
+sub compress ($)
+{
+	my ($tags) = @_;
+
+	# Group the tags by facet
+	my %facets;
+	my @unfaceted;
+	for my $t (split(', ', $tags))
+	{
+		if ($t =~ /^(.+?)::(.+)$/)
+		{
+			$facets{$1} = [] if not exists $facets{$1};
+			push @{$facets{$1}}, $2;
+		} else {
+			push @unfaceted, $t;
+		}
+	}
+
+	# Group together the tags belonging to the same facet, when there are
+	# more than 2 of them
+	my @res;
+	for my $f (sort keys %facets)
+	{
+		my @tags = @{$facets{$f}};
+		if (@tags <= 2)
+		{
+			push @res, @tags;
+		} else {
+			push @res, $f.'::{'.join(',', at tags).'}';
+		}
+	}
+
+	# Add the unfaceted tags (there shouldn't be any, but just in case)
+	push @res, @unfaceted;
+
+	return join(', ', @res);
+}
+
 open (MAIN, ">$basename") or die "Can't open $basename: $!";
 open (CONTRIB, ">$basename.contrib") or die "Can't open $basename.contrib: $!";
 open (NONFREE, ">$basename.non-free") or die "Can't open $basename.non-free: $!";
 while (<STDIN>)
 {
-	next if /^(\S+)\tTag\s*$/;
-	die "Can't parse $_" if not /^(\S+)\t/;
+	my ($pkg, $tags) = split(': ');
+	next if not $tags;
 
-	if (not exists $sects{$1})
+	if (not exists $sects{$pkg})
 	{
-		print STDERR "Warning: package $1 not found in APT database\n";
+		print STDERR "Warning: package $pkg not found in APT database\n";
 		next;
 	}
 
-	if ($sects{$1} =~ /^contrib\//)
+	$tags = compress($tags);
+	my $out = "$pkg\tTag\t$tags\n";
+
+	if ($sects{$pkg} =~ /^contrib\//)
 	{
-		print CONTRIB $_;
-	} elsif ($sects{$1} =~ /^non-free\//) {
-		print NONFREE $_;
+		print CONTRIB $out;
+	} elsif ($sects{$pkg} =~ /^non-free\//) {
+		print NONFREE $out;
 	} else {
-		print MAIN $_;
+		print MAIN $out;
 	}
 }