#!/usr/bin/perl
#
# JT-Tweak
#
# (C) 2013, 2022 ITEG IT-Engineers GmbH
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
#   http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#

use strict;

require "/usr/lib/jartools/jt-functions.pl";

$main::scriptName = "jt-tweak";

initFunctions();

initCommonOptions();
$main::processPomFiles = 0;

$main::helpMessage = '

 jt-tweak tweaks a bundle\'s MANIFEST.MF.

 The desired changes have to be specified in a script file, details far below.

 Syntax:
  '.$main::scriptName.' TweakSpec ObjectSpec [CommonOptions]

 TweakSpec := -t tweakScriptFile

'.$main::commonOptionsHelpText.'

 Tweak script details:

 A tweak script file is a text file with at least one command lines,
 and optionally comment lines resp. empty lines.

 Command lines consist of a command, white space, and command options.
 Command names are case sensitive, as are manifest header names.

 Comment lines start with a \'#\' or \';\'.

 Tweak commands are:

   setHeader headerName headerValue    
     Sets a header in the first manifest section.
     If the header was not present before, it is added.

   removeHeader headerName
     Removes the specified header from the first manifest section.
     If the header was not present before, nothing happens.

   setStanza headerName stanza
     Sets a stanza to a header that contains a comma-separated list of
     packages or services, with optional semicolon-separated attributes 
     like version="1.2.3".
     If the header or stanza was not present before, it is added.

   removeStanza headerName stanzaName
     Removes the stanza from a header that contains a comma-separated list
     of packages or services.

 Tweak command examples:
   # mark as tested
   setHeader X-Tested yes
   # remove internal comment
   removeHeader X-Internal-Comment
   # add some api package to imports
   setStanza Import-Packages spezial.api.foo;version="(1.2.3"
   # remove internal api package from exports
   removeStanza Exported-Packages internal.api.foo

';

$main::optionList = $main::commonOptionList . "t:";
getopts( $main::optionList, \%main::opts );

parseCommonOptions();

# parse my own options
my $tweakScriptFile = "";
if ( defined $main::opts{"t"} ) {
  $tweakScriptFile = $main::opts{"t"};
}

# check tweak script option
if ( $tweakScriptFile eq "" ) {
  errorExit("FATAL: No tweakScriptFile specified with -t.");
}
if ( ! -f $tweakScriptFile ) {
  errorExit("FATAL: Specified tweakScriptFile does not exist: ".$tweakScriptFile);
}

# read jar meta infos
if ($main::processManifest) {
  readManifest();
}
if ($main::processPomFiles) {
  #readPomFiles();
  print "WARNING: jt-tweak does not change pom properties yet.\n";
}


my $nrCommandsProcessed = 0;
my $nrCommandsApplied = 0; # = processed and effective 
my $nrCommandsIgnored = 0;

