update

update

import thread, re, time, socket;
import getopt, shlex;

try{
	import readline;
}catch(Exception e){
}

function welcome(){
	print ('ssdb (cli) - ssdb command line tool.');
	print ('Copyright (c) 2012 ideawu.com');
	print ('');
	print "'h' or 'help' for help, 'q' to quit.";
	print ('');
}
welcome();

function show_command_help(){
	print '';
	print '# KEY-VALUE COMMANDS';
	print '	set key value';
	print '	get key';
	print '	del key';
	print '	list key_start key_end limit';
	print '	keys key_start key_end limit';
	print '	scan key_start key_end limit';
	print '# MAP(HASHMAP) COMMANDS';
	print '	hset name key value';
	print '	hget name key';
	print '	hdel name key';
	print '	hlist name_start name_end limit';
	print '	hkeys name key_start key_end limit';
	print '	hscan name key_start key_end limit';
	print '# ZSET(SORTED SET) COMMANDS';
	print '	zset name key score';
	print '	zget name key';
	print '	zdel name key';
	print '	zlist name_start name_end limit';
	print '	zkeys name key_start score_start score_end limit';
	print '	zscan name key_start score_start score_end limit';
	print '# FLUSH DATABASE';
	print '	flushdb';
	print '	flushdb kv';
	print '	flushdb hash';
	print '	flushdb zset';
	print '';
	print '# EXAMPLES';
	print '	scan "" "" 10';
	print '	scan aa "" 10';
	print '	hlist "" "" 10';
	print '	hscan h "" "" 10';
	print '	hscan h aa "" 10';
	print '	zlist "" "" 10';
	print '	zscan z "" "" "" 10';
	print '	zscan z "" 1 100 10';
	print '';
	print 'press \'q\' and Enter to quit.';
	print '';
}

function usage(){
	print '';
	print 'Usage:';
	print '	ssdb-cli [-h HOST -p PORT]';
	print '';
	print 'Options:';
	print '	-h 127.0.0.1';
	print '		ssdb server hostname/ip address';
	print '	-p 8888';
	print '		ssdb server port';
	print '';
	print 'Examples:';
	print '	ssdb-cli';
	print '	ssdb-cli -p 8888';
	print '	ssdb-cli -h 127.0.0.1 -p 8888';
}

function repr_data(str){
	ret = repr(str);
	if(len(ret) > 0){
		if(ret[0] == '\''){
			ret = ret.replace("\\'", "'");
			ret = ret[1 .. -1];
		}else if(ret[0] == '"'){
			ret = ret.replace('\\"', '"');
			ret = ret[1 .. -1];
		}else{
		}
	}
	ret = ret.replace("\\\\", "\\");
	return ret;
}

function flushdb(link, data_type){
	printf('\n');
	printf('                  DANGEROUS!\n');
	printf('\n');
	printf('This operation is DANGEROUS and is not recoverable, if you\n');
	printf('realy want to flush the whole db(delete ALL data in ssdb server),\n');
	printf('input \'yes\' and press Enter, or just press Enter to cancel\n');
	printf('\n');
	printf('flushdb? ');

	line = sys.stdin.readline().strip();
	if(line != 'yes'){
		printf('Operation cancelled.\n\n');
		return;
	}

	print 'Begin to flushdb...';

	batch = 1000;

	d_kv = 0;
	if(data_type == '' || data_type == 'kv'){
		while(true){
			resp = link.request('keys', ['', '', batch]);
			if(len(resp.data) == 0){
				break;
			}
			d_kv += len(resp.data);
			foreach(resp.data as key){
				link.request('del', [key]);
			}
			printf('delete[kv] %d key(s).\n', d_kv);
		}
	}

	d_hash = 0;
	d_hkeys = 0;
	if(data_type == '' || data_type == 'hash'){
		while(true){
			resp = link.request('hlist', ['', '', batch]);
			if(len(resp.data) == 0){
				break;
			}
			foreach(resp.data as hname){
				d_hash += 1;
				while(true){
					r2 = link.request('hkeys', [hname, '', '', batch]);
					if(len(r2.data) == 0){
						break;
					}
					foreach(r2.data as key){
						d_hkeys += 1;
						link.request('hdel', [hname, key]);
					}
					printf('delete[hash] %d hash(s), %d key(s).\n', d_hash, d_hkeys);
				}
			}
			printf('delete[hash] %d hash(s), %d key(s).\n', d_hash, d_hkeys);
		}
	}

	d_zset = 0;
	d_zkeys = 0;
	if(data_type == '' || data_type == 'zset'){
		while(true){
			resp = link.request('zlist', ['', '', batch]);
			if(len(resp.data) == 0){
				break;
			}
			foreach(resp.data as zname){
				d_zset += 1;
				while(true){
					r2 = link.request('zkeys', [zname, '', '', '', batch]);
					if(len(r2.data) == 0){
						break;
					}
					foreach(r2.data as key){
						d_zkeys += 1;
						link.request('zdel', [zname, key]);
					}
					printf('delete[zset] %d zset(s), %d key(s).\n', d_zset, d_zkeys);
				}
			}
			printf('delete[zset] %d zset(s), %d key(s).\n', d_zset, d_zkeys);
		}
	}

	printf('\n');
	printf('===== flushdb stats =====\n');
	if(data_type == '' || data_type == 'kv'){
		printf('[kv]   %8d key(s).\n', d_kv);
	}
	if(data_type == '' || data_type == 'hash'){
		printf('[hash] %8d hash(s), %8d key(s).\n', d_hash, d_hkeys);
	}
	if(data_type == '' || data_type == 'zset'){
		printf('[zset] %8d zset(s), %8d key(s).\n', d_zset, d_zkeys);
	}
	printf('\n');
}

default_opts = {
	'-h' : '127.0.0.1',
	'-p' : '8888',
};

opt_err = false;
try{
	opts, args = getopt.getopt(sys.argv[1 .. ], 'h:p:');
	opts = dict(opts);
}catch(getopt.GetoptError e){
	opts = {};
	opt_err = true;
}
foreach(default_opts as k=>v){
	if(!opts.has_key(k)){
		opts[k] = v;
	}
}

if(opt_err){
	usage();
	sys.exit(0);
}

host = opts['-h'];
port = int(opts['-p']);

sys.path.append('./api/python');
sys.path.append('../api/python');
import SSDB.SSDB;

try{
	link = new SSDB(host, port);
}catch(socket.error e){
	print 'Connection error: ', str(e);
	sys.exit(0);
}

while(true){
	line = '';
	c = sprintf('ssdb %s:%s> ', host, str(port));
	line = raw_input(c);
	if(line == ''){
		continue;
	}
	line = line.strip();
	if(line == 'q' || line == 'quit'){
		print 'bye.';
		break;
	}
	if(line == 'h' || line == 'help'){
		show_command_help();
		continue;
	}

	try{
		ps = shlex.split(line);
	}catch(Exception e){
		print 'error: ', e;
		continue;
	}
	if(len(ps) == 0){
		continue;
	}
	cmd = ps[0];
	args = ps[1 .. ];

	if(cmd == 'flushdb'){
		if(len(args) == 0){
			flushdb(link, '');
		}else{
			flushdb(link, args[0]);
		}
		continue;
	}

	retry = 0;
	max_retry = 5;
	import datetime;
	stime = datetime.datetime.now();
	while(true){
		stime = datetime.datetime.now();
		resp = link.request(cmd, args);
		etime = datetime.datetime.now();
		if(resp.code == 'disconnected'){
			link.close();
			time.sleep(retry);
			retry ++;
			if(retry > max_retry){
				print 'cannot connect to server, give up...';
				break;
			}
			printf('[%d/%d] reconnecting to server... ', retry, max_retry);
			try{
				link = new SSDB(host, port);
				print 'done.';
			}catch(socket.error e){
				print 'Connect error: ', str(e);
				continue;
			}
			print '';
		}else{
			break;
		}
	}

	ts = etime - stime;
	time_consume = ts.seconds + ts.microseconds/1000000.;
	if(!resp.ok()){
		print 'error: ' + resp.code;
		printf('(%.3f sec)\n', time_consume);
	}else{
		switch(cmd){
			case 'exists':
			case 'hexists':
			case 'zexists':
				if(resp.data == true){
					printf('true\n');
				}else{
					printf('false\n');
				}
				printf('(%.3f sec)\n', time_consume);
				break;
			case 'multi_exists':
			case 'multi_hexists':
			case 'multi_zexists':
				printf('%-15s %s\n', 'key', 'value');
				print ('-' * 25);
				foreach(resp.data as k=>v){
					if(v == true){
						s = 'true';
					}else{
						s = 'false';
					}
					printf('  %-15s : %s\n', repr_data(k), s);
				}
				printf('%d result(s) (%.3f sec)\n', len(resp.data), time_consume);
				break;
			case 'get':
			case 'zget':
			case 'hget':
			case 'incr':
			case 'decr':
			case 'zincr':
			case 'zdecr':
			case 'hincr':
			case 'hdecr':
			case 'hsize':
			case 'zsize':
			case 'multi_del':
			case 'multi_hdel':
			case 'multi_zdel':
				print repr_data(resp.data);
				printf('(%.3f sec)\n', time_consume);
				break;
			case 'set':
			case 'zset':
			case 'hset':
			case 'del':
			case 'zdel':
			case 'hdel':
				print resp.code;
				printf('(%.3f sec)\n', time_consume);
				break;
			case 'scan':
			case 'rscan':
			case 'hscan':
			case 'hrscan':
				printf('%-15s %s\n', 'key', 'value');
				print ('-' * 25);
				foreach(resp.data['index'] as k){
					printf('  %-15s : %s\n', repr_data(k), repr_data(resp.data['items'][k]));
				}
				printf('%d result(s) (%.3f sec)\n', len(resp.data['index']), time_consume);
				break;
			case 'zscan':
			case 'zrscan':
				printf('%-15s %s\n', 'key', 'score');
				print ('-' * 25);
				foreach(resp.data['index'] as k){
					score = resp.data['items'][k];
					printf('  %-15s: %s\n', repr_data(repr_data(k)), score);
				}
				printf('%d result(s) (%.3f sec)\n', len(resp.data['index']), time_consume);
				break;
			case 'keys':
			case 'list':
			case 'zkeys':
			case 'hkeys':
				printf('  %15s\n', 'key');
				print ('-' * 17);
				foreach(resp.data as k){
					printf('  %15s\n', repr_data(k));
				}
				printf('%d result(s) (%.3f sec)\n', len(resp.data), time_consume);
				break;
			case 'hlist':
			case 'zlist':
				printf('  %15s\n', 'name');
				print ('-' * 17);
				foreach(resp.data as k){
					printf('  %15s\n', repr_data(k));
				}
				printf('%d result(s) (%.3f sec)\n', len(resp.data), time_consume);
				break;
			case 'multi_get':
			case 'multi_hget':
			case 'multi_zget':
				printf('%-15s %s\n', 'key', 'value');
				print ('-' * 25);
				foreach(resp.data as k=>v){
					printf('  %-15s : %s\n', repr_data(k), repr_data(v));
				}
				printf('%d result(s) (%.3f sec)\n', len(resp.data), time_consume);
				break;
			case 'info':
				is_val = false;
				for(i=1; i<len(resp.data); i++){
					s = resp.data[i];
					if(is_val){
						s = '	' + s.replace('\n', '\n	');
					}
					print s;
					is_val = !is_val;
				}
				printf('%d result(s) (%.3f sec)\n', len(resp.data), time_consume);
				break;
			case 'key_range':
				if(len(resp.data) != 6){
					print 'error!';
				}else{
					for(i=0; i<len(resp.data); i++){
						resp.data[i] = repr_data(resp.data[i]);
						if(resp.data[i] == ''){
							resp.data[i] = '""';
						}
					}
					klen = 0;
					vlen = 0;
					for(i=0; i<len(resp.data); i+=2){
						klen = max(len(resp.data[i]), klen);
						vlen = max(len(resp.data[i+1]), vlen);
					}
					printf('	kv   :  %-*s  -  %-*s\n', klen, resp.data[0], vlen, resp.data[1]);
					printf('	hash :  %-*s  -  %-*s\n', klen, resp.data[2], vlen, resp.data[3]);
					printf('	zset :  %-*s  -  %-*s\n', klen, resp.data[4], vlen, resp.data[5]);
				}
				printf('%d result(s) (%.3f sec)\n', len(resp.data), time_consume);
				break;
			default:
				print repr_data(resp.code), repr_data(resp.data);
				printf('(%.3f sec)\n', time_consume);
				break;
		}
	}
}


