#! /usr/bin/env perl

use strict;
use warnings;

my $do_cluster_subgraphs = 0;
my $collapse_clusters = 0;
my $ignore_missing = 0;
my $kconfig_pkgs = undef;

my $controlfile       = 'Control';
my $controlfile_local = 'Control.local';
my $prj_aliases_dir   = 'prj-config/aliases.d';
my %pkgs;
my %provided;
my %nodes;
my %clusters;
my %config;
my %build_only_deps;
my %modifications;
my %variant_deps;

my $pcfiledir_for_aliases;

sub new_node
{
  my $n = shift;
  $n = {} unless defined $n;
  $n->{requires} = [] unless defined $n->{requires};
  $n->{optional} = [] unless defined $n->{optional};
  $n->{provides} = [] unless defined $n->{provides};
  $n->{variants} = [] unless defined $n->{variants};
  $n->{'source-pkg'} = [] unless defined $n->{'source-pkg'};
  $n->{maintainer} = [] unless defined $n->{maintainer};
  return $n
}

sub filter_deps
{
  my $n = shift;
  my $attr = shift;

  my @r;
  foreach my $e (@{$n->{$attr}})
    {
      if ($e =~ /(\S+)\[(.+)\]$/)
        {
          my $p = $1;
          my @tokens = split /;+/, $2;

          my $enabled = 1;
          foreach my $t (@tokens)
            {
              # 'build-only'  is only useful for alias definitions
              # where we do not want to have a link dependency but
              # just a build dependency
              if ($t eq 'build-only')
                {
                  $build_only_deps{$p} = 1;
                }
              else
                {
                  my $expr = $t;

                  # now translate the expression into a perl expression
                  # so that we can use perl to evaluate it
                  $expr =~ s/\bconfig\((\w+)\)/
                             defined $config{$1} ? 1 : 0/eg;
                  $expr =~ s/\barch\((\w+)\)/
                             defined $config{"CONFIG_BUILD_ARCH_$1"} ? 1 : 0/eg;

                  $enabled &= eval $expr;
                }
            }

          # retain dependency if all conditions evaluated to true
          push @r, $p if $enabled;
        }
      else
        {
          push @r, $e;
        }
    }

  @{$n->{$attr}} = @r;
}

sub add_node
{
  my $n = shift;
  my $cluster = shift;

  filter_deps($n,'requires');
  filter_deps($n,'optional');

  my $name = $n->{name};
  $nodes{$name} = $n;

  if (not defined $cluster and $name =~ /(.*)\/([^\/]*)/)
    {
      $cluster = $1;
      $name = $2;
    }
  if (defined $cluster)
    {
      #print STDERR "new node: '$name' '$cluster'\n";
      $clusters{$cluster} = { name => $cluster, nodes => {} }
        unless defined $clusters{$cluster};

      my $c = $clusters{$cluster};
      $c->{nodes}->{$name} = $n;
      $n->{cluster} = $c;
    }

  # It is possible to define variants only for certain subdirectories. In this
  # case, we create a new node for the subdirectory by copying the current one
  # and changing the variant.
  my %new_nodes;
  my @variants = ();
  foreach my $variant (@{$n->{variants}})
    {
      # Check if variant has a special path given in square brackets. If that
      # is the case, we want the variant only to be present for this path.
      # Otherwise, we keep the variant for the current node.
      if ($variant =~ /(.*)\[(.*)\]/)
        {
          push(@{$new_nodes{$2}}, $1);
        }
      else
        {
          push(@variants, $variant);
        }
    }
  # replace variants with filtered list of variants
  $n->{variants} = ();
  push(@{$n->{variants}}, @variants);
  foreach my $node_name (keys %new_nodes)
    {
      # (shallow) copy node and change name and variants
      # We want that the node behaves exactly like the one we copied from. We
      # are okay with changes propagating except when it comes to the name and
      # the variants, which we assign new values to.
      my $node_copy = bless {%$n}, ref $n;
      $node_copy->{name} = "$node_copy->{name}/$node_name";
      $node_copy->{variants} = $new_nodes{$node_name};
      add_node($node_copy, undef);
    }

  $provided{$_} = $n foreach (@{$n->{provides}});

  return $n;
}

sub set_pcfiledir_for_aliases($)
{
  $pcfiledir_for_aliases = shift;
}

sub write_alias_pcfile($@)
{
  my $alias = shift;

  die "Path for pc-files not set, use '-P dir'"
    unless defined $pcfiledir_for_aliases;

  open(my $u, ">$pcfiledir_for_aliases/$alias.pc")
    || die "Cannot create '$pcfiledir_for_aliases/$alias.pc': $!";

  print $u "Name: $alias\n".
           "Version: 0\n".
           "Description: Alias Dependency Package\n".
           "Requires: ".join(' ', grep { not defined $build_only_deps{$_} } @_)."\n";

  close $u;
}

