小编Mik*_*ke 的帖子

如何编写Perl脚本来过滤掉已经过修改的数字图片?

昨天晚上睡觉之前,我再次浏览了Learning Perl的Scalar Data部分并看到了以下句子:

能够在字符串中包含任何字符意味着您可以创建,扫描和操作原始二进制数据作为字符串.

一个想法立即打击我,我实际上可以让Perl扫描我存储在硬盘上的图片,以检查它们是否包含Adobe字符串.通过这样做,我可以分辨出哪些已被拍照.所以我尝试实现这个想法并提出以下代码:

#!perl
use autodie;
use strict;
use warnings;

{
    local $/="\n\n";
    my $dir = 'f:/TestPix/';
    my @pix = glob "$dir/*";

    foreach my $file (@pix) {
        open  my $pic,'<',  "$file";

        while(<$pic>) {
            if (/Adobe/) {
                print "$file\n";
            }
        }
    }
}
Run Code Online (Sandbox Code Playgroud)

令人兴奋的是,代码似乎真的很有效,它可以过滤出已经过photoshopped的图片.但问题是许多图片是由其他公用事业编辑的.我想我有点卡在那里.我们是否有一些简单但通用的方法来判断数字图片是否已被编辑,例如

if (!= /the origianl format/) {...}
Run Code Online (Sandbox Code Playgroud)

或者我们只需添加更多条件?喜欢

if (/Adobe/|/ACDSee/|/some other picture editors/)
Run Code Online (Sandbox Code Playgroud)

有什么想法吗?或者由于我的编程知识极其有限,我还是过于简单化了?

一如既往地感谢任何指导.

regex photoshop perl

4
推荐指数
1
解决办法
550
查看次数

如何从Perl中彻底更改Win32标题栏的外观?

我正在学习使用Win32 :: GUI将GUI添加到我的Perl程序中.现在,我可以使用以下内容更改Win32标题栏的图标:

$myicon = new Win32::GUI::Icon('myicon.ico');
$myclass=new Win32::GUI::Class(
-name=>'myclass',                     
-icon=>$myicon,  
    );  
$mydialogbox = new Win32::GUI::DialogBox(
  -name         => 'mydialogbox',
  -class        => $myclass,
  );
Run Code Online (Sandbox Code Playgroud)

但是,其他的东西,比如背景颜色,最小化按钮的外观和感觉呢?

我搜索了这个主题并找到了几篇可能相关的文章.他们谈论非客户区域等等的东西,但代码片段似乎都是用C语言编写的,我对此并不熟悉.

我想知道是否有人在这里可以分享一些用Perl编写的代码片段来处理类似的情况?或者,希望是否有可以促进任务的Perl模块?

谢谢你的任何指导:)

********UPDATE1

我可以先使标题栏消失,然后在原始标题栏中添加标签,然后添加一些其他按钮以最小化和关闭对象吗?

现在的问题是:当我的鼠标在标签上时,如何移动Window对象?

********UPDATE2

我发现了一些VB代码片段应该完成我想要在Perl中完成的工作.有人可以帮我在Win32 :: GUI中重写它们吗?以下VB代码是在这里:

    Option Explicit

' API functions
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function …
Run Code Online (Sandbox Code Playgroud)

perl titlebar win32gui

4
推荐指数
1
解决办法
1522
查看次数

如何在Perl中垂直对齐文本行?

假设除了标点符号之外,两行文本逐字逐句对应.如何对它们进行垂直对齐?

例如:

$line1 = "I am English in fact";
$line2 = "Je suis anglais , en fait";

我希望输出如下:

I   am     English       in   fact
Je  suis   anglais   ,   en   fait  .

我根据我在SO上发布的先前问题的答案以及Learning Perl的"使用printf格式化输出"部分所学到的内容,提出了以下代码.

use strict;
use warnings;

my $line1 = "I am English in fact";
my $line2 = "Je suis anglais , en fait.";

my @array1 = split " ", $line1;
my @array2= split " ", $line2;

printf "%-9s" x @array1, @array1;
print "\n";
printf "%-9s" x @array2, @array2;
print "\n"; …
Run Code Online (Sandbox Code Playgroud)

perl text-alignment

3
推荐指数
1
解决办法
1553
查看次数

为什么我不能使用map函数从Perl中的简单数据文件创建一个好的哈希?

帖子已更新.如果您已阅读已发布的问题,请转到解决方案部分.谢谢!

这是展示我的问题的最小化代码:

用于测试的输入数据文件已由Window的内置记事本保存为UTF-8编码.它有以下三行:

abacus  æb?k?s
abalone æb?l?uni
abandon ?bænd?n

Perl脚本文件也被Window的内置记事本保存为UTF-8编码.它包含以下代码:

#!perl -w

use Data::Dumper;
use strict;
use autodie;
open my $in,'<',"./hash_test.txt";
open my $out,'>',"./hash_result.txt";

my %hash = map {split/\t/,$_,2} <$in>;
print $out Dumper(\%hash),"\n";
print $out "$hash{abacus}";
print $out "$hash{abalone}";
print $out "$hash{abandon}";
Run Code Online (Sandbox Code Playgroud)

