|
|
Home | Switchboard | Unix Administration | Red Hat | TCP/IP Networks | Neoliberalism | Toxic Managers |
| (slightly skeptical) Educational society promoting "Back to basics" movement against IT overcomplexity and bastardization of classic Unix | |||||||
This is a protocol of translation of pre-pythonizer by the current version of pythonizer. The default target language now is Python 3.8, not Python 2.7 as in prev. versions. The current version generates global statements to ensure the same visibility of global variables as in Perl, and has limited support for state variables. If also deals better with postfix conditions.
The resulting program has one syntax errors but still starts executing. Of course, it soon fails:[4] # python3.8 maintest.py maintest.py:920: SyntaxWarning: 'int' object is not subscriptable; perhaps you missed a comma? process_line([0[0:-1],0]) MAINTEST: PREPYTHONIZER: Phase 1 of pythonizer (last modified 201010_0801) Running at date "+%y/%m/%d %H:%M" Logs are at /tmp/maintest/maintest.date +"%y%m%d_%H%M".log. Type -h for help. ================================================================================ ATTENTION!!! maintest is working in debugging mode 1 with autocommit of source to /cygdrive/f/_Scripts/Archive Log is written to /tmp/maintest, The original file will be saved as None.original unless this file already exists ================================================================================ Traceback (most recent call last): File "maintest.py", line 938, inmain([]) File "maintest.py", line 727, in main SourceText=sys.stdin.readlines().copy KeyboardInterrupt
One uncanny realization from writing of pythonizer is the realization how complex and convoluted both languages are. In no way Python is the language for beginners. It in neither simple not transparent. Only syntax in Python is simple. While its tiny subset can be used in this role, but the language as a whole is very complex. Even seasoned programmer will struggle with it and need a lot of time to adapt to the non C language idioms using which the language constructed. It breaks with many things in C-tradition and not always for the better.
I also realized how weak is my knowledge of Perl is and how limited was the subset that I used in it for many years. The latter is not exaggeration. I discovered many new things about Perl while writing pythonizer, which I never suspected exists.
Looking into corresponding code it is clear that Python is more verbose and in certain cases less clear then Perl. For example idea of preparing translation table via a separate function is definitely lower level then perl implementation. Generally this is an optimization that is better done by interpreter, colliding identical translation tables, were possible, and moving them to outer block or even compile time BEGIN block.
As for readability you can judge yourself. Perl is slightly higher level language then Python, so from this point of view it is more readable, because the same algorithms can be expressed in fewer lines. From my point of view rumors that Python is more readable then Perk are greatly exaggerated. They actually are on the same level of obscurity (which in both languages can be greatly enhanced by abusing OO). So the blanket and simplistic statements like Dive Deep Into Python Vs Perl Debate - What Should I Learn Python or Perl-:
Python takes a huge advantage over Perl when it comes to code readability. Python’s code is a lot clearer to understand than that of Perl even when reading code after years.
is an exaggeration, and is not true. Moreover such blanket statement usually suggests that the author never really programmed in Perl anything complex. Because the issues that matter are not that simple and are connected with handling of namespaces and "time to live" for variables, not with superficial "look and feel" of the source code.
Where Python does shines and is definitely more readable is when it is working with substrings. The fact that stings can be addressed as arrays and ranges specified with starting and ending position represents an advantage. If makes program more compact too. Compare:
117 | 1 | | if intact_line[0]=='#': #PL: if( substr($intact_line,0,1) eq '#' ){
Python expresses the same condition with half symbols.
At the same time, even in issues that matter for novices, Python generally stepped on same rakes as Perl, just in a slightly different fashion. For example, both have C-style solution with '=' for assignment and '==' for comparison, which for a long time is a source of immense amount of errors by novices; Algol 60 solution with := and == is much better; Python 3.8 adopted ":=" for assignments within conditional statements, which is a progress in comparison with Perl, but still short of eliminating this wart.
There is some gains in readability in Python due to absence of sigils and more compact block structure due to the absence of closing block bracket (actually Python adopted the idea of semi-brackets as opening bracket in many cases is present -- it is a colon) but this makes any difference only for novices. Professional programmer does not care much and even can benefit from sigils on scalars as it helps to avoid conflicts with reserve words -- which is a problem for Python. Using beautifier solved that problem with the excessive number of curvy brackets in Perl scripts. Also using indentation for nesting proved to be a mixed blessing: one step forward, two steps back.
Please note that sigils in Perl allow really brilliant solution for dereferencing of the pointers (for example, $$refernce_to_hash). References to scalar variables are impossible in Python. Not that it matters much but still.
The difference between external libraries and methods creates confusion as to when you need to use postfix syntax like mystring.function() vs traditional lib.function(mystring) and it is definitely problem for novices.
NOTE TO MYSELF: output needs to be prepossessed in a separate file, replacing < with < Otherwise parts of the listing are not visible, unless viewed as the source code
PYTHONIZER: Fuzzy translator of Python to Perl. Version 0.84 (mtime 201010_0904) Started at 20/10/10 09:04
Logs are at /tmp/Pythonizer/pythonizer.201010_0904.log. Type -h for help.
=========================================================================================================================
Results of transcription are written to the file maintest.py
=========================================================================================================================
1 | 0 | |#!/usr/bin/python3 -u
2 | 0 | |#:: pre_pythonizer version 0.1
3 | 0 | |#:: Stage 1 of fuzzy translation of Perl to Python
4 | 0 | |#:: Nikolai Bezroukov, 2019-2020.
5 | 0 | |#:: Licensed under Perl Artistic license
6 | 0 | |#::
7 | 0 | |#:: This phase produced refactored Source PERL code and XREF table.
8 | 0 | |#:: XREF table is fuzzy, in a sense that it is constructed using heuristic methods.
9 | 0 | |#:: Currently it is not used by pythonizer and just is created for reference
10 | 0 | |#::
11 | 0 | |#:: --- INVOCATION:
12 | 0 | |#::
13 | 0 | |#:: pre_pythonizer [options] [file_to_process]
14 | 0 | |#::
15 | 0 | |#::--- OPTIONS:
16 | 0 | |#::
17 | 0 | |#:: -v -- display version
18 | 0 | |#:: -h -- this help
19 | 0 | |#:: -t number -- size of tab (emulated with spaces)
20 | 0 | |#::
21 | 0 | |#::--- PARAMETERS:
22 | 0 | |#:: 1st -- name of file
23 | 0 | |
24 | 0 | |
25 | 0 | |#--- Development History
26 | 0 | |#
27 | 0 | |# Ver Date Who Modification
28 | 0 | |# ==== ========== ======== ==============================================================
29 | 0 | |# 0.10 2019/10/14 BEZROUN Initial implementation
30 | 0 | |# 0.11 2019/11/20 BEZROUN Minor changes in legend and help screen
31 | 0 | |# 0.20 2020/08/20 BEZROUN The source reorganized into "subroutines-first" fashion
32 | 0 | |# 0.30 2020/09/01 BEZROUN Several errors corrected. Integration with pythonizer via option -r (refator) of the latter.
33 | 0 | |#=========================== START =========================================================
34 | 0 | |
35 | 0 | |import sys,os,re
35 | 0 | |import fileinput,subprocess
35 | 0 | |#SKIPPED: use v5.10;
36 | 0 | |# use Modern::Perl;
37 | 0 | |#SKIPPED: use warnings;
38 | 0 | |#SKIPPED: use strict 'subs';
39 | 0 | |#SKIPPED: use feature 'state';
40 | 0 | |#SKIPPED: use Getopt::Std;
41 | 0 | |
42 | 0 | |#
43 | 0 | |# Subroutines
44 | 0 | |#
45 | 0 | |
47 | 0 | |def normalize_line(perl_arg_array): #PL: sub normalize_line
48 | 1 | | line=perl_arg_array[0] #PL: my $line=$_[0];
49 | 1 | | line=line.translate(line.maketrans(r'\t',r' ')) # eliminate \t
#PL: $line=~tr/\t/ /;
51 | 1 | | if line[-1]=='\r': #PL: if( substr($line,-1,1) eq "\r" )
52 | 2 | | line=line[0:-1] #PL: chop($line);
54 | 1 | |
55 | 1 | | # trip trailing blanks, if any
57 | 1 | | if (default_match:=re.match(r'(^.*\S)\s+$',line)): #PL: if( $line=~/(^.*\S)\s+$/ )
58 | 2 | | line=default_match.group(1) #PL: $line=$1;
60 | 1 | |
61 | 1 | | return(line) #PL: return($line);
63 | 0 | |
65 | 0 | |def process_line(perl_arg_array): #PL: sub process_line
65 | 1 | | global cur_nest,FormattedSource,noformat,sublineno,sourcelineno,datalineno,mainlineno,ChannelNo,FormattedMain,prefix,FormattedSub,lineno,FormattedData,tab,InfoTags,new_nest #PL: sub process_line
66 | 1 | | line=perl_arg_array[0] #PL: my $line=$_[0];
67 | 1 | | offset=perl_arg_array[1] #PL: my $offset=$_[1];
68 | 1 | |
70 | 1 | | if len(line)>1 and line[0]!='#': #PL: if( length($line)>1 && substr($line,0,1) ne '#' )
71 | 2 | | check_delimiter_balance([line]) #PL: check_delimiter_balance($line);
73 | 1 | |
74 | 1 | | prefix='%4u %3d %4s' % ( lineno,cur_nest,InfoTags) #PL: $prefix=sprintf('%4u %3d %4s',$lineno, $cur_nest, $InfoTags);
76 | 1 | | if (cur_nest+offset)<0 or cur_nest<0: #PL: if( ($cur_nest+$offset)<0 || $cur_nest<0 )
77 | 2 | | spaces='' #PL: $spaces='';
80 | 1 | | else: #PL: else
81 | 2 | | offset=1 if ChannelNo==1 else 0 #PL: $offset=( $ChannelNo==1 )? 1 : 0;
82 | 2 | | spaces=' ' * ((cur_nest+offset)*tab) #PL: $spaces= ' ' x (($cur_nest+$offset)*$tab);
84 | 1 | |
85 | 1 | | line=f"{spaces}{line}\n" #PL: $line="$spaces$line\n";
86 | 1 | | print(f"{prefix} | {line}",file=sys.stderr,end="") #PL: print STDERR "$prefix | $line";
88 | 1 | | if ChannelNo==0: #PL: if( $ChannelNo==0)
89 | 2 | | FormattedSource.append(line) #PL: $FormattedSource[$sourcelineno++]=$line;
92 | 1 | | elif ChannelNo==1: #PL: elsif($ChannelNo==1)
93 | 2 | | FormattedMain.append(line) #PL: $FormattedMain[$mainlineno++]=$line;
96 | 1 | | elif ChannelNo==2: #PL: elsif($ChannelNo==2)
97 | 2 | | FormattedSub.append(line) #PL: $FormattedSub[$sublineno++]=$line;
100 | 1 | | elif ChannelNo==3: #PL: elsif($ChannelNo==3)
101 | 2 | | FormattedData.append(line) #PL: $FormattedData[$datalineno++]=$line;
104 | 1 | | else: #PL: else
105 | 2 | | logme(['S',f"Internal error. Channel is outside rance or 0-2. The value is {ChannelNo}. Exiting... "])
#PL: logme('S',"Internal error. Channel is outside rance or 0-2. The value is $Channe
Cont: lNo. Exiting... ");
106 | 2 | | sys.exit(255) #PL: exit 255;
108 | 1 | |
109 | 1 | | cur_nest=new_nest #PL: $cur_nest=$new_nest;
110 | 1 | | if noformat==0: #PL: if( $noformat==0 ){ $InfoTags='' }
110 | 2 | | InfoTags='' #PL: $InfoTags='' }
112 | 0 | |
114 | 0 | |def write_formatted_code(perl_arg_array): #PL: sub write_formatted_code
114 | 1 | | global FormattedSource,SourceText,FormattedMain,prefix,FormattedSub,FormattedData,SubList,fname #PL: sub write_formatted_code
115 | 1 | | output_file=fname #PL: my $output_file=$fname;
116 | 1 | | line=i=k=var=dict=type=xref_table=None #PL: my ($line,$i,$k,$var, %dict, %type, @xref_table);
117 | 1 | | FormattedMain.append('}') #PL: push(@FormattedMain,'}');
119 | 1 | | if os.path.exists(fname): #PL: if( -e $fname )
120 | 2 | | default_var=subprocess.run(f"cp {fname} {fname}.original",capture_output=True,text=True,shell=True) #PL: `cp $fname $fname.original`;
120 | 2 | | subprocess_rc=default_var.returncode #PL: `cp $fname $fname.original`;
122 | 1 | |
123 | 1 | | FormattedSource.extend(FormattedSub) #PL: push(@FormattedSource,@FormattedSub);
124 | 1 | | FormattedSource.extend(FormattedMain) #PL: push(@FormattedSource,@FormattedMain);
125 | 1 | | FormattedSource.append('main()\n') # generate call to main
#PL: push(@FormattedSource,"main()\n");
126 | 1 | | FormattedSource.extend(FormattedData) #PL: push(@FormattedSource,@FormattedData);
127 | 1 | | try: #PL: open (SYSFORM,'>',$output_file ) || abend(__LINE__,"Cannot open file $output_file for writing");
127 | 2 | | SYSFORM=open(output_file,'w') #PL: open (SYSFORM,'>',$output_file ) || abend(__LINE__,"Cannot open file $output_file for writing");
127 | 1 | | except OSError: #PL: open (SYSFORM,'>',$output_file ) || abend(__LINE__,"Cannot open file $output_file for writing");
127 | 2 | | abend([sys._getframe().f_lineno,f"Cannot open file {output_file} for writing"]) #PL: abend(__LINE__,"Cannot open file $output_file for writing");
128 | 1 | | print(FormattedSource,file=SYSFORM,end="") #PL: print SYSFORM @FormattedSource;
129 | 1 | | SYSFORM.f.close; #PL: close SYSFORM;
130 | 1 | | default_var=subprocess.run(f"perl -cw {output_file}",capture_output=True,text=True,shell=True) #PL: `perl -cw $output_file`;
130 | 1 | | subprocess_rc=default_var.returncode #PL: `perl -cw $output_file`;
132 | 1 | | if subprocess_rc>0: #PL: if( $? > 0 )
133 | 2 | | logme(['E',f"Checking reformatted source code via perl -cw produced some errors (RC={subprocess_rc}). Please correct them before proceeding"])
#PL: logme('E',"Checking reformatted source code via perl -cw produced some errors (R
Cont: C=$?). Please correct them before proceeding");
135 | 1 | |
136 | 1 | | output_file=f"{LOG_DIR}/fname.xref" #PL: $output_file="$LOG_DIR/fname.xref";
137 | 1 | | try: #PL: open (SYSFORM,'>',$output_file ) || abend(__LINE__,"Cannot open file $output_file for writing");
137 | 2 | | SYSFORM=open(output_file,'w') #PL: open (SYSFORM,'>',$output_file ) || abend(__LINE__,"Cannot open file $output_file for writing");
137 | 1 | | except OSError: #PL: open (SYSFORM,'>',$output_file ) || abend(__LINE__,"Cannot open file $output_file for writing");
137 | 2 | | abend([sys._getframe().f_lineno,f"Cannot open file {output_file} for writing"]) #PL: abend(__LINE__,"Cannot open file $output_file for writing");
138 | 1 | |
140 | 1 | | for i in range(0,len(len(SourceText))): #PL: for( $i=0; $i<@SourceText; $i++ )
141 | 2 | | line=SourceText[i] #PL: $line=$SourceText[$i];
142 | 2 | | if line[0]=='#' or (default_match:=re.match(r'(\s+)\#',line)): #PL: next if (substr($line,0,1) eq '#' || $line=~/(\s+)\#/ );
142 | 3 | | continue #PL: next if (substr($line,0,1) eq '#' || $line=~/(\s+)\#/ );
143 | 2 | | line=line.rstrip("\n") #PL: chomp($line);
144 | 2 | |
146 | 2 | | while(k:=line.find('$'))>-1: #PL: while( ($k=index($line,'$'))>-1 )
147 | 3 | | line=line[k+1:] #PL: $line=substr($line,$k+1);
148 | 3 | | if not (default_match:=re.match(r'^(\w+)',line)): #PL: next unless( $line=~/^(\w+)/ );
148 | 4 | | continue #PL: next unless( $line=~/^(\w+)/ );
149 | 3 | | if default_match.group(1)=='_' or re.match(r'[1-9]',default_match.group(1)): #PL: next if( $1 eq '_' || $1 =~/[1-9]/ );
149 | 4 | | continue #PL: next if( $1 eq '_' || $1 =~/[1-9]/ );
150 | 3 | | k+=len(default_match.group(1))+1 #PL: $k+=length($1)+1;
151 | 3 | | var='$' + default_match.group(1) #PL: $var='$'.$1;
153 | 3 | | if re.match(r'^\w+\s*[<>=+-]\s*[+-]?\d+',line): #PL: if($line=~/^\w+\s*[<>=+-]\s*[+-]?\d+/ )
154 | 4 | | if not var in type: #PL: unless(exists($type{$var})) {$type{$var}='int';}
154 | 5 | | type[var]='int' #PL: $type{$var}='int';}
157 | 3 | | elif re.match(r'^\w+\s*=\s*\$\#\w+',line): #PL: elsif( $line=~/^\w+\s*=\s*\$\#\w+/ )
158 | 4 | | if not var in type: #PL: unless( exists($type{$var}) ) {$type{$var}='int';}
158 | 5 | | type[var]='int' #PL: $type{$var}='int';}
161 | 3 | | elif (default_match:=re.match(r'^\w+\s*[+-=<>!]?=\s*(index|length|scalar)',line)): #PL: elsif( $line=~/^\w+\s*[+-=<>!]?=\s*(index|length|scalar)/ )
162 | 4 | | if not var in type: #PL: unless( exists($type{$var}) ) {$type{$var}='int';}
162 | 5 | | type[var]='int' #PL: $type{$var}='int';}
165 | 3 | | elif re.match(r'^\w+\s*[+-=<>!]?=\s*[+-]?\d+',line): #PL: elsif( $line=~/^\w+\s*[+-=<>!]?=\s*[+-]?\d+/ )
166 | 4 | | if not var in type: #PL: unless( exists($type{$var}) ) {$type{$var}='int';}
166 | 5 | | type[var]='int' #PL: $type{$var}='int';}
169 | 3 | | elif (default_match:=re.match(r'^\w+\s*\[.+?\]?\s*(\$\w+)',line)) and default_match.group(1) in type:
#PL: elsif( $line=~/^\w+\s*\[.+?\]?\s*(\$\w+)/ && exists($type{$1}) && $type{$1} eq '
Cont: int' )
170 | 4 | | if not var in type: #PL: unless( exists($type{$var}) ) {$type{$var}='int';}
170 | 5 | | type[var]='int' #PL: $type{$var}='int';}
173 | 3 | | elif re.match(r'^\w+\s*\[.+?\]?\s*[+-=<>!]=\s*\d+',line): #PL: elsif( $line=~/^\w+\s*\[.+?\]?\s*[+-=<>!]=\s*\d+/ )
174 | 4 | | #Array
175 | 4 | | if not var in type: #PL: unless( exists($type{$var}) ) {$type{$var}='int';}
175 | 5 | | type[var]='int' #PL: $type{$var}='int';}
178 | 3 | | elif re.match(r'^\w+\s*\{.+?\}\s*[+-=<>!]?=\s*\d+',line): #PL: elsif( $line=~/^\w+\s*\{.+?\}\s*[+-=<>!]?=\s*\d+/ )
179 | 4 | | #Hash
180 | 4 | | if not var in type: #PL: unless( exists($type{$var}) ) {$type{$var}='int';}
180 | 5 | | type[var]='int' #PL: $type{$var}='int';}
182 | 3 | |
183 | 3 | |
185 | 3 | | if var in dict: #PL: if( exists($dict{$var}) )
186 | 4 | | dict[var]+=', ' + i #PL: $dict{$var}.=', '.$i;
189 | 3 | | else: #PL: else
190 | 4 | | dict[var]+=i #PL: $dict{$var}.=$i;
191 | 4 | |
195 | 1 | | write_line(['\n\nCROSS REFERENCE TABLE\n']) #PL: write_line("\n\nCROSS REFERENCE TABLE\n");
196 | 1 | | i=0 #PL: $i=0;
198 | 1 | | for var in dictq.keys(): #PL: foreach $var (keys(%dict))
199 | 2 | | prefix=type[var] if var in type else 'str' #PL: $prefix=( exists($type{$var}) ) ? $type{$var} : 'str';
200 | 2 | | xref_table[i]=f"{prefix} {var} {dict[var]}\n" #PL: $xref_table[$i]="$prefix $var $dict{$var}\n";
201 | 2 | | i+=1 #PL: $i++;
203 | 1 | |
204 | 1 | | xref_table=sort(xref_table) #PL: @xref_table=sort(@xref_table);
205 | 1 | |
206 | 1 | | try: #PL: open (SYSFORM,'>',$output_file ) || abend(__LINE__,"Cannot open file $output_file for writing");
206 | 2 | | SYSFORM=open(output_file,'w') #PL: open (SYSFORM,'>',$output_file ) || abend(__LINE__,"Cannot open file $output_file for writing");
206 | 1 | | except OSError: #PL: open (SYSFORM,'>',$output_file ) || abend(__LINE__,"Cannot open file $output_file for writing");
206 | 2 | | abend([sys._getframe().f_lineno,f"Cannot open file {output_file} for writing"]) #PL: abend(__LINE__,"Cannot open file $output_file for writing");
208 | 1 | | for i in range(0,len(len(xref_table))): #PL: for( $i=0; $i<@xref_table; $i++ )
209 | 2 | | write_line([xref_table[i]]) #PL: write_line($xref_table[$i]);
211 | 1 | |
212 | 1 | | write_line(['\nSUBROUTINES\n']) #PL: write_line("\nSUBROUTINES\n");
214 | 1 | | for sub in SubListq.keys(): #PL: foreach $sub (keys(%SubList))
215 | 2 | | write_line([f"{sub}: {SubList[sub]}"]) #PL: write_line("$sub: $SubList{$sub}");
217 | 1 | |
218 | 1 | | SYSFORM.f.close; #PL: close SYSFORM;
220 | 0 | |
222 | 0 | |def write_line(perl_arg_array): #PL: sub write_line
223 | 1 | | myline=perl_arg_array[0] #PL: my $myline=$_[0];
224 | 1 | | print(myline,file=sys.stderr) #PL: say STDERR $myline;
225 | 1 | | print(myline,file=SYSFORM) #PL: say SYSFORM $myline;
227 | 0 | |
228 | 0 | |#
229 | 0 | |# Check delimiters balance without lexical parcing of the string
230 | 0 | |#
232 | 0 | |def check_delimiter_balance(perl_arg_array): #PL: sub check_delimiter_balance
232 | 1 | | global keyword,line,InfoTags #PL: sub check_delimiter_balance
233 | 1 | | i=None #PL: my $i;
234 | 1 | | scan_SourceText=perl_arg_array[0] #PL: my $scan_SourceText=$_[0];
235 | 1 | | [sq_br,round_br,curve_br,single_quote,double_quote]=(0,0,0,0,0) #PL: my ($sq_br, $round_br, $curve_br, $single_quote, $double_quote)=(0,0,0,0,0);
236 | 1 | | if len(perl_arg_array[0])==1 or re.match(r'.\s*#',line): # no balance in one symbol line.
#PL: return if( length($_[0])==1 || $line=~/.\s*#/);
236 | 2 | | return() #PL: return if( length($_[0])==1 || $line=~/.\s*#/);
238 | 1 | | for i in range(0,len(scan_SourceText)): #PL: for( $i=0; $i<length($scan_SourceText); $i++ )
239 | 2 | | s=scan_SourceText[i:i + 1] #PL: $s=substr($scan_SourceText,$i,1);
240 | 2 | | if s=='{': #PL: if( $s eq '{' ){ $curve_br++;} elsif( $s eq '}' ){ $curve_br--; }
240 | 3 | | curve_br+=1 #PL: $curve_br++;} elsif( $s eq '}' ){ $curve_br--; }
240 | 2 | | elif s=='}': #PL: elsif( $s eq '}' ){ $curve_br--; }
240 | 3 | | curve_br-=1 #PL: $curve_br--; }
241 | 2 | | if s=='(': #PL: if( $s eq '(' ){ $round_br++;} elsif( $s eq ')' ){ $round_br--; }
241 | 3 | | round_br+=1 #PL: $round_br++;} elsif( $s eq ')' ){ $round_br--; }
241 | 2 | | elif s==')': #PL: elsif( $s eq ')' ){ $round_br--; }
241 | 3 | | round_br-=1 #PL: $round_br--; }
242 | 2 | | if s=='[': #PL: if( $s eq '[' ){ $sq_br++;} elsif( $s eq ']' ){ $sq_br--; }
242 | 3 | | sq_br+=1 #PL: $sq_br++;} elsif( $s eq ']' ){ $sq_br--; }
242 | 2 | | elif s==']': #PL: elsif( $s eq ']' ){ $sq_br--; }
242 | 3 | | sq_br-=1 #PL: $sq_br--; }
243 | 2 | |
244 | 2 | | if s=="'": #PL: if( $s eq "'" ){ $single_quote++;}
244 | 3 | | single_quote+=1 #PL: $single_quote++;}
245 | 2 | | if s=='"': #PL: if( $s eq '"' ){ $double_quote++;}
245 | 3 | | double_quote+=1 #PL: $double_quote++;}
247 | 1 | |
248 | 1 | | if single_quote%2==1: #PL: if( $single_quote%2==1 ){ $InfoTags.="'";}
248 | 2 | | InfoTags+="'" #PL: $InfoTags.="'";}
249 | 1 | | elif double_quote%2==1: #PL: elsif( $double_quote%2==1 ){ $InfoTags.='"'; }
249 | 2 | | InfoTags+='"' #PL: $InfoTags.='"'; }
250 | 1 | |
251 | 1 | | #$first_word=( $line=~/(\w+)/ ) ? $1 : '';
252 | 1 | |
254 | 1 | | if single_quote%2==0 and double_quote%2==0: #PL: if( $single_quote%2==0 && $double_quote%2==0 )
256 | 2 | | if not first_word in keyword: #PL: unless( exists($keyword{$first_word}) )
258 | 3 | | if curve_br>0 and line.find('\{')==-1: #PL: if( $curve_br>0 && index($line,'\{') == -1 )
259 | 4 | | inbalance='{' #PL: $inbalance ='{';
260 | 4 | | if single_quote==0 and double_quote==0: #PL: ( $single_quote==0 && $double_quote==0 ) && logme('W',"Possible missing '}' on the following line:");
260 | 5 | | logme(['W',"Possible missing '}' on the following line:"]) #PL: logme('W',"Possible missing '}' on the following line:");
263 | 3 | | elif curve_br<0: #PL: elsif( $curve_br<0 )
264 | 4 | | inbalance='}' #PL: $inbalance ='}';
265 | 4 | | if single_quote==0 and double_quote==0: #PL: ( $single_quote==0 && $double_quote==0 ) && logme('W',"Possible missing '{' on the following line: ");
265 | 5 | | logme(['W',"Possible missing '{' on the following line: "]) #PL: logme('W',"Possible missing '{' on the following line: ");
267 | 3 | |
269 | 2 | |
270 | 2 | |
272 | 2 | | if round_br>0 and line.find('\(')==-1: #PL: if( $round_br>0 && index($line,'\(') == -1 )
273 | 3 | | inbalance='(' #PL: $inbalance ='(';
274 | 3 | | if single_quote==0 and double_quote==0: #PL: ( $single_quote==0 && $double_quote==0 ) && logme('W',"Possible missing ')' on the following line:");
274 | 4 | | logme(['W',"Possible missing ')' on the following line:"]) #PL: logme('W',"Possible missing ')' on the following line:");
277 | 2 | | elif round_br<0: #PL: elsif( $round_br<0 )
278 | 3 | | inbalance=')' #PL: $inbalance =')';
279 | 3 | | if single_quote==0 and double_quote==0: #PL: ( $single_quote==0 && $double_quote==0 ) && logme('W',"Possible missing '(' on the following line:");
279 | 4 | | logme(['W',"Possible missing '(' on the following line:"]) #PL: logme('W',"Possible missing '(' on the following line:");
281 | 2 | |
282 | 2 | |
284 | 2 | | if sq_br>0 and line.find('\[')==-1: #PL: if( $sq_br>0 && index($line,'\[') == -1 )
285 | 3 | | inbalance='[' #PL: $inbalance ='[';
286 | 3 | | if single_quote==0 and double_quote==0: #PL: ( $single_quote==0 && $double_quote==0 ) &&logme('W',"Possible missing ']' on the following line:");
286 | 4 | | ogme(['W',"Possible missing ']' on the following line:"]) #PL: ogme('W',"Possible missing ']' on the following line:");
289 | 2 | | elif sq_br<0: #PL: elsif( $sq_br<0 )
290 | 3 | | inbalance=']' #PL: $inbalance =']';
291 | 3 | | if single_quote==0 and double_quote==0: #PL: ( $single_quote==0 && $double_quote==0 ) && logme('W',"Possible missing '[' on the following line:");
291 | 4 | | logme(['W',"Possible missing '[' on the following line:"]) #PL: logme('W',"Possible missing '[' on the following line:");
293 | 2 | |
295 | 1 | |
296 | 1 | |
298 | 0 | |
299 | 0 | |#
300 | 0 | |# process parameters and options
301 | 0 | |#
303 | 0 | |def get_params(perl_arg_array): #PL: sub get_params
303 | 1 | | global breakpoint,debug,fname,tab #PL: sub get_params
304 | 1 | | global fname #PL: own fname;
305 | 1 | | #getopts("fhrb:t:v:d:",\%options);
307 | 1 | | if 'v' in options: #PL: if( exists $options{'v'} )
309 | 2 | | if re.match(r'\d',options['v']) and options['v']<3: #PL: if( $options{'v'} =~/\d/ && $options{'v'}<3 )
310 | 3 | | logme(['D',options['v'],]) #PL: logme('D',$options{'v'},);
313 | 2 | | else: #PL: else
314 | 3 | | logme(['D',3,3]) # add warnings
#PL: logme('D',3,3);
316 | 2 | |
318 | 1 | |
320 | 1 | | if 'h' in options: #PL: if( exists $options{'h'} )
321 | 2 | | helpme([]) #PL: helpme();
323 | 1 | |
324 | 1 | |
325 | 1 | |
327 | 1 | | if 'f' in options: #PL: if( exists $options{'f'} )
328 | 2 | | write_FormattedSource=1 #PL: $write_FormattedSource=1;
330 | 1 | |
331 | 1 | |
333 | 1 | | if 't' in options: #PL: if( exists $options{'t'} )
335 | 2 | | if options['t']>0 and options['t']<10: #PL: if( $options{'t'}>0 && $options{'t'}<10 )
336 | 3 | | tab=options['t'] #PL: $tab=$options{'t'};
339 | 2 | | else: #PL: else
340 | 3 | | raise(f"Wrong value of option -t (tab size): {options}('t')\n") #PL: die("Wrong value of option -t (tab size): $options('t')\n");
342 | 2 | |
344 | 1 | |
345 | 1 | |
347 | 1 | | if 'b' in options: #PL: if( exists $options{'b'} )
349 | 2 | | if options['b']>0 and options['t']<1000: #PL: if( $options{'b'}>0 && $options{'t'}<1000 )
350 | 3 | | breakpoint=options['b'] #PL: $breakpoint=$options{'b'};
353 | 2 | | else: #PL: else
354 | 3 | | raise(f"Wrong value of option -b (line for debugger breakpoint): {options}('b')\n") #PL: die("Wrong value of option -b (line for debugger breakpoint): $options('b')\n");
356 | 2 | |
358 | 1 | |
359 | 1 | |
361 | 1 | | if 'd' in options: #PL: if( exists $options{'d'} )
363 | 2 | | if re.match(r'\d',debug): #PL: if( $debug =~/\d/ )
364 | 3 | | debug=options['d'] #PL: $debug=$options{'d'};
367 | 2 | | elif options['d']=='': #PL: elsif( $options{'d'} eq '' )
368 | 3 | | debug=1 #PL: $debug=1;
371 | 2 | | else: #PL: else
372 | 3 | | raise(f"Wrong value of option -d: {options}('d')\n") #PL: die("Wrong value of option -d: $options('d')\n");
374 | 2 | |
376 | 1 | |
377 | 1 | |
379 | 1 | | if len(sys.argv)==0: #PL: if( scalar(@ARGV)==0 )
380 | 2 | | try: #PL: open (STDIN, ">-");
380 | 3 | | sys.stdin=open('-','w') #PL: open (STDIN, ">-");
380 | 2 | | except OSError: #PL: open (STDIN, ">-");
380 | 3 | | sys.exit() #PL: open (STDIN, ">-");
381 | 2 | | write_FormattedSource=0 #PL: $write_FormattedSource=0;
382 | 2 | | return() #PL: return;
384 | 1 | |
385 | 1 | |
387 | 1 | | if len(sys.argv)==1: #PL: if( scalar(@ARGV)==1 )
388 | 2 | | fname=sys.argv[0] #PL: $fname=$ARGV[0];
390 | 2 | | if not os.path.isfile(fname): #PL: unless( -f $fname )
391 | 3 | | raise(f"Unable to open file {sys.argv[0]}") #PL: die ("Unable to open file $ARGV[0]");
393 | 2 | |
394 | 2 | | try: #PL: open (STDIN, "<$fname");
394 | 3 | | sys.stdin=open(f"{fname}",'r') #PL: open (STDIN, "<$fname");
394 | 2 | | except OSError: #PL: open (STDIN, "<$fname");
394 | 3 | | sys.exit() #PL: open (STDIN, "<$fname");
397 | 1 | | else: #PL: else
398 | 2 | | args=sys.argv.join(' ') #PL: $args=join(' ', @ARGV);
400 | 2 | | raise(f"Too many arguments: {args}") #PL: die ("Too many arguments: $args")
401 | 1 | |
402 | 1 | |
404 | 0 | |
405 | 0 | |#
406 | 0 | |###================================================= NAMESPACE sp: My SP toolkit subroutines
407 | 0 | |#
408 | 0 | |#
409 | 0 | |# Create backup and commit script to GIT repository if there were changes from previous version.
410 | 0 | |#
411 | 0 | |#package sp;
413 | 0 | |def autocommit(perl_arg_array): #PL: sub autocommit
414 | 1 | | # parameters
415 | 1 | | archive_dir=perl_arg_array[0] #PL: my $archive_dir=$_[0]; # typically home or $HOME/bin
416 | 1 | | git_repo=perl_arg_array[1] #PL: my $git_repo=$_[1]; # GIT dir
417 | 1 | | script_name=__file__[__file__.rfind('/')+1:] #PL: my $script_name=substr($0,rindex($0,'/')+1);
418 | 1 | |
419 | 1 | | #
420 | 1 | | # commit each running version to the repository to central GIT
421 | 1 | | #
422 | 1 | |
423 | 1 | | script_timestamp=None #PL: my $script_timestamp;
424 | 1 | | script_delta=1 #PL: my $script_delta=1;
425 | 1 | | host='hostname -s' #PL: my $host=`hostname -s`;
426 | 1 | | host=host.rstrip("\n") #PL: chomp($host);
427 | 1 | | if not os.path.isdir(archive_dir): #PL: ( ! -d $archive_dir ) && `mkdir -p $archive_dir`;
427 | 2 | | default_var=subprocess.run(f"mkdir -p {archive_dir}",capture_output=True,text=True,shell=True) #PL: `mkdir -p $archive_dir`;
427 | 2 | | subprocess_rc=default_var.returncode #PL: `mkdir -p $archive_dir`;
429 | 1 | | if os.path.isfile(f"{archive_dir}/{script_name}"): #PL: if( -f "$archive_dir/$script_name" )
430 | 2 | | #if( (-s $0) == ( -s "$archive_dir/$script_name" ) ) # error with missing closing pareth.
432 | 2 | | if os.path.getsize(__file__)==os.path.getsize(f"{archive_dir}/{script_name}"): #PL: if( -s $0 == -s "$archive_dir/$script_name" )
433 | 3 | | default_var=subprocess.run(f"diff {__file__} {archive_dir}/{script_name}",capture_output=True,text=True,shell=True) #PL: `diff $0 $archive_dir/$script_name`;
433 | 3 | | subprocess_rc=default_var.returncode #PL: `diff $0 $archive_dir/$script_name`;
434 | 3 | | script_delta=0 if subprocess_rc==0 else 1 #PL: $script_delta=( $? == 0 )? 0: 1;
436 | 2 | |
437 | 2 | |
439 | 2 | | if script_delta: #PL: if( $script_delta )
440 | 3 | | script_timestamp=(script_timestamp:=subprocess.run(f'date -r {archive_dir}/{script_name} +"%y%m%d_%H%M"',capture_output=True,text=True,shell=True).stdout).rstrip("\n") #PL: chomp($script_timestamp=`date -r $archive_dir/$script_name +"%y%m%d_%H%M"`);
441 | 3 | | default_var=subprocess.run(f"mv {archive_dir}/{script_name} {archive_dir}/{script_name}.{script_timestamp}",capture_output=True,text=True,shell=True) #PL: `mv $archive_dir/$script_name $archive_dir/$script_name.$script_timestamp`;
441 | 3 | | subprocess_rc=default_var.returncode #PL: `mv $archive_dir/$script_name $archive_dir/$script_name.$script_timestamp`;
442 | 3 | |
444 | 2 | |
446 | 1 | |
447 | 1 | | if script_delta: #PL: ($script_delta) && `cp -p $0 $archive_dir/$script_name`;
447 | 2 | | default_var=subprocess.run(f"cp -p {__file__} {archive_dir}/{script_name}",capture_output=True,text=True,shell=True) #PL: `cp -p $0 $archive_dir/$script_name`;
447 | 2 | | subprocess_rc=default_var.returncode #PL: `cp -p $0 $archive_dir/$script_name`;
448 | 1 | | if git_repo: #PL: ($git_repo) && `cd $archive_dir && git commit $0`;
448 | 2 | | default_var=subprocess.run(f"cd {archive_dir} && git commit {__file__}",capture_output=True,text=True,shell=True) #PL: `cd $archive_dir && git commit $0`;
448 | 2 | | subprocess_rc=default_var.returncode #PL: `cd $archive_dir && git commit $0`;
450 | 0 | |# commit_source
451 | 0 | |
452 | 0 | |# Read script and extract help from comments starting with #::
453 | 0 | |#
455 | 0 | |def helpme(perl_arg_array): #PL: sub helpme
455 | 1 | | global line #PL: sub helpme
456 | 1 | | try: #PL: open(SYSHELP,"<$0");
456 | 2 | | SYSHELP=open(f"{__file__}",'r') #PL: open(SYSHELP,"<$0");
456 | 1 | | except OSError: #PL: open(SYSHELP,"<$0");
456 | 2 | | sys.exit() #PL: open(SYSHELP,"<$0");
458 | 1 | | while line in SYSHELP.readline(): #PL: while($line=<SYSHELP> )
460 | 2 | | if line[0]=='#::': #PL: if( substr($line,0,3) eq "#::" )
461 | 3 | | print(line[3:],file=sys.stderr,end="") #PL: print STDERR substr($line,3);
463 | 2 | |
465 | 1 | | # for
466 | 1 | | SYSHELP.f.close; #PL: close SYSHELP;
467 | 1 | | sys.exit() #PL: exit;
469 | 0 | |
470 | 0 | |
471 | 0 | |#
472 | 0 | |# Terminate program (variant without mailing)
473 | 0 | |#
475 | 0 | |def abend(perl_arg_array): #PL: sub abend
475 | 1 | | global MessagePrefix #PL: sub abend
476 | 1 | | message=None #PL: my $message;
477 | 1 | | [package,filename,lineno]=unknown #PL: my ($package, $filename, $lineno) = caller;
479 | 1 | | if len(perl_arg_array)==0: #PL: if( scalar(@_)==0 )
480 | 2 | | message=MessagePrefix + lineno + f"T ABEND at {lineno}. No message was provided. Exiting."
#PL: $message=$MessagePrefix.$lineno."T ABEND at $lineno. No message was provided. E
Cont: xiting.";
483 | 1 | | else: #PL: else
484 | 2 | | message=MessagePrefix + lineno + f"T {perl_arg_array[0]}. Exiting " #PL: $message=$MessagePrefix.$lineno."T $_[0]. Exiting ";
486 | 1 | |
487 | 1 | | # Syslog might not be available
488 | 1 | | out([message]) #PL: out($message);
489 | 1 | | #[EMAIL] banner('ABEND');
490 | 1 | | raise('Internal error') #PL: die('Internal error');
491 | 1 | |
493 | 0 | |# abend
494 | 0 | |
495 | 0 | |#
496 | 0 | |# Open log and output the banner; if additional arguments given treat them as subtitles
497 | 0 | |# depends of two variable from main namespace: VERSION and debug
499 | 0 | |def banner(perl_arg_array): #PL: sub banner
500 | 1 | | #
501 | 1 | | # Sanity check
502 | 1 | | #
504 | 1 | | if len(perl_arg_array)<4 and perl_arg_array[0]=='ABEND': #PL: if( scalar(@_)<4 && $_[0] eq 'ABEND' )
505 | 2 | | SYSLOG.f.close; #PL: close SYSLOG;
506 | 2 | | #`cat $logfile | mail -s "[ABEND for $HOSTNAME/$SCRIPT_NAME] $_[0] $PrimaryAdmin`;
507 | 2 | | return() #PL: return;
509 | 1 | |
510 | 1 | | #
511 | 1 | | # Decode obligatory arguments
512 | 1 | | #
513 | 1 | | my_log_dir=perl_arg_array[0] #PL: $my_log_dir=$_[0];
514 | 1 | | script_name=perl_arg_array[1] #PL: my $script_name=$_[1];
515 | 1 | | title=perl_arg_array[2] #PL: my $title=$_[2]; # this is an optional argumnet which is print STDERRed as subtitle after the title.
516 | 1 | | log_retention_period=perl_arg_array[3] #PL: my $log_retention_period=$_[3];
517 | 1 | |
518 | 1 | | timestamp='date "+%y/%m/%d %H:%M"' #PL: my $timestamp=`date "+%y/%m/%d %H:%M"`; chomp $timestamp;
518 | 1 | | timestamp=timestamp.rstrip("\n") #PL: chomp $timestamp;
519 | 1 | | day="date '+%d'" #PL: my $day=`date '+%d'`; chomp $day;
519 | 1 | | day=day.rstrip("\n") #PL: chomp $day;
520 | 1 | | logstamp='date +"%y%m%d_%H%M"' #PL: my $logstamp=`date +"%y%m%d_%H%M"`; chomp $logstamp;
520 | 1 | | logstamp=logstamp.rstrip("\n") #PL: chomp $logstamp;
521 | 1 | | script_mod_stamp=None #PL: my $script_mod_stamp;
522 | 1 | | script_mod_stamp=(script_mod_stamp:=subprocess.run(f'date -r {__file__} +"%y%m%d_%H%M"',capture_output=True,text=True,shell=True).stdout).rstrip("\n") #PL: chomp($script_mod_stamp=`date -r $0 +"%y%m%d_%H%M"`);
524 | 1 | | if os.path.isdir(my_log_dir): #PL: if( -d $my_log_dir )
526 | 2 | | if 1==day and log_retention_period>0: #PL: if( 1 == $day && $log_retention_period>0 )
527 | 3 | | #Note: in debugging script home dir is your home dir and the last thing you want is to clean it ;-)
528 | 3 | | default_var=subprocess.run(f'find {my_log_dir}""" -name "*.log" -type f -mtime +"""{log_retention_period} -delete',capture_output=True,text=True,shell=True) # monthly cleanup
#PL: `find $my_log_dir -name "*.log" -type f -mtime +$log_retention_period -delete`;
528 | 3 | | subprocess_rc=default_var.returncode # monthly cleanup
#PL: `find $my_log_dir -name "*.log" -type f -mtime +$log_retentio
530 | 2 | |
533 | 1 | | else: #PL: else
534 | 2 | | default_var=subprocess.run(f"mkdir -p {my_log_dir}",capture_output=True,text=True,shell=True) #PL: `mkdir -p $my_log_dir`;
534 | 2 | | subprocess_rc=default_var.returncode #PL: `mkdir -p $my_log_dir`;
536 | 1 | |
537 | 1 | |
538 | 1 | | logfile=f"{my_log_dir}/{script_name}.{logstamp}.log" #PL: $logfile="$my_log_dir/$script_name.$logstamp.log";
539 | 1 | | try: #PL: open(SYSLOG, ">$logfile") || abend(__LINE__,"Fatal error: unable to open $logfile");
539 | 2 | | SYSLOG=open(f"{logfile}",'w') #PL: open(SYSLOG, ">$logfile") || abend(__LINE__,"Fatal error: unable to open $logfile");
539 | 1 | | except OSError: #PL: open(SYSLOG, ">$logfile") || abend(__LINE__,"Fatal error: unable to open $logfile");
539 | 2 | | abend([sys._getframe().f_lineno,f"Fatal error: unable to open {logfile}"]) #PL: abend(__LINE__,"Fatal error: unable to open $logfile");
540 | 1 | | title='\n\n' + script_name.upper() + f": {title} (last modified {script_mod_stamp}) Running at {timestamp}\nLogs are at {logfile}. Type -h for help.\n"
#PL: $title="\n\n".uc($script_name).": $title (last modified $script_mod_stamp) Runni
Cont: ng at $timestamp\nLogs are at $logfile. Type -h for help.\n";
541 | 1 | | out([title]) # output the banner
#PL: out($title);
543 | 1 | | for i in range(4,len(perl_arg_array)): #PL: for( my $i=4; $i<@_; $i++)
544 | 2 | | out([default_var[i]]) # optional subtitles
#PL: out($_[$i]);
546 | 1 | |
547 | 1 | | out(['================================================================================\n\n'])
#PL: out ("==========================================================================
Cont: ======\n\n");
549 | 0 | |#banner
550 | 0 | |
551 | 0 | |#
552 | 0 | |# Message generator: Record message in log and STDIN
553 | 0 | |# PARAMETERS:
554 | 0 | |# lineno, severity, message
555 | 0 | |# ARG1 lineno, If it is negative skip this number of lines
556 | 0 | |# Arg2 Error code (the first letter is severity, the second letter can be used -- T is timestamp -- put timestamp inthe message)
557 | 0 | |# Arg3 Text of the message
558 | 0 | |# NOTE: $top_severity, $verbosity1, $verbosity1 are state variables that are initialized via special call to sp:: sp::logmes
559 | 0 | |
561 | 0 | |def logme(perl_arg_array): #PL: sub logme
561 | 1 | | global MessagePrefix #PL: sub logme
562 | 1 | | #our $top_severity; -- should be defined globally
563 | 1 | | error_code=perl_arg_array[0][0] #PL: my $error_code=substr($_[0],0,1);
564 | 1 | | error_suffix=perl_arg_array[0][1] if len(perl_arg_array[0])>1 else '' # suffix T means add timestamp
#PL: my $error_suffix=(length($_[0])>1) ? substr($_[0],1,1):'';
565 | 1 | | message=perl_arg_array[1] #PL: my $message=$_[1];
566 | 1 | | message=message.rstrip("\n") # we will add \n ourselves
#PL: chomp($message);
567 | 1 | |
568 | 1 | | global logme_verbosity1 # $verbosity console
#PL: state $verbosity1;
569 | 1 | | global logme_verbosity2 # $verbosity for log
#PL: state $verbosity2;
570 | 1 | | global logme_msg_cutlevel1 # variable 6-$verbosity1
#PL: state $msg_cutlevel1;
571 | 1 | | global logme_msg_cutlevel2 # variable 5-$verbosity2
#PL: state $msg_cutlevel2;
572 | 1 | | global logme_ermessage_db # accumulates messages for each caterory (warning, errors and severe errors)
#PL: state @ermessage_db;
573 | 1 | | global logme_ercounter #PL: state @ercounter;
574 | 1 | | delim='=' * 80 #PL: state $delim='=' x 80;
575 | 1 | | global logme_MessagePrefix #PL: state $MessagePrefix='';
576 | 1 | |
577 | 1 | | #
578 | 1 | | # special cases -- ercode "D" means set msglevel1 and msglevel2, ' ' means print STDERR in log and console -- essentially out with messsage header
579 | 1 | | #
580 | 1 | |
582 | 1 | | if error_code=='D': #PL: if( $error_code eq 'D' )
583 | 2 | | # NOTE You can dynamically change verbosity within the script by issue D message.
584 | 2 | | # Set script name and message prefix
586 | 2 | | if logme_MessagePrefix=='': #PL: if ( $MessagePrefix eq '')
587 | 3 | | logme_MessagePrefix=__file__[__file__.rfind('/')+1:] #PL: $MessagePrefix=substr($0,rindex($0,'/')+1);
588 | 3 | | logme_MessagePrefix=logme_MessagePrefix[0] #PL: $MessagePrefix=substr( $MessagePrefix,0,4);
590 | 2 | |
591 | 2 | | logme_verbosity1=perl_arg_array[1] #PL: $verbosity1=$_[1];
592 | 2 | | logme_verbosity2=perl_arg_array[2] #PL: $verbosity2=$_[2];
593 | 2 | |
594 | 2 | | logme_msg_cutlevel1=len('WEST')-logme_verbosity1-1 # verbosity 3 is max and means 4-3-1 =0 -- the index corresponding to code 'W'
#PL: $msg_cutlevel1=length("WEST")-$verbosity1-1;
595 | 2 | | logme_msg_cutlevel2=len('WEST')-logme_verbosity2-1 # same for log only (like in MSGLEVEL mainframes ;-)
#PL: $msg_cutlevel2=length("WEST")-$verbosity2-1;
596 | 2 | |
597 | 2 | | return() #PL: return;
599 | 1 | |
601 | 1 | | if not error_code: #PL: unless ( $error_code )
602 | 2 | | # Blank error code is old equivalent of out: put obligatory message on console and into log
603 | 2 | | out([message]) #PL: out($message);
604 | 2 | | return() #PL: return;
606 | 1 | |
607 | 1 | | #
608 | 1 | | # detect caller lineno.
609 | 1 | | #
610 | 1 | | [package,filename,lineno]=unknown #PL: my ($package, $filename, $lineno) = caller;
611 | 1 | | #
612 | 1 | | # Generate diagnostic message from error code, line number and message (optionally timestamp is suffix of error code is T)
613 | 1 | | #
614 | 1 | | message=f"{MessagePrefix}\-{lineno}{error_code}: {message}" #PL: $message="$MessagePrefix\-$lineno$error_code: $message";
615 | 1 | | severity='west'.find(error_code.lower()) #PL: my $severity=index("west",lc($error_code));
617 | 1 | | if severity==-1: #PL: if( $severity == -1 )
618 | 2 | | out([message]) #PL: out($message);
619 | 2 | | return() #PL: return;
621 | 1 | |
622 | 1 | |
623 | 1 | | logme_ercounter[severity]+=1 #Increase messages counter for given severity (supressed messages are counted too)
#PL: $ercounter[$severity]++;
624 | 1 | | logme_ermessage_db[severity]+=f"\n\n{message}" #Error history for the ercodes E and S
#PL: $ermessage_db[$severity] .= "\n\n$message";
625 | 1 | | if severity<logme_msg_cutlevel1 and severity<logme_msg_cutlevel2: # no need to process if this is lower then both msglevels
#PL: return if( $severity<$msg_cutlevel1 && $severity<$msg_cutlevel2 );
625 | 2 | | return() #PL: return if( $severity<$msg_cutlevel1 && $severity<$msg_cutlevel2 );
626 | 1 | | #
627 | 1 | | # Stop processing if severity is less then current msglevel1 and msglevel2
628 | 1 | | #
630 | 1 | | if severity<3: #PL: if( $severity < 3 )
632 | 2 | | if severity>=logme_msg_cutlevel2: #PL: if( $severity >= $msg_cutlevel2 )
633 | 3 | | # $msg_cutlevel2 defines writing to SYSLOG. 3 means Errors (Severe and terminal messages always whould be print STDERRed)
635 | 3 | | if severity<4: #PL: if( $severity<4 )
636 | 4 | | print(f"{message}\n",file=SYSLOG,end="") #PL: print SYSLOG "$message\n";
639 | 3 | | else: #PL: else
640 | 4 | | # special treatment of serious messages
641 | 4 | | print(f"{delim}\n{message}\n{delim}\n",file=SYSLOG,end="") #PL: print SYSLOG "$delim\n$message\n$delim\n";
643 | 3 | |
645 | 2 | |
647 | 2 | | if severity>=logme_msg_cutlevel1: #PL: if( $severity >= $msg_cutlevel1 )
648 | 3 | | # $msg_cutlevel1 defines writing to STDIN. 3 means Errors (Severe and terminal messages always whould be print STDERRed)
650 | 3 | | if severity<2: #PL: if( $severity<2 )
651 | 4 | | print(f"{message}\n",file=sys.stderr,end="") #PL: print STDERR "$message\n";
654 | 3 | | else: #PL: else
655 | 4 | | print(f"{delim}\n{message}\n{delim}\n",file=sys.stderr,end="") #PL: print STDERR "$delim\n$message\n$delim\n";
657 | 3 | |
659 | 2 | |
661 | 2 | | if len(__main__.STOP_STRING)>0 and __main__.STOP_STRING.find(error_code)>-1: #PL: if (length($::STOP_STRING)>0 && index($::STOP_STRING,$error_code) >-1 )
662 | 3 | | pdb.set_trace() #PL: $DB::single = 1;
664 | 2 | |
665 | 2 | | return() #PL: return;
667 | 1 | | # $severity<3
668 | 1 | | # severity=3 -- error code T
669 | 1 | | # Here we processing error code 'T' which means "Issue error summary and normally terminate"
670 | 1 | | # termination will be using die if the message suffix is "A" -- Nov 12, 2015
671 | 1 | | #
672 | 1 | |
673 | 1 | | summary='' #PL: my $summary='';
674 | 1 | |
675 | 1 | | #
676 | 1 | | # We will put the most severe errors at the end and make 15 sec pause before read them
677 | 1 | | #
678 | 1 | | out([f"\n{message}"]) #PL: out("\n$message");
680 | 1 | | for counter in range(1,len('WES')): #PL: for( my $counter=1; $counter<length('WES'); $counter++ )
682 | 2 | | if logme_ercounter != none[counter]: #PL: if( defined($ercounter[$counter]) )
683 | 3 | | summary+=' ' + 'WES'[counter:counter + 1] + ': ' + logme_ercounter[counter] #PL: $summary.=" ".substr('WES',$counter,1).": ".$ercounter[$counter];
686 | 2 | | else: #PL: else
687 | 3 | | logme_ercounter[counter]=0 #PL: $ercounter[$counter]=0;
689 | 2 | |
691 | 1 | | # for
692 | 1 | | if summary: #PL: ($summary) && out("\n=== SUMMARY OF ERRORS: $summary\n");
692 | 2 | | out([f"\n=== SUMMARY OF ERRORS: {summary}\n"]) #PL: out("\n=== SUMMARY OF ERRORS: $summary\n");
694 | 1 | | if logme_ercounter[1]+logme_ercounter[2]: #PL: if( $ercounter[1] + $ercounter[2] )
695 | 2 | | # print STDERR errors & severe errors
697 | 2 | | for severity in range(1,3): #PL: for( $severity=1; $severity<3; $severity++ )
698 | 3 | | # $ermessage_db[$severity]
700 | 3 | | if logme_ercounter[severity]>0: #PL: if( $ercounter[$severity] > 0 )
701 | 4 | | out([f"{ermessage_db[severity]}\n\n"]) #PL: out("$ermessage_db[$severity]\n\n");
703 | 3 | |
705 | 2 | |
706 | 2 | | if logme_ercounter[2]>0: #PL: ($ercounter[2]>0) && out("\n*** PLEASE CHECK $ercounter[2] SERIOUS MESSAGES ABOVE");
706 | 3 | | out([f"\n*** PLEASE CHECK {ercounter[2]} SERIOUS MESSAGES ABOVE"]) #PL: out("\n*** PLEASE CHECK $ercounter[2] SERIOUS MESSAGES ABOVE");
708 | 1 | |
709 | 1 | |
710 | 1 | | #
711 | 1 | | # Compute RC code: 10 or higher there are serious messages
712 | 1 | | #
713 | 1 | | rc=0 #PL: my $rc=0;
715 | 1 | | if logme_ercounter[2]>0: #PL: if( $ercounter[2]>0 )
716 | 2 | | rc=10*logme_ercounter[2] if logme_ercounter[2]<9 else 90 #PL: $rc=($ercounter[2]<9) ? 10*$ercounter[2] : 90;
718 | 1 | |
720 | 1 | | if logme_ercounter[1]>0: #PL: if( $ercounter[1]>0 )
721 | 2 | | rc=logme_ercounter[2] if logme_ercounter[1]<9 else 9 #PL: $rc=($ercounter[1]<9) ? $ercounter[2] : 9;
723 | 1 | |
724 | 1 | | sys.exit(rc) #PL: exit $rc;
725 | 0 | |logme_msg_cutlevel2=logme_MessagePrefix=logme_msg_cutlevel1=logme_ermessage_db=logme_verbosity1=logme_verbosity2=None #PL: exit $rc;
726 | 0 | |# logme
727 | 0 | |
728 | 0 | |#
729 | 0 | |# Output message to both log and STDERR
730 | 0 | |#
732 | 0 | |def out(perl_arg_array): #PL: sub out
734 | 1 | | if len(perl_arg_array)==0: #PL: if( scalar(@_)==0 )
735 | 2 | | print(file=sys.stderr) #PL: say STDERR;
736 | 2 | | #say SYSLOG;
737 | 2 | | return() #PL: return;
739 | 1 | |
740 | 1 | | print(perl_arg_array[0],file=sys.stderr) #PL: say STDERR $_[0];
741 | 1 | | #say SYSLOG $_[0];
744 | 0 | |def getopts(perl_arg_array): #PL: sub getopts
745 | 1 | | [options_def,options_hash]=perl_arg_array #PL: my ($options_def,$options_hash)=@_;
746 | 1 | | first=rest=pos=cur_opt=None #PL: my ($first,$rest,$pos,$cur_opt);
747 | 1 | | while sys.argv: #PL: while(@ARGV){
748 | 2 | | cur_opt=sys.argv[0] #PL: $cur_opt=$ARGV[0];
749 | 2 | | if cur_opt[0]!='-': #PL: last if( substr($cur_opt,0,1) ne '-' );
749 | 3 | | break #PL: last if( substr($cur_opt,0,1) ne '-' );
750 | 2 | | if cur_opt=='--': #PL: if ($cur_opt eq '--'){
751 | 3 | | sys.argv.pop(0) #PL: shift @ARGV;
752 | 3 | | break #PL: last;
754 | 2 | | first=cur_opt[1] #PL: $first=substr($cur_opt,1,1);
755 | 2 | | pos=options_def.find(first) #PL: $pos = index($options_def,$first);
756 | 2 | | if pos==-1: #PL: if( $pos==-1) {
757 | 3 | | print((f"Undefined option -{first} skipped without processing\n"),file=STDERR) #PL: warn("Undefined option -$first skipped without processing\n");
758 | 3 | | sys.argv.pop(0) #PL: shift(@ARGV);
759 | 3 | | continue #PL: next;
761 | 2 | | rest=cur_opt[2:] #PL: $rest=substr($cur_opt,2);
762 | 2 | | if pos<len(options_def)-1 and options_def[pos+1:pos+1 + 1]==':': #PL: if( $pos<length($options_def)-1 && substr($options_def,$pos+1,1) eq ':' ){
763 | 3 | | # option with parameters
764 | 3 | | if rest=='': #PL: if( $rest eq ''){
765 | 4 | | sys.argv.pop(0) # get the value of option
#PL: shift(@ARGV);
766 | 4 | | if not sys.argv: #PL: unless( @ARGV ){
767 | 5 | | print((f"End of line reached for option -{first} which requires argument\n"),file=STDERR) #PL: warn("End of line reached for option -$first which requires argument\n");
768 | 5 | | options_hash[first]='' #PL: $$options_hash{$first}='';
769 | 5 | | break #PL: last;
771 | 4 | | if re.match(r'^-',sys.argv[0]): #PL: if ( $ARGV[0] =~/^-/ ) {
772 | 5 | | print((f"Option -{first} requires argument\n"),file=STDERR) #PL: warn("Option -$first requires argument\n");
773 | 5 | | options_hash[first]='' #PL: $$options_hash{$first} = '';
774 | 4 | | else: #PL: else{
775 | 5 | | options_hash[first]=sys.argv[0] #PL: $$options_hash{$first}=$ARGV[0];
776 | 5 | | sys.argv.pop(0) # get next chunk
#PL: shift(@ARGV);
778 | 3 | | else: #PL: else {
779 | 4 | | #value is concatenated with option like -ddd
780 | 4 | | if (first * len(rest))==rest: #PL: if( ($first x length($rest)) eq $rest ){
781 | 5 | | options_hash[first]=len(rest)+1 #PL: $$options_hash{$first} = length($rest)+1;
782 | 4 | | else: #PL: else{
783 | 5 | | options_hash[first]=rest #PL: $$options_hash{$first}=$rest;
785 | 4 | | sys.argv.pop(0) #PL: shift(@ARGV);
787 | 2 | | else: #PL: else {
788 | 3 | | options_hash[first]=1 # set the option
#PL: $$options_hash{$first} = 1;
789 | 3 | | if rest=='': #PL: if ($rest eq '') {
790 | 4 | | sys.argv.pop(0) #PL: shift(@ARGV);
791 | 3 | | else: #PL: else {
792 | 4 | | sys.argv[0]=f"-{rest}" # there can be other options without arguments after the first
#PL: $ARGV[0] = "-$rest";
797 | 0 | |
799 | 0 | |def step(perl_arg_array): #PL: sub step
800 | 1 | | pdb.set_trace() #PL: $DB::single = 1;
802 | 0 | |
804 | 0 | |def main(perl_arg_array): #PL: sub main
804 | 1 | | global cur_nest,keyword,FormattedSource,breakpoint,noformat,sublineno,sourcelineno,datalineno,SourceText,mainlineno,ChannelNo,FormattedMain,FormattedSub,lineno,line,debug,FormattedData,SubList,fname,tab,InfoTags,new_nest #PL: sub main
805 | 1 | | global fname #PL: own $fname;
806 | 1 | | VERSION='0.1' # alpha vestion
#PL: $VERSION='0.1';
807 | 1 | | debug=1 # 0 production mode 1 - development/testing mode. 2-9 debugging modes
#PL: $debug=1;
808 | 1 | |
809 | 1 | | #$debug=1; # enable saving each source version without compile errors to GIT
810 | 1 | | #$debug=2; # starting from debug=2 the results are not written to disk
811 | 1 | | #$debug=3; # starting from Debug=3 only the first chunk processed
812 | 1 | | STOP_STRING='' # In debug mode gives you an ability to switch trace on any type of error message for example S (via hook in logme).
#PL: $STOP_STRING='';
813 | 1 | | use_git_repo='' #PL: $use_git_repo='';
814 | 1 | |
815 | 1 | | # You can switch on tracing from particular line of source ( -1 to disable)
816 | 1 | | breakpoint=-1 #PL: $breakpoint=-1;
817 | 1 | | SCRIPT_NAME=__file__[__file__.rfind('/')+1:] #PL: $SCRIPT_NAME=substr($0,rindex($0,'/')+1);
819 | 1 | | if (dotpos:=SCRIPT_NAME.find('.'))>-1: #PL: if( ($dotpos=index($SCRIPT_NAME,'.'))>-1 )
820 | 2 | | SCRIPT_NAME=SCRIPT_NAME[0:dotpos] #PL: $SCRIPT_NAME=substr($SCRIPT_NAME,0,$dotpos);
822 | 1 | |
823 | 1 | |
824 | 1 | | OS=os.name # $^O is built-in Perl variable that contains OS name
#PL: $OS=$^O;
825 | 1 | |
826 | 1 | | HOME='/cygdrive/f/_Scripts' # $HOME/Archive is used for backups
#PL: $HOME="/cygdrive/f/_Scripts";
828 | 1 | | if OS=='linux': #PL: if($OS eq 'linux' )
829 | 2 | | HOME=os.environ['HOME'] # $HOME/Archive is used for backups
#PL: $HOME=$ENV{'HOME'};
831 | 1 | |
832 | 1 | | LOG_DIR=f"/tmp/{SCRIPT_NAME}" #PL: $LOG_DIR="/tmp/$SCRIPT_NAME";
833 | 1 | | FormattedMain=['sub main\n','{\n'] #PL: @FormattedMain=("sub main\n","{\n");
834 | 1 | | FormattedSource=[] #PL: @FormattedSource=@FormattedSub=@FormattedData=();
834 | 1 | | FormattedSub=[] #PL: @FormattedSource=@FormattedSub=@FormattedData=();
834 | 1 | | FormattedData=[] #PL: @FormattedSource=@FormattedSub=@FormattedData=();
835 | 1 | | mainlineno=len(FormattedMain) # we need to reserve one line for sub main
#PL: $mainlineno=scalar( @FormattedMain);
836 | 1 | | sourcelineno=sublineno=datalineno=0 #PL: $sourcelineno=$sublineno=$datalineno=0;
837 | 1 | |
838 | 1 | | tab=4 #PL: $tab=4;
839 | 1 | | nest_corrections=0 #PL: $nest_corrections=0;
840 | 1 | | keyword={'if': 1,'while': 1,'unless': 1,'until': 1,'for': 1,'foreach': 1,'given': 1,'when': 1,'default': 1}
#PL: %keyword=('if'=>1,'while'=>1,'unless'=>1, 'until'=>1,'for'=>1,'foreach'=>1,'give
Cont: n'=>1,'when'=>1,'default'=>1);
841 | 1 | |
842 | 1 | | banner([LOG_DIR,SCRIPT_NAME,'PREPYTHONIZER: Phase 1 of pythonizer',30]) # Opens SYSLOG and print STDERRs banner; parameter 4 is log retention period
#PL: banner($LOG_DIR,$SCRIPT_NAME,'PREPYTHONIZER: Phase 1 of pythonizer',30);
843 | 1 | | #get_params(); # At this point debug flag can be reset
845 | 1 | | if debug>0: #PL: if( $debug>0 )
846 | 2 | | print(f"ATTENTION!!! {SCRIPT_NAME} is working in debugging mode {debug} with autocommit of source to {HOME}/Archive\n",file=sys.stderr,end="")
#PL: print STDERR "ATTENTION!!! $SCRIPT_NAME is working in debugging mode $debug with
Cont: autocommit of source to $HOME/Archive\n";
847 | 2 | | autocommit([f"{HOME}/Archive",use_git_repo]) # commit source archive directory (which can be controlled by GIT)
#PL: autocommit("$HOME/Archive",$use_git_repo);
849 | 1 | |
850 | 1 | | print(f"Log is written to {LOG_DIR}, The original file will be saved as {fname}.original unless this file already exists ",)
#PL: say "Log is written to $LOG_DIR, The original file will be saved as $fname.origi
Cont: nal unless this file already exists ";
851 | 1 | | print('=' * 80,'\n',file=sys.stderr) #PL: say STDERR "=" x 80,"\n";
852 | 1 | |
853 | 1 | | #
854 | 1 | | # Main loop initialization variables
855 | 1 | | #
856 | 1 | | new_nest=cur_nest=0 #PL: $new_nest=$cur_nest=0;
857 | 1 | | #$top=0; $stack[$top]='';
858 | 1 | | lineno=noformat=SubsNo=0 #PL: $lineno=$noformat=$SubsNo=0;
859 | 1 | | here_delim='\n' # impossible combination
#PL: $here_delim="\n";
860 | 1 | | InfoTags='' #PL: $InfoTags='';
861 | 1 | | SourceText=sys.stdin.readlines().copy #PL: @SourceText=<STDIN>;
862 | 1 | |
863 | 1 | | #
864 | 1 | | # Slurp the initial comment block and use statements
865 | 1 | | #
866 | 1 | | ChannelNo=lineno=0 #PL: $ChannelNo=$lineno=0;
868 | 1 | | while True: #PL: while(1)
870 | 2 | | if lineno==breakpoint: #PL: if( $lineno == $breakpoint )
872 | 3 | | pdb.set_trace() #PL: $DB::single = 1
873 | 2 | |
874 | 2 | | line=(line:=SourceText[lineno]).rstrip("\n") #PL: chomp($line=$SourceText[$lineno]);
876 | 2 | | if re.match(r'^\s*$',line): #PL: if( $line=~/^\s*$/ )
877 | 3 | | process_line(['\n',-1000]) #PL: process_line("\n",-1000);
878 | 3 | | lineno+=1 #PL: $lineno++;
879 | 3 | | continue #PL: next;
881 | 2 | |
882 | 2 | | intact_line=line #PL: $intact_line=$line;
884 | 2 | | if intact_line[0]=='#': #PL: if( substr($intact_line,0,1) eq '#' )
885 | 3 | | process_line([line,-1000]) #PL: process_line($line,-1000);
886 | 3 | | lineno+=1 #PL: $lineno++;
887 | 3 | | continue #PL: next;
889 | 2 | |
890 | 2 | | line=([line]) #PL: $line=normalize_line($line);
891 | 2 | | line=line.rstrip("\n") #PL: chomp($line);
892 | 2 | | [line]=re.split(' ',line,1) #PL: ($line)=split(' ',$line,1);
894 | 2 | | if re.match(r'^use\s+',line): #PL: if($line=~/^use\s+/)
895 | 3 | | process_line([line,-1000]) #PL: process_line($line,-1000);
898 | 2 | | else: #PL: else
899 | 3 | | break #PL: last;
901 | 2 | |
902 | 2 | | lineno+=1 #PL: $lineno++;
904 | 1 | | #while
905 | 1 | | #
906 | 1 | | # MAIN LOOP
907 | 1 | | #
908 | 1 | | ChannelNo=1 #PL: $ChannelNo=1;
910 | 1 | | for lineno in range(lineno,len(len(SourceText))): #PL: for( ; $lineno<@SourceText; $lineno++ )
911 | 2 | | line=SourceText[lineno] #PL: $line=$SourceText[$lineno];
912 | 2 | | offset=0 #PL: $offset=0;
913 | 2 | | line=line.rstrip("\n") #PL: chomp($line);
914 | 2 | | intact_line=line #PL: $intact_line=$line;
916 | 2 | | if lineno==breakpoint: #PL: if( $lineno == $breakpoint )
918 | 3 | | pdb.set_trace() #PL: $DB::single = 1
919 | 2 | |
920 | 2 | | line=([line]) #PL: $line=normalize_line($line);
921 | 2 | |
922 | 2 | | #
923 | 2 | | # Check for HERE line
924 | 2 | | #
925 | 2 | |
927 | 2 | | if noformat: #PL: if($noformat)
929 | 3 | | if line==here_delim: #PL: if( $line eq $here_delim )
930 | 4 | | noformat=0 #PL: $noformat=0;
931 | 4 | | InfoTags='' #PL: $InfoTags='';
933 | 3 | |
934 | 3 | | process_line([line,-1000]) #PL: process_line($line,-1000);
935 | 3 | | continue #PL: next;
937 | 2 | |
938 | 2 | |
940 | 2 | | if (default_match:=re.match(r"""<<['"](\w+)['"]$""",line)): #PL: if( $line =~/<<['"](\w+)['"]$/ )
941 | 3 | | here_delim=default_match.group(1) #PL: $here_delim=$1;
942 | 3 | | noformat=1 #PL: $noformat=1;
943 | 3 | | InfoTags='HERE' #PL: $InfoTags='HERE';
945 | 2 | |
946 | 2 | | #
947 | 2 | | # check for comment lines
948 | 2 | | #
950 | 2 | | if line[0]=='#': #PL: if( substr($line,0,1) eq '#' )
952 | 3 | | if line=='#%OFF': #PL: if( $line eq '#%OFF' )
953 | 4 | | noformat=1 #PL: $noformat=1;
954 | 4 | | here_delim='#%ON' #PL: $here_delim='#%ON';
955 | 4 | | InfoTags='OFF' #PL: $InfoTags='OFF';
958 | 3 | | elif re.match(r'^#%ON',line): #PL: elsif( $line =~ /^#%ON/ )
959 | 4 | | noformat=0 #PL: $noformat=0;
962 | 3 | | elif line[0]=='#%NEST': #PL: elsif( substr($line,0,6) eq '#%NEST')
964 | 4 | | if (default_match:=re.match(r'^#%NEST=(\d+)',line)): #PL: if( $line =~ /^#%NEST=(\d+)/)
966 | 5 | | if cur_nest!=default_match.group(1): #PL: if( $cur_nest != $1 )
967 | 6 | | cur_nest=new_nest=default_match.group(1) # correct current nesting level
#PL: $cur_nest=$new_nest=$1;
968 | 6 | | InfoTags=f"={cur_nest}" #PL: $InfoTags="=$cur_nest";
971 | 5 | | else: #PL: else
972 | 6 | | InfoTags=f"OK {cur_nest}" #PL: $InfoTags="OK $cur_nest";
974 | 5 | |
977 | 4 | | elif re.match(r'^#%NEST++',line): #PL: elsif( $line =~ /^#%NEST++/)
978 | 5 | | cur_nest=new_nest=default_match.group(1)+1 # correct current nesting level
#PL: $cur_nest=$new_nest=$1+1;
979 | 5 | | InfoTags='+1' #PL: $InfoTags='+1';
982 | 4 | | elif re.match(r'^#%NEST--',line): #PL: elsif( $line =~ /^#%NEST--/)
983 | 5 | | cur_nest=new_nest=default_match.group(1)+1 # correct current nesting level
#PL: $cur_nest=$new_nest=$1+1;
984 | 5 | | InfoTags='-1' #PL: $InfoTags='-1';
987 | 4 | | elif re.match(r'^#%ZERO\?',line): #PL: elsif( $line =~ /^#%ZERO\?/)
989 | 5 | | if cur_nest==0: #PL: if( $cur_nest == 0 )
990 | 6 | | InfoTags=f"OK {cur_nest}" #PL: $InfoTags="OK $cur_nest";
993 | 5 | | else: #PL: else
994 | 6 | | InfoTags='??' #PL: $InfoTags="??";
995 | 6 | | logme(['E',f"Nest is {cur_nest} instead of zero. Reset to zero"]) #PL: logme('E',"Nest is $cur_nest instead of zero. Reset to zero");
996 | 6 | | cur_nest=new_nest=0 #PL: $cur_nest=$new_nest=0;
997 | 6 | | nest_corrections+=1 #PL: $nest_corrections++;
999 | 5 | |
1001 | 4 | |
1003 | 3 | |
1004 | 3 | | process_line([line,-1000]) #PL: process_line($line,-1000);
1005 | 3 | | continue #PL: next;
1007 | 2 | |
1009 | 2 | | if (default_match:=re.match(r'^sub\s+(\w+)',line)): #PL: if( $line =~ /^sub\s+(\w+)/ )
1010 | 3 | | SubList[default_match.group(1)]=lineno #PL: $SubList{$1}=$lineno;
1011 | 3 | | SubsNo+=1 #PL: $SubsNo++;
1012 | 3 | | ChannelNo=2 #PL: $ChannelNo=2;
1013 | 3 | | CommentBlock=0 #PL: $CommentBlock=0;
1015 | 3 | | for backno in range(len(FormattedMain)-1,0,-1): #PL: for( $backno=$#FormattedMain;$backno>0;$backno-- )
1016 | 4 | | comment=FormattedMain[backno] #PL: $comment=$FormattedMain[$backno];
1018 | 4 | | if re.match(r'^\s*#',comment) or re.match(r'^\s*$',comment): #PL: if ($comment =~ /^\s*#/ || $comment =~ /^\s*$/)
1019 | 5 | | CommentBlock+=1 #PL: $CommentBlock++;
1022 | 4 | | else: #PL: else
1023 | 5 | | break #PL: last;
1025 | 4 | |
1027 | 3 | |
1028 | 3 | | backno+=1 #PL: $backno++;
1030 | 3 | | for backno in range(backno,len(len(FormattedMain))): #PL: for (; $backno<@FormattedMain; $backno++)
1031 | 4 | | comment=FormattedMain[backno] #PL: $comment=$FormattedMain[$backno];
1032 | 4 | | process_line([comment,-1000]) #copy comment block from @FormattedMain were it got by mistake
#PL: process_line($comment,-1000);
1034 | 3 | |
1036 | 3 | | for backno in range(0,CommentBlock): #PL: for ($backno=0; $backno<$CommentBlock; $backno++)
1037 | 4 | | FormattedMain.pop() # then got to it by mistake
#PL: pop(@FormattedMain);
1039 | 3 | |
1041 | 3 | | if cur_nest!=0: #PL: if( $cur_nest != 0 )
1042 | 4 | | logme(['E',f"Non zero nesting encounted for subroutine definition {default_match.group(1)}"]) #PL: logme('E',"Non zero nesting encounted for subroutine definition $1");
1044 | 4 | | if cur_nest>0: #PL: if ($cur_nest>0)
1045 | 5 | | InfoTags='} ?' #PL: $InfoTags='} ?';
1048 | 4 | | else: #PL: else
1049 | 5 | | InfoTags='{ ?' #PL: $InfoTags='{ ?';
1051 | 4 | |
1052 | 4 | | nest_corrections+=1 #PL: $nest_corrections++;
1054 | 3 | |
1055 | 3 | | cur_nest=new_nest=0 #PL: $cur_nest=$new_nest=0;
1058 | 2 | | elif line=='__END__' or line=='__DATA__': #PL: elsif( $line eq '__END__' || $line eq '__DATA__' )
1059 | 3 | | ChannelNo=3 #PL: $ChannelNo=3;
1060 | 3 | | logme(['E',f"Non zero nesting encounted for {line}"]) #PL: logme('E',"Non zero nesting encounted for $line");
1062 | 3 | | if cur_nest>0: #PL: if ($cur_nest>0)
1063 | 4 | | InfoTags='} ?' #PL: $InfoTags='} ?';
1066 | 3 | | else: #PL: else
1067 | 4 | | InfoTags='{ ?' #PL: $InfoTags='{ ?';
1069 | 3 | |
1070 | 3 | | noformat=1 #PL: $noformat=1;
1071 | 3 | | here_delim='"' # No valid here delimiter in this case !
#PL: $here_delim='"';
1072 | 3 | | InfoTags='DATA' #PL: $InfoTags='DATA';
1074 | 2 | |
1076 | 2 | | if line[0]=='=' and line!='=cut': #PL: if( substr($line,0,1) eq '=' && $line ne '=cut' )
1077 | 3 | | noformat=1 #PL: $noformat=1;
1078 | 3 | | InfoTags='POD' #PL: $InfoTags='POD';
1080 | 3 | | here_delim='=cut' #PL: $here_delim='=cut'
1081 | 2 | |
1082 | 2 | |
1083 | 2 | | # blank lines should not be processed
1085 | 2 | | if re.match(r'^\s*$',line): #PL: if( $line =~/^\s*$/ )
1086 | 3 | | process_line(['',-1000]) #PL: process_line('',-1000);
1087 | 3 | | continue #PL: next;
1089 | 2 | |
1090 | 2 | | # trim leading blanks
1092 | 2 | | if (default_match:=re.match(r'^\s*(\S.*$)',line)): #PL: if( $line=~/^\s*(\S.*$)/)
1093 | 3 | | line=default_match.group(1) #PL: $line=$1;
1095 | 2 | |
1096 | 2 | | # comments on the level of nesting 0 should be shifted according to nesting
1098 | 2 | | if line[0]=='#': #PL: if( substr($line,0,1) eq '#' )
1099 | 3 | | process_line([line,0]) #PL: process_line($line,0);
1100 | 3 | | continue #PL: next;
1102 | 2 | |
1103 | 2 | |
1104 | 2 | | # comments on the level of nesting 0 should start with the first position
1105 | 2 | | first_sym=line[0] #PL: $first_sym=substr($line,0,1);
1106 | 2 | | last_sym=line[-1] #PL: $last_sym=substr($line,-1,1);
1108 | 2 | | if first_sym=='{' and len(line)==1: #PL: if( $first_sym eq '{' && length($line)==1 )
1109 | 3 | | process_line(['{',0]) #PL: process_line('{',0);
1110 | 3 | | cur_nest=new_nest=new_nest+1 #PL: $cur_nest=$new_nest+=1;
1111 | 3 | | continue #PL: next;
1114 | 2 | | elif first_sym=='}': #PL: elsif( $first_sym eq '}' )
1115 | 3 | | cur_nest=new_nest=new_nest-1 #PL: $cur_nest=$new_nest-=1;
1116 | 3 | | process_line(['}',0]) # shift "{" left, aligning with the keyword
#PL: process_line('}',0);
1118 | 3 | | if line[0]=='}': #PL: if( substr($line,0,1) eq '}' )
1119 | 4 | | line=line[1:] #PL: $line=substr($line,1);
1121 | 3 | |
1123 | 3 | | while line[0]==' ': #PL: while( substr($line,0,1) eq ' ' )
1124 | 4 | | line=line[1:] #PL: $line=substr($line,1);
1126 | 3 | |
1127 | 3 | | # Case of }else{
1129 | 3 | | if not last_sym=='{': #PL: unless( $last_sym eq '{')
1130 | 4 | | process_line([line,0]) #PL: process_line($line,0);
1131 | 4 | | continue #PL: next;
1133 | 3 | |
1135 | 3 | | if cur_nest==0: #PL: if( $cur_nest==0 )
1136 | 4 | | ChannelNo=1 # write to main
#PL: $ChannelNo=1;
1138 | 3 | |
1140 | 2 | |
1141 | 2 | | # Step 2: check the last symbol for "{" Note: comments are prohibited on such lines
1143 | 2 | | if last_sym=='{' and len(line)>1: #PL: if( $last_sym eq '{' && length($line)>1 )
1144 | 3 | | process_line([line[0:-1],0]) #PL: process_line(substr($line,0,-1),0);
1145 | 3 | | process_line(['{',0]) #PL: process_line('{',0);
1146 | 3 | | cur_nest=new_nest=new_nest+1 #PL: $cur_nest=$new_nest+=1;
1147 | 3 | | continue #PL: next;
1149 | 2 | | # if
1150 | 2 | | #elsif( $last_sym eq '}' && length($line)==1 ){
1151 | 2 | | # NOTE: only standalone } on the line affects effective nesting; line that has other symbols is assumed to be like if (...) { )
1152 | 2 | | # $new_nest-- is not nessary as as it is also the first symbol and nesting was already corrected
1153 | 2 | | #}
1154 | 2 | | process_line([line,offset]) #PL: process_line($line,$offset);
1156 | 1 | | # while
1157 | 1 | | #
1158 | 1 | | # Epilog
1159 | 1 | | #
1160 | 1 | | write_formatted_code([]) # write to the database.
#PL: write_formatted_code();
1161 | 1 | | sys.exit(0) #PL: exit 0;
1163 | 0 | |fname='' #PL: $fname='';
1164 | 0 | |cur_nest=keyword=FormattedSource=breakpoint=noformat=sublineno=sourcelineno=datalineno=SourceText=mainlineno=ChannelNo=FormattedMain=FormattedSub=lineno=line=debug=FormattedData=SubList=fname=tab=InfoTags=new_nest=None #PL: main();
1164 | 0 | |main([]) #PL: main();
ERROR STATISTICS: E: 4
LINE 89 [Perlscan-1201E]: Increment of array index found on the left side of assignement and replaced by append function. This guess might be wrong
LINE 93 [Perlscan-1201E]: Increment of array index found on the left side of assignement and replaced by append function. This guess might be wrong
LINE 97 [Perlscan-1201E]: Increment of array index found on the left side of assignement and replaced by append function. This guess might be wrong
LINE 101 [Perlscan-1201E]: Increment of array index found on the left side of assignement and replaced by append function. This guess might be wrong
Society
Groupthink : Two Party System as Polyarchy : Corruption of Regulators : Bureaucracies : Understanding Micromanagers and Control Freaks : Toxic Managers : Harvard Mafia : Diplomatic Communication : Surviving a Bad Performance Review : Insufficient Retirement Funds as Immanent Problem of Neoliberal Regime : PseudoScience : Who Rules America : Neoliberalism : The Iron Law of Oligarchy : Libertarian Philosophy
Quotes
War and Peace : Skeptical Finance : John Kenneth Galbraith :Talleyrand : Oscar Wilde : Otto Von Bismarck : Keynes : George Carlin : Skeptics : Propaganda : SE quotes : Language Design and Programming Quotes : Random IT-related quotes : Somerset Maugham : Marcus Aurelius : Kurt Vonnegut : Eric Hoffer : Winston Churchill : Napoleon Bonaparte : Ambrose Bierce : Bernard Shaw : Mark Twain Quotes
Bulletin:
Vol 25, No.12 (December, 2013) Rational Fools vs. Efficient Crooks The efficient markets hypothesis : Political Skeptic Bulletin, 2013 : Unemployment Bulletin, 2010 : Vol 23, No.10 (October, 2011) An observation about corporate security departments : Slightly Skeptical Euromaydan Chronicles, June 2014 : Greenspan legacy bulletin, 2008 : Vol 25, No.10 (October, 2013) Cryptolocker Trojan (Win32/Crilock.A) : Vol 25, No.08 (August, 2013) Cloud providers as intelligence collection hubs : Financial Humor Bulletin, 2010 : Inequality Bulletin, 2009 : Financial Humor Bulletin, 2008 : Copyleft Problems Bulletin, 2004 : Financial Humor Bulletin, 2011 : Energy Bulletin, 2010 : Malware Protection Bulletin, 2010 : Vol 26, No.1 (January, 2013) Object-Oriented Cult : Political Skeptic Bulletin, 2011 : Vol 23, No.11 (November, 2011) Softpanorama classification of sysadmin horror stories : Vol 25, No.05 (May, 2013) Corporate bullshit as a communication method : Vol 25, No.06 (June, 2013) A Note on the Relationship of Brooks Law and Conway Law
History:
Fifty glorious years (1950-2000): the triumph of the US computer engineering : Donald Knuth : TAoCP and its Influence of Computer Science : Richard Stallman : Linus Torvalds : Larry Wall : John K. Ousterhout : CTSS : Multix OS Unix History : Unix shell history : VI editor : History of pipes concept : Solaris : MS DOS : Programming Languages History : PL/1 : Simula 67 : C : History of GCC development : Scripting Languages : Perl history : OS History : Mail : DNS : SSH : CPU Instruction Sets : SPARC systems 1987-2006 : Norton Commander : Norton Utilities : Norton Ghost : Frontpage history : Malware Defense History : GNU Screen : OSS early history
Classic books:
The Peter Principle : Parkinson Law : 1984 : The Mythical Man-Month : How to Solve It by George Polya : The Art of Computer Programming : The Elements of Programming Style : The Unix Hater’s Handbook : The Jargon file : The True Believer : Programming Pearls : The Good Soldier Svejk : The Power Elite
Most popular humor pages:
Manifest of the Softpanorama IT Slacker Society : Ten Commandments of the IT Slackers Society : Computer Humor Collection : BSD Logo Story : The Cuckoo's Egg : IT Slang : C++ Humor : ARE YOU A BBS ADDICT? : The Perl Purity Test : Object oriented programmers of all nations : Financial Humor : Financial Humor Bulletin, 2008 : Financial Humor Bulletin, 2010 : The Most Comprehensive Collection of Editor-related Humor : Programming Language Humor : Goldman Sachs related humor : Greenspan humor : C Humor : Scripting Humor : Real Programmers Humor : Web Humor : GPL-related Humor : OFM Humor : Politically Incorrect Humor : IDS Humor : "Linux Sucks" Humor : Russian Musical Humor : Best Russian Programmer Humor : Microsoft plans to buy Catholic Church : Richard Stallman Related Humor : Admin Humor : Perl-related Humor : Linus Torvalds Related humor : PseudoScience Related Humor : Networking Humor : Shell Humor : Financial Humor Bulletin, 2011 : Financial Humor Bulletin, 2012 : Financial Humor Bulletin, 2013 : Java Humor : Software Engineering Humor : Sun Solaris Related Humor : Education Humor : IBM Humor : Assembler-related Humor : VIM Humor : Computer Viruses Humor : Bright tomorrow is rescheduled to a day after tomorrow : Classic Computer Humor
The Last but not Least Technology is dominated by two types of people: those who understand what they do not manage and those who manage what they do not understand ~Archibald Putt. Ph.D
Copyright © 1996-2021 by Softpanorama Society. www.softpanorama.org was initially created as a service to the (now defunct) UN Sustainable Development Networking Programme (SDNP) without any remuneration. This document is an industrial compilation designed and created exclusively for educational use and is distributed under the Softpanorama Content License. Original materials copyright belong to respective owners. Quotes are made for educational purposes only in compliance with the fair use doctrine.
FAIR USE NOTICE This site contains copyrighted material the use of which has not always been specifically authorized by the copyright owner. We are making such material available to advance understanding of computer science, IT technology, economic, scientific, and social issues. We believe this constitutes a 'fair use' of any such copyrighted material as provided by section 107 of the US Copyright Law according to which such material can be distributed without profit exclusively for research and educational purposes.
This is a Spartan WHYFF (We Help You For Free) site written by people for whom English is not a native language. Grammar and spelling errors should be expected. The site contain some broken links as it develops like a living tree...
|
|
You can use PayPal to to buy a cup of coffee for authors of this site |
Disclaimer:
The statements, views and opinions presented on this web page are those of the author (or referenced source) and are not endorsed by, nor do they necessarily reflect, the opinions of the Softpanorama society. We do not warrant the correctness of the information provided or its fitness for any purpose. The site uses AdSense so you need to be aware of Google privacy policy. You you do not want to be tracked by Google please disable Javascript for this site. This site is perfectly usable without Javascript.
Last modified: October 10, 2020
