#! /usr/bin/perl

=head1 NAME

ycpmakedep - find out YaST import dependencies

=head1 SYNOPSIS

  ycpmakedep -h|--help|--man
  ycpmakedep [-I <incpath> -M <modpath> -M ...] [--prefix <prefix>]
  ycpmakedep {--modules [--clusters] | --packages} [--topdown]

=head1 AUTHOR

Martin Vidner <mvidner@suse.cz>

=cut

use strict;
use warnings;
use diagnostics;
use IO qw(File);
use Getopt::Long;
use Pod::Usage;

my $help = 0;
my $man = 0;

my $prefix = "/usr";

my %search_paths =
    (
     "INCLUDE" => [],
     "MODULE" =>  [],
    );

# what should be output
# makefile:
# dot:
my ($modgraph, $clusters) = (0, 0);
my $pkggraph = 0;
my $topdown = 0;

Getopt::Long::Configure ("bundling");
GetOptions (
	    "help|h" => \$help,
	    "man" => \$man,
	    "modules|m" => \$modgraph,
	    "clusters|c" => \$clusters,
	    "packages|p" => \$pkggraph,
	    "topdown|t" => \$topdown,
	    "include-path|I=s" => $search_paths{INCLUDE},
	    "module-path|M=s" => $search_paths{MODULE},
	    "prefix=s" => \$prefix,
	   ) or pod2usage (2);
pod2usage (1) if $help;
pod2usage (-exitstatus => 0, -verbose => 2) if $man;

my $y2dir = "$prefix/share/YaST2";
my %std_search_paths =
    (
     "INCLUDE" => [ "$y2dir/include" ],
     "MODULE" =>  ["$y2dir/modules" ],
    );

my $makefile = !($modgraph || $pkggraph);

# prevent include cycles :-(
#my %includes;

sub progress (@)
{
    if (!$makefile)
    {
	print STDERR @_;
    }
}

# scans $pathname for import statements, processing includes
# pathname - current file
# includes - what include files are open
sub get_imports ($$);
sub get_imports ($$)
{
    my ($pathname, $r_includes) = @_;
    my @result;

    print STDERR " I $pathname\n";

    # has this one been processed?
    if ($r_includes->{$pathname})
    {
	print STDERR "  Cycle! Returning.\n";
	return ();
    }

    my $F = new IO::File ($pathname) or die "Cannot open $pathname: $!";
    # we have seen it already
    $r_includes->{$pathname} = 1;

    while (defined ($_ = <$F>))
    {
	# YCP import
	if (m/^\s*import\s*"(.*)";/)
	{
	    push @result, $1;
	}
	# Perl import
	elsif (m/^\s*YaST::YCP::Import\s*\(?\s*"(.*)"\)?;/)
	{
	    push @result, $1 unless ($1 eq "SCR");
	}
	elsif (m/^\s*include\s*"(.*)";/)
	{
	    my $inc = "$y2dir/include/$1";
	    push (@result, get_imports ($inc, $r_includes));
	}
    }
    $F->close ();
    delete $r_includes->{$pathname};
    return @result;
}

# type - "INCLUDE" or "IMPORT"
# if not found in the search path,
# returns "" and for INCLUDE also reports error
# TODO check that it corresponds to ycpc search order
sub find_file ($$)
{
    my ($type, $what) = @_;
    my @where = (".", @{$search_paths{$type}}, @{$std_search_paths{$type}});
    foreach my $path (@where)
    {
	if (-f "$path/$what")
	{
	    return "$path/$what";
	}
    }
    # not found
    if ($type eq "INCLUDE")
    {
	local @, = ":";
	print STDERR "File '$what' not found in @where\n";
    }
    return "";
}

sub ycp2ybc ($)
{
    my $name = shift;
    $name =~ s/ycp$/ybc/;
    return $name;
}