sub write_kconfig_file()
{
  open(my $f, ">$kconfig_pkgs") || die "Cannot create '$kconfig_pkgs': $!";

  print $f "# Automatically Kconfig for provided packages\n";
  print $f "#\n";
  print $f "# ", `date`;
  print $f "#\n";


  foreach my $p (keys %provided)
    {
      $p =~ s/\+/PLUS/g;
      $p =~ s/[^A-Za-z0-9]/_/g;
      print $f "config HAVE_BIDPC_" . uc($p) . "\n";
      print $f "\tbool\n";
      print $f "\tdefault y\n\n";
    }
}


sub add_alias($$@)
{
  my $alias = shift;
  my $cluster = shift;

  add_node(new_node({
        name => $alias,
        alias => 1,
        provides => [ $alias ],
        requires => [ @_ ] }), $cluster);
}

sub write_alias_pc_files()
{
  foreach my $n (values %nodes)
    {
      next unless $n->{alias};
      write_alias_pcfile($n->{name}, @{$n->{requires}});
    }
}

sub is_alias($)
{
  my $a = shift;
  defined $nodes{$a}->{alias};
}

sub read_aliases_dir($$)
{
  my $dir = shift;
  my $cluster = shift;

  opendir(A, $dir) || die "Cannot open directory '$dir': $!";

  foreach my $file (sort readdir(A))
    {
      next if $file =~ /^\./;
      next if -d $file;

      open(F, "$dir/$file") || die "Cannot open file '$dir/$file': $!";
      my $line = 0;

      while (<F>)
        {
          $line++;
          chomp;
          s/\#.*//;
          s/^\s+$//;
          next if /^$/;
          if (/^\s*(\S+)\s*:?=\s*(.+)/)
            {
              my @r;
              my $s = $2;
              while (1)
                {
                  last unless $s =~ s/(\S+\[.+?\]|\S+)\s*//;
                  push @r, $1;
                }

              add_alias($1, $cluster, @r);
            }
          else
            {
              die "Invalid syntax in $dir/$file:$line";
            }
        }

      close F;
    }

  closedir A;
}


