#! /usr/bin/perl -w

# click-mkelemmap -- make map of element name to C++ class and file
# Eddie Kohler
#
# Copyright (c) 1999-2001 Massachusetts Institute of Technology
#
# 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, subject to the conditions
# listed in the Click LICENSE file. These conditions include: you must
# preserve this copyright notice, and you cannot mention the copyright
# holders in advertising related to the Software without their permission.
# The Software is provided WITHOUT ANY WARRANTY, EXPRESS OR IMPLIED. This
# notice is a summary of the Click LICENSE file; the license in that file is
# legally binding.

my(%processing_constants) =
    ('AGNOSTIC' => 'a/a', 'PUSH' => 'h/h', 'PULL' => 'l/l',
     'PUSH_TO_PULL' => 'h/l', 'PULL_TO_PUSH' => 'l/h');
my(%flow_code_constants) =
    ('COMPLETE_FLOW' => 'x/x');
my(@source_file, @header_file, @click_name, @cxx_name, @doc_name,
   @parents, @processing, @flow_code, @flags, @requirements, @provisions,
   %click_name_to_id, %cxx_name_to_id);
my(@includes) = ( '.' );

sub driver_mask ($) {
    my($m) = 0;
    # XXX "|" syntax?
    $m |= 1 if $_[0] =~ /\buserlevel\b/;
    $m |= 2 if $_[0] =~ /\blinuxmodule\b/;
    $m |= 4 if $_[0] =~ /\bbsdmodule\b/;
    $m |= 8 if $_[0] =~ /\bns\b/;
    ($m ? $m : 15);
}

