Perlデーモンがループ全体を通過しない

Question

私はPerlで非常に単純なサーバのように動作するプログラムを作ろうとしています。

プログラム自体は、図書館のカタログとして機能し、タイトルや著者別に書籍を検索したり、書籍を借りたり返ったりするオプションをユーザに提供します。書籍のリストは別ファイルで提供されています。

基本的には、「リクエスト」フォルダからリクエスト（ファイル）を取り出して処理し、「アンサー」フォルダに回答（ファイル）を与えることになっています。プロセスが終了すると、古いリクエストが削除され、プロセスが繰り返されます（回答は受け入れられた後にクライアントによって削除されます）。

デーモンとして実行することを意図していますが、何らかの理由でリクエストファイルの削除を担当するループだけがバックグラウンドで動作します。リクエストは回答に処理されず、ただ削除されます。新しいリクエストが表示されるたびに、すぐに削除されます。

私はデーモンを使用することを学んでいて、this threadにあるものをエミュレートしようとしました。

#!/usr/bin/perl 
use warnings; 
use strict; 
use Proc::Daemon; 

#FUNCTIONS DEFINTIONS 
sub FindAuthor 
{ 
#try to find book by this author in the catalogue 
} 


sub FindTitle 
{ 
#try to find book with this title in the catalogue 
} 


sub CheckIfCanBeReturned 
{ 
#check if the book is borrowed and by whom 
} 

#attempt at daemonization 
Proc::Daemon::Init; 

my $continueWork = 1; 
$SIG{TERM} = sub { $continueWork = 0 }; 

while ($continueWork) 
{ 

    sleep(2); 
    my @RequestFilesArray = `ls /home/Ex5/Requests`; 

    #list all requests currently in the Request folder 
    for (my $b = 0; $b < @RequestFilesArray; $b++) 
    { 
     my $cut = `printf "$RequestFilesArray[$b]" | wc -m`; 
     $cut = $cut - 1; 
     $RequestFilesArray[$b] = substr $RequestFilesArray[$b], 0, $cut;  
    } 


    #the requests are formatted in such way, 
    #that the first 2 letters indicate what the client wants to be done 
    #and the rest is taken parameters used in the processing 

    for (my $i = 0; $i < @RequestFilesArray; $i++) 
    { 
     my $UserRequest = `tail -1 Requests/$RequestFilesArray[$i]`; 
      my $fix = `printf "$UserRequest" | wc -m`; 
      $fix = $fix - 1; 
      $UserRequest = substr $UserRequest, 0, $fix; 

     my $RequestType = substr $UserRequest, 0, 2; 
     my $RequestedValue = substr $UserRequest, 3; 

     my $RequestNumber = $i; 

     if ($RequestType eq "fa") 
     { 
      #FIND BY AUTHOR 
      my @results = FindAuthor ($RequestedValue); 

      my $filename = "/home/Ex5/Answers/" . $RequestFilesArray[$RequestNumber]; 

      open (my $answerFile, '>', $filename) or die "$!"; 

      for (my $a = 0; $a < @results; $a++) 
      { 
       print $answerFile $results[$a],"\n"; 
      } 
      close $answerFile; 

     } 
     elsif ($RequestType eq "ft") 
     { 
      #FIND BY TITLE 
      my @results = FindTitle ($RequestedValue); 

      my $filename = "/home/Ex5/Answers/" . $RequestFilesArray[$RequestNumber]; 

      open (my $answerFile, '>', $filename) or die "$!"; 

      for (my $a = 0; $a < @results; $a++) 
      { 
       print $answerFile $results[$a],"\n"; 
      } 
      close $answerFile; 

     } 
     elsif ($RequestType eq "br") 
     { 
      #BOOK RETURN 
      my $result = CheckIfCanBeReturned ($RequestedValue, $RequestFilesArray[$RequestNumber]); 

      my $filename = "/home/Ex5/Answers/" . $RequestFilesArray[$RequestNumber]; 

      open (my $answerFile, '>', $filename) or die "$!"; 
      print $answerFile $result; 
      close $answerFile; 
     } 
     elsif ($RequestType eq "bb") 
     { 
      #BOOK BORROW 
      my $result = CheckIfCanBeBorrowed ($RequestedValue, $RequestFilesArray[$RequestNumber]); 

      my $filename = "/home/Ex5/Answers/" . $RequestFilesArray[$RequestNumber]; 

      open (my $answerFile, '>', $filename) or die "$!"; 
      print $answerFile $result; 
      close $answerFile; 
     } 
     else 
     { 
      print "something went wrong with this request"; 
     } 
    } 

    #deleting processed requests 
    for (my $e = 0; $e < @RequestFilesArray; $e++) 
    { 
     my $removeReq = "/home/Ex5/Requests/" . $RequestFilesArray[$e]; 
     unlink $removeReq; 
    } 

#$continueWork =0; 
} 

Answer 1

あなたはそれをテストしようとする前あまりにも多くのコードを書かれています。 Perlで正しいことを達成する正しい方法を習得するのではなく、あらゆる機会にシェルプロセスを開始しました。

最初に間違ったのは、待っているジョブを見つけるためにlsです。 lsは行ごとに複数のファイルを印刷し、ファイル名として、各ラインの全体を扱う、奇妙なprintf "$RequestFilesArray[$b]" | wc -m代わりのlength $RequestFilesArray[$b]

