2002-02-23 15:42 ebcdic2ascii.pl Page 1 1 #!/usr/local/bin/perl 2 # 3 # $Id: ebcdic2ascii.pl.lst,v 1.1.1.1 2002/03/01 21:50:52 valerio Exp $ 4 # 5 # This script is copyrighted 6 # Copyright (c) 2002 Valerio Di Giampietro 7 # Valerio@DiGiampietro.com 8 # 9 # All rights reserved. This program is free software; you can 10 # redistribute it and/or modify it under the same terms as Perl 11 # itself. 12 # 13 # 14 # 15 # $Log: ebcdic2ascii.pl.lst,v $ 15 # Revision 1.1.1.1 2002/03/01 21:50:52 valerio 15 # Imported sources 15 # 16 # 17 # 18 use Getopt::Std; 19 use Convert::EBCDIC; 20 21 $translator = new Convert::EBCDIC; 22 23 24 $debug=0; 25 $status=0; 26 #====================================================================== 27 # data related to file.layout format; a tipical row has the following 28 # format: 29 # 30 # field field description type len dec. len start end 31 # name log phy 32 # ITNBR ITEM NUMBER A 15 15 1 15 33 # 34 # each array has 2 element the starting row and the length of related 35 # field 36 #====================================================================== 37 @campo=(0,10); #field name 38 @descr=(11,35); #field description 39 @dacol=(70,4); #from column 40 @len =(63,4); #field length in bytes 41 @loglen = (52,4); #field logical length 42 @type=(49,1); #field type 43 @decimals=(56,3); #number of decimals 44 # 45 #====================================================================== 46 # packed2ascii converts a packed decimal to ascii 47 # input parameters: 48 # $str the packed decimal string 49 # $decimals number of decimals 50 # example: $str=0x123456d; $decimals=2; 51 # packed2asci($str,$decimals) would return -1234.56 52 #====================================================================== 53 # 54 sub packed2ascii { 55 my $decimals=$_[1]; 56 my $str=unpack("H*",$_[0]); 2002-02-23 15:42 ebcdic2ascii.pl Page 2 57 if ($debug > 2) { 58 print STDERR "===> packed2ascii input str: ", uc $str,"\n"; 59 print STDERR " decimals: $decimals\n"; 60 } 61 my $n; 62 my $sign=chop $str; 63 if ($decimals > 0) { 64 $str=substr($str,0,-$decimals) . '.' . substr($str,-$decimals); 65 $n= $str + 0.0; 66 } else { 67 $n= $str + 0; 68 } 69 if ($sign eq 'd') { 70 $n= -$n; 71 } 72 if ($decimalpoint ne '.') { 73 $n=~s/\./$decimalpoint/; 74 } 75 if ($debug > 2) { 76 print STDERR " coverted: $n\n"; 77 } 78 return $n; 79 } 80 # 81 #====================================================================== 82 # signed2ascii converts asigned decimal to ascii 83 # input parameters: 84 # $str the signed decimal string 85 # $decimals number of decimals 86 # 87 # example: $str=0xf1f2f3f4d5; $decimals=2; 88 # packed2asci($str,$decimals) would return -1234.56 89 #====================================================================== 90 # 91 sub signed2ascii { 92 my $decimals=$_[1]; 93 my $str=unpack("H*",$_[0]); 94 if ($debug > 2) { 95 print STDERR "===> signed2ascii input str: ", uc $str,"\n"; 96 print STDERR " decimals: $decimals\n"; 97 } 98 $str=~s/f//g; 99 my $n; 100 if ($str=~s/d//g) { 101 $sign='d'; 102 } else { 103 $sign='c'; 104 } 105 if ($decimals > 0) { 106 $str=substr($str,0,-$decimals) . '.' . substr($str,-$decimals); 107 $n= $str + 0.0; 108 } else { 109 $n= $str + 0; 110 } 111 if ($sign eq 'd') { 112 $n= -$n; 2002-02-23 15:42 ebcdic2ascii.pl Page 3 113 } 114 if ($decimalpoint ne '.') { 115 $n=~s/\./$decimalpoint/; 116 } 117 if ($debug > 2) { 118 print STDERR " coverted: $n\n"; 119 } 120 return $n; 121 } 122 #====================================================================== 123 # autocrop strips leading and trailing spaces from a string 124 # input parameter 125 # $str string 126 # returnd value 127 # $str with leading and trailing spaces tripped 128 #====================================================================== 129 sub autocrop { 130 my $s=$_[0]; 131 $s=~s/^\s*//; 132 $s=~s/\s*$//; 133 return $s; 134 } 135 #====================================================================== 136 # usage print usage message and exit 137 #====================================================================== 138 sub usage { 139 print "Usage: $0 [-s c] [-d lev] [-f|-b] file.layout file.ebcdic\n"; 140 print " -d lev set debug level\n"; 141 print " -f use field names instead of descriptions\n"; 142 print " -b use both field names and descriptions\n"; 143 print " -s c use c as field separator (default is '|')\n"; 144 print " -a no '.' -> ',' translation for decimal point\n"; 145 exit; 146 } 147 # 148 #====================================================================== 149 # main program 150 #====================================================================== 151 # 152 getopts('d:s:fba'); 153 $decimalpoint=","; #default value (here in Italy) for the decimal point 154 if ($opt_a) { 155 $decimalpoint="."; 156 } 157 158 $csep = $opt_s || "|"; 159 if (defined $opt_d) { 160 $debug=$opt_d; 161 } 162 163 if ($#ARGV < 1) { 164 usage(); 165 } 166 167 $ftracciato=$ARGV[0]; 168 $fdati=$ARGV[1]; 2002-02-23 15:42 ebcdic2ascii.pl Page 4 169 $dirtracciati="/prj/as400imm/formats2"; 170 if (not -e $ftracciato) { 171 $ftracciato="$dirtracciati/$ftracciato"; 172 } 173 print "ftracciato: $ftracciato\n" if $debug; 174 print "fdati: $fdati\n" if $debug; 175 176 #====================================================================== 177 # read the layout file and fill in related data structure 178 #====================================================================== 179 open(FTRA,$ftracciato) || die "Error opening $ftracciato\n"; 180 $status=2; 181 while () { 182 if (/^\s*-+\s*$/) { 183 $status++; 184 print "# status: $status\n" if $debug; 185 } else { 186 if ($status==2) { 187 $campo=lc autocrop(substr $_, $campo[0], $campo[1]); 188 $descr=autocrop(substr $_, $descr[0], $descr[1]); 189 $dacol=autocrop(substr $_, $dacol[0], $dacol[1]) - 1; 190 $len =autocrop(substr $_, $len[0], $len[1]); 191 $loglen =autocrop(substr $_, $loglen[0], $loglen[1]); 192 $type=substr $_, $type[0],$type[1]; 193 $decimals=substr $_, $decimals[0],$decimals[1]; 194 $dacol{$campo}=$dacol; 195 $len{$campo}=$len || $loglen; 196 if ($loglen > $len) { 197 $len{$campo}=$loglen if ($type ne 'P'); 198 } 199 $descr{$campo}=$descr; 200 $type{$campo}=$type; 201 $decimals{$campo}=$decimals; 202 push @campi,$campo; 203 print "# $campo ($descr{$campo},$dacol{$campo},$len{$campo},", 204 "$type{$campo},$decimals{$campo})\n" 205 if $debug; 206 } 207 } 208 } 209 210 print "--- Second part\n" if $debug; 211 print "---campi: @campi\n" if $debug; 212 213 @outcampi=@campi; 214 215 216 $totlen=0; 217 for $i (@outcampi) { 218 $dscr=$descr{$i} || $i; 219 if ($opt_f) { 220 print "$i",$csep; 221 } elsif ($opt_b) { 222 print "$i: $dscr",$csep; 223 } 224 else { 2002-02-23 15:42 ebcdic2ascii.pl Page 5 225 print "$dscr",$csep; 226 } 227 $totlen = $totlen + $len{$i}; 228 print " -> $i ($totlen= $totlen)\n" if $debug; 229 } 230 print "\n"; 231 print "-->Total record length = $totlen \n\n" if $debug; 232 233 234 #====================================================================== 235 # process the ebcdic file 236 #====================================================================== 237 238 open (FDAT,$ARGV[1]) || die "error opening $ARGV[1]\n"; 239 240 while (read(FDAT,$_,$totlen)) { 241 242 ################## fill in the %s hash 243 for $i (@campi) { 244 $sebcdic=substr $_,$dacol{$i},$len{$i}; 245 246 if ($type{$i} eq 'P') { #### Packed field 247 $s=packed2ascii($sebcdic,$decimals{$i}); 248 } elsif ($type{$i} eq 'S') { #### Signed field 249 $s=signed2ascii($sebcdic,$decimals{$i}); 250 } else { #### Normal field 251 $sascii=$translator->toascii($sebcdic); 252 $s=autocrop($sascii); 253 } 254 $s{$i}=$s; 255 } 256 ################ printout the %s hash; 257 258 for $i (@outcampi) { 259 print $s{$i},$csep; 260 } 261 print "\n"; 262 263 } 264 265 266 267 268