# scans $pathname for import statements, processing includes
# returns a list of ybc pathnames
# pathname - current file
# r_includes - what include files are open in the recursion
sub mf_imports ($$);
sub mf_imports ($$)
{
    my ($pathname, $r_includes) = @_;
    my @result;

    progress " I $pathname\n";

    # has this one been processed?
    if ($r_includes->{$pathname})
    {
	progress "  Cycle! Returning.\n";
	return ();
    }

    my $F = new IO::File ($pathname) or die "Cannot open $pathname: $!";
    # we have seen it already
    $r_includes->{$pathname} = 1;

    my $in_comment = 0;
    while (defined ($_ = <$F>))
    {
	# /* */ comment handling, still line oriented
	if (m{/\*})
	{
	    $in_comment = 1;
	}
	if ($in_comment)
	{
	    $in_comment = ! m{\*/};
	    next;
	}

	# import
	# what if the module is not in YCP?
	if (m/^\s*import\s*"(.*)";/)
	{
	    my $module = find_file ("MODULE", "$1.ycp");
	    push (@result, ycp2ybc ($module)) if $module;
	}
	elsif (m/^\s*include\s*"(.*)";/)
	{
	    my $inc = find_file ("INCLUDE", $1);
	    push (@result, $inc, mf_imports ($inc, $r_includes));
	}
    }
    $F->close ();
    delete $r_includes->{$pathname};
    return @result;
}

# main_module: filename, will be open and output only as is
sub mf_module ($)
{
    my $main_module = shift;
    my @deps = mf_imports ($main_module, {});
    print ycp2ybc($main_module), ":";
    foreach (@deps)
    {
	print " \\\n\t$_";
    }
    print "\n\n";
}

# main function for makefile output
sub output_makefile
{
    # not all of these are modules, we have to filter
    foreach my $ycpfile (glob "*.ycp")
    {
	my $is_module = 0;
	open F, $ycpfile or die $!;
	while (defined ($_ = <F>))
	{
	    if (m/^\s*module\s*".*";/)
	    {
		$is_module = 1;
		last;
	    }
	}
	close F;
	next unless $is_module;

	mf_module $ycpfile;
    }
}

sub output_dot
{
    print "digraph \"import\" {\n";
    print "rankdir=LR;\n" unless ($topdown);
    print "size=\"16,11\"; rotate=90;\n";
    my %pkg2mod = ();		# hash of lists
    my %mod2pkg = ();		# hash of strings
    my %dep = ();		# hash of lists
    foreach (glob ("$y2dir/modules/{*,*/*}.{ycp,pm}"))
    {
	my $module = $_;
	my $rpm = `rpm -qf --qf \%{name} $module`;
	#    chomp $rpm;
	#    $rpm =~ s/[0-9.-]*$//;
	chomp $rpm;
	$module =~ s:$y2dir/modules/(.*)\.[^.]*:$1:;
	$module =~ s{/}{::}g;
	print STDERR "M $module\n";
	$mod2pkg{$module} = $rpm;
	push @{$pkg2mod{$rpm}}, $module;

	# reset before processing includes
	#    %includes = ();
	my @imported = get_imports ($_, {});
	foreach my $i (@imported)
	{
	    push @{$dep{$module}}, $i;
	}
    }

    while (my ($module, $deps_r) = each %dep)
    {
	foreach (@{$deps_r})
	{
	    print "  \"$module\" -> \"$_\"\n" if $modgraph;
	    print "  \"$mod2pkg{$module}\" -> \"$mod2pkg{$_}\"\n" if $pkggraph;
	}
    }

    print "\n";
    # rpm clusters
    if ($clusters)
    {
	while (my ($pkg, $modules_r) = each %pkg2mod)
	{
	    print "  subgraph \"cluster-$pkg\" {\n";
	    foreach (@{$modules_r})
	    {
		print "    \"$_\";\n";
	    }
	    print "  }\n";
	}
    }
    print "}\n";
}

if ($makefile)
{
    output_makefile;
}
else
{
    output_dot;
}
