-
-
Save sirkro/241ef6924245c3ffa6c2 to your computer and use it in GitHub Desktop.
#!/usr/bin/env perl | |
use 5.012; | |
use warnings; | |
use File::Temp; | |
use IPC::System::Simple qw(capture system); | |
use LWP::UserAgent; | |
use URI; | |
use URI::QueryParam; | |
use File::Copy; | |
my $url = shift || die 'missing url'; | |
my $ua = LWP::UserAgent->new; | |
my $res = $ua->get($url); | |
die $res->status_line unless $res->is_success; | |
my $content = $res->decoded_content // $res->content // die 'no content'; | |
my @url = $content =~ m[<embed(?: [^>]*?)? src="([^"]+)"]gi; | |
die 'no swf urls found' unless @url; | |
for my $url (@url) { | |
my $uri = URI->new($url); | |
my ($h, $w, $id) = map $uri->query_param($_), qw(h w id); | |
next unless $h and $w and $id; | |
$uri->query_param(c => 'z'); | |
my $swf = File::Temp->new(suffix => '.swf'); | |
my $res = $ua->get($uri, ':content_file' => $swf->filename); | |
my $out = capture swfextract => $swf; | |
my ($ids) = $out =~ /^\s*\[-j\] \d+ JPEGs: ID\(s\) (\d+,.*)/m; | |
my @ids = split(", ", $ids); | |
my $dir = File::Temp->newdir; | |
foreach my $id (@ids) { | |
system swfextract => '-j', $id, '--outputformat', "$dir/%05d.%s", $swf; | |
} | |
my @jpg = glob "$dir/*.jpg"; | |
$out = capture identify => $jpg[0]; | |
my ($x, $y) = $out =~ / JPEG (\d+)x(\d+)/; | |
next unless $x and $y and $x == $y; | |
$_ = int $_ / $x * 2 for $w, $h; | |
# The edges of each puzzle piece image need to be overlapped. | |
$_ = int $_ / 4 for $x, $y; | |
my $img = "$id.jpg"; | |
system montage => '-tile', "${w}x$h", '-geometry', "-$x-$y", @jpg, $img; | |
} |
Hi, how do i start this script in windows? I want to solve puzzle:
http://four.flash-gear.com/npuz/puz.php?c=v&id=3992598&k=81505825
i start the script perl depuzzlefy.pl "http://four.flash-gear.com/npuz/puz.php?c=v&id=3992598&k=81505825"
With your script i get the message unknown option --outputformat so i changed it to -o in your script. Looks like it works. But
After a while i got the message : Use of uninitialized value $args[0] in join or string at C:/Perl/site/lib/IPC/Sy
stem/Simple.pm line 306.
Can you help me?
I am an absolute beginner when it it is about using these kind of scripts, but like Sholofly I am looking for a way to solve difficult flash-gear puzzles.
I installed imagemagick and swftools, but how do I create the proper path ?
Can you give an example by using the puzzle Sholofly mentioned?
Thanks for your attention
I have updated my previous comment with more information for windows :)
@Sholofly I used windows and did not get that message, which perl package did you use when instal Perl?
I opened the script in Padre and changed my $url = shift || die 'missing url'; too my $url = "http://four.flash-gear.com/npuz/puz.php?c=v&id=3992598&k=81505825";
Clicked the run button and it solved the puzzle
Installed the components indicated, and saved the script to a temp directory. Script works like a charm on the puzzle in the above puzzle url (a gate with a gps coordinate)!
However, with the puzzle in "http://five.flash-gear.com/npuz/puz.php?c=v&id=4331634&k=70547172", I get an error at montage stage: "System cannot find file". It is able to find the montage executable, but appears not to be able to find the resulting jpg file, probably because it wasn't constructed properly.
Any suggestions? System resources seem not to be a problem.
Update: found the solution: change the $dir from the currently temporary directory to a dedicated directory somewhere on your filesystem
im so lost, all i want is to solve this puzzle ;-;
I need an adult
!/usr/bin/env perl
use 5.012;
use warnings;
use File::Temp;
use IPC::System::Simple qw(capture system);
use LWP::UserAgent;
use URI;
use URI::QueryParam;
use File::Copy;
my $url = /http://two.flash-gear.com/npuz/puz.php?c=v&id=3302800&k=43348347;
my $ua = LWP::UserAgent->new;
my $res = $ua->get($url);
die $res->status_line unless $res->is_success;
my $content = $res->decoded_content // $res->content // die 'no content';
my @url = $content =~ m[<embed(?: [^>]*?)? src="([^"]+)"]gi;
die 'no swf urls found' unless @url;
for my $url (@url) {
my $uri = URI->new($url);
my ($h, $w, $id) = map $uri->query_param($_), qw(h w id);
next unless $h and $w and $id;
$uri->query_param(c => 'z');
my $swf = File::Temp->new(suffix => '.swf');
my $res = $ua->get($uri, ':content_file' => $swf->filename);
my $out = capture swfextract => $swf;
my ($ids) = $out =~ /^\s*\[-j\] \d+ JPEGs: ID\(s\) (\d+,.*)/m;
my @ids = split(", ", $ids);
my $dir = C:\Users\jacob\Desktop\241ef6924245c3ffa6c2-355d0c4771f2804e19ec2674c05c62402b9043ac (1)
foreach my $id (@ids) {
system swfextract => '-j', $id, '--outputformat', "$dir/%05d.%s", $swf;
}
my @jpg = glob "$dir/*.jpg";
$out = capture identify => $jpg[0];
my ($x, $y) = $out =~ / JPEG (\d+)x(\d+)/;
next unless $x and $y and $x == $y;
$_ = int $_ / $x * 2 for $w, $h;
# The edges of each puzzle piece image need to be overlapped.
$_ = int $_ / 4 for $x, $y;
my $img = "$id.jpg";
system montage => '-tile', "${w}x$h", '-geometry', "-$x-$y", @jpg, $img;
}
Hy,
I have a problem with this script.
i have installed the three programms,
copied the URL in line 12
insert a path for the JPG file in line 44
`#!/usr/bin/env perl
use 5.012;
use warnings;
use File::Temp;
use IPC::System::Simple qw(capture system);
use LWP::UserAgent;
use URI;
use URI::QueryParam;
use File::Copy;
my $url = "http://four.flash-gear.com/npuz/puz.php?c=v&id=3992598&k=81505825";
my $ua = LWP::UserAgent->new;
my $res = $ua->get($url);
die $res->status_line unless $res->is_success;
my $content = $res->decoded_content // $res->content // die 'no content';
my @url = $content =~ m[<embed(?: [^>]*?)? src="([^"]+)"]gi;
die 'no swf urls found' unless @url;
for my $url (@url) {
my $uri = URI->new($url);
my ($h, $w, $id) = map $uri->query_param($_), qw(h w id);
next unless $h and $w and $id;
$uri->query_param(c => 'z');
my $swf = File::Temp->new(suffix => '.swf');
my $res = $ua->get($uri, ':content_file' => $swf->filename);
my $out = capture swfextract => $swf;
my ($ids) = $out =~ /^\s*\[-j\] \d+ JPEGs: ID\(s\) (\d+,.*)/m;
my @ids = split(", ", $ids);
my $dir = File::Temp->newdir;
foreach my $id (@ids) {
system swfextract => '-j', $id, '--outputformat', "$dir/%05d.%s", $swf;
}
my @jpg = glob "C:\*.jpg";
$out = capture identify => $jpg[0];
my ($x, $y) = $out =~ / JPEG (\d+)x(\d+)/;
next unless $x and $y and $x == $y;
$_ = int $_ / $x * 2 for $w, $h;
# The edges of each puzzle piece image need to be overlapped.
$_ = int $_ / 4 for $x, $y;
my $img = "$id.jpg";
system montage => '-tile', "${w}x$h", '-geometry', "-$x-$y", @jpg, $img;
}`
now i get this error message:
"swfextract" failes to start: "Das System kann die angegebene Datei nicht finden" at depuzzlefy.pl line 33
I hope someone can help me.
Sorry, i am from Germany, and my english is not so good :)
Hi,
the script works fine, if i use this URL: http://four.flash-gear.com/npuz/puz.php?c=v&id=3992598&k=81505825
But if i use this one: http://six.flash-gear.com/npuz/puz.php?c=v&id=3526884&k=40009991
this message is displayed:
"montage" failed to start: "Das System kann die angegebene Datei nicht finden" at C:\Strawberry\depuzzle.pl line 54.
Who can help? What`s wrong?
Thanks
Michael
Hello,
Thank you for the script, but could you please tell me what am I doing wrong?
I get his error message: "identify" failed to start: "The filename, directory name, or volume label syntax is incorrect" at depuzzlefy.pl line 46
Thank you
Update: I found out the problem. I hadn't installed imagemagik with all the options selected.
I can't get this to work either:
"swfextract" failed to start: "File not found" at depuzzlefy.pl line 33"
Also, in the tutorial you say to "Add both to PATH and this script should work" how, where, when?
Thanks in advance.
Could you explain in more detail on how to use this? I've never used perl before but i did manage to install everything and get the script to run but I would get the same errors as everyone else in this thread.
Hi Sirko.
I've done exactly what you said, but I get the message
Unknown option: --outputformat
I am running windows 10 64 bit, Dwimper 0.0.7, Imagemagick 7.0.7-1,, swftools 0.9.0 and all are in PATH
Can you please help
This is what is in the pl file:
#!/usr/bin/env perl
use 5.012;
use warnings;
use File::Temp;
use IPC::System::Simple qw(capture system);
use LWP::UserAgent;
use URI;
use URI::QueryParam;
use File::Copy;
my $url = 'http://six.flash-gear.com/npuz/puz.php?c=v&id=3544874&k=37669764';
my $ua = LWP::UserAgent->new;
my $res = $ua->get($url);
die $res->status_line unless $res->is_success;
my $content = $res->decoded_content // $res->content // die 'no content';
my @url = $content =~ m[<embed(?: [^>]*?)? src="([^"]+)"]gi;
die 'no swf urls found' unless @url;
for my $url (@url) {
my $uri = URI->new($url);
my ($h, $w, $id) = map $uri->query_param($_), qw(h w id);
next unless $h and $w and $id;
$uri->query_param(c => 'z');
my $swf = File::Temp->new(suffix => '.swf');
my $res = $ua->get($uri, ':content_file' => $swf->filename);
my $out = capture swfextract => $swf;
my ($ids) = $out =~ /^\s*\[-j\] \d+ JPEGs: ID\(s\) (\d+,.*)/m;
my @ids = split(", ", $ids);
my $dir = File::Temp->newdir;
foreach my $id (@ids) {
system swfextract => '-j', $id, '--outputformat', "$dir/%05d.%s", $swf;
}
my @jpg = glob "$dir/*.jpg";
$out = capture identify => $jpg[0];
my ($x, $y) = $out =~ / JPEG (\d+)x(\d+)/;
next unless $x and $y and $x == $y;
$_ = int $_ / $x * 2 for $w, $h;
# The edges of each puzzle piece image need to be overlapped.
$_ = int $_ / 4 for $x, $y;
my $img = "$id.jpg";
system montage => '-tile', "${w}x$h", '-geometry', "-$x-$y", @jpg, $img;
}
I get the same message as thabutters on jan. 6th.
What do I have to enter in line 33? Complete newbie to scripts by the way ;).
Thanks!
I installed Strawberry Perl / swftools / imagemagick, commented the line use 5.012 and ran it:
c:\strawberryperl\perl\bin\perl.exe dopuzzle.pl http://five.flash-gear.com/npuz/puz.php?c=v&id=4642644&k=86817760
"montage" failed to start: "De ingang is ongeldig" at dopuzzle.pl line 54.
("De ingang is ongeldig" would be translated to something like: "the entry is invalid")
(FYI: a new directory is created in the temp directory and I see that thousands of small images are created (which looks to be parts of the puzzle - after montage fails, these files are cleaned out)
Any idea?
If you get the error about the --outputformat parameter, change line 41 to:
system swfextract => '-j', $id, '-o', "$dir/$id.jpg", $swf;
For me, it opens a DOS box that disappears much too fast after I clicked on the .pl-script.
Also no chance to tell pearl any paths.
But I couldn't find a jpg anywhere in the folder.
For this to work, install imagemagick (http://www.imagemagick.org/script/binary-releases.php) and swftools (http://www.swftools.org/).
Add both to PATH and this script should work
Update: Since this is a perl script, you need to install Perl also (https://www.perl.org/get.html) I used DWIM package for windows