if ($main::processManifest) {

  # read twaekscript
  if ($main::verbosity gt 0) { print "Reading tweakScriptFile ".$tweakScriptFile."\n"; }
  my $tweakScriptContent = readCompleteFile($tweakScriptFile);
  if ($main::verbosity gt 2) { print "Read ".length($tweakScriptContent)." chars from ".$tweakScriptFile."\n"; }
  # first unify linebreaks
  $tweakScriptContent =~ s/\r\n/\n/g;
  $tweakScriptContent =~ s/\r/\n/g;
  
  # process tweak script
  if ($main::verbosity gt 0) { print "Processing tweakScriptFile.\n"; }
  my @lines = split(/\n/, $tweakScriptContent);
  my $lineNr = 0;

  foreach my $line (@lines) {
    $lineNr++;
    if (length($line) eq 0) { next; }
    if ($line =~ m/^#/) { next; }
    if ($line =~ m/^;/) { next; }
    if (not($line =~ /^[a-zA-Z]+\s+.+/)) {
      print "WARNING: Ignoring illegal script line at ".$tweakScriptFile.":".$lineNr."\n";
      $nrCommandsIgnored++;
      next;
    }
    my @commandParts = split(/\s+/, $line);
    my $commandName = shift @commandParts;
    my $commandProcessed = 0;
    if ($main::verbosity gt 2) { print "Processing command '".$commandName."'.\n"; }
  
    if ($commandName eq "setHeader") {
      $commandProcessed++;
      my $headerName = shift @commandParts;
      my $newHeaderValue = join(" ", @commandParts);
      if ( grep(/^$headerName$/, @main::manifestNames) ) {
        if ($main::manifestValues{$headerName} eq $newHeaderValue) {
          if ($main::verbosity gt 1) { print "setHeader noneffective: header '".$headerName."' already has value '".$newHeaderValue."'.\n"; }
        } else {
          if ($main::verbosity gt 2) { print "setHeader: changing header '".$headerName."' to value '".$newHeaderValue."'.\n"; }
          $main::manifestValues{$headerName} = $newHeaderValue;
          $nrCommandsApplied++;
        }
      } else {
        if ($main::verbosity gt 2) { print "setHeader: adding header '".$headerName."' with value '".$newHeaderValue."'.\n"; }
        push @main::manifestNames, $headerName;
        $main::manifestValues{$headerName} = $newHeaderValue;
        $nrCommandsApplied++;
      }
    }
  
    if ($commandName eq "removeHeader") {
      $commandProcessed++;
      my $headerNameToRemove = shift @commandParts;
      if ( grep(/^$headerNameToRemove$/, @main::manifestNames) ) {
        if ($main::verbosity gt 2) { print "removeHeader: removing header '".$headerNameToRemove."'.\n"; }
        # search position
        my $indexToRemove = -1;
        my $i = 0;
        foreach my $headerName(@main::manifestNames) {
          if ($headerName eq $headerNameToRemove) {
            $indexToRemove = $i;
          }
          $i++;
        }
        # actually remove
        if ($indexToRemove >= 0) {
          splice(@main::manifestNames, $indexToRemove, 1);
        }
        undef $main::manifestValues{$headerNameToRemove};
        $nrCommandsApplied++;
      } else {
        if ($main::verbosity gt 1) { print "removeHeader noneffective: no header '".$headerNameToRemove."' to remove.\n"; }
      }
    }

    if ($commandName eq "setStanza") {
      $commandProcessed++;
      my $headerName = shift @commandParts;
      my $newStanza = join(" ", @commandParts);
      my ($newStanzaName, $newStanzaProperties, $newStanzaVersion) = splitPackageSpec($newStanza);
      my $newHeaderValue = $main::manifestValues{$headerName};
      if ( grep(/^$headerName$/, @main::manifestNames) ) {
        if ($main::verbosity gt 2) { print "setStanza: processing header '".$headerName."' to include new or updated stanza named '".$newStanzaName."' ...\n"; }
        # patch headerValue
        my $oldHeaderValue = $main::manifestValues{$headerName};
        my @oldStanzas = splitPackageList($oldHeaderValue);
        my @newStanzas = ();
        my $newStanzaSatisfied = 0;
        foreach my $oldStanza (@oldStanzas) {
          my ($oldStanzaName, $oldStanzaProperties, $oldStanzaVersion) = splitPackageSpec($oldStanza);
          #if ($main::verbosity gt 3) { print "setStanza: oldStanzaName = '".$oldStanzaName."' ...\n"; }
          if ($oldStanzaName eq $newStanzaName) {
            if ($oldStanza eq $newStanza) {
              if ($main::verbosity gt 2) { print "setStanza noneffective: stanza '".$oldStanza."' already in header '".$headerName."' with requested details.\n"; }
            } else {
              if ($main::verbosity gt 2) { print "setStanza: replacing old stanza '".$oldStanza."' with '".$newStanza."'.\n"; }
            }
            $newStanzaSatisfied++;
            push @newStanzas, $newStanza;
          } else {
            push @newStanzas, $oldStanza;
          }
        }
        if (!$newStanzaSatisfied) {
          if ($main::verbosity gt 2) { print "setStanza: adding new stanza '".$newStanza."'.\n"; }
          push @newStanzas, $newStanza;
        }
        $newHeaderValue = join(",", @newStanzas);
        if ($newHeaderValue eq $oldHeaderValue) {
          if ($main::verbosity gt 1) { print "setStanza noneffective: header '".$headerName."' already contains stanza '".$newStanza."'.\n"; }
        } else {
          if ($main::verbosity gt 2) { print "setStanza: changing header '".$headerName."' to value '".$newHeaderValue."'.\n"; }
          $main::manifestValues{$headerName} = $newHeaderValue;
          $nrCommandsApplied++;
        }
      } else {
        if ($main::verbosity gt 2) { print "setStanza: adding header '".$headerName."' with value '".$newStanza."'.\n"; }
        push @main::manifestNames, $headerName;
        $newHeaderValue = $newStanza;
        $main::manifestValues{$headerName} = $newHeaderValue;
        $nrCommandsApplied++;
      }
    }

    if ($commandName eq "removeStanza") {
      $commandProcessed++;
      my $headerName = shift @commandParts;
      my $stanzaNameToRemove = join(" ", @commandParts);
      if ( grep(/^$headerName$/, @main::manifestNames) ) {
        if ($main::verbosity gt 2) { print "removeStanza: changing header '".$headerName."' not to include stanza named '".$stanzaNameToRemove."' ...\n"; }
        # patch headerValue
        my @oldStanzas = splitPackageList($main::manifestValues{$headerName});
        my @newStanzas = ();
        my $oldStanzaRemoved = 0;
        foreach my $oldStanza (@oldStanzas) {
          my ($oldStanzaName, $oldStanzaProperties, $oldStanzaVersion) = splitPackageSpec($oldStanza);
          #if ($main::verbosity gt 3) { print "removeStanza: oldStanzaName = '".$oldStanzaName."' ...\n"; }
          if ($oldStanzaName eq $stanzaNameToRemove) {
            if ($main::verbosity gt 2) { print "removeStanza: removing old stanza '".$oldStanza."'.\n"; }
            $oldStanzaRemoved++;
          } else {
            push @newStanzas, $oldStanza;
          }
        }
        if ($oldStanzaRemoved) {
          my $newHeaderValue = join(",", @newStanzas);
          if ($main::verbosity gt 2) { print "removeStanza: changing header '".$headerName."' to value '".$newHeaderValue."'.\n"; }
          $main::manifestValues{$headerName} = $newHeaderValue;
          $nrCommandsApplied++;
        } else {
          if ($main::verbosity gt 1) { print "removeStanza noneffective: header '".$headerName."' did not contain an old stanza '".$stanzaNameToRemove."' to remove.\n"; }
        }
      } else {
        if ($main::verbosity gt 1) { print "removeStanza noneffective: no header '".$headerName."' to change.\n"; }
      }
    }
  
    if ($commandProcessed) {
      $nrCommandsProcessed++;
    } else {
      print "WARNING: Ignoring unkown command '".$commandName."' in line ".$tweakScriptFile.":".$lineNr."\n";
      $nrCommandsIgnored++;
    }

  } # end for $line

  if ($main::verbosity gt 0) { print "Successfully processed tweakScriptFile. ".$nrCommandsProcessed."/".$nrCommandsApplied."/".$nrCommandsIgnored." commands processed/applied/ignored.\n"; }
  
} # end if processManifest

if ($nrCommandsApplied gt 0) {
  print "Writing changed manifest.\n";
  # write changed jar meta infos
  if ($main::processManifest) {
    recollectManifestContent();
    writeManifest();
  }
} else {
  print "No command effects applied, not writing unchanged manifest.\n";
}

eraseTempDir();

print "\nDone processing ".$nrCommandsProcessed." commands, ".$nrCommandsApplied." of which may have had effects.\n";
if ($nrCommandsIgnored gt 0) {
  print "WARNING: ".$nrCommandsIgnored." command lines had to be ignored.\n";
}

exit 0;