在输出中,哈希表似乎没问题:

$VAR1 = {
          'abalone' => 'æb?l?uni
',
          'abandon' => '?bænd?n',
          '?abacus' => 'æb?k?s
'
        };

但实际上并非如此,因为我只获得两个值而不是三个:

æb?l?uni
?bænd?n

Perl给出以下警告消息:

Use of uninitialized value $hash{"abacus"} in string at C:\test2.pl line 11, <$i n> line 3.

哪里有问题?有人可以解释一下吗?谢谢.

解决方案

数百万的感谢你们所有人:)现在终于找到了罪魁祸首,问题变得可以解决了:)正如@Sinan深刻地指出的那样,我现在100%确定导致上述问题的罪魁祸首是两个BOM的字节,当记事本保存为UTF-8时,记事本添加到我的数据文件中,并且Perl不知道如何正确处理.虽然很多人建议我应该使用"<:utf8"和">:utf8"来读写文件,但事情是这些utf-8配置并没有解决问题.相反,它们可能会导致其他一些问题 …

perl hash byte-order-mark

3
推荐指数
1
解决办法
402
查看次数

我可以使用y运算符在Perl中进行非一对一的音译吗?

Perl中的y运算符执行逐个字符的音译.例如,如果我们对字符串"foobar"执行y/abc/dfg,则会得到"foofdr".但是,如果我想将"ā"音译为"ei",将"ä"音译为"a:",将"ō"音译为"әu",将"o"音译为"ɒ".

我尝试了以下代码行,但没有运气:(

y/?ä?o/(ei)(a:)(?u)?/
Run Code Online (Sandbox Code Playgroud)

我们希望有解决这个问题的方法吗?或者我是否必须重复使用s运算符并进行大量繁琐的替换?

在此先感谢任何指导:)

perl transliteration

3
推荐指数
1
解决办法
266
查看次数

如何使用PerlMagick替换任何非特定颜色的颜色?

在经历了许多令人沮丧的挫折之后,我终于得到了一个版本的PerlMagick模块与我的ActivePerl 5.10.0 build 1005一起工作.现在我正在玩它来做一些非常基本的颜色替换.

我已经可以使用以下代码替换一种颜色,比如黑色,另一种颜色,比如说蓝色.

#!perl
 use strict;
 use warnings;
 use Image::Magick;

  my $image = Image::Magick->new;
  $image->Read('color-test.bmp');
  $image->Opaque(fill => 'blue', color => 'black');
  $image->Write('result.bmp');
Run Code Online (Sandbox Code Playgroud)

但我想知道我是否可以用蓝色替换任何不是黑色的颜色.我希望并且认为有一些惯用的语法来实现这一点,所以我要求快速帮助:)任何想法?

总是感谢任何指导/建议/意见:)

UPDATE

@rjh,谢谢你的代码和信息:)我尝试了所有的一点点的吸引力,他们都像魅力一样工作!

旧版本无法运行.我的PerlMagick是6.5.4,但有一点适应性,它也是这样的:

  use strict;
  use warnings;
  use Image::Magick;

  my $image = Image::Magick->new;
  $image->Read('color-test.bmp');
     $image->Transparent(color=>'black');
     $image->Colorize(fill=>'blue');
     $image->Composite(image=>$image);
     $image->Write('result.bmp');
Run Code Online (Sandbox Code Playgroud)

好吧,当然我喜欢你的第二个版本.这是超级的.这是我期待的语法,呵呵:)

第一个命令行版本也运行良好,虽然我没想到这个版本.

再次,谢谢!

perl imagemagick

3
推荐指数
1
解决办法
1418
查看次数

在这个Perl脚本中,"无效使用void上下文中的变量"是什么意思?

下面的脚本给了我我想要的东西,但Perl也向我发出警告说"在void上下文中无用的使用变量".这是什么意思?

use strict;
use warnings;

my $example = 'http\u003a//main\u002egslb\u002eku6\u002ecom/c0/q7LmJPfV4DfXeTYf/1260269522170/93456c39545857a15244971e35fba83a/1279582254980/v632/6/28/a14UAJ0CeSyi3UTEvBUyMuBxg\u002ef4v\u002chttp\u003a//main\u002egslb\u002eku6\u002ecom/c1/q7LmJPfV4DfXeTYf/1260269522170/3cb143612a0050335c0d44077a869fc0/1279582254980/v642/10/20/7xo2MJ4tTtiiTOUjEpCJaByg\u002ef4v\u002chttp\u003a//main\u002egslb\u002eku6\u002ecom/c2/q7LmJPfV4DfXeTYf/1260269522170/799955b45c8c32c955564ff9bc3259ea/1279582254980/v652/32/4/6pzkCf4iqTSUVElUA5A3PpMAoA\u002ef4v\u002chttp\u003a//main\u002egslb\u002eku6\u002ecom/c3/q7LmJPfV4DfXeTYf/1260269522170/cebbb619dc61b3eabcdb839d4c2a4402/1279582254980/v567/36/19/MBcbnWwkSJu46UoYCabpvArA\u002ef4v\u002chttp\u003a//main\u002egslb\u002eku6\u002ecom/c4/q7LmJPfV4DfXeTYf/1260269522170/1365c39355424974dbbe4ae8950f0e73/1279582254980/v575/17/15/EDczAa0GTjuhppapCLFjtaQ\u002ef4v';