sub process_file ($) {
  my($filename) = @_;
  my($headername, $headerfile, $i, $comment);

  if ($filename =~ /^(.*):"(.*)"$/) {
      ($filename, $headername) = ($1, $2);
      $headerfile = $headername;
  } elsif ($filename =~ /^(.*):<(.*)>$/) {
      ($filename, $headername) = ($1, "<$2>");
      $headerfile = $2;
  } else {
      $headername = $filename;
      $headername =~ s/\.cc$/.hh/;
      $headerfile = $headername;
  }

  my $text;
  foreach $i (@includes) {
      if (open(IN, "$i/$headerfile")) {
	  $text = <IN>;
	  close IN;
	  last;
      }
  }
  if (!$text) {
      print STDERR "$headerfile: $!\n" if $headerfile eq $filename;
      return;
  }

  my $first;
  $first = @cxx_name;
  foreach $_ (split(m{^class(?=.*\{)}m, $text)) {
    my($cxx_class) = (/^\s*(\w+)(\s|:\s).*\{/);
    next if !$cxx_class;
    push @cxx_name, $cxx_class;
    push @source_file, $filename;
    push @header_file, $headername;
    $cxx_name_to_id{$cxx_class} = @cxx_name - 1;
    if (/\A\s*\w*\s*:\s*([\w\s,]+)/) {
      my $p = $1;
      $p =~ s/\bpublic\b//g;
      push @parents, [ split(/[\s,]+/, $p) ];
    } else {
      push @parents, [];
    }
    if (/class_name.*return\s*\"([^\"]+)\"/) {
      push @click_name, $1;
    } else {
      push @click_name, "";
    }
    if (/processing.*return\s*(.*?);/) {
      my $p = $1;
      $p = $processing_constants{$p} if exists($processing_constants{$p});
      $p =~ tr/\" \t\r\n//d;
      push @processing, $p;
    } else {
      push @processing, "";
    }
    if (/flow_code.*return\s*(.*?);/) {
      my $p = $1;
      $p = $flow_code_constants{$p} if exists($flow_code_constants{$p});
      $p =~ tr/\" \t\r\n//d;
      push @flow_code, $p;
    } else {
      push @flow_code, "";
    }
    if (/\bflags\(\).*return\s*"(.*?)";/) {
      push @flags, $1;
    } else {
      push @flags, undef;
    }
  }

  # process element documentation
  my(%doc_titles);
  foreach $comment (split(m{(/\*.*?\*/)}s, $text)) {
      if ($comment =~ /^\/\*/ && $comment =~ /^[\/*\s]+=/) {
	  $comment =~ s/^\/\*\s*//g;
	  $comment =~ s/\s*\*\/$//g;
	  $comment =~ s/^ ?\* ?//gm;
	  my($title, $count);
	  while ($comment =~ m{^=(\w+)( *)(.*)([\0-\377]*?)(?=^=\w|\Z)}mg) {
	      if ($1 eq 'title') {
		  $title = $3;
	      } elsif ($1 eq 'c') {
		  $_ = $4;
		  while (/^\s*(\w+)\(/mg) {
		      $doc_titles{$1} = ($title ? $title : $1);
		  }
		  if (!%doc_titles && /^\s*([\w@]+)\s*$/) {
		      $doc_titles{$1} = ($title ? $title : $1);
		  }
		  last;
	      }
	  }
      }
  }

  # apply element documentation to element names
  for ($i = $first; $i < @processing; $i++) {
      push @doc_name, $doc_titles{$click_name[$i]};
  }

  # process ELEMENT_REQUIRES, ELEMENT_PROVIDES, and EXPORT_ELEMENT
  if (!open(IN, $filename)) {
    print STDERR "$filename: $!\n";
    return;
  }
  $text = <IN>;
  close IN;

  my($req, $prov, $exp) = ('', '', '');
  $req .= " " . $1 while $text =~ /^ELEMENT_REQUIRES\((.*)\)/mg;
  $prov .= " " . $1 while $text =~ /^ELEMENT_PROVIDES\((.*)\)/mg;
  $exp .= " " . $1 while $text =~ /^EXPORT_ELEMENT\((.*)\)/mg;
  $req =~ s/^\s+//;
  $req =~ s/"/\\"/g;
  $prov =~ s/^\s+//;
  $prov =~ s/"/\\"/g;

  # make copies of classes as required
  while ($exp =~ /(\S+)-(\S+)/g) {
      my($cxx, $click) = ($1, $2);
      for ($i = $first; $i < @processing; $i++) {
	  if ($cxx_name[$i] eq $cxx) {
	      push @click_name, $click;
	      push @cxx_name, $cxx;
	      push @doc_name, $doc_name[$i];
	      push @source_file, $source_file[$i];
	      push @header_file, $header_file[$i];
	      push @parents, $parents[$i];
	      push @processing, $processing[$i];
	      push @flow_code, $flow_code[$i];
	      push @flags, $flags[$i];
	      last;
	  }
      }
  }
  
  # add a fake class if there were no classes
  if (@cxx_name == $first && $prov) {
    push @click_name, "";
    push @cxx_name, "";
    push @doc_name, "";
    push @source_file, $filename;
    push @header_file, $headername;
    push @parents, [];
    push @processing, "";
    push @flow_code, "";
    push @flags, undef;
  }

  # apply requirements and provisions
  for ($i = $first; $i < @processing; $i++) {
    push @requirements, $req;
    push @provisions, $prov;
    
    # check to see if overloading is valid
    if ($click_name[$i] && exists($click_name_to_id{$click_name[$i]})) {
      my($j) = $click_name_to_id{$click_name[$i]};
      my($dm_a) = driver_mask($requirements[$i]);
      my($dm_b) = driver_mask($requirements[$j]);
      if (($dm_a & $dm_b) == 0) {
	# ok
      } else {
	print STDERR "invalid multiple definition of element class \`$click_name[$i]'\n";
	print STDERR $header_file[$j], ": first definition here\n";
	print STDERR $header_file[$i], ": second definition here\n";
	print STDERR "(Two classes may share a name only if they work in disjoint drivers.\nAdd explicit ELEMENT_REQUIRES() statements.)\n";
      }
    }
    $click_name_to_id{$click_name[$i]} = $i;
  }
}

sub parents_processing ($) {
    my($classid) = @_;
    return undef if !defined $classid;
    if (!$processing[$classid]) {
	my($parent);
	foreach $parent (@{$parents[$classid]}) {
	    if ($parent eq 'Element') {
		$processing[$classid] = 'a/a';
		last;
	    } elsif ($parent ne '') {
		$processing[$classid] = &parents_processing($cxx_name_to_id{$parent});
		last if $processing[$classid];
	    }
	}
    }
    return $processing[$classid];
}

sub parents_flow_code ($) {
    my($classid) = @_;
    return undef if !defined $classid;
    if (!$flow_code[$classid]) {
	my($parent);
	foreach $parent (@{$parents[$classid]}) {
	    if ($parent eq 'Element') {
		$flow_code[$classid] = 'x/x';
		last;
	    } elsif ($parent ne '') {
		$flow_code[$classid] = &parents_flow_code($cxx_name_to_id{$parent});
		last if $flow_code[$classid];
	    }
	}
    }
    return $flow_code[$classid];
}

sub parents_flags ($) {
    my($classid) = @_;
    return undef if !defined $classid;
    if (!defined $flags[$classid]) {
	my($parent);
	foreach $parent (@{$parents[$classid]}) {
	    if ($parent eq 'Element') {
		last;
	    } elsif ($parent ne '') {
		$flags[$classid] = &parents_flags($cxx_name_to_id{$parent});
		last if defined $flags[$classid];
	    }
	}
    }
    return $flags[$classid];
}

# main program: parse options
sub read_files_from ($) {
    my($fn) = @_;
    if (open(IN, ($fn eq '-' ? "<&STDIN" : $fn))) {
	my(@a, @b, $t);
	$t = <IN>;
	close IN;

	# Parse file; click-buildtool gets special treatment
	if ($t =~ /\A#.*click-buildtool findelem/) {
	    $t =~ s/^#.*//mg;
	    @a = map {
		if (/^(\S+)\s+(\S+)/) {
		    "$1:$2";
		} else {
		    $_;
		}
	    } split(/\n+/, $t);
	} else {
	    $t =~ s/^#.*//mg;
	    @a = split(/\s+/, $t);
	}
	
	foreach $t (@a) {
	    next if $t eq '';
	    if ($t =~ /[*?\[]/) {
		push @b, glob($t);
	    } else {
		push @b, $t;
	    }
	}
	
	@b;
    } else {
	print STDERR "$fn: $!\n";
	();
    }
}

sub long_option_match ($$$) {
    my($have, $want, $len) = @_;
    $have = $1 if $have =~ /^(--[^=]*)=/;
    my($hl) = length($have);
    ($hl <= length($want) && $hl >= $len && $have eq substr($want, 0, $hl));
}

sub help () {
    print STDERR <<"EOD;";
\`Click-mkelemmap' creates an elementmap file from a collection of Click
elements.

Usage: click-mkelemmap [-l | -L] [-d DIRECTORY] [-f FILE | SRCFILE]...

Each SRCFILE is a Click header file. \`-' means standard input. Default is
\`-f -' if no \`-f' or \`SRCFILE' options are supplied.

Options:
  -f, --files FILE        Read header filenames, or an \`elements.conf' file,
                          from FILE.
  -r, --provide PROV      Record provisions PROV in output.
      --webdoc DOCSTR     Record Web documentation DOCSTR in output.
  -I, --include DIR       Look for header files in DIR.
  -h, --help              Print this message and exit.

Report bugs to <click\@pdos.lcs.mit.edu>.
EOD;
    exit 0;
}

undef $/;
my(@files, @provides, $fn, $prefix, $any_files, $webdoc);
$prefix = "";

while (@ARGV) {
    $_ = shift @ARGV;
    if (/^-f$/ || long_option_match($_, '--files', 3)) {
	die "not enough arguments" if !@ARGV;
	push @files, read_files_from(shift @ARGV);
	$any_files = 1;
    } elsif (long_option_match($_, '--files', 3) && /^[^=]*=(.*)$/) {
	push @files, read_files_from($1);
	$any_files = 1;
    } elsif (/^-p$/ || long_option_match($_, '--prefix', 5)) {
	die "not enough arguments" if !@ARGV;
	$prefix = shift @ARGV;
    } elsif (long_option_match($_, '--prefix', 5) && /^[^=]*=(.*)$/) {
	$prefix = $1;
    } elsif (/^-r$/ || long_option_match($_, '--provide', 5)) {
	die "not enough arguments" if !@ARGV;
	push @provides, split(/\s+/, shift @ARGV);
    } elsif (long_option_match($_, '--provide', 5) && /^[^=]*=(.*)$/) {
	push @provides, split(/\s+/, $1);
    } elsif (/^-I$/ || long_option_match($_, '--include', 3)) {
	die "not enough arguments" if !@ARGV;
	push @includes, shift @ARGV;
    } elsif (long_option_match($_, '--include', 3) && /^[^=]*=(.*)$/) {
	push @includes, $1;
    } elsif (/^-I(.+)$/) {
	push @includes, $1;
    } elsif (long_option_match($_, '--webdoc', 3)) {
	die "not enough arguments" if !@ARGV;
	die "repeated --webdoc" if defined($webdoc);
	$webdoc = shift @ARGV;
    } elsif (long_option_match($_, '--webdoc', 3) && /^[^=]*=(.*)$/) {
	die "repeated --webdoc" if defined($webdoc);
	$webdoc = $1;
    } elsif (/^-h$/ || long_option_match($_, '--help', 3)) {
	help();
    } elsif (/^-./) {
	die "unknown option `$_'\n";
    } elsif (/^-$/) {
	push @files, "-";
	$any_files = 1;
    } else {
	push @files, glob($_);
	$any_files = 1;
    }
}
push @files, read_files_from("-") if !$any_files;

foreach $fn (@files) {
    process_file($fn);
}

umask(022);
open(OUT, ">&STDOUT");

my($sourcedir) = `/bin/pwd`;
$sourcedir =~ s/\s+$//s;
print OUT "<?xml version=\"1.0\" standalone=\"yes\"?>
<elementmap xmlns=\"http://www.lcdf.org/click/xml/\" sourcedir=\"$sourcedir\" provides=\"", join(' ', @provides), "\"";
print OUT " webdoc=\"$webdoc\"" if defined($webdoc);
print OUT ">\n";

foreach $id (sort { $click_name[$a] cmp $click_name[$b] } 0..$#click_name) {
    print OUT "<entry";

    print OUT " name=\"", $click_name[$id], "\"" if $click_name[$id];
    print OUT " cxxclass=\"", $cxx_name[$id], "\"" if $cxx_name[$id];
    print OUT " docname=\"", $doc_name[$id], "\"" if $doc_name[$id];
  
    my($hf) = $header_file[$id];
    $hf =~ s/^$prefix\/*//;
    print OUT " headerfile=\"", $hf, "\"" if $hf;

    my($sf) = $source_file[$id];
    $sf =~ s/^$prefix\/*//;
    print OUT " sourcefile=\"", $sf, "\"" if $sf;

    my($p) = $processing[$id];
    $p = parents_processing($id) if !$p;
    print OUT " processing=\"", $p, "\"" if $p;

    my($flow) = $flow_code[$id];
    $flow = parents_flow_code($id) if !$flow;
    print OUT " flowcode=\"", $flow, "\"" if $flow;

    my($flags) = $flags[$id];
    $flags = parents_flags($id) if !defined($flags);
    print OUT " flags=\"", $flags, "\"" if defined($flags);
  
    print OUT " requires=\"", $requirements[$id], "\"" if $requirements[$id];
    print OUT " provides=\"", $provisions[$id], "\"" if $provisions[$id];

    print OUT " />\n";
}

print OUT "</elementmap>\n";
close OUT;