物事が唯一の悪化使用して、その

後、私は次のよう

を提案します

• 最初からやり直してください

• プログラムをPerlで記述してください。 Perlはあなたのコードがコンパイルされ、それがすべての3つのまたは4つのラインになっているものをしていることを確認して、非常に小さい増分で

• アドバンスシェル言語ではありません。ランダムな文字の魔法のシ​​ーケンスを作成するのではなく、作業コードを向上させていることを自信を持って知りたいのです。

• デバッグ方法を学びます。あなたは、なぜ始まらないのかを知りたいと思って、車のエンジンを見つめている人の気持ちを喚起するために、あなたのコードを見つめているようです。

• リクエストの処理の一部としてリクエストファイルを削除し、要求が処理され、応答ファイルが正常に書き込まれた後でなければなりません。それはあなたが提供するものを取ると別のループに

Answer 2

を行うべきではありません、ここで私はあなたにややテンプレートの使用することができ、あなたのために考案されてきたいくつかの擬似コードです。これは網羅的ではありません。ボロディンの助言は健全で慎重であると私は思う。

これはすべてテストされておらず、新しいものの多くは擬似コードです。しかし、うまくいけば、そこから学ぶべきブレッドクラムがある。また、上記のとおり、Proc::Daemon::Initの使用は疑わしいです。少なくとも、それはエラーが発生していても何も起こっていないので、スクリプトの何が間違っているか分かりません。

#!/usr/bin/perl -wl 

use strict; 
use File::Basename; 
use File::Spec; 
use Proc::Daemon; 
use Data::Dumper; 

# turn off buffering 
$|++; 

#FUNCTIONS DEFINTIONS 
sub FindAuthor 
{ 
#try to find book by this author in the catalogue 
} 


sub FindTitle 
{ 
#try to find book with this title in the catalogue 
} 


sub CheckIfCanBeReturned 
{ 
#check if the book is borrowed and by whom 
} 

sub tail 
{ 
    my $file = shift; 

# do work 
} 

sub find_by 
{ 
    my $file = shift; 
    my $val = shift; 
    my $by = shift; 
    my @results; 
    my $xt = 0; 

# sanity check args 
# do work 

    if ($by eq 'author') 
    { 
    my @results = FindByAuthor(blah); 
    } 
    elsif ($by eq 'blah') 
    { 
    @results = blah(); 
    } 
    #...etc 

    # really should use File::Spec IE 
    my $filename = File::Spec->catfile('home', 'Ex5', 'Answers', $file); 

    # might be a good idea to either append or validate you're not clobbering 
    # an existent file here because this is currently clobbering. 
    open (my $answerFile, '>', $filename) or die "$!"; 

    for (@results) 
    { 
    print $answerFile $_,"\n"; 
    } 
    close $answerFile; 

    # have some error checking in place and set $xt to 1 if an error occurs 
    return $xt; 
} 

#attempt at daemonization 
# whatever this is is completely broken methinks. 
#Proc::Daemon::Init; 

my $continueWork++; 
my $r_dir = '/home/user/Requests'; 

$SIG{TERM} = sub { $continueWork = 0 }; 

# going with pseudocode 
while ($continueWork) 
{ 
    #list all requests currently in the Request folder 
    my @RequestFilesArray = grep(/[^\.]/, <$r_dir/*>); 

    #the requests are formatted in such way, 
    #that the first 2 letters indicate what the client wants to be done 
    #and the rest is taken parameters used in the processing 

    for my $request_file (@RequestFilesArray) 
    { 
    my $result = 0; 

    $request_file = basename($request_file); 
    my $cut  = length($request_file) - 1; 
    my $work_on = substr $request_file, 0, $cut; 

    my $UserRequest = tail($request_file); 
    my $fix  = length($UserRequest) - 1; 
    $UserRequest = substr $UserRequest, 0, $fix; 

    my $RequestType = substr $UserRequest, 0, 2; 
    my $RequestedValue = substr $UserRequest, 3; 

    if ($RequestType eq "fa") 
    { 
     #FIND BY AUTHOR 
     $result = find_by($request_file, $RequestedValue, 'author'); 
    } 
    elsif ($RequestType eq "ft") 
    { 
     #FIND BY TITLE 
     $result = find_by($request_file, $RequestedValue, 'title'); 
    } 
    elsif ($RequestType eq "br") 
    { 
     #BOOK RETURN 
     $result = CheckIfCanBeReturned ($RequestedValue, $request_file) or handle(); 
    } 
    elsif ($RequestType eq "bb") 
    { 
     #BOOK BORROW 
     $result = CheckIfCanBeBorrowed ($RequestedValue, $request_file) or handle(); 
    } 
    else 
    { 
     print STDERR "something went wrong with this request"; 
    } 
    } 

    #deleting processed requests 
    if ($result == 1) 
    { 
     unlink $work_on; 
    } 

    sleep(2); 
} 

は私の「マイルド」の試みとfind_byサブルーチンを使用して、コードを乾燥に特別な注意してください。元のスクリプトにはたくさんの重複したコードがありました。私は1つのサブルーチンに移行しました。 DRY eq 'あなた自身を繰り返さない'。