COMPUTEで楽するのやめてみたが関係なかったみたい、やはり40点のまま

COMPUTEで楽するのやめてみたが関係なかったみたい、やはり40点のまま

       *>
       *> 結果 https://paiza.jp/poh/joshibato/rio/result/c515c89e
       *>
       IDENTIFICATION DIVISION.
       PROGRAM-ID. Answer.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
              FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
              01 Answer-Values.
                     05 n          PIC 9(2).  *> 05 である必要はなく 02 n PIC 9(2). でもよいらしい
                     05 i          PIC 9(2).
                     05 w          PIC 9(4)V9(20) VALUE 0.0. *> 9(4)V9(20)は計算用 9(4).9(20)だと文字出力用？
                     05 c          PIC 9(4)V9(20) VALUE 0.0.
                     05 wc         PIC 9(4)V9(20).
                     05 ans        PIC 9(4)V9(20).
                     05 x1         PIC 9(4)V9(20).
                     05 x2         PIC 9(4)V9(20).
                     05 dsp        PIC Z(4).        *> Zは表示用,9での上位桁の0をスペースに置き換える
                     05 tas.
                            10 T   PIC 9(2). *> tが1桁と分かっているので文字数決め打ち分割
                            10 S   PIC 9(3). *> sは3桁までなので
       PROCEDURE DIVISION.
       MainRoutine SECTION.
       000-Main.
              ACCEPT n.
              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = n
                     ACCEPT tas
                     IF NUMVAL(t) = 1 THEN
                            ADD NUMVAL(s) TO w
                     END-IF
                     IF NUMVAL(t) = 2 THEN *> 流石にELSEネストはキツイ
                            ADD NUMVAL(s) TO c
                     END-IF
                     IF NUMVAL(t) = 3 THEN
                        MOVE w TO wc
                        ADD c TO wc

                        MOVE w TO x1
                        MULTIPLY wc BY x1
                        MOVE NUMVAL(s) TO x2
                        MULTIPLY w BY x2
                        ADD x2 TO x1
                        DIVIDE wc INTO x1
                        MOVE x1 TO w

                        MOVE c TO x1
                        MULTIPLY wc BY x1
                        MOVE NUMVAL(s) TO x2
                        MULTIPLY c BY x2
                        ADD x2 TO x1
                        DIVIDE wc INTO x1
                        MOVE x1 TO c

                     END-IF
              END-PERFORM.

              MOVE w TO wc.
              ADD c TO wc.

              MOVE 100 TO ans.
              MULTIPLY c BY ans.
              DIVIDE wc INTO ans.

              MOVE ans TO dsp.
              DISPLAY TRIM(dsp).
       END PROGRAM Answer.

       *>
       *> 結果 https://paiza.jp/poh/joshibato/rio/result/b28273f3
       *>
       IDENTIFICATION DIVISION.
       PROGRAM-ID. Answer.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
              FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
              01 Answer-Values.
                     05 n          PIC 9(2).  *> 05 である必要はなく 02 n PIC 9(2). でもよいらしい
                     05 i          PIC 9(2).
                     05 w          PIC 9(4)V9(20) VALUE 0.0. *> 9(4)V9(20)は計算用 9(4).9(20)だと文字出力用？
                     05 c          PIC 9(4)V9(20) VALUE 0.0.
                     05 wc         PIC 9(4)V9(20).
                     05 ans        PIC 9(4)V9(20).
                     05 dsp        PIC Z(4).        *> Zは表示用,9での上位桁の0をスペースに置き換える
                     05 tas.
                            10 T   PIC 9(2). *> tが1桁と分かっているので文字数決め打ち分割
                            10 S   PIC 9(3). *> sは3桁までなので
       PROCEDURE DIVISION.
       MainRoutine SECTION.
       000-Main.
              ACCEPT n.
              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = n
                     ACCEPT tas
                     IF NUMVAL(t) = 1 THEN
                            ADD NUMVAL(s) TO w
                     END-IF
                     IF NUMVAL(t) = 2 THEN *> 流石にELSEネストはキツイ
                            ADD NUMVAL(s) TO c
                     END-IF
                     IF NUMVAL(t) = 3 THEN
                            COMPUTE wc = w + c  *> 面倒なのでCOMPUTEで処理ｗ
                            COMPUTE w = (w * wc - NUMVAL(s) * w) / wc
                            COMPUTE c = (c * wc - NUMVAL(s) * c) / wc
                     END-IF
              END-PERFORM.
              COMPUTE wc = w + c.
              COMPUTE ans = 100 * c / wc.
              MOVE ans TO dsp.
              DISPLAY TRIM(dsp).
       END PROGRAM Answer.


Update answer.cob

Update answer.cob

result
https://paiza.jp/poh/joshibato/matsue-ruby/result/f146b1b1

       IDENTIFICATION DIVISION.
       PROGRAM-ID. Hello.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
              FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
              01 Hello-Values.
                     05 n PIC 9(4).
                     05 i PIC 9(4).
                     05 j PIC 9(4).
                     05 k PIC 9(4).
                     05 t PIC A(10).
                     05 c PIC A(10).
                     05 r PIC A(10).
                     05 p PIC A(5000).
                     05 a OCCURS 1000 TIMES.
                            10 w PIC A(10).
       PROCEDURE DIVISION.
       MainRoutine SECTION.
       000-Main.
              ACCEPT n.
              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = n
                     ACCEPT w(i)
              END-PERFORM
              IF n = 1 THEN
                     GO TO 002-Make-Palindome.
       001-Sort.
              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = n - 1
                     MOVE i TO k
                     PERFORM WITH TEST AFTER VARYING j FROM i BY 1 UNTIL j + 1 = n
                            IF w(j + 1) < w(k) THEN
                                   COMPUTE k = j + 1
                            END-IF
                     END-PERFORM
                     IF k NOT = i THEN
                            MOVE w(k) TO t
                            MOVE w(i) TO w(k)
                            MOVE t TO w(i)
                     END-IF
              END-PERFORM
              .
       002-Make-Palindome.
              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = n
                     IF W(i) NOT = SPACES THEN
                            MOVE REVERSE(TRIM(w(i))) TO r
                            PERFORM WITH TEST AFTER VARYING j FROM i BY 1 UNTIL j >= n - 1
                                   IF w(j + 1) = r THEN
                                         MOVE CONCATENATE(TRIM(p), TRIM(w(i))) TO p
                                         MOVE SPACES TO w(j + 1)
                                         EXIT PERFORM
                                   END-IF
                            END-PERFORM
                            IF j >= n - 1 AND w(i) = r THEN
                                   IF c = SPACES OR r < c THEN
                                          MOVE r TO c
                                   END-IF
                            END-IF
                     END-IF
              END-PERFORM
              .
       003-Show-Palindome.
              IF p NOT = SPACES THEN
                     DISPLAY TRIM(p) WITH NO ADVANCING.
              IF c NOT = SPACES THEN
                     DISPLAY TRIM(c) WITH NO ADVANCING.
              IF p NOT = SPACES THEN
                     DISPLAY REVERSE(TRIM(p)) WITH NO ADVANCING.
       END PROGRAM Hello.

        IDENTIFICATION DIVISION.
        PROGRAM-ID. hello.
        ENVIRONMENT DIVISION.
        CONFIGURATION SECTION.
        REPOSITORY.
            FUNCTION ALL INTRINSIC.
        DATA DIVISION.
        WORKING-STORAGE SECTION.
            01 EQUALITY IS GLOBAL PIC 9(4) VALUE 0.
            01 SMALL IS GLOBAL PIC 9(4) VALUE 1.
            01 LARGE IS GLOBAL PIC 9(4) VALUE 2.
            01 Hello-Values IS GLOBAL.
                05 Number-Of-Words PIC 9(4).
                05 Word PIC A(10) OCCURS 1000 TIMES.
                05 Word-Length PIC 9(2).
                05 Index1 PIC 9(4).
                05 Index2 PIC 9(4).
            01 Compare-Values IS GLOBAL.
                05 IndexC1 PIC 9(4).
                05 String1 PIC A(10).
                05 String2 PIC A(10).
                05 Ord1 PIC 9(4).
                05 Ord2 PIC 9(4).
                05 Result PIC 9(4).
            01 Seek-Values IS GLOBAL.
                05 IndexF1 PIC 9(4).
                05 IndexF2 PIC 9(4).
                05 Reversed-Word PIC A(10).
                05 Left-Side PIC A(5000) VALUE SPACE.
                05 Center-Word PIC A(10) VALUE SPACE.
                05 For-Copy PIC A(5000) VALUE SPACE.
        PROCEDURE DIVISION.
        Hello-Main SECTION.
        Main-Dayo.
                ACCEPT Number-Of-Words
                    FROM SYSIN
                END-ACCEPT.
        Init-Read-Words.
                MOVE 1 TO Index1.
        Read-Words.
                IF Index1 <= Number-Of-Words THEN
                    ACCEPT Word(Index1)
                        FROM SYSIN
                    END-ACCEPT
                    ADD 1 TO Index1
                    GO TO Read-Words
                END-IF
                MOVE STORED-CHAR-LENGTH(Word(1)) TO Word-Length.
                IF Number-Of-Words > 1 THEN
                    CALL "Sort-Words".

        Init-Make-Palindome.
                MOVE 1 TO Index1.
        Make-Palindome.
                If Index1 <= Number-Of-Words THEN
                    MOVE Index1 TO IndexF1
                    CALL "Seek-Reverse-Word"
                    ADD 1 TO Index1
                    GO TO Make-Palindome
                END-IF.
        Show-Result.
                IF STORED-CHAR-LENGTH(Left-Side) > 0 THEN
                    DISPLAY TRIM(Left-Side) WITH NO ADVANCING.
                IF STORED-CHAR-LENGTH(Center-Word) = Word-Length THEN
                    DISPLAY TRIM(Center-Word) WITH NO ADVANCING
                END-IF
                IF STORED-CHAR-LENGTH(Left-Side) > 0 THEN
                    DISPLAY REVERSE(TRIM(Left-Side)) WITH NO ADVANCING.
                STOP RUN.
        PROGRAM-ID. Sort-Words.
        DATA DIVISION.
        WORKING-STORAGE SECTION.
            01 IndexS1 PIC 9(4).
            01 IndexS2 PIC 9(4).
            01 IndexS3 PIC 9(4).
            01 TempWord PIC A(10).
        PROCEDURE DIVISION.
        Sort-Main SECTION.
        Init-Sort.
                MOVE 1 TO IndexS1.
        Main-Loop.
                IF IndexS1 = Number-Of-Words THEN
                    GOBACK
                END-IF
                MOVE IndexS1 TO IndexS2 IndexS3.
        Sub-Loop.
                ADD 1 TO IndexS2.
                IF IndexS2 > Number-Of-Words THEN
                    IF NOT IndexS1 = IndexS3 THEN
                        MOVE Word(IndexS1) TO TempWord
                        MOVE Word(IndexS3) TO Word(IndexS1)
                        MOVE TempWord TO Word(IndexS3)
                    END-IF
                    ADD 1 TO IndexS1
                    GO TO Main-Loop
                ELSE
                    MOVE Word(IndexS3) TO String1 OF Compare-Values
                    MOVE Word(IndexS2) TO String2 OF Compare-Values
                    CALL "Compare-Strings"
                    IF SMALL = Result OF Compare-Values THEN
                        MOVE IndexS2 TO IndexS3
                    END-IF
                    GO TO Sub-Loop
                END-IF.
        END PROGRAM Sort-Words.
        PROGRAM-ID. Compare-Strings.
        PROCEDURE DIVISION.
        Compare-Main SECTION.
        Init-Compare.
                MOVE 1 TO IndexC1.
        Main-Loop.
                IF IndexC1 > Word-Length THEN
                    MOVE EQUALITY TO Result OF Compare-Values
                ELSE
                    MOVE ORD(String1(IndexC1:1)) TO Ord1
                    MOVE ORD(String2(IndexC1:1)) TO Ord2
                    IF Ord1 < Ord2 THEN
                        MOVE LARGE TO Result OF Compare-Values
                    ELSE
                        IF Ord1 > Ord2 THEN
                            MOVE SMALL TO Result OF Compare-Values
                        ELSE
                            ADD 1 TO IndexC1
                            GO TO Main-Loop
                        END-IF
                    END-IF
                END-IF.
        END PROGRAM Compare-Strings.
        PROGRAM-ID. Seek-Reverse-Word.
        PROCEDURE DIVISION.
        Seek-Main SECTION.
        Init-Seek.
            MOVE Word(IndexF1) TO String1 OF Compare-Values.
            MOVE "-" TO String2 OF Compare-Values.
            CALL "Compare-Strings".
            IF EQUALITY = Result OF Compare-Values THEN
                GOBACK
            END-IF
            MOVE REVERSE(TRIM(Word(IndexF1))) TO Reversed-Word String1.
            MOVE IndexF1 TO IndexF2.
        Main-Loop.
            ADD 1 TO IndexF2.
            IF IndexF2 > Number-Of-Words THEN
                MOVE Word(IndexF1) TO String2 OF Compare-Values
                CALL "Compare-Strings"
                IF EQUALITY = Result OF Compare-Values THEN
                    IF STORED-CHAR-LENGTH(Center-Word) = 0 THEN
                        MOVE Reversed-Word TO Center-Word
                    ELSE
                        MOVE Center-Word TO String2
                        CALL "Compare-Strings"
                        IF LARGE = Result OF Compare-Values THEN
                            MOVE Reversed-Word TO Center-Word
                        END-IF
                    END-IF
                END-IF
                GOBACK
            ELSE
                MOVE Word(IndexF2) TO String2 OF Compare-Values
                CALL "Compare-Strings"
                IF EQUALITY = Result OF Compare-Values THEN
                    MOVE CONCATENATE(TRIM(Left-Side), TRIM(WORD(IndexF1))) TO For-Copy
                    MOVE For-Copy TO Left-Side
                    MOVE "-" TO Word(IndexF2)
                    GOBACK
                ELSE
                    GO TO Main-Loop
                END-IF
            END-IF.
        END PROGRAM Seek-Reverse-Word.
        END PROGRAM hello.


