mk_modules.pl

This a framework to test new ideas in transmission technology. Actual development is a LDPC-coder in

#!/usr/bin/perl -w
# mkreadme - a very simple document-extractor for modules of the 
# software-radio...
#
# First version by ineiti in 2003
# 04/03/04 - ineiti - added an empty-line detector in config- and stats
#                     structures...
# 04/03/08 - ineiti - fixed some bugs with certain main/module configurations
#

if ( $#ARGV < 0 ){
  die "Give the directory name as argument"
}
getType( $ARGV[0] );

# Tries to look at the directory and to decide what to do..
sub getType{
  my $d = shift;
  my $make = `cat $d/Makefile`;
  my @modules = `grep -l "swr_cdb_register_spc" $d/*.c`;
  my ($name) = ( $make =~ /MODULE_NAME\s*=\s*(\w*)/ );
  my $main = "$d/$name.c";
  chop( @modules );

  # if the file defined in the MAKEFILE doesn't exist, we still can
  # try to find a file that contains "^module_init", which would qualify
  # it as the main-file...
  if ( !stat( $main ) ){
    $main_old = $main;
    $main = `grep -l "^module_init.*(" $d/*c`;
    chop( $main );
    if ( !stat( $main ) ){
      die( "Hmm, $main_old doesn't exist and there seems to be no module\n".
	   "declaring module_init... This is BAD\n" );
    }
  }

  # And all this to cut out the $main from @modules...
  $modules = ":" . join( "::", @modules ) . ":";
  $modules =~ s/:$main://;
  $modules =~ s/:([^:])/$1/g;
  @modules = split( /:/, $modules );
  if ( @modules ){
    getModules( $name, $main, @modules );
  } else {
    writeModuleHeaderTxt( getBlocks( $main ) );
  }

  return;
}


# Takes information from main and other modules
sub getModules{
  my ( $name, $main, @modules ) = @_;

  my ( $desc ) = getMain( $main );
  print "$name\n";
  for ($i=0; $i<length( $name ); $i++){
    print "=";
  }
  print "\n\n$desc\n\n\n";
  foreach $module ( @modules ){
    writeModuleHeaderTxt( getBlocks( $module ) );
  }
}

# Searches for a comment on the module. The idea is that the
# first /** starts a comment, and that all other headers have
# a /\*{3,} to begin with.
sub getDesc{
  my $file = shift;
  my ( $desc ) = ( $file =~ /\/\*\*([^\*].*?)\*\//s );
  $desc =~ s/\n\s*\*( |)/\n/g;
  $desc =~ s/\s*$//;
  return $desc;
}

# takes a file-name and extrudes:
# name - by looking for swr_cdb_register_spc)
# description - by looking for the first /** ... */ comment
# config - by searching for { ... }config_t
# stats - by searching for { ... }stats_t
sub getBlocks{
  my $fname = shift;
  open( SOURCE, "<$fname" ) || die ( "Couldn't open input-file: $! $fname\n" );
  undef $/;
  my $file = <SOURCE>;

  my ($name) = ( $file =~ /swr_cdb_register_spc\(.*\"(.*)\".*\)/ );
  my $desc = getDesc( $file );

  my ($config) = ( $file =~ /\{\s*([^\}]*)\}\s*config_t/ );

  my ($stats) = ( $file =~ /\{\s*([^\}]*)\}\s*stats_t/ );

  my @inputs = countPuts( $file =~ /\n\s*UM_INPUT\(\s*SIG_(.*),[^;]*/g );
  my @outputs = countPuts( $file =~ /\n\s*UM_OUTPUT\(\s*SIG_(.*),[^;]*/g );

  close SOURCE;

  my %ret = ( name => $name,
	      desc => $desc,
	      config => $config,
	      stats => $stats,
	      inputs => [@inputs],
	      outputs => [@outputs] );
  return \%ret;
}


# Reads the comment of the main-module
sub getMain{
  my $fname = shift;

  open( SOURCE, "<$fname" ) || die ( "Couldn't open input-file $!\n" );
  undef $/;
  my $file = <SOURCE>;
  my $desc = getDesc( $file );

  return $desc;
}


# Counts the occurences of inputs and outputs and puts them
# nicely together
sub countPuts{
  my @p = @_;
  my @puts;
  my $c = 0;
  my $i;
  if ( @p ){
    my $last = $p[0];
    push @p, "";
    foreach $i ( @p ){
      if ( $i eq $last ){
	$c++;
      } else {
	if ( $c > 1 ){
	  push @puts, "$last" . "[$c]";
	} else {
	  push @puts, "$last";
	}
	$last = $i;
	$c = 1;
      }
    }
    return @puts;
  } else {
    return;
  }
}

# takes either config or stats and returns a hash indexed with
# the name and containing ( type, default, description )
sub getArgs{
  my ( $desc, $type, $name, $l, $d, $def, %args );

  foreach $l ( split( /\n/, shift ) ){
    # if there is a description
    if ( $l !~ /(\/\/|;)/ ){
      # empty line...
    } elsif ( ($d, $d, $d) = ( $l =~ /^\s*(\/\/|\*)( |)(.*)/ ) ){
      $desc .= $d . "\n";
    } else {
      ($type, $name) = ( $l =~ /^\s*([^\s]*)\s*([^;]*)/ );
      if ( !( ($def) = ( $l =~ /\/\/\s*(.*)/ ) ) ){
	$def = "undef";
      }
      $desc =~ s/\n$//;
      $args{$name} = [$type, $desc, $def];
      $desc = "";
    }
  }
  return \%args;
}


# Takes a reference to a config-hash and make a nice txt-table
sub writeConfigTxt{
  my $cl = shift;
  my ( $name, @c );
  if ( keys %{$cl} ){
    print "Config:\n";
    foreach $name ( sort keys %{$cl} ){
      @c = @{${$cl}{$name}};
      $c[1] =~ s/\n/\n\t\t/g;
      print "\t$name<$c[0]>: $c[2]\n\t\t$c[1]\n\n";
    }
    print "\n";
  }
}


# Takes a reference to a stats-hash and make a nice txt-table
sub writeStatsTxt{
  my $cl = shift;
  my ( $name, @c );
  if ( keys %{$cl} ){
    print "Stats:\n";
    foreach $name ( sort keys %{$cl} ){
      @c = @{${$cl}{$name}};
      $c[1] =~ s/\n/\n\t\t/g;
      print "\t$name<$c[0]>:\n\t\t$c[1]\n\n";
    }
    print "\n";
  }
}


# Writes the name and the description of a module
sub writeModuleHeaderTxt{
  my $arg = shift;
  my $name = $arg->{name};
  my $desc = $arg->{desc};
  my $inputs = $arg->{inputs};
  my $outputs = $arg->{outputs};
  my ( $i, $last, $p, $c );
  print "$name\n";
  for ($i=0; $i<length( $name ); $i++){
    print "-";
  }
  print "\n$desc\n\n";
  if ( @{$inputs} ){
    print "Inputs:\n\t", join( "\n\t", @{$inputs} ), "\n\n";
  }
  if ( @{$outputs} ){
    print "outputs:\n\t", join( "\n\t", @{$outputs} ), "\n\n";
  }
  writeConfigTxt( getArgs( $arg->{config} ) );
  writeStatsTxt( getArgs( $arg->{stats} ) );
}