sub scan_for_provided_pkg_configs
{
  my $node = shift;
  my $path = shift;
  my $pkg = shift;
  my $scan_all = shift;

  $node->{disabled} = 1 if -e "$path/broken" or -e "$path/obsolete";

  return if not $scan_all and $node->{disabled};

  foreach my $ctfn ($controlfile, $controlfile_local)
    {
      if (open(A, "$path/$ctfn"))
        {
          my $o;
          {
            undef local $/;
            $o = <A>;
          }

          $o =~ s/#.*$//gm;
          $o =~ s/\n[ \t]+/ /smg;

          my $control_entry = sub
            {
              my $tag = shift;
              return 0 unless $o =~ /^$tag(\[.+?\])?:[ \t]*(.+)$/im;
              my $tagfilter = $1 || '';
              my $s = $2;
              while (1)
                {
                  last unless $s =~ s/(\S+\[(.+?)\]|\S+)\s*//;
                  die "Error: Double filter not allowed in $path/$ctfn for '$tag\[$tagfilter\]: $1'"
                    if $tagfilter and $2;
                  push @{$node->{$tag}}, $1.$tagfilter;
                }
              $o = $`."\n".$';
              return 1;
            };

          while (1)
            {
              last unless    $control_entry->('optional')
                          || $control_entry->('requires')
                          || $control_entry->('provides')
                          || $control_entry->('variants')
                          || $control_entry->('source-pkg')
                          || $control_entry->('maintainer');
            }

          close A;
      }
    }
}

sub find_pkg_dirs
{
  my ($base_path, $cdir, $scan_all, $depth, $process) = @_;

  read_aliases_dir("$base_path/$cdir$prj_aliases_dir", substr($cdir, 0, -1))
    if -d "$base_path/$cdir$prj_aliases_dir";

  my $dh;
  opendir($dh, "$base_path/$cdir") || die "Cannot readdir in '$base_path/$cdir': $!";

  foreach (readdir($dh))
    {
      my $pkg = "$cdir$_";
      my $path = "$base_path/$pkg";

      $path = readlink $path if -l $path;
      next unless -d $path;
      next if /^\./ or /^CVS$/;
      if (-e "$path/$controlfile")
        {
          &$process($base_path, $pkg);
          next;
        }
      find_pkg_dirs($base_path, "$pkg/", $scan_all, $depth - 1, $process)
        if $depth > 0;
    }
  closedir $dh;
}

# search for Control files and aliases in prj-config directories
# starting from base_path (first argument)
# the second argument(scan_all) control whether disabled packages shall
# be handled as well
sub scan_files
{
  my $base_path = shift;
  my $scan_all = shift;

  find_pkg_dirs($base_path, "", $scan_all, 2, sub {
    my ($base, $pkg) = @_;
    $pkgs{$pkg} = 1;
    my $n = new_node({ name => $pkg, pkg => 1 });
    scan_for_provided_pkg_configs($n, "$base/$pkg", $pkg, $scan_all);
    add_node($n, undef);
  });
}

# same as scan_files but only use the list of directories given as
# after the second argument.
# NOTE: this function does not scan for prj-config directories, these must
#       be given using '-A' arguments
sub scan_files_dirs
{
  my $base = shift;
  my $scan_all = shift;
  my @subdirs = @_;

  foreach my $pkg (@subdirs)
    {
      my $scanpath = "$base/$pkg";
      # Absolute paths are external packages. Do not at the base to them
      $scanpath = $pkg if $pkg =~ /^\//;
      $pkgs{$pkg} = 1;
      my $n = new_node({ name => $pkg, pkg => 1 });
      scan_for_provided_pkg_configs($n, "$scanpath", $pkg, $scan_all);
      add_node($n, undef);
    }
}

sub generate_single_dep
{
  my ($tag, $n, $ignore_missing, $error_count) = @_;
  return 0 unless @{$n->{$tag}};

  my $a = $n->{name};

  print "# $a $tag ".join(' ', @{$n->{$tag}})."\n";
  print ".PHONY: $a\n" if $n->{alias};
  print "$a:";
  my @pdeps;
  foreach (sort @{$n->{$tag}})
    {
      if (defined $provided{$_} and not $provided{$_}->{disabled})
        {
          print " $provided{$_}->{name}";
          push @pdeps, $_;
        }
      elsif (not $ignore_missing and not defined $n->{disabled})
        {
          print STDERR "ERROR: Package providing \"$_\" not found as required by \"$a\".\n";
          $$error_count++;
        }
    }
  print "\nDEPS_$a +=";
  print " $_ \$(DEPS_" . $provided{$_}->{name} . ")" foreach (sort @pdeps);
  print "\n";
  return 1;
}

# Add modification variant names to all variants.
sub modification_variants
{
  my $node_variants = shift;
  my $modifications = shift;
  # do nothing if no modifications to add
  return @{$node_variants} unless defined $modifications;

  my @modification_variants = ();
  foreach my $modification (@{$modifications})
    {
      # We do not keep plain variants but only the modified ones. In case of
      # more than one modification, we have to reset the modification variants
      # to override them again.
      my @node_variants = @modification_variants;

      # Add modification to *all* variants
      @modification_variants = map { "$_+$modification" } @node_variants;
      # No variant means there is "std"
      @modification_variants = "std+$modification" unless @modification_variants;
    }
  return @modification_variants;
}

sub extra_deps
{
  my $variant = shift;

  my %extra_deps;
  my @single_variants = split(/\+/, $variant);
  foreach my $single_variant (@single_variants)
    {
      $extra_deps{$_} = 1 foreach @{$variant_deps{$single_variant}};
    }
  return keys %extra_deps;
}

sub generate_dep_makefile
{
  scan_files_dirs(shift, 1, @_);
  write_alias_pc_files();
  my $error_count = 0;

  print "# Automatically generated Makefile for dependencies\n";
  print "#\n";
  print "# ", `date`;
  print "#\n";

  my %p = %pkgs;
  my %variants;

  foreach my $a (sort keys %nodes)
    {
      my $n = $nodes{$a};

      # In case we have modification variants, we add them to each variant
      # before saving the list of variants for later printout.
      my @node_variants = modification_variants($n->{variants}, $modifications{$n->{name}});
      foreach (@node_variants)
        {
          push(@{$variants{$_}}, $n->{name});
          push(@{$n->{requires}},extra_deps($_));
        }

      my $d = generate_single_dep('requires', $n, $ignore_missing, \$error_count);
      $d |=  generate_single_dep('optional', $n, 1, \$error_count);
      # Also add provides to catch internal dependencies
      print "DEPS_$n->{name} += " . join(" ", sort(@{$n->{provides}})) . "\n";
      delete $p{$a} if $d;
    }

  print "\n# project targets\n";
  foreach (keys %clusters)
    {
      next unless $_;
      next if /^\//; # Do not recurse for absolute paths for external packages
      my $nodes = $clusters{$_}->{nodes};
      my $clustername = $_;
      while ($clustername =~ /(.*)\/([^\/]*)/)
        {
          print "$1: $clustername\n";
          $clustername = $2;
        }
      print "$_:";
      foreach (values %$nodes)
        {
          print " $_->{name}" unless is_alias($_);
        }
      print "\n";
    }

  # delete those packages that do not have dependencies, to avoid circular
  # 'make' deps
  foreach (keys %p)
    {
      delete $p{$_} if $_ eq $p{$_};
    }

  # Generate variant overview
  print "\n# variant configurations\n";
  foreach my $variant (keys %variants)
    {
      my @p = figure_out_pkg_dependencies(@{$variants{$variant}});
      print "\n# Derived from: " . join(' ', sort @{$variants{$variant}}) . "\n";
      print "VARIANTS_$_+=$variant\n" foreach @p;
    }

  print "\n# pakages w/o deps\n.PHONY: ".join(' ', sort keys %p)."\n" if %p;

  if ($error_count)
    {
      print STDERR "PANIC: Detected $error_count dependency error(s).\n";
      exit(1);
    }
}

# get the package providing the given abstract target
sub get_providing_pkg($$$)
{
  my $n = shift;
  my $r = shift;
  my $optional = shift;
  my $p = $provided{$n};
  return $p if defined $p;
  print STDERR "ERROR: no package providing '$n' found, as required by '$r'\n"
    unless defined $optional;
  return undef;
}

# get the source package given a package and the name of the source package
sub get_src_pkg($$)
{
  my $pkg = shift;
  my $src_pkg_name = shift;
  my $c = $pkg->{cluster};
  my $spkg;
  # search in our cluster first
  $spkg = $c->{nodes}->{$src_pkg_name} if defined $c;
  # if not found try it globally
  $spkg = $nodes{$src_pkg_name} unless defined $spkg;
  return $spkg;
}

# Get required and optional dependencies
sub get_deps_recursive(@)
{
  my %deps;
  my $done = 0;

  $deps{$_->{name}} = $_ foreach @_;

  while (not $done)
    {
      $done = 1;
      foreach my $pkg (values %deps)
        {
          foreach my $spkg (@{$pkg->{'source-pkg'}})
            {
              my $s = get_src_pkg($pkg, $spkg);
              if (not defined $s)
                {
                  print STDERR "ERROR: source package '$spkg' ".
                               "of package '$pkg->{name}' not found\n";
                  next;
                }
              $done = 0 unless defined $deps{$s->{name}};
              $deps{$s->{name}} = $s;
            }

          foreach my $rpkg (@{$pkg->{requires}}, @{$pkg->{optional}})
            {
              my $r = get_providing_pkg($rpkg, $pkg->{name},
                                        grep { $rpkg eq $_ } @{$pkg->{optional}});
              next unless defined $r;
              $done = 0 unless defined $deps{$r->{name}};
              $deps{$r->{name}} = $r;
            }
        }
    }

  return values %deps;
}

sub figure_out_pkg_dependencies(@)
{
  my %newpkgs;
  foreach (@_)
    {
      if (not defined $nodes{$_})
        {
          if (not defined $provided{$_})
            {
              print STDERR "WARNING: '$_' does not exist (forgot -A?).\n";
              next;
            }
          $newpkgs{$provided{$_}->{name}} = $provided{$_};
        }
      else
        {
          $newpkgs{$_} = $nodes{$_};
        }
    }
  return map $_->{name}, get_deps_recursive(values %newpkgs);
}

# this sub figures out which packages depend on the given ones
sub figure_out_dependant_pkgs(@)
{
  my %h;
  my %r;
  $h{$_} = 1 foreach @_;

  while (1)
    {
      my %tmp = %r;
      foreach my $node (values %nodes)
        {
          foreach (@{$node->{requires}})
            {
              my $p = $_;
              $p = $provided{$_}->{name} if defined $provided{$_};
              $tmp{$node->{name}} = 1 if defined $h{$p} or $tmp{$p};
            }
        }

      last if scalar keys %r == scalar keys %tmp;
      %r = %tmp;
    }

  # remove aliases
  foreach my $p (keys %r)
    {
      delete $r{$p} if is_alias($p);
    }

  %r;
}

sub disabled_requirements
{
  my $n = shift;
  return 1 if $n->{disabled_because_of_deps};
  foreach (@{$n->{requires}})
    {
      my $p = $provided{$_};
      if (not defined $p or $p->{disabled} or disabled_requirements($p))
        {
          $n->{disabled_because_of_deps} = 1;
          return 1;
        }
    }
  return 0;
}

sub generate_dot_file_all($$)
{
  my $base_path = shift;
  my $output = shift;
  scan_files($base_path, 1) if defined $base_path;
  my $error_count = 0;

  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
    = localtime(time);
  $year += 1900;
  $mon++;

  open O, $output or die "Cannot open '$output': $!";

  print O "# Automatically generated\n";
  print O "#\n";
  print O "# ", `date`;
  print O "#\n";
  print O "digraph dep {\n";
  print O "  compound=true;\n";
  print O "  graph [ label = \"\\nSource based package dependency\\n",
          sprintf("%02d. %02d. %04d, %02d:%02d \"];\n",
                  $mday, $mon, $year, $hour, $min);

  #my %disabled_because_of_deps = figure_out_dependant_pkgs(%disabled);

  if ($do_cluster_subgraphs)
    {
      foreach my $a (sort keys %clusters)
        {
          print O "  subgraph \"cluster_$a\" {\n";
          foreach my $b (sort keys %{$clusters{$a}->{nodes}})
            {
              print O "    \"$b\";\n";
            }
          print O "  }\n";
        }
    }

  sub get_node_name($)
  {
    my $n = shift;
    return $n unless $collapse_clusters and defined $nodes{$n}->{cluster};
    return $nodes{$n}->{cluster}->{name};
  }

  sub gen_node($$)
  {
    my $n = shift;
    my $onodes = shift;
    return if defined $onodes->{$n};
    $onodes->{$n} = 1;
    my @attr;

    if (defined $clusters{$n}) {
      push @attr, "shape=box";
    } elsif (is_alias($n)) {
      push @attr, "shape=septagon";
    }

    my $node = $nodes{$n};
    if (defined $node) {
      if (defined $node->{disabled}) {
        push @attr, "style=filled", "fillcolor=red";
      } elsif (disabled_requirements($node)) {
        push @attr, "style=filled", "fillcolor=sandybrown";
      }
    }
    print O "  \"$n\" [".join(', ', @attr)."]\n" if @attr;
  }

  sub gen_edge($$$)
  {
    my $s = shift;
    my $e = shift;
    my $edges = shift;

    return if $s eq $e;
    my $outgoing = $edges->{$s};
    return if defined $outgoing and defined $outgoing->{$e};
    $outgoing->{$e} = 1 if defined $outgoing;
    $edges->{$s} = { $e => 1 } unless defined $outgoing;

    print O "  \"$s\" -> \"$e\" [color=black]\n";
  }

  my %onodes;
  my %edges;

  foreach my $a (sort keys %nodes)
    {
      my $node = $nodes{$a};
      my $lnode = get_node_name($a);
      gen_node($lnode, \%onodes);

      foreach (sort @{$node->{requires}})
        {
          if (defined $provided{$_})
            {
              gen_edge($lnode, get_node_name($provided{$_}->{name}), \%edges);
            }
          elsif (not defined $node->{disabled} and not $node->{alias})
            {
              print STDERR "ERROR: Package providing \"$_\" not found as required by \"$a\".\n";
              $error_count++;
            }
        }
      print O "\n";
    }

  print O "}\n";

  close O;

  if ($error_count)
    {
      print STDERR "PANIC: Detected $error_count dependency error(s).\n";
      exit(1);
    }
}

sub resolve_requires($)
{
  my $n = shift;
  foreach (@{$n->{requires}})
    {
      my $p = get_providing_pkg($_, $n->{name}, undef);
      next unless defined $p;
      $p->{required_by}->{$n->{name}} = $n;
      $n->{requires_pkgs}->{$p->{name}} = $p;
    }

  foreach (@{$n->{'source-pkg'}})
    {
      my $p = get_src_pkg($n, $_);
      next unless defined $p;
      $p->{src_required_by}->{$n->{name}} = $n;
      $n->{src_requires_pkgs}->{$p->{name}} = $p;
    }
}

sub gen_required_dot_subtree
{
  my $pnode = shift;
  my $file = shift;
  my $seen = shift;
  my $edges = shift;

  my @attribs = ("style=filled, fillcolor=yellow1");

  $seen->{$pnode->{name}} = 1;

  foreach (values %{$pnode->{requires_pkgs}})
    {
      my $edge = "\"$pnode->{name}\" -> \"$_->{name}\"";
      next if defined $edges->{$edge};

      $edges->{$edge} = 1;
      my @attr;
      push @attr, @attribs;
      push @attr, "shape=septagon" if $_->{alias};
      print $file "  \"$_->{name}\" [".join(',',@attr)."]\n" if @attr;
      print $file "  $edge\n";

      next if $seen->{$_->{name}};
      gen_required_dot_subtree($_, $file, $seen, $edges);
    }

  foreach (values %{$pnode->{src_requires_pkgs}})
    {
      my @attr;
      push @attr, @attribs;
      push @attr, "shape=septagon" if $_->{alias};
      print $file "  \"$_->{name}\" [".join(',',@attr)."]\n" if @attr;
      print $file "  \"$pnode->{name}\" -> \"$_->{name}\" [constraint=false,style=dotted]\n";
    }
}

sub gen_required_by_dot_subtree
{
  my $p = shift;
  my $file = shift;
  my $seen = shift;
  my $edges = shift;

  my @attribs = ("style=filled, fillcolor=seagreen1");

  $seen->{$p->{name}} = 1;

  foreach (values %{$p->{required_by}})
    {
      my $edge = "\"$_->{name}\" -> \"$p->{name}\"";
      next if defined $edges->{$edge};

      $edges->{$edge} = 1;
      my @attr;
      push @attr, @attribs;
      push @attr, "shape=septagon" if $_->{alias};
      print $file "  \"$_->{name}\" [".join(',',@attr)."]\n" if @attr;
      print $file "  $edge\n";

      next if $seen->{$_->{name}};
      gen_required_by_dot_subtree($_, $file, $seen, $edges);
    }
}

sub generate_overview_set($$)
{
  my $base_path = shift;
  my $output_dir = shift;

  die "Output directory not given." unless defined $output_dir;

  scan_files($base_path, 1);
  my $error_count = 0;

  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
    = localtime(time);
  $year += 1900;
  $mon++;
  my $datestring = sprintf("%02d. %02d. %04d, %02d:%02d",
                           $mday, $mon, $year, $hour, $min);

  generate_dot_file_all(undef, "| tred | dot -Tsvg -o $output_dir/all.svg");

  open INDEX, ">$output_dir/index.html" or die "Cannot create $output_dir/index.html: $!";
  print INDEX <<EOFOO;
<html>
 <head>
 <title>L4Re package dependency overview</title>
 </head>
 <body>
  <h2>L4Re package dependency overview</h2>
  <p>Generated: $datestring</p>
  <p>
    Legend of overview graphs:
    <ul>
      <li>Red: Broken package</li>
      <li>Lightred: Package broken because it depends on broken package but is itself not broken</li>
    </ul>
    Legend of package graphs:
    <ul>
      <li>Blue: The package itself</li>
      <li>Green: Reverse dependency of package</li>
      <li>Yellow: Dependency of package</li>
    </ul>
  </p>
  <p><a href=\"all.svg\">General overview</a><br/></p>
  <table border=\"1\"><tr><td>Package</td><td>Maintainer(s)</td><td>Deps</td><td>Reverse Deps</td></tr>
EOFOO

  resolve_requires($_) foreach values %nodes;

  foreach my $pkg (sort keys %pkgs)
    {
      my $pnode = $nodes{$pkg};
      (my $pkg_file = $pkg) =~ s/\//_/g;

      open F, "| dot -Tsvg -o $output_dir/p_$pkg_file.svg" || die "Cannot open $output_dir/p_$pkg_file.svg: $!";
      #open F, ">$output_dir/pkg_$pkg.dot" || die "Cannot open pkg_$pkg.dot: $!";

      print F "# Automatically generated\n";
      print F "#\n";
      print F "# ", `date`;
      print F "#\n";
      print F "digraph dep {\n";
      print F "  graph [ label = \"\\nSource based package dependency for package '$pkg'\\n",
              "$datestring\"];\n";

      gen_required_dot_subtree($pnode, *F);
      gen_required_by_dot_subtree($pnode, *F);

      my %rev_deps = figure_out_dependant_pkgs($pkg);
      my @deps     = figure_out_pkg_dependencies($pkg);
      print F "  \"$pkg\" [style=filled, fillcolor=dodgerblue];\n";
      print F "}\n";
      close F;

      # Generate HTML content

      print INDEX "<tr><td><a href=\"p_$pkg_file.svg\">$pkg</a></td><td>\n";
      print INDEX defined $pnode->{maintainer}
                  ? (join " ", map { "<a href=\"mailto:$_\">$_</a>" } @{$pnode->{maintainer}}) : "none";
      print INDEX "</td><td>\n";
      foreach my $a (sort @deps)
        {
          (my $a_file = $a) =~ s/\//_/g;
          print INDEX " <a href=\"p_$a_file.svg\">$a</a> ";
        }
      print INDEX "</td><td>\n";
      foreach my $a (sort keys %rev_deps)
        {
          (my $a_file = $a) =~ s/\//_/g;
          print INDEX " <a href=\"p_$a_file.svg\">$a</a> ";
        }
      print INDEX "</td></tr>\n";
    }

  print INDEX "</table>\n";
  print INDEX "</body>\n</html>\n";
  close INDEX;

  if ($error_count)
    {
      print STDERR "PANIC: Detected $error_count dependency error(s).\n";
      exit(1);
    }
}

sub check_control($)
{
  my $base_path = shift;

  scan_files($base_path, 0);

  foreach my $p (keys %pkgs)
    {
      my %pc_filenames;
      my @libs_wo_pcfile;
      open(F, "find '$base_path/$p' -name Makefile -o -name Make.rules |")
        || die "Cannot start find: $!";
      while (my $file = <F>)
        {
          my $is_lib_build;
          my $found_pc_filename;
          my $not_public;
          chomp $file;
          open(M, $file) || die "Cannot open \"$_\": $!";
          while (<M>)
            {
              chomp;
              $found_pc_filename = $1
                if /^\s*PC_FILENAME\s*:?=\s*(.+)\s*$/;
              $is_lib_build = 1
                if /^\s*include\s+.+\/mk\/lib.mk\s*$/;
              $not_public = 1
                if /^\s*NOTARGETSTOINSTALL\s*:?=\s/;
            }
          close M;

          print "ERROR: $p: Not public but PC_FILENAME given\n"
            if defined $not_public and defined $found_pc_filename;

          unless (defined $not_public)
            {
              if (defined $found_pc_filename)
                {
                  $found_pc_filename =~ s/\$\(PKGNAME\)/$p/;
                  $pc_filenames{$found_pc_filename} = 1;
                }
              elsif (defined $is_lib_build)
                {
                  my $pkgname = $p;
                  $pkgname = $1 if $p =~ /.*\/([^\/]*)/;

                  $pc_filenames{$pkgname} = 1;
                  push @libs_wo_pcfile, $file;
                }
            }
        }

      foreach my $a (keys %pc_filenames)
        {
          print "ERROR: $p: Missing in provides '$a'\n"
            if not defined $provided{$a} or $provided{$a}->{name} ne $p;
        }

      foreach my $a (keys %provided)
        {
          print "ERROR: $p: Provide not found as PC_FILENAME '$a'\n"
            if $provided{$a}->{name} eq $p and not defined $pc_filenames{$a};

          if ($provided{$a}->{name} eq $p and not defined $pc_filenames{$a}) {
            print "P: ".join(' ', keys %pc_filenames)."\n";
          }
        }

      print "ERROR: $p: Contains multiple libs without PC_FILENAME:\n",
            "       ", join("\n       ", @libs_wo_pcfile), "\n"
        if scalar @libs_wo_pcfile > 1;

      close F;
    }

  print "TODO: check if something is provided by multiple packages\n";
}


sub show_pkg_deps($$@)
{
  my $base_path = shift;
  my $prefix = shift;
  scan_files($base_path, 0);

  my @p = figure_out_pkg_dependencies(@_);

  print join("\n", map { "$prefix$_" } sort @p), "\n" if $prefix;
  print join(' ', sort @p), "\n"                      unless $prefix;
}

sub show_pkg_deps_and_rdeps($$@)
{
  my $base_path = shift;
  my $prefix = shift;

  scan_files($base_path, 0);

  my %r = figure_out_dependant_pkgs(@_);
  my @p = figure_out_pkg_dependencies(@_, keys %r);

  print join("\n", map { "$prefix$_" } sort @p), "\n" if $prefix;
  print join(' ', sort @p), "\n"                      unless $prefix;
}

sub show_maintainer($@)
{
  scan_files(shift, 1);

  if (@_)
    {
      my %m;

      foreach (@_)
        {
          next if $_->{alias};

          my $pkg = $nodes{$_};
          if ($pkg->{maintainer})
            {
              $m{$_}++ foreach @{$pkg->{maintainer}};
            }
          else
            {
              $m{'NO MAINTAINER'} = 1;
            }
        }

      print join(", ", keys %m), "\n";
    }
  else
    {
      my %m;
      foreach (values %nodes)
        {
          next if $_->{alias};

          if ($_->{maintainer})
            {
              print "$_->{name}: ", join(', ', @{$_->{maintainer}}), "\n";
              $m{$_}++ foreach @{$_->{maintainer}};
            }
          else
            {
              print "$_->{name}: NO MAINTAINER\n";
            }
        }
      print "Stats:\n", join("\n", map { sprintf "%3d: %s", $m{$_}, $_ } sort { $m{$b} <=> $m{$a} } keys %m), "\n";
    }
}


sub smooth_control_file($$)
{
  my $path = shift;
  my $pkg = shift;

  my $node = new_node({ name => $pkg, pkg => 1 });

  scan_for_provided_pkg_configs($node, $path, $pkg, 1);
  add_node($node, undef);

  print "Provides: ".join(' ', keys %provided)."\n";
  print "Requires: ".join(' ', @{$nodes{$pkg}->{requires}})."\n";
}

sub read_config
{
  my $configfile = shift;

  open(my $c, $configfile) || die "Cannot open $configfile: $!";

  while (my $l = <$c>)
    {
      chomp $l;
      $l =~ s/^\s*#.*//; # Avoid destroying strings with hashes inside
      $l =~ s/^\s+//;
      $l =~ s/\s+$//;
      next unless length($l);
      my ($key, $val) = split(/\s*=\s*/, $l, 2);
      $config{$key} = $val;
    }

  close $c;
}

# a bit of hand-crafted option parsing, if it gets more use getopt
my @aliases_dirs;
while (1)
  {
    last unless defined $ARGV[0];
    if ($ARGV[0] eq '-A')
      {
        shift;
        push @aliases_dirs, shift;
      }
    elsif ($ARGV[0] eq '-P')
      {
        shift;
        set_pcfiledir_for_aliases(shift),
      }
    elsif ($ARGV[0] eq '-I')
      {
        shift;
        $ignore_missing = 1;
      }
    elsif ($ARGV[0] eq '-C')
      {
        shift;
        read_config(shift);
      }
    elsif ($ARGV[0] eq '-K')
      {
        shift;
        $kconfig_pkgs = shift;
      }
    # The `-M <variant> <nodes ...> -ME` option can be provided to the
    # pkgdep utility to add `<variant>` as an additional variant to all
    # nodes of the subtrees of `<nodes...>`.
    # This way, all nodes keep the variants they need, but also get those,
    # that are added as modification on top.
    elsif ($ARGV[0] eq '-M')
      {
        shift;
        my $variant = shift;
        while ($ARGV[0] ne '-ME')
          {
            my $pkg = shift;
            $modifications{$pkg} = () unless exists $modifications{$pkg};
            push(@{$modifications{$pkg}}, $variant);
            die "Missing -ME to end Modification variant scope."
              unless defined $ARGV[0];
          }
        shift;
      }
    # The `-D <variant> <dependencies ...> -DE` option can be provided to the
    # pkgdep utility to add `<dependencies ...>` as additional dependencies to
    # all nodes with variant `<variant>`.
    elsif ($ARGV[0] eq '-D')
      {
        shift;
        my $variant = shift;

        while ($ARGV[0] ne '-DE')
          {
            my $dep = shift;
            push(@{$variant_deps{$variant}}, $dep);
            die "Missing -DE to end variant dependency scope."
              unless defined $ARGV[0];
          }
        shift;
      }
    else
      {
        last;
      }
  }

my $cmd         = shift @ARGV;
my $base_path   = shift @ARGV;

die "Missing arguments"
  if not defined $cmd or not defined $base_path;

read_aliases_dir($_, undef) foreach @aliases_dirs;

if ($cmd eq 'generate') {
  generate_dep_makefile($base_path, @ARGV);
} elsif ($cmd eq 'genkconfig') {
  scan_files_dirs($base_path, 1, @ARGV);
  write_kconfig_file() if $kconfig_pkgs;
} elsif ($cmd eq 'dot') {
  generate_dot_file_all($base_path, '>-');
} elsif ($cmd eq 'overviewset') {
  generate_overview_set($base_path, $ARGV[0]);
} elsif ($cmd eq 'pkgdeps') {
  show_pkg_deps($base_path, undef, @ARGV[0 .. $#ARGV]);
} elsif ($cmd eq 'pkgdepspath') {
  show_pkg_deps($base_path, $ARGV[0], @ARGV[1 .. $#ARGV]);
} elsif ($cmd eq 'pkgdepsandrdeps') {
  show_pkg_deps_and_rdeps($base_path, undef, @ARGV[0 .. $#ARGV]);
} elsif ($cmd eq 'collect') {
  die "Missing argument" unless defined $ARGV[0];
  smooth_control_file("$base_path/$ARGV[0]", $ARGV[0]);
} elsif ($cmd eq 'maintainer') {
  show_maintainer($base_path, @ARGV[0 .. $#ARGV]);
} elsif ($cmd eq 'check') {
  check_control($base_path);
} else {
  die "Invalid command '$cmd'";
}
