LinuxSir.cn,穿越时空的Linuxsir!

 找回密码
 注册
搜索
热搜: shell linux mysql
查看: 1144|回复: 3

向版主求助! PerlSvc包使用问题!

[复制链接]
发表于 2005-10-15 12:34:00 | 显示全部楼层 |阅读模式
我写了一段代码,使用perlsvc编译后,运行时服务可以正常注册、卸载,但不能“启动”。启动时报错“xxxxxx fail to start” ,我使用 --debug 跟踪调试 ,未发现错误。

代码主要内容如下: 请指教!!(刚才忘了说明 需要在.exe 的同级目录下放一个urllist.txt文件,该文件一行为一个词)

package PerlSvc;
use strict;
use warnings;
use FileHandle;

$" = "-";
$|=1;
my $strFilename = "UrlList.txt";
my $splicetime = 60 * 15;
my $service = "TrackSvc";
my @options = ('fileName' => \$strFilename,
        'Time' => \$splicetime);

(my $progname = $0) =~ s/.*?([^\\]+?)(\.\w+)$/$1/;
our(%Config,$Verbose);

unless (defined &ContinueRun) {
  # Don't delay the very first time ContinueRun() is called
  my $sleep;
  *ContinueRun = sub {
     Win32::Sleep(1000*shift) if $sleep && @_;
     $sleep = 1;
     return 1
  };
  *RunningAsService = sub {return 0};
  # Interactive() would be called automatically if we were running
  # the compiled PingSvc.exe
  Interactive();
}
sub unsupported {
  my $option = shift;
  die "The '--$option' option is only supported in the compiled script.\n";
}
sub get_options {
  require Getopt:ong;
  my @options = @_;
  my $usage = pop @options;
  $SIG{__WARN__} = sub { print "$usage\n$_[0]"; exit 1 };
  Getopt:ong::GetOptions(@options);
  $SIG{__WARN__} = 'DEFAULT';
}

sub configure {
  %Config = (ServiceName => $service,
         DisplayName => "GetHtml $service",
         Parameters => "--fileName $strFilename --Time $splicetime",
         Description => "Get Html"
                );

}

sub Interactive {
  # These entries are only used when the program is run with
  # `perl PingSvc.pl` and is not compiled into a service yet.
  push(@options,
      'help'  => \&Help,
      'install' => \&unsupported,
      'remove' => \&unsupported);

  # Setup the %Config hash based on our configuration parameter
  configure();
  Startup();
}
sub GetContents
{  
    my $contents = shift;
    mkdir("data");
    my $fw = new FileHandle(">> data/log.txt");
    print $fw $contents;
    $fw->close;
  
}
sub Startup
{
  get_options(@options, <<__USAGE__);
Try `$progname --help` to get a list of valid options.
__USAGE__


  if(!(-f $strFilename))
  {
    exit 1;
  }
  while(1)
  {
    my $fr = new FileHandle($strFilename);
    while(<$fr>)
    {
      chomp($_);
      GetContents($_);  
    }
    $fr->close;
    Win32::Sleep($splicetime * 1000);
  }
  
}

sub Install
{
  get_options('name=s' => \$service, @options, <<__USAGE__);
Valid --install suboptions are:

auto    automatically start service
--name   service name           [$service]
--fileName   file name            [$strFilename]
--Time   time          [$splicetime]

For example:

$progname --install auto --name TrackSvc --UrlList.txt --Time 120

__USAGE__
  configure();

}

sub Remove {
  get_options('name=s' => \$service, <<__USAGE__);
Valid --remove suboptions are:

--name   service name           [$service]

For example:

$progname --remove --name PingFoo
__USAGE__

  # Let's be generous and support `PingSvc --remove PingFoo` too:
  $service = shift @ARGV if @ARGV;

  $Config{ServiceName} = $service;
}

sub Help
{
  print <<__HELP__;
TrackSvc -- get html every $splicetime seconds and writedowntime in data

Run it interactivly with configurable FILENAME, LOGFILE and DELAY:

  $progname --fileName FILENAME --Time SECONDS

or install it as a service:

  $progname --install auto
  net start $service

You can pause and resume the service with:

  net pause $service
  net continue $service

To remove the service from your system, stop und uninstall it:

  net stop $service
  $progname --remove
__HELP__

  # Don't display standard PerlSvc help text
  $Verbose = 0;
}

sub Pause {
  
}

sub Continue {
  
}
发表于 2005-10-18 16:39:21 | 显示全部楼层
只有斑竹可以回答吗?我闪了...
回复 支持 反对

使用道具 举报

发表于 2005-11-2 16:16:38 | 显示全部楼层
既然Startup 有問題就應該?膕ub Startup開始找, 這個sub 很短就算加幾行print xxx ?韉ebug 也很容易的, 兄弟可以在這三行前加上 print 什麼的?砜纯磁艿侥茄e不行
exit 1;
my $fr = new FileHandle($strFilename);
Win32::Sleep($splicetime * 1000);
回复 支持 反对

使用道具 举报

发表于 2005-11-2 16:38:20 | 显示全部楼层
填空题,改一下就可以了
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

快速回复 返回顶部 返回列表