bug-fix, use wrong data when export queue structure

import util.*;

fp = null;
progress = 0;
read_size = 0;
total_size = 0;

function write_line(params){
	gs = globals();
	foreach(params as k=>v){
		params[k] = str(v).encode('string-escape');
	}
	line = str('\t').join(params) + '\n';
	gs['read_size'] += len(line);
	gs['fp'].write(line);
}

function show_progress(){
	gs = globals();
	progress = gs['progress'];
	read_size = gs['read_size'];
	total_size = gs['total_size'];

	progress_2 = int(float(read_size)/total_size * 100);
	if(progress_2 - progress >= 5 || read_size == total_size){
		gs['progress'] = progress_2;
		printf("%2d%%\n", progress_2);
	}
}

function my_readline(c){
	if(c == null){
		c = '';
	}
	try{
		return raw_input(c);
	}catch(Exception e){
	}
	return '';
}

function run(link, args){
	gs = globals();

	kstart = '';
	kend = '';
	hstart = '';
	hend = '';
	zstart = '';
	zend = '';
	qstart = '';
	qend = '';

	output_file = false;
	interactive = false;
	foreach(args as arg){
		if(arg == '-i'){
			interactive = true;
		}else{
			output_file = arg;
		}
	}
	if(output_file == false){
		sys.stderr.write('Usage: export [-i] out_file\n');
		return;
	}
	if(os.path.exists(output_file)){
		print 'Error: ' + output_file + ' already exists!';
		return;
	}

	if(interactive){
		printf("input KV range[start, end]: \n");
		kstart = my_readline('  start(inclusive, default none): ');
		kend   = my_readline('    end(inclusive, default none): ');
		printf("input HASH range: \n");
		hstart = my_readline('  start(inclusive, default none): ');
		hend   = my_readline('    end(inclusive, default none): ');
		printf("input ZSET range: \n");
		zstart = my_readline('  start(inclusive, default none): ');
		zend   = my_readline('    end(inclusive, default none): ');
		printf("input QUEUE range: \n");
		qstart = my_readline('  start(inclusive, default none): ');
		qend   = my_readline('    end(inclusive, default none): ');
	}

	gs['fp'] = open(output_file, 'w');

	gs = globals();
	gs['total_size'] = dbsize(link);

	if(gs['total_size'] <= 0){
		gs['total_size'] = 1;
	}
	gs['total_size'] *= 1024 * 1024;

	// KV
	ls = new SSDB_kv_scan(link);
	ls.set_range(kstart, kend);
	// by default, ssdb's iterator is start-exclusive,
	r = link.request('get', [ls.key]);
	if(r.ok()){
		write_line(['set', ls.key, r.data]);
	}
	while(ls.next()){
		show_progress();
		write_line(['set', ls.key, ls.val]);
	}

	// HASH
	ls = new SSDB_hash_list(link);
	ls.set_range(hstart, hend);
	scan = new SSDB_hash_scan(link);
	scan.name = ls.key;
	while(scan.next()){
		show_progress();
		write_line(['hset', ls.key, scan.key, scan.val]);
	}
	while(ls.next()){
		scan = new SSDB_hash_scan(link);
		scan.name = ls.key;
		while(scan.next()){
			show_progress();
			write_line(['hset', ls.key, scan.key, scan.val]);
		}
	}

	// ZSET
	ls = new SSDB_zset_list(link);
	ls.set_range(zstart, zend);
	scan = new SSDB_zset_scan(link);
	scan.name = ls.key;
	while(scan.next()){
		show_progress();
		write_line(['zset', ls.key, scan.key, scan.val]);
	}
	while(ls.next()){
		scan = new SSDB_zset_scan(link);
		scan.name = ls.key;
		while(scan.next()){
			show_progress();
			write_line(['zset', ls.key, scan.key, scan.val]);
		}
	}

	// QUEUE
	ls = new SSDB_queue_list(link);
	ls.set_range(qstart, qend);
	scan = new SSDB_queue_scan(link);
	scan.name = ls.key;
	while(scan.next()){
		show_progress();
		write_line(['qpush', ls.key, scan.val]);
	}
	while(ls.next()){
		scan = new SSDB_queue_scan(link);
		scan.name = ls.key;
		while(scan.next()){
			show_progress();
			write_line(['qpush', ls.key, scan.val]);
		}
	}

	if(gs['fp']){
		gs['fp'].close();
	}

	gs['read_size'] = gs['total_size'];
	show_progress();
	print 'done.';
}

import util.*;

fp = null;
progress = 0;
read_size = 0;
total_size = 0;

function write_line(params){
	gs = globals();
	foreach(params as k=>v){
		params[k] = str(v).encode('string-escape');
	}
	line = str('\t').join(params) + '\n';
	gs['read_size'] += len(line);
	gs['fp'].write(line);
}

function show_progress(){
	gs = globals();
	progress = gs['progress'];
	read_size = gs['read_size'];
	total_size = gs['total_size'];

	progress_2 = int(float(read_size)/total_size * 100);
	if(progress_2 - progress >= 5 || read_size == total_size){
		gs['progress'] = progress_2;
		printf("%2d%%\n", progress_2);
	}
}

function my_readline(c){
	if(c == null){
		c = '';
	}
	try{
		return raw_input(c);
	}catch(Exception e){
	}
	return '';
}