my @raw_url = $example =~ m{(http\\u003a.+?f4v)}g;

my @processed_url =   map {
                             s{\\u003a}{:}g,$_; 
                             s{\\u002e}{.}g,$_;
                             s{\\u002d}{@}g,$_;
  } @raw_url;

print join("\n",@processed_url);
Run Code Online (Sandbox Code Playgroud)

如果我省略这样的美元下划线,为什么这个地图的东西不起作用呢?

 my @processed_url =   map {
                             s{\\u003a}{:}g; 
                             s{\\u002e}{.}g;
                             s{\\u002d}{@}g;
  } @raw_url;
Run Code Online (Sandbox Code Playgroud)

当我省略那些美元下划线时,除了可能的成功标志"1"之外我什么也得不到.我错过了什么?有任何想法吗?总是如此谢谢:)

perl map

3
推荐指数
2
解决办法
1605
查看次数

如何使用Perl在后续订单中获取所有可能的相邻项组合?

例如,我有一个数组

my @arr = qw(0 1 2 3 4);
Run Code Online (Sandbox Code Playgroud)

如何获得以下组合:

0
01
012
0123
01234
1
12
123
1234
2
23
234
3
34
4
Run Code Online (Sandbox Code Playgroud)

如果有的话,这种组合(或排列)的名称是什么?

永远感谢!

perl combinations

3
推荐指数
2
解决办法
368
查看次数

如何在 Perl 中使用 Win32::Ole 将格式应用于 docx 文件中的特定单词?

例如,我的 docx 文件包含以下句子:

这是一个 Perl 示例
这是一个 Python 示例
这是另一个 Perl 示例

我想将粗体样式应用于所有出现的“Perl”一词,如下所示:

这是一个Perl示例
这是一个 Python 示例
这是另一个Perl示例

到目前为止,我想出了以下脚本:

use strict; use warnings;
use Win32::OLE::Const 'Microsoft Word';

my $file = 'E:\test.docx';

my $Word = Win32::OLE->new('Word.Application', 'Quit');
$Word->{'Visible'} = 0;
my $doc = $Word->Documents->Open($file);
my $paragraphs = $doc->Paragraphs() ;
my $enumerate = new Win32::OLE::Enum($paragraphs);


while(defined(my $paragraph = $enumerate->Next())) {

    my $text = $paragraph->{Range}->{Text};
    my $sel = $Word->Selection;
    my $font = $sel->Font;

    if ($text =~ /Perl/){
        $font->{Bold} = …
Run Code Online (Sandbox Code Playgroud)

formatting perl win32ole

3
推荐指数
1
解决办法
1771
查看次数

是否有Perl等效的SAS'INTNX函数或Javascript的Dateadd函数?

我正在尝试使用Perl将中国月球系统转换为格里高利,无论是为了娱乐还是为了学习目的.我认为有一些简单的数学算法来完成这项工作,但事实证明我错了.无论如何,经过一番谷歌搜索后,我找到了一些可以完成这项工作的SAS代码.好吧,对我来说,弄清楚如何重写Perl中的大部分代码并不困难.但有这样的事情:

Convert2Gregorian = INTNX ('day', conDate, AddDay-1);
Run Code Online (Sandbox Code Playgroud)

谷歌告诉我,INTNX是一个可以返回日期的函数,在该日期之后添加了特定的日期间隔.但使用关键字"Perl INTNX"并没有给我带来任何帮助.然后我找到了一个用Javascript编写的脚本,除了Javascript使用Dateadd函数之外,一般方法大致相同,例如:

Return DateAdd(DateInterval.Day, AddDay - 1, conDate) 
Run Code Online (Sandbox Code Playgroud)

我也尝试使用PPM进行搜索,但无法找到我想要的模块.有人可以给我一些指示吗?

提前致谢 :)

更新

感谢@psilva和@hobbs :)

哈哈,最后我可以将一种编程语言翻译成另一种.这很有趣:)只是为了好玩,也许以后参考:这是原始的SAS代码和我翻译的Perl代码.如我错了请纠正我 :)

注意:数据不完整.

SAS代码如下:

data DateNtoG (drop = Ngstrings conDate AddMonth AddDay Mrunyue I);
array NGlist{43} $18_TEMPORARY_(
"010110101010170130" /*(1968)*/
"010101101010000217" /*(1969)*/
"100101101101000206" /*(1970)*/
"010010101110150127" /*(1971)*/
);

input tYear tMonth tDay RunYue;

if (tyear >1967 and tyear<2011) then do;
NGstrings = NGlist(tYear - 1967);
conDate = MDY (substr (NGstrings,15,2),(NGstrings, 17,2), tYear);

AddMonth = tMonth;

select (substr(NGstrings, 14, 1));
when ("A" …
Run Code Online (Sandbox Code Playgroud)

perl date

2
推荐指数
1
解决办法
520
查看次数