makettf/checkdata.cgi

   1 #!/usr/bin/perl
   2
   3 $ERROR_LINE_SYNTAX = 1;
   4 $ERROR_STROKE_SYNTAX = 2;
   5 $ERROR_NOPARTS = 4;
   6
   7 use utf8;
   8 binmode STDOUT, ":utf8";
   9 use CGI;
  10 $form = new CGI;
  11 $| = 1;
  12
  13 my $data = $form->param('partsdata');
  14 utf8::decode($data);
  15 $data =~ s/\&/\&amp\;/g;
  16 $data =~ s/</\&lt\;/g;
  17 $data =~ s/>/\&gt\;/g;
  18 $data =~ s/\"/\&quot\;/g;
  19 @buffer = split(/\r\n|\r|\n/, $data);
  20
  21 $result = "";
  22
  23 $pre1 = "";
  24 $pre2 = "";
  25
  26 %parts = ();
  27 foreach $temp (@buffer){
  28   if($temp =~ m/:/ && $temp =~ m/[0-9]/){
  29     @temp = split(/ |\t|\r\n|\r|\n/, $temp);
  30     $parts{$temp[0]} = 1;
  31   }
  32 }
  33
  34 foreach $temp (@buffer){
  35   if($temp =~ m/:/ && $temp =~ m/[0-9]/){
  36     $error = 0;
  37     $error_data = "";
  38     @temp = split(/ +|\t|\r\n|\r|\n/, $temp);
  39     if(scalar(@temp) != 2){
  40       $error = $error | $ERROR_LINE_SYNTAX;
  41     }
  42     @temp2 = split(/\$/, $temp[1]);
  43     foreach $temp2 (@temp2){
  44       $check = 0;
  45       $error_data = $temp2;
  46       if($temp2 =~ m/^1:(0|2):(0|2):/){ $check++; }
  47       if($temp2 =~ m/^1:(0|12|22|32):(0|13|23|32|4):/){ $check++; }
  48       if($temp2 =~ m/^2:(0|12|22|32):(4|5|7):/){ $check++; }
  49       if($temp2 =~ m/^2:7:(0|4|8):/){ $check++; }
  50       if($temp2 =~ m/^2:2:7:/){ $check++; }
  51       if($temp2 =~ m/^3:(0|12|22|32):(0|5):/){ $check++; }
  52       if($temp2 =~ m/^6:22:5:/){ $check++; }
  53       if($temp2 =~ m/^7:(0|12|22|32):7:/){ $check++; }
  54       if($temp2 =~ m/^99:[^:]+:[^:]+:[^:]+:[^:]+:[^:]+:[^:]+:([^:]+)/){
  55         $check++;
  56         if(!exists($parts{$1})){
  57           $error = $error | $ERROR_NOPARTS;
  58         }
  59       }
  60       if($temp2 =~ m/^0:/){ $check++; }
  61       if($check == 0){
  62         $error = $error | $ERROR_STROKE_SYNTAX;
  63         last;
  64       }
  65     }
  66     if($error != 0){
  67       if($error & $ERROR_LINE_SYNTAX){
  68         $result .= "** 行の構造が変です。またはコメント行が紛らわしいための誤検出の可能性があります。 **\n";
  69       }
  70       if($error & $ERROR_STROKE_SYNTAX){
  71         $result .= "** 処理できない筆画があります **\n";
  72         $temp =~ s/$error_data/<span style="color: red;">$error_data<\/span>/;
  73       }
  74       if($error & $ERROR_NOPARTS){
  75         $result .= "** 99番で使用されている部品が存在しません **\n";
  76       }
  77       $result .= "$pre2\n$pre1\n==> $temp\n"."-" x 70 . "\n";
  78     }
  79   }
  80   $pre2 = $pre1;
  81   $pre1 = $temp;
  82 }
  83
  84 if($result eq ""){
  85   $result = "エラーはありませんでした\n";
  86 }
  87
  88 print <<"EOT";
  89 Content-type: text/html;
  90
  91 <!DOCTYPE html
  92     PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
  93     "http://www.w3.org/TR/html4/loose.dtd">
  94 <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  95 <link rel="stylesheet" type="text/css" href="http://fonts.jp/green.css">
  96 <html>
  97 <head>
  98 <title>チェック結果</title>
  99 </head>
 100 <body>
 101 <div class="main">
 102 <h1>チェック結果</h1>
 103 <p>チェック結果は以下の通りです。なお、エラーがある場合、ここれで表示される以外にもエラーがある可能性がありますので、エラー修正後、再度チェックを行ってください。</p>
 104 <pre>
 105 $result
 106 </pre>
 107 <p><a href="checkdata.html">戻る</a></p>
 108 <hr class="footer">
 109 fonts.jp
 110 </div>
 111 </body>
 112 </html>
 113 EOT