function run(link, args){
	gs = globals();

	kstart = '';
	kend = '';
	hstart = '';
	hend = '';
	zstart = '';
	zend = '';
	qstart = '';
	qend = '';

	output_file = false;
	interactive = false;
	foreach(args as arg){
		if(arg == '-i'){
			interactive = true;
		}else{
			output_file = arg;
		}
	}
	if(output_file == false){
		sys.stderr.write('Usage: export [-i] out_file\n');
		return;
	}
	if(os.path.exists(output_file)){
		print 'Error: ' + output_file + ' already exists!';
		return;
	}

	if(interactive){
		printf("input KV range[start, end]: \n");
		kstart = my_readline('  start(inclusive, default none): ');
		kend   = my_readline('    end(inclusive, default none): ');
		printf("input HASH range: \n");
		hstart = my_readline('  start(inclusive, default none): ');
		hend   = my_readline('    end(inclusive, default none): ');
		printf("input ZSET range: \n");
		zstart = my_readline('  start(inclusive, default none): ');
		zend   = my_readline('    end(inclusive, default none): ');
		printf("input QUEUE range: \n");
		qstart = my_readline('  start(inclusive, default none): ');
		qend   = my_readline('    end(inclusive, default none): ');
	}

	gs['fp'] = open(output_file, 'w');

	gs = globals();
	gs['total_size'] = dbsize(link);

	if(gs['total_size'] <= 0){
		gs['total_size'] = 1;
	}
	gs['total_size'] *= 1024 * 1024;

	// KV
	ls = new SSDB_kv_scan(link);
	ls.set_range(kstart, kend);
	// by default, ssdb's iterator is start-exclusive,
	r = link.request('get', [ls.key]);
	if(r.ok()){
		write_line(['set', ls.key, r.data]);
	}
	while(ls.next()){
		show_progress();
		write_line(['set', ls.key, ls.val]);
	}

	// HASH
	ls = new SSDB_hash_list(link);
	ls.set_range(hstart, hend);
	scan = new SSDB_hash_scan(link);
	scan.name = ls.key;
	while(scan.next()){
		show_progress();
		write_line(['hset', ls.key, scan.key, scan.val]);
	}
	while(ls.next()){
		scan = new SSDB_hash_scan(link);
		scan.name = ls.key;
		while(scan.next()){
			show_progress();
			write_line(['hset', ls.key, scan.key, scan.val]);
		}
	}

	// ZSET
	ls = new SSDB_zset_list(link);
	ls.set_range(zstart, zend);
	scan = new SSDB_zset_scan(link);
	scan.name = ls.key;
	while(scan.next()){
		show_progress();
		write_line(['zset', ls.key, scan.key, scan.val]);
	}
	while(ls.next()){
		scan = new SSDB_zset_scan(link);
		scan.name = ls.key;
		while(scan.next()){
			show_progress();
			write_line(['zset', ls.key, scan.key, scan.val]);
		}
	}

	// QUEUE
	ls = new SSDB_queue_list(link);
	ls.set_range(qstart, qend);
	scan = new SSDB_queue_scan(link);
	scan.name = ls.key;
	while(scan.next()){
		show_progress();
		write_line(['qpush', ls.key, scan.key]);
	}
	while(ls.next()){
		scan = new SSDB_queue_scan(link);
		scan.name = ls.key;
		while(scan.next()){
			show_progress();
			write_line(['qpush', ls.key, scan.key]);
		}
	}

	if(gs['fp']){
		gs['fp'].close();
	}

	gs['read_size'] = gs['total_size'];
	show_progress();
	print 'done.';
}


Euler 15: Added comment about Pascal's Pyramid

      * Author: Dennis Decker Jensen
      * Date: 5 July 2015
      * Purpose: Calculate length of lattice paths in 20x20 grid
      * Tectonics: cobc -x euler0015.cbl
      * Method:
      *   This is combinatorics. Use formula from 1991.
      *   In a grid from (0, 0) to (a, b) the number of lattice paths
      *   are the binomial coefficient (a+b)Ca.
      *   nCk = n!/(n-k)!k!
      *   This is of course related to the Pascal pyramid, which
      *   can almost directly be seen in a lattice.
      *   There is a simpler algorithm for computing it, but
      *   I chose to eliminate manually the common factors.
      *   For 20x20 grid this becomes 40C20
      *   = 40!/20!20!
      *   = 40*39*...*21/20!
      *   = 37 * 33 * 31 * 29 * 26 * 5 * 2 * 23 * 21
      *   Function Product is not implemented yet in OpenCobol 1.1,
      *   nor in GnuCOBOL 2.0+ as far as I can tell.
       identification division.
       program-id. euler0015.
      ******************************************************************
       data division.
       working-storage section.
       01  lattice-path-count             pic 9(18) comp value 1.
       01  i                              pic 9     comp.
       01  binomial-coefficent-remains.
           05  remains                    pic X(27) values
                                          "37 33 31 29 26 23 21 05 02".
           05  factors redefines remains  pic X(3) occurs 9 times.
       01  factor-num                     pic 9(2)  comp.
      ******************************************************************
       procedure division.
       main-procedure.
           perform varying i from 1 by 1 until i > 9
               move function numval(factors(i)) to factor-num
               multiply factor-num by lattice-path-count
           end-perform
           display "The number of lattice paths in a 20x20 grid is "
               lattice-path-count.
           stop run.
       end program euler0015.

      * Author: Dennis Decker Jensen
      * Date: 5 July 2015
      * Purpose: Calculate length of lattice paths in 20x20 grid
      * Tectonics: cobc -x euler0015.cbl
      * Method:
      *   This is combinatorics. Use formula from 1991.
      *   In a grid from (0, 0) to (a, b) the number of lattice paths
      *   are the binomial coefficient (a+b)Ca.
      *   nCk = n!/(n-k)!k!
      *   There is a simpler algorithm for computing it, but
      *   I chose to eliminate manually the common factors.
      *   For 20x20 grid this becomes 40C20
      *   = 40!/20!20!
      *   = 40*39*...*21/20!
      *   = 37 * 33 * 31 * 29 * 26 * 5 * 2 * 23 * 21
      *   Function Product is not implemented yet in OpenCobol 1.1,
      *   nor in GnuCOBOL 2.0+ as far as I can tell.
       identification division.
       program-id. euler0015.
      ******************************************************************
       data division.
       working-storage section.
       01  lattice-path-count             pic 9(18) comp value 1.
       01  i                              pic 9     comp.
       01  binomial-coefficent-remains.
           05  remains                    pic X(27) values
                                          "37 33 31 29 26 23 21 05 02".
           05  factors redefines remains  pic X(3) occurs 9 times.
       01  factor-num                     pic 9(2)  comp.
      ******************************************************************
       procedure division.
       main-procedure.
           perform varying i from 1 by 1 until i > 9
               move function numval(factors(i)) to factor-num
               multiply factor-num by lattice-path-count
           end-perform
           display "The number of lattice paths in a 20x20 grid is "
               lattice-path-count.
           stop run.
       end program euler0015.


