makettf/checkdata.cgi

   1 #!/usr/bin/perl
   2
   3 $ERROR_SYNTAX = 1;
   4 $ERROR_NOPARTS = 2;
   5
   6 use utf8;
   7 binmode STDOUT, ":utf8";
   8 use CGI;
   9 $form = new CGI;
  10 $| = 1;
  11
  12 my $data = $form->param('partsdata');
  13 utf8::decode($data);
  14 @buffer = split(/\r\n|\r|\n/, $data);
  15
  16 $result = "";
  17
  18 $pre1 = "";
  19 $pre2 = "";
  20
  21 %parts = ();
  22 foreach $temp (@buffer){
  23   if($temp =~ m/:/ && $temp =~ m/[0-9]/){
  24     @temp = split(/ |\t|\r\n|\r|\n/, $temp);
  25     $parts{$temp[0]} = 1;
  26   }
  27 }
  28
  29 foreach $temp (@buffer){
  30   if($temp =~ m/:/ && $temp =~ m/[0-9]/){
  31     $error = 0;
  32     $check = 0;
  33     @temp = split(/ |\t|\r\n|\r|\n/, $temp);
  34     @temp2 = split(/\$/, $temp[1]);
  35     foreach $temp2 (@temp2){
  36       if($temp2 =~ m/^1:(0|2):(0|2):/){ $check++; }
  37       if($temp2 =~ m/^1:(0|12|22|32):(0|13|23|32|4):/){ $check++; }
  38       if($temp2 =~ m/^2:(0|12|22|32):(4|5|7):/){ $check++; }
  39       if($temp2 =~ m/^2:7:(0|4|8):/){ $check++; }
  40       if($temp2 =~ m/^2:2:7:/){ $check++; }
  41       if($temp2 =~ m/^3:(0|12|22|32):(0|5):/){ $check++; }
  42       if($temp2 =~ m/^6:22:5:/){ $check++; }
  43       if($temp2 =~ m/^7:(0|12|22|32):7:/){ $check++; }
  44       if($temp2 =~ m/^99:[^:]+:[^:]+:[^:]+:[^:]+:[^:]+:[^:]+:([^:]+)/){
  45         $check++;
  46         if(!exists($parts{$1})){
  47           $error = $error | $ERROR_NOPARTS;
  48         }
  49       }
  50       if($temp2 =~ m/^0:/){ $check++; }
  51     }
  52     if($check == 0){
  53       $error = $error | $ERROR_SYNTAX;
  54     }
  55     if($error != 0){
  56       if($error & $ERROR_SYNTAX){
  57         $result .= "** 文法エラー・処理できない筆画があります **\n";
  58       }
  59       if($error & $ERROR_NOPARTS){
  60         $result .= "** 99番で使用されている部品が存在しません **\n";
  61       }
  62       $result .= "$pre2\n$pre1\n==> $temp\n"."-" x 70 . "\n";
  63     }
  64   }
  65   $pre2 = $pre1;
  66   $pre1 = $temp;
  67 }
  68
  69 if($result eq ""){
  70   $result = "エラーはありませんでした\n";
  71 }
  72
  73 print <<"EOT";
  74 Content-type: text/html;
  75
  76 <!DOCTYPE html
  77     PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
  78     "http://www.w3.org/TR/html4/loose.dtd">
  79 <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  80 <link rel="stylesheet" type="text/css" href="http://fonts.jp/green.css">
  81 <html>
  82 <head>
  83 <title>チェック結果</title>
  84 </head>
  85 <body>
  86 <div class="main">
  87 <h1>チェック結果</h1>
  88 <p>チェック結果は以下の通りです。</p>
  89 <pre>
  90 $result
  91 </pre>
  92 <p><a href="checkdata.html">戻る</a></p>
  93 <hr class="footer">
  94 fonts.jp
  95 </div>
  96 </body>
  97 </html>
  98 EOT