又一个Perl的程序（原创）

最新推荐文章于 2025-12-16 10:39:54 发布

原创最新推荐文章于 2025-12-16 10:39:54 发布 · 921 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#perl #path #dst #insert #file #command

Perl 专栏收录该内容

1 篇文章

订阅专栏

该博客展示了一段Perl代码，用于创建一个图形界面，让用户输入源文件路径和目标文件路径。代码会检查路径有效性，获取源文件夹中的JPG文件，并执行特定命令处理这些文件，同时将处理信息输出到界面文本框中。

#!/usr/bin/perl -W

use Tk;
use Tk::PathEntry;
use Tk::message;
use DirHandle;
use Cwd;

my $srcPath = cwd();
my $dstPath = cwd();

$mw = MainWindow -> new(-title => "Auto Red Eye Removal");

$srcFrame = $mw -> Frame(-width => 600, -height => 10);
$srcFrame -> Label(-width => 10) -> pack(-side => 'left');
$srcFrame -> Label(-text => "源文件路径:") -> pack(-side => 'left');
$srcEntry = $srcFrame -> PathEntry(-textvariable => /$srcPath, -width => 70);
$srcFrame -> Label(-width => 10) -> pack(-side => 'right');
$srcEntry -> pack(-side => 'right');

$dstFrame = $mw -> Frame(-width => 600, -height => 10);
$dstFrame -> Label(-width => 10) -> pack(-side => 'left');
$dstFrame -> Label(-text => "目标文件路径:") -> pack(-side => 'left');
$dstEntry = $dstFrame -> PathEntry(-textvariable => /$dstPath, , -width => 70);
$dstFrame -> Label(-width => 10) -> pack(-side => 'right');
$dstEntry -> pack(-side => 'right');

$cmdFrame = $mw -> Frame(-width => 600, -height => 35);
$cmdFrame -> Label(-width => 25) -> pack(-fill => 'x', -side => 'left');
$cmdFrame -> Label(-width => 25) -> pack(-fill => 'x', -side => 'right');
$runButton = $cmdFrame -> Button(-text => "Run", -height => 1, -width => 8,
-command => /&Run);
$exitButton = $cmdFrame -> Button(-text => "Exit", -height => 1, -width => 8,
-command => sub{ exit }, -default => 'active');
$runButton -> pack(-side => 'left');
$exitButton -> pack(-side => 'right');

$outputFrame = $mw -> Frame(-width => 600, -height => 400);
$outputText = $outputFrame -> Text(-width => 80, -height => 25, -wrap => 'word',
-background => 'gray', -font => 'normal');
$outputText -> pack(-side => 'left', -fill => 'y');

$scrollBar = $outputFrame -> Scrollbar(-command => ['yview' => $outputText]);
$outputText -> configure(-yscrollcommand => ['set' => $scrollBar]);
$scrollBar -> pack(-side => 'right', -fill => 'y');

$srcFrame -> pack(-side => 'top', -fill => 'both');
$dstFrame -> pack(-side => 'top', -fill => 'both');
$cmdFrame -> pack(-side => 'top', -fill => 'both');
$outputFrame -> pack(-side => 'top');
$mw -> resizable(0, 0);

MainLoop;

sub Run() {
my $src_path = $srcPath."/";
my $dst_path = $dstPath."/";

if($src_path eq '' || $dst_path eq '') {
    $mw -> messageBox(-type => 'OK', -title => "Error",
       -message => "请输入目标文件路径或源文件路径!!");
    die;
}
elsif ($src_path eq ' ' || $dst_path eq ' ') {
    $mw -> messageBox(-type => 'OK', -title => "Error",
       -message => "请输入目标文件路径或源文件路径!!");
    die;
}

$src_path = &Trim($src_path);
$dst_path = &Trim($dst_path);

my @arrayFiles;
if(&isFolder($src_path)) {
@arrayFiles = &getJPGFiles($src_path);
}
else {
  $mw -> messageBox(-type => 'OK', -title => "Error",
     -message => "源文件夹路径不存在，请输入正确的文件夹路径！");
  die;
}

if(&isFolder($dst_path)) {

}
else {
$mw -> messageBox(-type => 'OK', -title => "Error",
     -message => "目标文件夹路径不存在，请输入正确的文件夹路径！");
  die;
}

foreach my $file (@arrayFiles) {
$outputText -> insert('end', "Source file is: ".$src_path.$file."/n".
             "Dest file is: ".$dst_path.$file."/n");
  $outputText -> insert('end', "Current redeye is detected: ");

$command = "demo $src_path"."$file "."$dst_path"."$file 1 1 0";
eval {
  open(FD, "$command 2>&1 |");
  while($line = <FD>) {
   $outputText -> insert('end', $line);
  }
  $outputText -> insert('end', "/n");
}
}

close(FD);
die;
}

sub Trim() {
$tmp = $_[0];

for($tmp) {
s/^/s+//;
s//s+$//;
}
return $tmp;
}

sub getJPGFiles() {
my $tmppath = $_[0];

$tmppath = $tmppath."/";
my $dh = new DirHandle("$tmppath");

@files = DirHandle::read($dh);
undef $dh;

@files = sort(@files);
shift(@files);
shift(@files);

if(@files == 0) {
  $mw -> messageBox(-type => 'OK', -title => "Error",
     -message => "当前文件夹为空，请检查！");
  die;
}

my @tempfiles;

foreach my $f (@files) {
  if($f =~ /(.jpg)$/ || $f =~ /(.JPG)$/) {
   push @tempfiles, $f;
  }
}

if(@tempfiles == 0) {
  $mw -> messageBox(-type => 'OK', -title => "Error",
     -message => "当前文件夹中不存在jpg文件!");
  die;
}

@files = @tempfiles;
return @files;
}

sub isFolder() {
$tmp = $_[0];

my $dh = new DirHandle("$tmp");

if(!(defined $dh)) {
return 0;
}

undef $dh;
return 1;
}