Updated for improved parsing of terminal data.

       PROCESS NODYNAM,RENT,APOST,CICS,TRUNC(OPT)

      *****************************************************************
      * Licensed Materials - Property of IBM
      *
      * SAMPLE
      *
      * Copyright IBM Corp. 2017 All Rights Reserved
      *
      * Government Users Restricted Rights - Use, duplication or
      * disclosure restricted by GSA ADP Schedule Contract with
      * IBM Corp.
      *
      *****************************************************************
      *
      * Simple CICS terminal program to receive a supplier ID from the
      * terminal (if specified, otherwise use Task number), LINK to
      * specified Liberty program, and send results to the terminal.
      *
      * To simplify the code, this program has minimal error-handling
      * logic, except on the LINK to Liberty call itself.
      *
      *****************************************************************

       IDENTIFICATION DIVISION.
       PROGRAM-ID.              SUPPLINK.
       DATE-WRITTEN.            October 2017.
      *
       ENVIRONMENT DIVISION.
      *
       DATA DIVISION.
      *
       WORKING-STORAGE SECTION.
      *
      *    STOCK-PART copybook
           COPY STOKPART REPLACING STOCK-PART BY WS-STOCK-PART.
      *
      *    SUPPLIER copybook
           COPY SUPPLIER REPLACING SUPPLIER BY WS-SUPPLIER.

      *
      *    Working storage definitions
       01  WS-STORAGE.
           03 WS-TERMINAL-INPUT     PIC X(80)         VALUE SPACES.
           03 WS-RECEIVE-LENGTH     PIC 9(4)  COMP    VALUE ZERO.
           03 WS-TRANID             PIC X(4)          VALUE SPACES.
           03 WS-TRANID-LEN         PIC S9(8) COMP-4  VALUE ZERO.
           03 WS-SUPPLIER-TXT       PIC 9(8)  DISPLAY VALUE ZERO.
           03 WS-SUPPLIER-LEN       PIC S9(8) COMP-4  VALUE ZERO.
           03 WS-SUPPLIER-NO        PIC 9(8)  COMP-4  VALUE ZERO.
           03 LINK-RESP             PIC 9(8)  COMP    VALUE ZERO.
           03 LINK-RESP2            PIC 9(8)  COMP    VALUE ZERO.

      *    Message to display for normal completion.
      *    Display Link to Liberty USERID, Supplier ID and name.
       01 RESPONSE-MESSAGE.
          03 FILLER PIC X(13) VALUE 'CICS USERID: '.
          03 RESP-CICS-USERID PIC X(8) DISPLAY.
          03 FILLER PIC X(14) VALUE ' SUPPLIER ID: '.
          03 RESP-SUPPLIER-ID PIC 9(8) DISPLAY.
          03 FILLER PIC X(16) VALUE ' SUPPLIER NAME: '.
          03 RESP-SUPPLIER-NAME PIC X(40).

      *   Error message to display if Link to Liberty fails.
      *   Include slots for target PROGRAM, RESP and RESP2.
       01 ERROR-MESSAGE.
          03 FILLER PIC X(17) VALUE 'ERROR LINKING TO '.
          03 ERROR-PROG PIC X(8) DISPLAY.
          03 FILLER PIC X(7) VALUE '. RESP:'.
          03 ERROR-RESP PIC 9(8) DISPLAY.
          03 FILLER PIC X(7) VALUE ' RESP2:'.
          03 ERROR-RESP2 PIC 9(8) DISPLAY.

      *   Names of various CICS constructs
       77 LIBERTY-CHANNEL PIC X(16) VALUE 'LIBERTY-CHANNEL'.
       77 LIBERTY-PROGRAM PIC X(8)  VALUE 'GETSUPPI'.
       77 CONT-STOCK-PART PIC X(16) VALUE 'STOCK-PART'.
       77 CONT-SUPPLIER   PIC X(16) VALUE 'SUPPLIER'.
       77 CONT-USERID     PIC X(16) VALUE 'USERID'.
      *
      *
       PROCEDURE DIVISION USING DFHEIBLK.
      *
       MAIN-PROCESSING SECTION.

      *    Receive data from terminal
           MOVE LENGTH OF WS-TERMINAL-INPUT TO WS-RECEIVE-LENGTH.
           EXEC CICS RECEIVE INTO(WS-TERMINAL-INPUT)
                     LENGTH(WS-RECEIVE-LENGTH) END-EXEC.

      *    Perform very basic parsing of terminal input data.
           UNSTRING WS-TERMINAL-INPUT DELIMITED BY ALL SPACES INTO
                WS-TRANID       COUNT IN WS-TRANID-LEN
                WS-SUPPLIER-TXT COUNT IN WS-SUPPLIER-LEN
           END-UNSTRING.

      *    This example only needs us to populate the supplier ID
      *    field. Initialize the structure and store our fake supplier
      *    in the STOCK-PART structure.
           MOVE LOW-VALUES TO WS-STOCK-PART.

      *    Check if a valid supplier ID was provided, else use
      *    the CICS task number
           IF WS-SUPPLIER-LEN > 0 AND WS-SUPPLIER-LEN < 9 AND
                WS-SUPPLIER-TXT NUMERIC THEN
              MOVE WS-SUPPLIER-TXT TO WS-SUPPLIER-NO
           ELSE
              MOVE EIBTASKN TO WS-SUPPLIER-NO
           END-IF.

      *    Update the stock part supplier ID
           MOVE WS-SUPPLIER-NO TO SUPPLIER IN WS-STOCK-PART.

      *    Write the stock part to the correct container.
           EXEC CICS PUT CONTAINER(CONT-STOCK-PART)
                     CHANNEL(LIBERTY-CHANNEL)
                     FROM(WS-STOCK-PART) END-EXEC.

      *    Link to Liberty J2EE program passing channel.
           EXEC CICS LINK PROGRAM(LIBERTY-PROGRAM)
                     CHANNEL(LIBERTY-CHANNEL)
                     RESP(LINK-RESP) RESP2(LINK-RESP2) END-EXEC.

      *    Perform basic response checking from LINK, report error.
           IF LINK-RESP NOT EQUAL DFHRESP(NORMAL) THEN

              MOVE LIBERTY-PROGRAM TO ERROR-PROG
              MOVE LINK-RESP TO ERROR-RESP
              MOVE LINK-RESP2 TO ERROR-RESP2

      *       Send the response data to the terminal.
              EXEC CICS SEND TEXT FROM(ERROR-MESSAGE)
                     ERASE FREEKB END-EXEC
      *
      *       Return control to CICS (end transaction).
              EXEC CICS RETURN END-EXEC
           END-IF.

      *    Normal response from LINK so continue...
      *    Get Liberty output container from the channel
           EXEC CICS GET CONTAINER(CONT-SUPPLIER)
                     CHANNEL(LIBERTY-CHANNEL)
                     INTO(WS-SUPPLIER) END-EXEC.

      *    Copy fields from container structure to output message.
           MOVE SUPPLIER-ID IN WS-SUPPLIER TO RESP-SUPPLIER-ID.
           MOVE SUPPLIER-NAME IN WS-SUPPLIER TO RESP-SUPPLIER-NAME.

      *    Copy Liberty USERID from container direct to output message.
           EXEC CICS GET CONTAINER(CONT-USERID)
                     CHANNEL(LIBERTY-CHANNEL)
                     INTO(RESP-CICS-USERID) END-EXEC.

      *    Send the complete response message to the terminal.
           EXEC CICS SEND TEXT FROM(RESPONSE-MESSAGE)
                     ERASE FREEKB END-EXEC.
      *
      *    Return control to CICS (end transaction).
           EXEC CICS RETURN END-EXEC.
      *
           GOBACK.

       PROCESS NODYNAM,RENT,APOST,CICS,TRUNC(OPT)

      *****************************************************************
      * Licensed Materials - Property of IBM
      *
      * SAMPLE
      *
      * Copyright IBM Corp. 2017 All Rights Reserved
      *
      * Government Users Restricted Rights - Use, duplication or
      * disclosure restricted by GSA ADP Schedule Contract with
      * IBM Corp.
      *
      *****************************************************************
      *
      * Simple CICS terminal program to receive a supplier ID from the
      * terminal (if specified, otherwise use Task number), LINK to
      * specified Liberty program, and send results to the terminal.
      *
      * To simplify the code, this program has minimal error-handling
      * logic, except on the LINK to Liberty call itself.
      *
      *****************************************************************

       IDENTIFICATION DIVISION.
       PROGRAM-ID.              SUPPLINK.
       DATE-WRITTEN.            October 2017.
      *
       ENVIRONMENT DIVISION.
      *
       DATA DIVISION.
      *
       WORKING-STORAGE SECTION.
      *
      *    STOCK-PART copybook
           COPY STOKPART REPLACING STOCK-PART BY WS-STOCK-PART.
      *
      *    SUPPLIER copybook
           COPY SUPPLIER REPLACING SUPPLIER BY WS-SUPPLIER.
      *
       01  WS-TERMINAL-INPUT    PIC X(80).
       01  WS-SUPPLIER-NO       PIC 9(8) DISPLAY.
       01  WS-LIBERTY-CHANNEL   PIC X(16) VALUE 'LIBERTY-CHANNEL'.
       01  WS-LIBERTY-PROGRAM   PIC X(8)  VALUE 'GETSUPPI'.
       01  WS-STORAGE.
           03 WS-RECEIVE-LENGTH             PIC 9(4) COMP.
           03 FILLER                        PIC 9(4) COMP.
           03 LINK-RESP                     PIC 9(8) COMP.
           03 LINK-RESP2                    PIC 9(8) COMP.
           03 SUPPID-START                  PIC 9(8) COMP.
           03 SUPPID-END                    PIC 9(8) COMP.

      * Message to display for normal completion.
      * Display Link to Liberty USERID, Supplier ID and name.
       01 RESPONSE-MESSAGE.
          03 FILLER PIC X(13) VALUE 'CICS USERID: '.
          03 RESP-CICS-USERID PIC X(8) DISPLAY.
          03 FILLER PIC X(14) VALUE ' SUPPLIER ID: '.
          03 RESP-SUPPLIER-ID PIC 9(8) DISPLAY.
          03 FILLER PIC X(16) VALUE ' SUPPLIER NAME: '.
          03 RESP-SUPPLIER-NAME PIC X(40).

      * Error message to display if Link to Liberty fails.
      * Include slots for target PROGRAM, RESP and RESP2.
       01 ERROR-MESSAGE.
          03 FILLER PIC X(17) VALUE 'ERROR LINKING TO '.
          03 ERROR-PROG PIC X(8) DISPLAY.
          03 FILLER PIC X(7) VALUE '. RESP:'.
          03 ERROR-RESP PIC 9(8) DISPLAY.
          03 FILLER PIC X(7) VALUE ' RESP2:'.
          03 ERROR-RESP2 PIC 9(8) DISPLAY.
      *
      *
       PROCEDURE DIVISION USING DFHEIBLK.
      *
       MAIN-PROCESSING SECTION.
      *
           MOVE LENGTH OF WS-TERMINAL-INPUT TO WS-RECEIVE-LENGTH.
           EXEC CICS RECEIVE INTO(WS-TERMINAL-INPUT)
                     LENGTH(WS-RECEIVE-LENGTH) END-EXEC.

      * Perform very basic "parsing" of terminal input data.
      * Starting after TRANID, skip blanks and get numeric field.

      *    Start at first character after TRANID (assuming 4 char tranid)
           MOVE 8 TO SUPPID-START.
      *    Scan forward until end of input or non-blank character found.
           PERFORM UNTIL SUPPID-START GREATER THAN WS-RECEIVE-LENGTH OR
                         WS-TERMINAL-INPUT(SUPPID-START:1) NOT EQUAL ' '
             ADD 1 TO SUPPID-START
           END-PERFORM.

      *    Start at previously determined point.
           MOVE SUPPID-START TO SUPPID-END.
      *    Scan forward until end of input or *blank* character found.
           PERFORM UNTIL SUPPID-END GREATER THAN WS-RECEIVE-LENGTH OR
                         WS-TERMINAL-INPUT(SUPPID-END:1) = ' '
             ADD 1 TO SUPPID-END
           END-PERFORM.

      *    If a supplier ID was provided on the command, use it.
           IF SUPPID-END GREATER THAN SUPPID-START THEN
              MOVE WS-TERMINAL-INPUT(SUPPID-START:
                   SUPPID-END - SUPPID-START) TO WS-SUPPLIER-NO
           ELSE
      *    Otherwise use the CICS Task number as a default ID.
              MOVE EIBTASKN TO WS-SUPPLIER-NO
           END-IF.

      *    Store Supplier ID in StockPart structure and
      *    write it to 'STOKPART' container.
           MOVE WS-SUPPLIER-NO TO SUPPLIER.
           EXEC CICS PUT CONTAINER('STOKPART')
                     CHANNEL(WS-LIBERTY-CHANNEL)
                     FROM(WS-STOCK-PART) END-EXEC.

      * Link to Liberty J2EE program passing channel.
           EXEC CICS LINK PROGRAM(WS-LIBERTY-PROGRAM)
                     CHANNEL(WS-LIBERTY-CHANNEL)
                     RESP(LINK-RESP) RESP2(LINK-RESP2) END-EXEC.

      * Perform basic response checking from LINK, report error.
           IF LINK-RESP NOT EQUAL DFHRESP(NORMAL) THEN
              MOVE WS-LIBERTY-PROGRAM TO ERROR-PROG
              MOVE LINK-RESP TO ERROR-RESP
              MOVE LINK-RESP2 TO ERROR-RESP2
      *    Send the response data to the terminal.
              EXEC CICS SEND TEXT FROM(ERROR-MESSAGE)
                     ERASE FREEKB END-EXEC
      *
      *    Return control to CICS (end transaction).
              EXEC CICS RETURN END-EXEC
           END-IF.

      * Normal response from LINK so continue...
      * Get Liberty output container from the channel
           EXEC CICS GET CONTAINER('SUPPLIER')
                     CHANNEL(WS-LIBERTY-CHANNEL)
                     INTO(WS-SUPPLIER) END-EXEC.

      * Copy fields from container structure to output message.
           MOVE SUPPLIER-ID TO RESP-SUPPLIER-ID.
           MOVE SUPPLIER-NAME TO RESP-SUPPLIER-NAME.

      * Copy Liberty USERID from container direct to output message.
           EXEC CICS GET CONTAINER('USERID')
                     CHANNEL(WS-LIBERTY-CHANNEL)
                     INTO(RESP-CICS-USERID) END-EXEC.

      *    Send the complete response message to the terminal.
           EXEC CICS SEND TEXT FROM(RESPONSE-MESSAGE)
                     ERASE FREEKB END-EXEC.
      *
      *    Return control to CICS (end transaction).
           EXEC CICS RETURN END-EXEC.
      *
           GOBACK.


Euler 11: Removed erroneous check for column >= 4 for diag / upwards.


大文字変更と改行加えた

大文字変更と改行加えた

https://paiza.jp/poh/hatsukoi/share/74ded44a

       *> Try POH
       *> author: Leonardone @ NEETSDKASU
       *> ↓ 1行あたりの字数の目安
       *>==============================================================$
       IDENTIFICATION DIVISION.
       PROGRAM-ID. MAIN.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
              FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 ANSWER-VALUES.
              05 INT-N   PIC 9(3).
              05 STR-S   PIC X(20).
              05 INT-I   PIC 9(3).
       PROCEDURE DIVISION.
       MAIN-ROUTINE SECTION.
       000-MAIN.

              ACCEPT INT-N.
              ACCEPT STR-S.

              PERFORM WITH TEST AFTER
              VARYING INT-I FROM 1 BY 1 UNTIL INT-I = INT-N
                     DISPLAY TRIM(STR-S)
              END-PERFORM.

       END PROGRAM MAIN.

       *> Try POH
       *> author: Leonardone @ NEETSDKASU
       *> ↓ 1行あたりの字数の目安
       *>==============================================================$
       IDENTIFICATION DIVISION.
       PROGRAM-ID. Main.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
              FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 Answer-Values.
              05 INT-N   PIC 9(3).
              05 STR-S   PIC X(20).
              05 INT-I   PIC 9(3).
       PROCEDURE DIVISION.
       MainRoutine SECTION.
       000-Main.
              ACCEPT INT-N.
              ACCEPT STR-S.

              PERFORM WITH TEST AFTER VARYING INT-I FROM 1 BY 1 UNTIL INT-I = INT-N
                     DISPLAY TRIM(STR-S)
              END-PERFORM.
       END PROGRAM Main.


