Perl 守护进程不会遍历整个循环

Question

我正在尝试制作一个像 Perl 中非常简单的服务器一样工作的程序。

该程序本身旨在用作图书馆目录，为用户提供按书名或作者搜索书籍以及借阅或归还书籍的选项。图书列表在单独的文件中提供。

基本上，它应该从“Requests”文件夹中获取请求（文件），处理它们，然后在“Answers”文件夹中给出答案（也是文件）。该过程结束后，它会删除旧的请求并重复该过程（答案被客户端接受后将被删除）。

它本来是作为守护进程运行的，但由于某种原因，只有负责删除请求文件的循环在后台工作——请求不会被处理成答案，而只是被删除。每当出现新请求时，它几乎会立即被删除。

我正在学习使用守护进程并尝试模拟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

在尝试测试之前，您已经编写了太多代码。您还一有机会就启动了 shell 进程，而不是学习在 Perl 中实现目标的正确方法

第一个错误是使用ls 来发现正在等待的作业。 ls 每行打印多个文件，并且您将每一行的整个视为文件名，使用奇怪的 printf "$RequestFilesArray[$b]" | wc -m 而不是 length $RequestFilesArray[$b]

在那之后事情只会变得更糟

我建议如下

• 从头开始

• 用 Perl 编写程序。 Perl 不是 shell 语言

• 以非常小的增量前进，确保您的代码每三到四行编译一次并执行应有的操作。知道您是在增强工作代码而不是创建一个神奇的随机字符序列，这确实让您有信心感到惊奇

• 了解如何调试。你似乎在盯着你的代码，希望得到灵感，就像某人盯着他们的汽车引擎希望看到它为什么无法启动一样

• 在处理请求的过程中删除请求文件，并且仅在处理请求并且成功写入应答文件后才删除。它不应该在单独的循环中完成

Answer 2

根据您提供的内容，这是我为您设计的一些伪代码，您可以将其用作某种模板。这绝不是详尽无遗的。我认为@Borodin 给出的建议是合理而谨慎的。

这一切都未经测试，而且大部分新内容都是伪代码。但是，希望有一些面包屑可供学习。另外，如上所述，您对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 子例程干燥您的代码。您的原始脚本中有很多重复的代码，我将它们移到了一个子例程中。 DRY eq '不要重复自己'。