uninclude

#!/usr/bin/perl
# uninclude generated from pcpp-0.11/uninclude.pl 2024-08-29

# included ".version.pl"
our $PACKAGE = "pcpp";
our $VERSION = "0.11";
our $AUTHOR = "R.Jaksa 2008,2024 GPLv3";
our $SUBVERSION = "";
# end ".version.pl"

# included ".uninclude.built.pl"
our $BUILT = "2024-08-29";
# end ".uninclude.built.pl"

$HELP=<<EOF;

NAME
    uninclude - remove included parts from pcpp generated files

USAGE
    uninclude [OPTIONS] file

DESCRIPTION
    Removes all included parts from a pcpp generated file.  Depends
    on pcpp watermarking.  Can return back the #include statements,
    but they are flattened to a single level direct includes.

OPTIONS
    -h  This help.
    -v  Verbose.
    -l  Just list all includes, indentation by the include level.
   -ni  Don't return back #include statements.

VERSION
    $PACKAGE-$VERSION$SUBVERSION CK($AUTHOR) CK(built $BUILT)

EOF

# ------------------------------------------------------------------------------------- ARGV

# included "color.pl"
# color.pl generated from libpl-0.1/src/color.pl 2024-08-27
{ # TERMINAL COLORS

our $CR_="\033[31m"; # color red
our $CG_="\033[32m"; # color green
our $CM_="\033[35m"; # color magenta
our $CC_="\033[36m"; # color cyan
our $CW_="\033[37m"; # color white
our $CK_="\033[90m"; # color black
our $CD_="\033[0m";  # color default

# return length of string without escape sequences
our sub esclen {
  my $s = shift;
  $s =~ s/\033\[[0-9]+m//g;
  return length $s; }

} # R.Jaksa 2003,2024 GPLv3
# end "color.pl"

# included "array.pl"
# array.pl generated from libpl-0.1/src/array.pl 2024-08-29
{ # PERL ARRAYS SUPPORT

# inar newgen, returns index+1 instead of simple 0/1
# inar(\@a,$s) - check whether the string is in the array, return its idx+1 or zero (1st match)
our sub inar {
  my $a=$_[0];	# array ref
  my $s=$_[1];	# string
  for(my $i=0;$i<=$#{$a};$i++) { return $i+1 if $$a[$i] eq $s; }
  return 0; }

# clar(\@a,$s) - clear the string in the array (1st match), return its idx+1 or zero
our sub clar {
  my $a=$_[0];	# array ref
  my $s=$_[1];	# string
  for(my $i=0;$i<=$#{$a};$i++) {
    if($$a[$i] eq $s) {
      $$a[$i] = "";
      return $i+1; }}
  return 0; }

# pushq(\@a,$s) - string push unique, only if not there
our sub pushq {
  my $a=$_[0];	# array ref
  my $s=$_[1];	# string
  return if inar $a,$s;
  push @{$a},$s; }

# inar \@a,$s; checks whether the string $s is in an array @a
# sub inar { for(@{$_[0]}) { return 1 if $_ eq $_[1] } return 0 }

# delar \@a,$s; removes 1st instance of the string $s from an array @a, i.e. set it to empty ""
sub delar { for(@{$_[0]}) { $_="" if $_ eq $_[1] }}

# return the length of array without empty "" elements
sub lenar { my $i=0; for(@{$_[0]}) { $i++ if $_ ne "" } return $i }

} # R.Jaksa 2008,2024 GPLv3
# end "array.pl"

# included "print.pl"
# print.pl generated from libpl-0.1/src/print.pl 2024-08-29
{

# stderr prints, 'e' for error, allows the "grep print" to find it
our sub eprint  { print  STDERR @_ }
our sub eprintf { printf STDERR @_ }

}
# end "print.pl"

# included "printhelp.pl"
# printhelp.pl generated from helpman-0.3/src/printhelp.pl 2024-08-27
{ # PRINT A MAN-STYLE HELP
  # require color.pl

our sub printhelp {
  my $help = $_[0];

  # we will store parsed text elements in this private hash
  my %STR;				# private substitutions content strings
  my $id=0;				# last ID

  # in the text these elements will be repled by this string
  my ($L,$R) = ("\#\#\>","\<\#\#");	# private left/right brace
  my sub REP { return "$L$_[0]$R"; }	# return complete private substitution identifier

  # ------------------------------------------------------------------------ PREPROCESSOR

  $help =~ s/(\n\#.*)*\n/\n/g;		# skip commented-out lines
  $help =~ s/\\\)/REP "brc2"/eg;	# save escaped bracket

  # ------------------------------------------------------------------------------ PARSER

  # CC(text)
  my $colors = "CWRDKGMB";
  my $RE1 = qr/(\((([^()]|(?-3))*)\))/x; # () group, $1=withparens, $2=without
  $STR{$id++}=$4 while $help =~ s/([^A-Z0-9])(C[$colors])$RE1/$1.REP("c$2$id")/e;

  # options lists, like -option ...
  $STR{$id++}=$2 while $help =~ s/(\n[ ]*)(-[a-zA-Z0-9]+(\[?[ =][A-Z]{2,}(x[A-Z]{2,})?\]?)?)([ \t])/$1.REP("op$id").$5/e;

  # bracketed uppercase words, like [WORD]
  $STR{$id++}="$1$2" while $help =~ s/\[([+-])?([A-Z]+)\]/REP("br$id")/e;

  # plain uppercase words, like sections headers
  $STR{$id++}=$2 while $help =~ s/(\n|[ \t])(([A-Z_\/-]+[ ]?){4,})/$1.REP("pl$id")/e;

  # --------------------------------------------------------------------------- PROCESSOR

  # re-substitute
  $help =~ s/${L}pl([0-9]+)$R/$CC_$STR{$1}$CD_/g;	# plain uppercase words
  $help =~ s/${L}op([0-9]+)$R/$CC_$STR{$1}$CD_/g;	# options
  $help =~ s/${L}br([0-9]+)$R/\[$CC_$STR{$1}$CD_\]/g;	# bracketed words

  # CC(text)
  my %cc; $cc{$_} = ${"C".$_."_"} for split //,$colors;
  $help =~ s/${L}cC([$colors])([0-9]+)$R/$cc{$1}$STR{$2}$CD_/g;

  # escapes
  $help =~ s/${L}brc2$R/)/g;

  # ----------------------------------------------------------------------- POSTPROCESSOR

  # star bullets
  $help =~ s/\n(\h\h+)\* /\n$1$CC_\*$CD_ /g;

  print $help; }

} # R.Jaksa 2015,2019,2024 GPLv3
# end "printhelp.pl"

# included "mode.pl"

# included "path.pl"
# path.pl generated from libpl-0.1/src/path.pl 2024-08-29
{ # FILESYSTEM PATHS ROUTINES

# return the dirname from the path
# ccc/aaa/bbb  -> ccc/aaa
# ccc/aaa/bbb/ -> ccc/aaa
sub dirname { my $p=$_[0]; $p=~s/\/*$//; $p=~s/\/[^\/]*$//; return $p }

# return file suffix
sub sx { my $s=$_[0]; $s=~s/^.*\.//; return $s }

# beautify($path,$cwd)
our sub beautify {
  my $qcwd = quotemeta $_[1];								# CWD
  my $p1=$_[1]; $p1=~s/\/*$//; $p1=~s/[^\/]*$//; $p1=~s/\/*$//; my $qp1 = quotemeta $p1;# parent
  my $p2=$p1; $p2=~s/\/*$//; $p2=~s/[^\/]*$//; $p2=~s/\/*$//; my $qp2 = quotemeta $p2;	# grandparent
  my $qh = quotemeta $ENV{HOME};							# home
  my $p = $_[0];

  $p =~ s/^$qcwd\/// if $qcwd;		# /abc/def/ghi -> ghi if cwd=/abc/def
  $p =~ s/^$qp1\//..\// if $qp1;	# /abc/def/ghi -> ../ghi if cwd=/abc/def/xyz
  $p =~ s/^$qp2\//..\/..\// if $qp2;	# /abc/def/ghi -> ../../ghi if cwd=/abc/def/xyz/ijk
  $p =~ s/^$qh\//~\// if $qh;		# /home/abc/xyz -> ~/xyz

  $p =~ s/^\.\///;			# remove the leading "./"

  return $p }

# just remove the leading "./" from the path
sub undot { my $p=$_[0]; $p=~s/^\.\///; return $p }

} # R.Jaksa 2024 GPLv3
# end "path.pl"

{

# return the file mode by the suffix of filename: pl, py or c
my sub getbysx {
  return "pl" if $_[0] eq "pl";
  return "py" if $_[0] eq "py";
  return "c"  if $_[0] eq "c++";
  return "c"  if $_[0] eq "c"; }

# return the mode by the filename, or return the default perl mode
our sub getmode {
  my $sx = sx $_[0];
  my $mode = getbysx $sx;
     $mode = "pl" if not $mode;
  return $mode }

# auto-identify the mode of a list of files by the first identifiable
# file suffix, or return the default perl mode
our sub firstmode {
  my $mode;
  for(@{$_[0]}) {
    $mode = getbysx sx $_;
    last if $mode }
  $mode = "pl" if not $mode;
  return $mode }

# return the comment identifier string by the mode: # or //
our sub getsy {
  return "//" if $_[0] eq "c";
  return "#" }

} # R.Jaksa 2024 GPLv3
# end "mode.pl"

# TODO: uninclude only specified file

for(@ARGV) { if($_ eq "-h")  { printhelp $HELP; exit 0 }}
for(@ARGV) { if($_ eq "-v")  { $VERBOSE=1; $_=""; last }}
for(@ARGV) { if($_ eq "-l")  { $LIST=1; $_=""; last }}
for(@ARGV) { if($_ eq "-ni") { $NOINC=1; $_=""; last }}

# input file
for(@ARGV) { $FILE=$_ and last if $_ ne "" and -f $_ }

# no input file
if(not $FILE) { eprint "No input file specified.\n"; exit(1) }

# ------------------------------------------------------------------------------------- MAIN

our $MODE = getmode $FILE; # input file mode: pl, py or c
our $SY = getsy $MODE;	   # comment identifier
our $SYQ = quotemeta $SY;

# read the file
my @included;				# at-current-line list of original files we are inc.
my @body = split /\n/,`cat $FILE`;	# full text

# remove includes - replace included content with :DEL tags
for my $i (0..$#body) {
  my $file="";	# active for include directive line only, included filename
  my $end=0;	# whether we are on the end directive

  # start of included section
  if($body[$i] =~ /^\h*$SYQ\h*included\h+\"([^\"]+)\"/) {
    push @included,$1; $file=$1;
    my $n = lenar \@included,$1;
    my $sp = "  " x (lenar(\@included,$1)-1);
    if($VERBOSE) { eprint "${CK_}# uninclude$CD_ $sp$CC_$file$CD_\n" }
    if($LIST) { print "$sp$file\n" }}

  # end of section
  if($body[$i] =~ /^\h*$SYQ\h*end\h+\"([^\"]+)\"/) {
    delar \@included,$1; $end=1; }

  # return the #include directive
  my $n = lenar \@included,$1;
  if($file ne "") {
    if($NOINC) { $body[$i] = "$SY:DEL" }
    else       { $body[$i] = "$SY include \"$file\"" }}

  # remove the line, or not
  elsif($n>0 or $end) {
    $body[$i] = "$SY:DEL" }}

# skip the rest in the list mode
exit if $LIST;

# remove :DEL lines and accompanying empty lines
my @output; my $i=0;
while($i<=$#body) {
  if($body[$i]=~/^$SYQ:DEL/) {
    push @output,"" if $body[$i-1]!~/^\h*$/; # add empty line if not already there
    $i++ while $body[$i]=~/^$SYQ:DEL/ or $body[$i]=~/^\h*$/ } # skip DELs
  push @output,$body[$i++] }

# put together multiple #include
for my $i (0..$#output) {
  $output[$i+1]="$SY:DEL" if $output[$i]   =~ /^$SYQ include \"/ and
                             $output[$i+1] =~ /^\h*$/ and
                             $output[$i+2] =~ /^$SYQ include \"/ }

# TODO: group consecutive includes
# TODO: do quoting according to original (needs pcpp update)

# assembly of the final body string
my $out;
for my $i (0..$#output) {
  if($output[$i] =~ /^$SYQ:DEL/) { next }
  $out .= "$output[$i]\n" }

# emit the output
print $out;

# ----------------------------------------------------------------------- R.Jaksa 2024 GPLv3