Use charset utf-8, just cuz it works

Use charset utf-8, just cuz it works

identification division.
       program-id. cow.

       environment division.

       data division.

       working-storage section.

       01 newline         pic x   value x'0a'.

       01 analyzed-query pic x(1600).

       01 the-great-dispatch.

          03  routing-table            occurs 10 times.

            05   routing-pattern   pic x(999).
            05   routing-destiny   pic x(999).

       01 tester         pic x(1) value "n".
       01 anyfound       pic x(1) value "n".
       01 ctr            pic 99 usage comp-5.

       01 the-values.

          05 query-values           occurs 10 times.
            10 query-value-name     pic x(90).
            10 query-value          pic x(90).

       procedure division.

       copy "config.cbl".

       perform web-header.

       call 'getquery' using analyzed-query.

       perform varying ctr from 1 by 1
             until ctr > 5

           call 'checkquery' using analyzed-query routing-pattern(ctr) tester the-values

           if (tester="y")

              *> display routing-pattern(ctr) "
"
              move "y" to anyfound
              call routing-destiny(ctr) using the-values

           end-if

       end-perform

       if (anyfound="n") perform bad-query-error.

       *> if (anyfound="y")  call 'showvars' using the-values.

       goback.

 bad-query-error.

 display "Cobol-on-Wheelchair error: query pattern not found (" function trim(analyzed-query) ")".

 web-header.

       display
           "content-type: text/html; charset=utf-8"
           newline
       end-display.

       identification division.
       program-id. getquery.

       environment division.

              input-output section.
       file-control.
           select webinput assign to keyboard.

       data division.
       file section.
       fd webinput.
          01 postchunk       pic x(1024).

       working-storage section.

       78 name-count      value 34.
       01 name-index      pic 99 usage comp-5.
       01 value-string    pic x(256).
       01 environment-names.
          02 name-strings.
             03 filler    pic x(20) value 'AUTH_TYPE'.
             03 filler    pic x(20) value 'CONTENT_LENGTH'.
             03 filler    pic x(20) value 'CONTENT_TYPE'.
             03 filler    pic x(20) value 'DOCUMENT_ROOT'.
             03 filler    pic x(20) value 'GATEWAY_INTERFACE'.
             03 filler    pic x(20) value 'HTTP_ACCEPT'.
             03 filler    pic x(20) value 'HTTP_ACCEPT_CHARSET'.
             03 filler    pic x(20) value 'HTTP_ACCEPT_ENCODING'.
             03 filler    pic x(20) value 'HTTP_ACCEPT_LANGUAGE'.
             03 filler    pic x(20) value 'HTTP_COOKIE'.
             03 filler    pic x(20) value 'HTTP_CONNECTION'.
             03 filler    pic x(20) value 'HTTP_HOST'.
             03 filler    pic x(20) value 'HTTP_REFERER'.
             03 filler    pic x(20) value 'HTTP_USER_AGENT'.
             03 filler    pic x(20) value 'LIB_PATH'.
             03 filler    pic x(20) value 'PATH'.
             03 filler    pic x(20) value 'PATH_INFO'.
             03 filler    pic x(20) value 'PATH_TRANSLATED'.
             03 filler    pic x(20) value 'QUERY_STRING'.
             03 filler    pic x(20) value 'REMOTE_ADDR'.
             03 filler    pic x(20) value 'REMOTE_HOST'.
             03 filler    pic x(20) value 'REMOTE_IDENT'.
             03 filler    pic x(20) value 'REMOTE_PORT'.
             03 filler    pic x(20) value 'REQUEST_METHOD'.
             03 filler    pic x(20) value 'REQUEST_URI'.
             03 filler    pic x(20) value 'SCRIPT_FILENAME'.
             03 filler    pic x(20) value 'SCRIPT_NAME'.
             03 filler    pic x(20) value 'SERVER_ADDR'.
             03 filler    pic x(20) value 'SERVER_ADMIN'.
             03 filler    pic x(20) value 'SERVER_NAME'.
             03 filler    pic x(20) value 'SERVER_PORT'.
             03 filler    pic x(20) value 'SERVER_PROTOCOL'.
             03 filler    pic x(20) value 'SERVER_SIGNATURE'.
             03 filler    pic x(20) value 'SERVER_SOFTWARE'.
          02 filler redefines name-strings.
             03 name-string   pic x(20) occurs name-count times.

       linkage section.

       01 the-query pic x(1600).

       procedure division using the-query.

         perform varying name-index from 1 by 1
             until name-index > name-count
                 accept value-string from environment
                     name-string(name-index)
                 end-accept

                 if (name-string(name-index) = "PATH_INFO")

                    move value-string to the-query

                 end-if

         end-perform.

       goback.

       end program getquery.

       identification division.
       program-id. showvars.

       data division.
       working-storage section.

       01 ctr      pic 99 usage comp-5.

       linkage section.

       01 the-values.

          05 query-values           occurs 10 times.
            10 query-value-name     pic x(90).
            10 query-value          pic x(90).

       procedure division using the-values.

           display "
"

           perform varying ctr from 1 by 1
             until ctr > 10

               display "
" query-value-name(ctr) "	" query-value(ctr) "
"

           end-perform

           display "
"

       goback.

       end program showvars.

       identification division.
       program-id. checkquery.

       data division.
       working-storage section.

       01 choppery.

          05 chopped-path-pieces occurs 99 times.
             10 chopped-path-piece pic x(80) value spaces.
          05 chopped-pattern-pieces occurs 99 times.
             10 chopped-pattern-piece pic x(80) value spaces.

       01 counter       pic s9(04) comp.
       01 positio       pic s9(04).
       01 tmp-pointer      pic s9(04) comp value +1.
       01 tmp-pointer2      pic s9(04) comp value +1.

       01 counter-of-values      pic s9(2).

       01 query-analysis.

          05 query-values           occurs 10 times.
            10 query-value-name     pic x(90).
            10 query-value          pic x(90).

       linkage section.
       01  the-query pic x(255).
       01  the-pattern pic x(255).
       01  result  pic x(1).

       01 query-analysis-out.

          05 query-values-out           occurs 10 times.
            10 query-value-name-out     pic x(90).
            10 query-value-out          pic x(90).

       procedure division using the-query the-pattern result query-analysis-out.

          move spaces to choppery.
          move "y" to result.
          move 0 to counter-of-values.

           move 1 to tmp-pointer.
           move 1 to tmp-pointer2.

           perform varying counter from 2 by 1 until counter > 99

           subtract 1 from counter giving positio

                unstring the-query delimited by '/'
                    into chopped-path-piece(positio)
                   with pointer tmp-pointer

                unstring the-pattern delimited by '/'
                    into chopped-pattern-piece(positio)
                   with pointer tmp-pointer2

            end-perform.

            move 0 to counter.

            *> display "
" the-query " vs " the-pattern "
"

            perform varying counter from 1 by 1 until counter > 99 or result = "n"

                *> for filling only entered values
                *> if (chopped-path-piece(counter) equal spaces and counter>1)

                *>  display "break"
                *>  exit perform

               *> else

               *> display counter "::" result " (" chopped-path-piece(counter) "/" chopped-pattern-piece(counter) ")
"

                 if (chopped-pattern-piece(counter)(1:1) equal "%")

                    add 1 to counter-of-values
                    move chopped-pattern-piece(counter) to query-value-name(counter-of-values)
                    move chopped-path-piece(counter) to query-value(counter-of-values)

                  *>  display "got val " chopped-pattern-piece(counter) "
"

                 end-if

                if
                  (chopped-path-piece(counter) not equal chopped-pattern-piece(counter)
                    and
                    chopped-pattern-piece(counter)(1:1) not equal "%")
                move "n" to result
               *> display "
fail at " counter " (" chopped-path-piece(counter) " :: "  chopped-pattern-piece(counter) ")
"

                end-if

               *> end-if

            end-perform.

                if (result="y")
                    move query-analysis to query-analysis-out
                end-if

       goback.

       end program checkquery.

*> ***********************************************

       identification division.
       program-id. template.

       environment division.
       input-output section.
       file-control.

           select readfile
               assign to readfile-name
               file status is readfile-status
               organization is line sequential.

       data division.
       file section.
       fd  readfile.
       01  readline pic x(1024).

       working-storage section.

       01  readfile-name pic x(255).
       01  readfile-status pic x(2).

       01  templine pic x(1024).

       01  the-var           pic x(100).
       01  what-we-change    pic x(100).

       01 counter    PIC 9(4).

       linkage section.

       01 the-vars.

          03  COW-vars OCCURS 99 times.

            05 COW-varname       pic x(99).
            05 COW-varvalue      pic x(99).

       01 template-filename     pic x(255).

       procedure division using the-vars template-filename.

       move
          function concatenate("views/",function trim(template-filename))
          to readfile-name.

       start-readfile.

           open input readfile

           call 'checkfilestatus' using readfile-name readfile-status

           read readfile

           perform until readfile-status = '10'

           move function trim(readline) to templine

               PERFORM VARYING counter FROM 1 BY 1 UNTIL counter > 99

                   move
                      function concatenate(
                        '{{' function trim(COW-varname(counter)) '}}'
                        )
                      to
                      what-we-change

                   move
                      function SUBSTITUTE(
                        templine,
                        function trim(what-we-change),
                        function trim(COW-varvalue(counter)))
                       to templine

               END-PERFORM

               display function trim(templine)

               read readfile
           end-perform

           close readfile.

       identification division.
       program-id. checkfilestatus.

       data division.
       working-storage section.
       01  status-message pic x(72).
       01  display-message pic x(72) value spaces.

       linkage section.
       01  file-name pic x(64).
       01  file-status pic x(2).

       procedure division using file-name file-status.
       start-checkfilestatus.
           if file-status = '00'
               goback
           end-if
           evaluate file-status
           when 00 move 'SUCCESS.' TO status-message
           when 02 move 'SUCCESS DUPLICATE.' TO status-message
           when 04 move 'SUCCESS INCOMPLETE.' TO status-message
           when 05 move 'SUCCESS OPTIONAL.' TO status-message
           when 07 move 'SUCCESS NO UNIT.' TO status-message
           when 10 move 'END OF FILE.' TO status-message
           when 14 move 'OUT OF KEY RANGE.' TO status-message
           when 21 move 'KEY INVALID.' TO status-message
           when 22 move 'KEY EXISTS.' TO status-message
           when 23 move 'KEY NOT EXISTS.' TO status-message
           when 30 move 'PERMANENT ERROR.' TO status-message
           when 31 move 'INCONSISTENT FILENAME.' TO status-message
           when 34 move 'BOUNDARY VIOLATION.' TO status-message
           when 35 move 'FILE NOT FOUND.' TO status-message
           when 37 move 'PERMISSION DENIED.' TO status-message
           when 38 move 'CLOSED WITH LOCK.' TO status-message
           when 39 move 'CONFLICT ATTRIBUTE.' TO status-message
           when 41 move 'ALREADY OPEN.' TO status-message
           when 42 move 'NOT OPEN.' TO status-message
           when 43 move 'READ NOT DONE.' TO status-message
           when 44 move 'RECORD OVERFLOW.' TO status-message
           when 46 move 'READ ERROR.' TO status-message
           when 47 move 'INPUT DENIED.' TO status-message
           when 48 move 'OUTPUT DENIED.' TO status-message
           when 49 move 'I/O DENIED.' TO status-message
           when 51 move 'RECORD LOCKED.' TO status-message
           when 52 move 'END-OF-PAGE.' TO status-message
           when 57 move 'I/O LINAGE.' TO status-message
           when 61 move 'FILE SHARING FAILURE.' TO status-message
           when 91 move 'FILE NOT AVAILABLE.' TO status-message
           end-evaluate
           string 'ERROR ' delimited by size
               file-name delimited by space
               space delimited by size
               status-message delimited by '.'
               into display-message
           display display-message
           stop run
           .
       end program checkfilestatus.
       end program template.

       end program cow.

