#!C:/PERL/BIN/perl -w
#!/bin/perl -w
#!/usr/bin/perl -w
#
#@(#) copy_menu.pl - v1.0.1 - Copies a Menu and its Scripts to another name.
         $version = 'v1.0.1';
#@(#) Copyright (C)2005 Bob Stockler, All Rights Reserved - 10/10/2005
#
# NOTE:  On Action Command Lines all backslashes (except \r) will be converted
#        to slashes (filePro on Windows doesn't mind).
#
# NOTE:  Legacy Menus (those of size 2801 bytes), if copied, will be converted
#        to the current menu style (4719 bytes), with no password.
#
# All prompts are written to the standard error output.
#
# See "User Definable Parameters" below to custom tailor the program.
#
# This program respects FPPROG, FPMENU and FPCONFIG but gives precedence
# to PFPROG, PFMENU and PFCONFIG.  All references hereafter will refer to
# these by their "PF" names.
#
# If the variable named ME2MENU is set in the environment to the name
# of a filePro User Menu located in the directory pointed to by PFMENU,
# that Menu will be the default menu copied to a new menu name.
#
# The value of PFMENU set in the environment will be used.
#
# If PFMENU is not set in the environment, the file pointed to by PFCONFIG,
# if it is set in the environment, or the the default filePro "config" file
# will be read, and if not set there, will be set to "$PFPROG/fp/menus".
#
# If PFPROG is not set in the environment it will be read from the file
# (UNIX or Linux) "/etc/default/fppath" or (Windows) "C:\FPPATH".  If that
# file does not exist the values assigned to the UNIX/Linux or Windows
# defaults for them as set in "User Definable Parameters" will be used.

#=#=#=#=#=#=#=#=#=#=#=#=>>> User Definable Parameters <<<=#=#=#=#=#=#=#=#=#=#=#
#                           ^^^^^^^^^^^^^^^^^^^^^^^^^
# Default filePro environmental parameters for UNIX and Linux:
$UNIX_PFPROG = '/appl';
# Default filePro environmental parameters for Windows:
$Win_PFPROG  = 'C:';
#
#=#=#=#=#=#=#=#=#=#=#=>>> End User Definable Parameters <<<=#=#=#=#=#=#=#=#=#=#

if (-d "C:/WINDOWS") {
  $OS = "Windows"; $Dflt_PFPROG = $Win_PFPROG;
}
else {
  system "clear >/dev/stderr";
  $OS = "UNIX"; $Dflt_PFPROG = $UNIX_PFPROG;
}
$Dflt_PFMENU = $Dflt_PFPROG . '/fp/menus';

