| Server IP : 81.2.241.106 / Your IP : 216.73.216.165 Web Server : Apache/2.4.67 (Debian) System : Linux tranq-f.bakta.org 5.10.0-45-amd64 #1 SMP Debian 5.10.259-1 (2026-07-02) x86_64 User : lisky ( 1002) PHP Version : 7.4.33 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : OFF Directory : /usr/share/perl5/sdf/ |
Upload File : |
# $Id$
$VERSION{''.__FILE__} = '$Revision$';
#
# >>Title:: mf6 Post Processing Filter
#
# >>Copyright::
# Copyright (c) 1992-1997, Ian Clatworthy (ianc@mincom.com).
# You may distribute under the terms specified in the LICENSE file.
#
# >>History::
# -----------------------------------------------------------------------
# Date Who Change
# 08-Sep-97 ianc Ported Craig Willis' stuff from gendoc
# -----------------------------------------------------------------------
#
# >>Purpose::
# {{mf6_PostFilter}} post filters plain text format to generate
# MIMS F6 Help format.
#
sub mf6_PostFilter {
local(*text) = @_;
local(@result);
local($_);
local($client_sw, $header_sw, $idx_k, $idx_s, $key_sw, $part1, $part2,
$print_sw, $screen_sw, $subtopic_sw);
$ADD_SW = $SPLIT_SW = 0;
$idx_k = $idx_s = -1;
$CONT_TEXT = '';
for (@text) {
$_ =~ s/\n//;
$line = $_;
$print_sw = 1;
# If '&CLIENT' is found, it is the start of a new file
if ( $_ =~ /^&CLIENT +/i ) {
( $part1 = $& ) =~ s/ +$//;
if ( $client_sw ) {
&End_File($subtopic_sw);
$header_sw = 0;
$key_sw = 0;
$screen_sw = 0;
$subtopic_sw = 0;
$idx_k = -1;
$idx_s = -1;
}
else {
push(@result, "\\001\\001\n");
}
push(@result, " &BEGIN_TEXT_FILE\n");
&Get_Client_Dets unless ( $client_sw );
$client_sw++;
$line = sprintf(" %-19s%-60s",$part1,$CLIENT);
}
# If client name, format line
elsif ( $_ =~ /^&(CLIENT-NAME) +/i ) {
( $part1 = $& ) =~ s/ +$//;
$line = sprintf(" %-19s%-60s",$part1,$CLIENT_NAME);
}
# If machine , format line
elsif ( $_ =~ /^&MACHINE +/i ) {
( $part1 = $& ) =~ s/ +$//;
$line = sprintf(" %-19s%-60s",$part1,$MACHINE);
}
# If you reach '&SUBTOPICS' and 1st one, it is the end of text area
elsif ( $_ =~ /^&SUBTOPICS +/i ) {
push(@result, " &END_TEXT\n") unless $subtopic_sw;
$subtopic_sw++;
( $line = $_ ) =~ s/\n$//;
$line = " $line";
}
# Format line for list of variables
elsif ( $_ =~ /^&(MODULE|MODULE-NAME|TOPIC|TOPIC-GROUP|VERSION) +/ ||
$_ =~ /^&(ENQUIRY|SAMPLE) */ ) {
$part1 = $& ;
( $part2 = $' ) =~ s/^ +| *$//;
$part1 =~ s/&//;
$part1 =~ s/ +//;
$line = sprintf(" &%-18s%-60s",$part1, $part2);
$VARIABLES{"$part1"} = $part2;
$header_sw++;
}
# If 'KEYWORD' save keyword to be processed after end of text
elsif ( $_ =~ /^&KEYWORDS +/i ) {
$KEYWORDS[++$idx_k] = $';
# If a keyword continues onto more than one line
if ( $KEYWORDS[$idx_k] =~ / >> *$/ ) {
$key_sw++;
}
else {
$key_sw = 0;
}
$print_sw = 0;
}
# There is a continuation of the KEYWORD over multiple lines
elsif ( $key_sw ) {
$KEYWORDS[$idx_k] .= $_;
if ( $_ =~ / >> *$/ ) {
$key_sw++;
}
else {
$key_sw = 0;
}
$print_sw = 0;
}
# Else TEXT
else {
# Start of text area if header_sw is set
if ( $header_sw > 0 ) {
if ( $line =~ /^ *$/ || $line eq '' ) {
$line = " &BEGIN_TEXT";
}
elsif ( $line =~ /^ +\d+(\.\d+)* *\w+/ ) {
$line = " &BEGIN_TEXT\n$line";
}
$header_sw = 0;
}
# If line defines a screen, replace line and set switch to store screen in array
elsif ( $line =~ /^\d+(\.\d+)*\W+Screen MSM[0-9A-Z]+/ ) {
if ( $line =~ /^\d+(\.\d+)*\W+Screen / ) {
( $part2 = $' ) =~ s/ *$//;
}
else {
&AppMsg("warning", "can not file correct screen layout");
}
$line = " .INSERT_SCREEN $part2";
$SCREEN[++$idx_s] = " Screen Layout - $part2";
$screen_sw++;
}
elsif ( $line =~ /^\d+(\.\d+)* / ) { # Header line
$line = sprintf(" %-83s",$line) if ( $client_sw );
$print_sw = 1;
}
# If line is less than 80 and a normal text line and screen, set flag not to print
else {
$line = sprintf(" %-80s",$line) if ( $client_sw && length($line) < 75 );
if ( $screen_sw ) {
$SCREEN[++$idx_s] = "$line";
$print_sw = 0;
}
}
}
# If we are printing this line, format it to 83 characters wide
if ( $print_sw ) {
$line = &Format_Line($line);
push(@result, "$line\n");
}
}
&End_File($subtopic_sw);
# Return result
return @result;
}
#
# Get_Client_Dets: Will ask for a client ID and get client name and machine
#
sub Get_Client_Dets {
local( @client_array, $client_dir, $client_list, $found_sw);
# Get the client code
$CLIENT = $SDF_USER'var{'MIMS_CLIENT_CODE'};
if ( $CLIENT eq '') {
&AppExit('fatal', "MIMS_CLIENT_CODE variable must be specified");
}
$client_dir = "/usr/m3conv/client/";
$client_list = "${client_dir}client.codes";
unless ( -d "$client_dir") {
&AppExit('fatal', "Could not locate client directory '$client_dir'");
}
unless ( -r "$client_list") {
&AppExit('fatal', "Could not locate client list '$client_list'");
}
open(CLIENT_FH, $client_list) ||
&AppExit('fatal', "Could not open client list '$client_list'");
while ( <CLIENT_FH> ) {
@client_array = split(/,/,$_,4);
if ( $client_array[0] eq $CLIENT) {
$found_sw++;
last;
}
}
close ( CLIENT_FH );
&AppExit('fatal', "$CLIENT is not a valid client code") unless $found_sw;
$CLIENT_NAME = $client_array[$#client_array]; # Client name is last in array
$CLIENT_NAME =~ s/^ *//;
$CLIENT_NAME =~ s/\n//;
$MACHINE = $client_array[2]; # Client machine is always the 3rd array element
$CLIENT = 'MIMS';
$CLIENT_NAME = 'MIMS';
$MACHINE = 'UNIX';
}
#
# End_File: Manipulates the EOF processing within the MIMS Online Help Generation
#
sub End_File {
local( $end_sw, *result) = @_;
local( $keyword);
push(@result, " &END_TEXT\n") unless ( $end_sw );
foreach $keyword (@KEYWORDS) {
$keyword =~ s/ *$//;
$line = sprintf (" %-19s%-62s",'&KEYWORDS',$keyword);
push(@result, "$line\n");
}
undef(@KEYWORDS);
push(@result, " &END_TEXT_FILE\n");
if ( $SCREEN[0] ne '' ) { # If a screen has been specified
push(@result, " &BEGIN_TEXT_FILE\n");
push(@result, sprintf(" %-19s%-62s\n",'&CLIENT',$CLIENT));
push(@result, sprintf(" %-19s%-62s\n",'&CLIENT_NAME',$CLIENT_NAME));
push(@result, sprintf(" %-19s%-62s\n",'&MACHINE',$MACHINE));
foreach $key (keys (%VARIABLES)) {
$VARIABLES{$key} = 'SCREEN' if ( $key eq 'TOPIC' ) ;
push(@result, sprintf(" &%-18s%-63s\n",$key,$VARIABLES{"$key"}));
}
push(@result, "&BEGIN_SCREEN\n");
foreach $line (@SCREEN) {
push(@result, "$line\n");
}
push(@result, " &END_SCREEN\n");
push(@result, " &END_TEXT_FILE\n\n");
undef(@SCREEN);
}
$ADD_SW = 0;
$CONT_TEXT = '';
}
#
# Format_Line: This will ensure the line is 83 characters long no matter what and
# will wrap the lines if it is more than 83 chracters long.
# Used for the MIMS Online Help generation
#
sub Format_Line {
local( $line, *result) = @_;
local( $idx, $text);
$line =~ s/\t/ /g; # Convert all tabs to 4 spaces
$line =~ s/ +$//; # Strip trailing spaces
LINE: {
last LINE unless ( length($line) > 75 || $ADD_SW > 0 ); #
# If there is leftover text from previous line
if ( $ADD_SW ) {
$ADD_SW = 0; # Initialise ADD_SW
# If line is empty or full of spaces, print previous line
if ( $line =~ /^ *$/ ) {
$CONT_TEXT = " $CONT_TEXT" if ( $CONT_TEXT !~ /^ / ) ; # Add leading space if line does not have one
push(@result, "$CONT_TEXT\n");
$CONT_TEXT = ''; # Del CONT_TEXT as it has been added to line
last LINE;
}
else { # Else add the previous line to the current line
$CONT_TEXT =~ s/^ +//;
$CONT_TEXT =~ s/ +$//;
if ( $line =~ /^ +/ && $SPLIT_SW ) {
$line = "${&}${CONT_TEXT}${'}";
$SPLIT_SW = 0;
}
elsif ( $CONT_TEXT =~ /^\w+/ ) {
$line = "${CONT_TEXT} $line";
}
else {
$line = "${CONT_TEXT}${line}";
}
}
} # End ADD_SW
$CONT_TEXT = ''; # Del CONT_TEXT as it has been added to line
# IF line ended in a split word ie thorough-
if ( $line =~ /\w+\-$/ ) {
$line = $`;
($text = $&) =~ s/\-$//;
$ADD_SW++;
$SPLIT_SW++;
}
else {
$SPLIT_SW = 0;
}
@characters = split(//,$line);
$idx = $#characters;
for (local($i)=($#characters); $i > 0 ; $i-- ) {
if ( $characters[$i] =~ /\W/ && $i < 75 ) {
$idx = $i;
last;
}
}
for ( local($i)=++$idx; $i <= $#characters; $i++) {
$CONT_TEXT = "${CONT_TEXT}${characters[$i]}";
}
$CONT_TEXT = "${CONT_TEXT}${text}" if ( $text ne '' );
$#characters = --$idx if ( $idx != $#characters );
$line = ''; # Reset line to nothing
foreach $char (@characters) { $line = "$line$char"};
$ADD_SW++;
}
$line = " $line" if ( $line !~ /^ / ) ; # Add leading space if line does not have one
return("$line");
}
# package return value
1;