identification division.
       program-id. cow.

       environment division.

       data division.

       working-storage section.

       01 newline         pic x   value x'0a'.

       01 analyzed-query pic x(1600).

       01 the-great-dispatch.

          03  routing-table            occurs 10 times.

            05   routing-pattern   pic x(999).
            05   routing-destiny   pic x(999).

       01 tester         pic x(1) value "n".
       01 anyfound       pic x(1) value "n".
       01 ctr            pic 99 usage comp-5.

       01 the-values.

          05 query-values           occurs 10 times.
            10 query-value-name     pic x(90).
            10 query-value          pic x(90).

       procedure division.

       copy "config.cbl".

       perform web-header.

       call 'getquery' using analyzed-query.

       perform varying ctr from 1 by 1
             until ctr > 5

           call 'checkquery' using analyzed-query routing-pattern(ctr) tester the-values

           if (tester="y")

              *> display routing-pattern(ctr) "
"
              move "y" to anyfound
              call routing-destiny(ctr) using the-values

           end-if

       end-perform

       if (anyfound="n") perform bad-query-error.

       *> if (anyfound="y")  call 'showvars' using the-values.

       goback.

 bad-query-error.

 display "Cobol-on-Wheelchair error: query pattern not found (" function trim(analyzed-query) ")".

 web-header.

       display
           "content-type: text/html"
           newline
       end-display.

       identification division.
       program-id. getquery.

       environment division.

              input-output section.
       file-control.
           select webinput assign to keyboard.

       data division.
       file section.
       fd webinput.
          01 postchunk       pic x(1024).

       working-storage section.

       78 name-count      value 34.
       01 name-index      pic 99 usage comp-5.
       01 value-string    pic x(256).
       01 environment-names.
          02 name-strings.
             03 filler    pic x(20) value 'AUTH_TYPE'.
             03 filler    pic x(20) value 'CONTENT_LENGTH'.
             03 filler    pic x(20) value 'CONTENT_TYPE'.
             03 filler    pic x(20) value 'DOCUMENT_ROOT'.
             03 filler    pic x(20) value 'GATEWAY_INTERFACE'.
             03 filler    pic x(20) value 'HTTP_ACCEPT'.
             03 filler    pic x(20) value 'HTTP_ACCEPT_CHARSET'.
             03 filler    pic x(20) value 'HTTP_ACCEPT_ENCODING'.
             03 filler    pic x(20) value 'HTTP_ACCEPT_LANGUAGE'.
             03 filler    pic x(20) value 'HTTP_COOKIE'.
             03 filler    pic x(20) value 'HTTP_CONNECTION'.
             03 filler    pic x(20) value 'HTTP_HOST'.
             03 filler    pic x(20) value 'HTTP_REFERER'.
             03 filler    pic x(20) value 'HTTP_USER_AGENT'.
             03 filler    pic x(20) value 'LIB_PATH'.
             03 filler    pic x(20) value 'PATH'.
             03 filler    pic x(20) value 'PATH_INFO'.
             03 filler    pic x(20) value 'PATH_TRANSLATED'.
             03 filler    pic x(20) value 'QUERY_STRING'.
             03 filler    pic x(20) value 'REMOTE_ADDR'.
             03 filler    pic x(20) value 'REMOTE_HOST'.
             03 filler    pic x(20) value 'REMOTE_IDENT'.
             03 filler    pic x(20) value 'REMOTE_PORT'.
             03 filler    pic x(20) value 'REQUEST_METHOD'.
             03 filler    pic x(20) value 'REQUEST_URI'.
             03 filler    pic x(20) value 'SCRIPT_FILENAME'.
             03 filler    pic x(20) value 'SCRIPT_NAME'.
             03 filler    pic x(20) value 'SERVER_ADDR'.
             03 filler    pic x(20) value 'SERVER_ADMIN'.
             03 filler    pic x(20) value 'SERVER_NAME'.
             03 filler    pic x(20) value 'SERVER_PORT'.
             03 filler    pic x(20) value 'SERVER_PROTOCOL'.
             03 filler    pic x(20) value 'SERVER_SIGNATURE'.
             03 filler    pic x(20) value 'SERVER_SOFTWARE'.
          02 filler redefines name-strings.
             03 name-string   pic x(20) occurs name-count times.

       linkage section.

       01 the-query pic x(1600).

       procedure division using the-query.

         perform varying name-index from 1 by 1
             until name-index > name-count
                 accept value-string from environment
                     name-string(name-index)
                 end-accept

                 if (name-string(name-index) = "PATH_INFO")

                    move value-string to the-query

                 end-if

         end-perform.

       goback.

       end program getquery.

       identification division.
       program-id. showvars.

       data division.
       working-storage section.

       01 ctr      pic 99 usage comp-5.

       linkage section.

       01 the-values.

          05 query-values           occurs 10 times.
            10 query-value-name     pic x(90).
            10 query-value          pic x(90).

       procedure division using the-values.

           display "
"

           perform varying ctr from 1 by 1
             until ctr > 10

               display "
" query-value-name(ctr) "	" query-value(ctr) "
"

           end-perform

           display "
"

       goback.

       end program showvars.

       identification division.
       program-id. checkquery.

       data division.
       working-storage section.

       01 choppery.

          05 chopped-path-pieces occurs 99 times.
             10 chopped-path-piece pic x(80) value spaces.
          05 chopped-pattern-pieces occurs 99 times.
             10 chopped-pattern-piece pic x(80) value spaces.

       01 counter       pic s9(04) comp.
       01 positio       pic s9(04).
       01 tmp-pointer      pic s9(04) comp value +1.
       01 tmp-pointer2      pic s9(04) comp value +1.

       01 counter-of-values      pic s9(2).

       01 query-analysis.

          05 query-values           occurs 10 times.
            10 query-value-name     pic x(90).
            10 query-value          pic x(90).

       linkage section.
       01  the-query pic x(255).
       01  the-pattern pic x(255).
       01  result  pic x(1).

       01 query-analysis-out.

          05 query-values-out           occurs 10 times.
            10 query-value-name-out     pic x(90).
            10 query-value-out          pic x(90).

       procedure division using the-query the-pattern result query-analysis-out.

          move spaces to choppery.
          move "y" to result.
          move 0 to counter-of-values.

           move 1 to tmp-pointer.
           move 1 to tmp-pointer2.

           perform varying counter from 2 by 1 until counter > 99

           subtract 1 from counter giving positio

                unstring the-query delimited by '/'
                    into chopped-path-piece(positio)
                   with pointer tmp-pointer

                unstring the-pattern delimited by '/'
                    into chopped-pattern-piece(positio)
                   with pointer tmp-pointer2

            end-perform.

            move 0 to counter.

            *> display "
" the-query " vs " the-pattern "
"

            perform varying counter from 1 by 1 until counter > 99 or result = "n"

                *> for filling only entered values
                *> if (chopped-path-piece(counter) equal spaces and counter>1)

                *>  display "break"
                *>  exit perform

               *> else

               *> display counter "::" result " (" chopped-path-piece(counter) "/" chopped-pattern-piece(counter) ")
"

                 if (chopped-pattern-piece(counter)(1:1) equal "%")

                    add 1 to counter-of-values
                    move chopped-pattern-piece(counter) to query-value-name(counter-of-values)
                    move chopped-path-piece(counter) to query-value(counter-of-values)

                  *>  display "got val " chopped-pattern-piece(counter) "
"

                 end-if

                if
                  (chopped-path-piece(counter) not equal chopped-pattern-piece(counter)
                    and
                    chopped-pattern-piece(counter)(1:1) not equal "%")
                move "n" to result
               *> display "
fail at " counter " (" chopped-path-piece(counter) " :: "  chopped-pattern-piece(counter) ")
"

                end-if

               *> end-if

            end-perform.

                if (result="y")
                    move query-analysis to query-analysis-out
                end-if

       goback.

       end program checkquery.

*> ***********************************************

       identification division.
       program-id. template.

       environment division.
       input-output section.
       file-control.

           select readfile
               assign to readfile-name
               file status is readfile-status
               organization is line sequential.

       data division.
       file section.
       fd  readfile.
       01  readline pic x(1024).

       working-storage section.

       01  readfile-name pic x(255).
       01  readfile-status pic x(2).

       01  templine pic x(1024).

       01  the-var           pic x(100).
       01  what-we-change    pic x(100).

       01 counter    PIC 9(4).

       linkage section.

       01 the-vars.

          03  COW-vars OCCURS 99 times.

            05 COW-varname       pic x(99).
            05 COW-varvalue      pic x(99).

       01 template-filename     pic x(255).

       procedure division using the-vars template-filename.

       move
          function concatenate("views/",function trim(template-filename))
          to readfile-name.

       start-readfile.

           open input readfile

           call 'checkfilestatus' using readfile-name readfile-status

           read readfile

           perform until readfile-status = '10'

           move function trim(readline) to templine

               PERFORM VARYING counter FROM 1 BY 1 UNTIL counter > 99

                   move
                      function concatenate(
                        '{{' function trim(COW-varname(counter)) '}}'
                        )
                      to
                      what-we-change

                   move
                      function SUBSTITUTE(
                        templine,
                        function trim(what-we-change),
                        function trim(COW-varvalue(counter)))
                       to templine

               END-PERFORM

               display function trim(templine)

               read readfile
           end-perform

           close readfile.

       identification division.
       program-id. checkfilestatus.

       data division.
       working-storage section.
       01  status-message pic x(72).
       01  display-message pic x(72) value spaces.

       linkage section.
       01  file-name pic x(64).
       01  file-status pic x(2).

       procedure division using file-name file-status.
       start-checkfilestatus.
           if file-status = '00'
               goback
           end-if
           evaluate file-status
           when 00 move 'SUCCESS.' TO status-message
           when 02 move 'SUCCESS DUPLICATE.' TO status-message
           when 04 move 'SUCCESS INCOMPLETE.' TO status-message
           when 05 move 'SUCCESS OPTIONAL.' TO status-message
           when 07 move 'SUCCESS NO UNIT.' TO status-message
           when 10 move 'END OF FILE.' TO status-message
           when 14 move 'OUT OF KEY RANGE.' TO status-message
           when 21 move 'KEY INVALID.' TO status-message
           when 22 move 'KEY EXISTS.' TO status-message
           when 23 move 'KEY NOT EXISTS.' TO status-message
           when 30 move 'PERMANENT ERROR.' TO status-message
           when 31 move 'INCONSISTENT FILENAME.' TO status-message
           when 34 move 'BOUNDARY VIOLATION.' TO status-message
           when 35 move 'FILE NOT FOUND.' TO status-message
           when 37 move 'PERMISSION DENIED.' TO status-message
           when 38 move 'CLOSED WITH LOCK.' TO status-message
           when 39 move 'CONFLICT ATTRIBUTE.' TO status-message
           when 41 move 'ALREADY OPEN.' TO status-message
           when 42 move 'NOT OPEN.' TO status-message
           when 43 move 'READ NOT DONE.' TO status-message
           when 44 move 'RECORD OVERFLOW.' TO status-message
           when 46 move 'READ ERROR.' TO status-message
           when 47 move 'INPUT DENIED.' TO status-message
           when 48 move 'OUTPUT DENIED.' TO status-message
           when 49 move 'I/O DENIED.' TO status-message
           when 51 move 'RECORD LOCKED.' TO status-message
           when 52 move 'END-OF-PAGE.' TO status-message
           when 57 move 'I/O LINAGE.' TO status-message
           when 61 move 'FILE SHARING FAILURE.' TO status-message
           when 91 move 'FILE NOT AVAILABLE.' TO status-message
           end-evaluate
           string 'ERROR ' delimited by size
               file-name delimited by space
               space delimited by size
               status-message delimited by '.'
               into display-message
           display display-message
           stop run
           .
       end program checkfilestatus.
       end program template.

       end program cow.