$[ = 1; # set array base to 1

# Get this program's basename:
$X = (@Y = split(/\/|\\/, $0, 999)); $PROG = $Y[$X];
# Remove any ".pl" extension to it:
if ($PROG =~ /.+\.pl$/) { $PROG =~ s/\.pl$//; }

print STDERR "
  $PROG  [$version]  (C)2005 Bob Stockler\n";

# Get the pathname of the PFMENU directory:
if    ($ENV{PFMENU}) { $PFMENU = $ENV{PFMENU}; }
elsif ($ENV{FPMENU}) { $PFMENU = $ENV{FPMENU}; }
else { $PFMENU = ""; }
if    ($ENV{PFPROG}) { $PFPROG = $ENV{PFPROG}; }
elsif ($ENV{FPPROG}) { $PFPROG = $ENV{FPPROG}; }
else { $PFPROG = ""; }
if (!$PFMENU) {
  if (!$PFPROG) {
    if ($OS eq "UNIX") { $fppath = "/etc/default/fppath"; }
    else {
      if    (-e "C:/FPPATH") { $fppath = "C:/FPPATH"; }
      elsif (-e "D:/FPPATH") { $fppath = "D:/FPPATH"; }
      elsif (-e "E:/FPPATH") { $fppath = "E:/FPPATH"; }
      elsif (-e "F:/FPPATH") { $fppath = "F:/FPPATH"; }
      else                   { $fppath = ""; }
    }
    if ($fppath && -r $fppath) {
      open(FPPATH, $fppath) or die "\n  Can't open \"$fppath\":  $!.\n\n";
      chomp($Line = <FPPATH>); $PFPROG = $Line; close FPPATH;
    }
    else { $PFPROG = $Dflt_PFPROG; }
  }
  # Check the user's permissions:
  if (! -w "$PFPROG/fp") {
    printf STDERR "
  $PROG:  You MUST be the user \"root\" or \"filepro\".\n\n"; exit 2;
  }
  if    ($ENV{PFCONFIG}) { $PFCONFIG = $ENV{PFCONFIG}; }
  elsif ($ENV{FPCONFIG}) { $PFCONFIG = $ENV{FPCONFIG}; }
  else { $PFCONFIG = "$PFPROG/fp/lib/config"; }
  open(FPCONFIG, $PFCONFIG) or die "\n  Can't open \"$PFCONFIG\": $!\n";
  while ($Line = <FPCONFIG>) {
    if ($Line =~ /^PFMENU=|^FPMENU=/) {
      chomp($Line); $PFMENU = substr($Line, 8, 99999); last;
    }
  }
  close FPCONFIG;
  if (!$PFMENU) {
    if ($PFPROG) { $PFMENU = "$PFPROG/fp/menus"; }
    else { $PFMENU = $Dflt_PFMENU; }
  }
}

# Change to the PFMENU directory:
if (-d $PFMENU) { chdir $PFMENU; }
else {
  print STDERR "
  $PROG:  PFMENU \"$PFMENU\" is NOT a directory.\n\n";
  if ($OS eq "Windows") { printf STDERR "  $PROG:  Press [Enter]: "; <STDIN>; }
  exit 2;
}

if ($OS eq "UNIX") { $Shell_Batch = "Shell Scripts"; }
else { $Shell_Batch = "Batch Files"; }
print STDERR "
  Copy a filePro User Menu to another name, copying any $Shell_Batch,
  and editing the Action Command Lines that execute them.\n";

# Get the name of the Menu to be copied:
$ME2MENU = $ENV{ME2MENU};
if ($ME2MENU) {
  $err_msg = "";
  if (!-e $ME2MENU) {
    $err_msg = "\n  $PROG:  A Menu named \"$ME2MENU\" does NOT exist.\n";
  }
  elsif ( -s $ME2MENU != 4719 && -s $ME2MENU != 2801 && -s $ME2MENU != 5661 ) {
    $err_msg = "\n  $PROG:  \"$ME2MENU\" is NOT a filePro User Menu.\n";
  }
  if ($err_msg) { print STDERR "$err_msg"; $ME2MENU = ""; }
  else {
    printf STDERR "
                    Copy the filePro User Menu: $ME2MENU\n";
  }
}
if (!$ME2MENU) {
  until ($ME2MENU) {
    printf STDERR "
  Enter the name of the User Menu to be copied: ";
    chomp($ME2MENU = <STDIN>);
    $ME2MENU =~ s/\s+//g;
    if ($ME2MENU) {
      $err_msg = "";
      if (!-e $ME2MENU) {
        $err_msg = "\n  $PROG:  \"$ME2MENU\" does NOT exist.\n";
      }
      elsif (-s $ME2MENU != 4719 && -s $ME2MENU != 2801 && -s $ME2MENU != 5661) {
        $err_msg = "\n  $PROG:  \"$ME2MENU\" is NOT a filePro User Menu.\n";
      }
      if ($err_msg) { print STDERR "$err_msg"; $ME2MENU = ""; }
    }
  }
}

# Get the name for the new Menu:
until ($New_Name) {
  printf STDERR "
          Enter the name for the NEW User Menu: ";
  chomp($New_Name = <STDIN>);
  $New_Name =~ s/\s+//g;
  if ($New_Name) {
    $err_msg = "";
    if ($New_Name eq $ME2MENU) {
      $err_msg = "\n  $PROG:  \"$New_Name\" and \"$ME2MENU\" are identical.\n";
    }
    elsif (-e $New_Name) {
      $err_msg = "\n  $PROG:  A file named \"$New_Name\" already exists.\n";
    }
    if ($err_msg) { print STDERR "$err_msg"; $New_Name = ""; }
  }
}

$RE = '/fp/menus/' . $ME2MENU . '.-[!-~]';
$Seg1_Fmt_Write = '%1.1s%-32.32s   %-75.75s ';
$First_Time = 1;
$No_Pword = 'Tw<z6u}V\"D%>S(^';

# Open the filePro User Menu to be copied:
open(MENU, $ME2MENU) or die "\n  Can't open \"$ME2MENU\": $!\n";
$Seg = 1; $Seg1 = ''; $Seg2 = ''; $Seg3 = '';

while (<MENU>) {
  chomp;
  if ($Seg == 1) {
    if ($_ eq '') { $Last_Element = 10; next; }
    for ($i = 0; $i <= 24; $i++) {
      if ($i) {
        $Choice_Char[$i] = substr($_, $j, 1);
        $Description[$i] = substr($_, $j + 1, 32);
        $Action_Comd[$i] = substr($_, $j + 36, 75);
        if ($Action_Comd[$i] =~ /\\/) { $Action_Comd[$i] =~ s/\\/\//g; }
        if ($Action_Comd[$i] =~ $RE) {
          if ($First_Time) {
            $First_Time = 0; print STDERR "
  $PROG:  Editing Action Command Lines and Copying $Shell_Batch:\n\n";
          }
          $X = index($Action_Comd[$i], '/fp/menus/');
          $head = substr($Action_Comd[$i], 1, $X - 1);
          $tail = substr($Action_Comd[$i], $X + 10, 999);
          $tail =~ s/ +$//;
          $Old_Script_Name = $tail;
          ($s_ = '"'.($New_Name).'"') =~ s/&/\$&/g,
          $tail =~ s/$ME2MENU/eval $s_/e;
          $New_Script_Name = $tail;
          $Action_Comd[$i] = sprintf('%-75.75s', $head . '/fp/menus/' . $tail);
          $ADVISE = "Copy $Old_Script_Name to $New_Script_Name";
          printf STDERR "    %-s\n", $ADVISE;
          &Copy($Old_Script_Name,$New_Script_Name);
          if ($OS eq "UNIX") { system( "chown filepro $New_Script_Name" ); }
        }
        elsif ($Action_Comd[$i] =~ /\/r.+\/r/) {
          $Action_Comd[$i] =~ s/\/r/\\r/g;
          if ($Action_Comd[$i] =~ /\\r[cru]/) { $Action_Comd[$i] =~ s/\\/\//; }
        }
        $Element = sprintf($Seg1_Fmt_Write,
                     $Choice_Char[$i], $Description[$i], $Action_Comd[$i]);
        if ($Description[$i] !~ /^[ \t]*$/) { $Last_Element = $i; }
        $Seg1 = $Seg1 . $Element;
        $j += 112;
      }
      else {
        $Seg1 = substr($_, 1, 112);
        $j = 113;
      }
    }
    $Seg++;
  }
  elsif ($Seg == 2 ) { $Seg2 = $_; $Seg++; }
  elsif ($Seg == 3 ) { $Seg3 = $_; $Seg++; }
}
close MENU;

if ($Seg < 3) {
  $Seg2 = sprintf('%950s', '') . sprintf('%950s', ''); $Seg3 = $No_Pword;
}

if ($First_Time) { # The Menu was not edited:
  print STDERR "
  $PROG:  No $Shell_Batch were executed on this Menu.\n";
  # Copy the Menu to the New Name:
  print STDERR "
  $PROG:  Copying the Menu:\n";
  $ADVISE = "Copying \"$ME2MENU\" to \"$New_Name\"";
  printf STDERR "
    %-s\n", $ADVISE; 
  &Copy($ME2MENU,$New_Name);
  if ($OS eq "UNIX") {
    system("chown filepro $New_Name ; chmod 0644 $New_Name");
  }
}
else { # Write out the edited menu to the New Menu name:
  print STDERR "\n  $PROG:  Writing the edited New Menu.\n";
  $ERR = "\n  $PROG:  Can NOT write to \"$New_Name\":";
  # Open the output file for writing:
  open $HANDLE, ">$New_Name" or die "\n  $ERR  $!.\n\n";
  if ($OS eq "Windows") { binmode $HANDLE; }
  # Change the default output from STDOUT to $New_Menu:
  select $HANDLE;
  $ADVISE = "Writing the edited Menu \"$ME2MENU\" to \"$New_Name\"";
  printf STDERR "
    %-s\n", $ADVISE; 
  $FMT = "%c%s\n%s\n%s\n";
  printf $FMT, $Last_Element, substr($Seg1, 2, 99999), $Seg2, $Seg3;
  close $HANDLE;
  if ($OS eq "UNIX") {
    system("chown filepro $New_Name ; chmod 0644 $New_Name");
  }
}

# If the Menu has a ".hlp" file, copy it also:
$Old_Help_File = "$ME2MENU.hlp"; $New_Help_File = "$New_Name.hlp";
if (-f $Old_Help_File) {
  $ADVISE = "Copying \"$ME2MENU.hlp\" to \"$New_Name.hlp\"";
  printf STDERR "
    %-s\n", $ADVISE; 
  &Copy($Old_Help_File,$New_Help_File);
  if ($OS eq "UNIX") {
    system("chown filepro $New_Help_File ; chmod 0644 $New_Help_File");
  }
}

# Copy any "orphan" Shell Scripts / Batch Files to the New Menu's name:
$Msg = "";
for ($i = 33; $i <= 126; $i++) {
  if ($i == 97) { $i += 26; }
  $Char = chr($i);
  # Do NOT copy a MENU EDIT II lock file:
  if ($Char ne "X" && $Char ne "?" && $Char ne "*") {
    $Old_Script_Name = "$ME2MENU.-$Char";
    $New_Script_Name = "$New_Name.-$Char";
    if (-f $Old_Script_Name && !-f $New_Script_Name) {
      if (!$Msg) {
        $Msg = "
  $PROG:  Copying \"orphan\" $Shell_Batch to the New Menu's name.\n\n";
        print STDERR "$Msg";
      }
      $ADVISE = "Copy $Old_Script_Name to $New_Script_Name";
      printf STDERR "    %-s\n", $ADVISE;
      &Copy($Old_Script_Name,$New_Script_Name);
      if ($OS eq "UNIX") {
        system("chown filepro $New_Script_Name ; chmod 0755 $New_Script_Name");
      }
    }
  }
}

if ($OS eq "Windows") { printf STDERR "\n  Press [Enter]: "; <STDIN>; }
else { printf STDERR "\n"; }

exit 0;

sub Copy {
  local($old, $new) = @_;
  use File::Copy;
  copy($old,$new);
}

#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#
# EOF - 'copy_menu.pl' - Bob Stockler - Wed Dec  7 10:10:10 EST 2005