原因は文字列分割にあった、UNSTRING使わず自前でやったら全ケース通った

原因は文字列分割にあった、UNSTRING使わず自前でやったら全ケース通った

       *>
       *> 結果 https://paiza.jp/poh/joshibato/kirishima/result/533911b5
       *>
       IDENTIFICATION DIVISION.
       PROGRAM-ID. Answer.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
              FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
              01 Answer-Values.
                     05 n      BINARY-CHAR UNSIGNED.  *> PIC 9(4) とかより便利そうなのあるじゃん
                     05 m      BINARY-CHAR UNSIGNED.
                     05 d      BINARY-SHORT.
                     05 x      BINARY-SHORT.
                     05 i      BINARY-SHORT UNSIGNED.
                     05 j      BINARY-SHORT UNSIGNED.
                     05 t_str  PIC X(1000).
                     05 t_cnt  BINARY-SHORT.
                     05 t_len  BINARY-SHORT.
                     05 t_c    PIC X.
                     05 tbl    OCCURS 100 TIMES.
                            10 t       BINARY-SHORT.
                            10 f       BINARY-CHAR UNSIGNED.
       PROCEDURE DIVISION.
       AnswerMain SECTION.
       000-Start.

              ACCEPT n.
              ACCEPT t_str.

              MOVE 1 TO t_cnt.
              MOVE 1 TO t_len.
              *> 文字列の分割でけた
              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = n
                     PERFORM WITH TEST AFTER VARYING j FROM t_cnt BY 1 UNTIL j = 1000
                            MOVE t_str(j:1) TO t_c
                            IF t_c = SPACE THEN
                                   EXIT PERFORM
                            END-IF
                     END-PERFORM
                     COMPUTE t_len = j - t_cnt
                     MOVE NUMVAL(t_str(t_cnt:t_len)) TO t(i)
                     COMPUTE t_cnt = j + 1
              END-PERFORM.

              ACCEPT m.

              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = m
                     ACCEPT d
                     PERFORM WITH TEST AFTER VARYING j FROM 1 BY 1 UNTIL j = n
                            MOVE 0 TO f(j)
                     END-PERFORM
                     PERFORM WITH TEST AFTER VARYING j FROM 1 BY 1 UNTIL j > n
                            IF d < 1 OR d >= n THEN
                                   DISPLAY "No"
                                   ExIT PERFORM
                            END-IF
                            IF d = n - 1 THEN
                                   DISPLAY "Yes"
                                   EXIT PERFORM
                            END-IF
                            COMPUTE x = d + 1
                            IF t(x) = 0 THEN
                                   DISPLAY "No"
                                   EXIT PERFORM
                            END-IF
                            IF f(x) = 1 THEN
                                   DISPLAY "No"
                                   EXIT PERFORM
                            END-IF
                            MOVE 1 TO f(x)
                            ADD t(x) TO d
                     END-PERFORM
              END-PERFORM.

       END PROGRAM Answer.

       *>
       *> 結果 https://paiza.jp/poh/joshibato/kirishima/result/818ce3e5
       *>
       IDENTIFICATION DIVISION.
       PROGRAM-ID. Answer.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
              FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
              01 Answer-Values.
                     05 n      BINARY-CHAR UNSIGNED.  *> PIC 9(4) とかより便利そうなのあるじゃん
                     05 m      BINARY-CHAR UNSIGNED.
                     05 d      BINARY-SHORT.
                     05 x      BINARY-SHORT.
                     05 i      BINARY-SHORT UNSIGNED.
                     05 j      BINARY-SHORT UNSIGNED.
                     05 t_str  PIC X(1000).
                     05 t_cnt  BINARY-SHORT.
                     05 t_len  BINARY-SHORT.
                     05 tbl    OCCURS 100 TIMES.
                            10 t       BINARY-SHORT.
                            10 f       BINARY-CHAR UNSIGNED.
       PROCEDURE DIVISION.
       AnswerMain SECTION.
       000-Start.

              ACCEPT n.
              ACCEPT t_str.

              *> 文字列の分割でけた
              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = n
                     UNSTRING t_str DELIMITED BY ALL SPACES INTO t(i) COUNT IN t_cnt
                     ADD 2 TO t_cnt
                     COMPUTE t_len = 1000 - t_cnt
                     MOVE t_str(t_cnt:t_len) TO t_str
              END-PERFORM.

              ACCEPT m.

              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = m
                     ACCEPT d
                     PERFORM WITH TEST AFTER VARYING j FROM 1 BY 1 UNTIL j = n
                            MOVE 0 TO f(j)
                     END-PERFORM
                     PERFORM WITH TEST AFTER VARYING j FROM 1 BY 1 UNTIL j > n
                            IF d < 1 OR d >= n THEN
                                   DISPLAY "No"
                                   ExIT PERFORM
                            END-IF
                            IF d = n - 1 THEN
                                   DISPLAY "Yes"
                                   EXIT PERFORM
                            END-IF
                            COMPUTE x = d + 1
                            IF t(x) = 0 THEN
                                   DISPLAY "No"
                                   EXIT PERFORM
                            END-IF
                            IF f(x) = 1 THEN
                                   DISPLAY "No"
                                   EXIT PERFORM
                            END-IF
                            MOVE 1 TO f(x)
                            ADD t(x) TO d
                     END-PERFORM
              END-PERFORM.

       END PROGRAM Answer.


気になった部分をちょこっと修正

気になった部分をちょこっと修正

       *>
       *> 結果 https://paiza.jp/poh/joshibato/rio/result/2506c7df
       *>
       IDENTIFICATION DIVISION.
       PROGRAM-ID. Answer.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
              FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
              01 Answer-Values.
                     05 n          PIC 9(2).  *> 05 である必要はなく 02 n PIC 9(2). でもよいらしい
                     05 i          PIC 9(2).
                     05 w          PIC 9(11)V9(24) VALUE 0.0. *> 9(11)V9(24)は計算用 9(11).9(24)だと文字出力用？
                     05 c          PIC 9(11)V9(24) VALUE 0.0. *> 最大36文字までらしい
                     05 wc         PIC 9(11)V9(24).
                     05 ans        PIC 9(11)V9(24).
                     05 dsp        PIC Z(10)9.        *> Zは表示用,9での上位桁の0をスペースに置き換える
                     05 tas.
                            10 t   PIC 9(2). *> tが1桁と分かっているので文字数決め打ち分割
                            10 s   PIC 9(3). *> sは3桁までなので
       PROCEDURE DIVISION.
       MainRoutine SECTION.
       000-Main.
              ACCEPT n.
              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = n
                     ACCEPT tas
                     IF NUMVAL(t) = 1 THEN
                            ADD NUMVAL(s) TO w
                     END-IF
                     IF NUMVAL(t) = 2 THEN *> 流石にELSEネストはキツイ
                            ADD NUMVAL(s) TO c
                     END-IF
                     IF NUMVAL(t) = 3 THEN
                            COMPUTE wc = w + c  *> 面倒なのでCOMPUTEで処理ｗ
                            COMPUTE w = (w * wc - NUMVAL(s) * w) / wc
                            COMPUTE c = (c * wc - NUMVAL(s) * c) / wc
                     END-IF
              END-PERFORM.
              COMPUTE wc = w + c.
              COMPUTE ans = 100 * c / wc.
              MOVE ans TO dsp.
              DISPLAY TRIM(dsp).
       END PROGRAM Answer.

       *>
       *> 結果 https://paiza.jp/poh/joshibato/rio/result/3fa70112
       *>
       IDENTIFICATION DIVISION.
       PROGRAM-ID. Answer.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
              FUNCTION ALL INTRINSIC.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
              01 Answer-Values.
                     05 n          PIC 9(2).  *> 05 である必要はなく 02 n PIC 9(2). でもよいらしい
                     05 i          PIC 9(2).
                     05 w          PIC 9(11)V9(24) VALUE 0.0. *> 9(4)V9(20)は計算用 9(4).9(20)だと文字出力用？
                     05 c          PIC 9(11)V9(24) VALUE 0.0. *> 最大36文字までらしい
                     05 wc         PIC 9(11)V9(24).
                     05 ans        PIC 9(11)V9(24).
                     05 dsp        PIC Z(10)9.        *> Zは表示用,9での上位桁の0をスペースに置き換える
                     05 tas.
                            10 T   PIC 9(2). *> tが1桁と分かっているので文字数決め打ち分割
                            10 S   PIC 9(3). *> sは3桁までなので
       PROCEDURE DIVISION.
       MainRoutine SECTION.
       000-Main.
              ACCEPT n.
              PERFORM WITH TEST AFTER VARYING i FROM 1 BY 1 UNTIL i = n
                     ACCEPT tas
                     IF NUMVAL(t) = 1 THEN
                            ADD NUMVAL(s) TO w
                     END-IF
                     IF NUMVAL(t) = 2 THEN *> 流石にELSEネストはキツイ
                            ADD NUMVAL(s) TO c
                     END-IF
                     IF NUMVAL(t) = 3 THEN
                            COMPUTE wc = w + c  *> 面倒なのでCOMPUTEで処理ｗ
                            COMPUTE w = (w * wc - NUMVAL(s) * w) / wc
                            COMPUTE c = (c * wc - NUMVAL(s) * c) / wc
                     END-IF
              END-PERFORM.
              COMPUTE wc = w + c.
              COMPUTE ans = 100 * c / wc.
              MOVE ans TO dsp.
              DISPLAY TRIM(dsp).
       END PROGRAM Answer.