Skip to content

Instantly share code, notes, and snippets.

@sirkro
Forked from gray/depuzzlefy.pl
Last active November 4, 2017 11:48
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save sirkro/241ef6924245c3ffa6c2 to your computer and use it in GitHub Desktop.
Save sirkro/241ef6924245c3ffa6c2 to your computer and use it in GitHub Desktop.
Solves image jigsaw puzzles created by http://flash-gear.com/puzzle/
#!/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;
}
@sirkro
Copy link
Author

sirkro commented Mar 21, 2016

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

@Sholofly
Copy link

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?

@Geoass
Copy link

Geoass commented Mar 29, 2016

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

@sirkro
Copy link
Author

sirkro commented Apr 1, 2016

I have updated my previous comment with more information for windows :)

@sirkro
Copy link
Author

sirkro commented Apr 1, 2016

@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

@GTBoon72
Copy link

GTBoon72 commented Apr 3, 2016

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

@Deathmeter1
Copy link

im so lost, all i want is to solve this puzzle ;-;

@Deathmeter1
Copy link

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;

}

@JNoise
Copy link

JNoise commented Jun 19, 2016

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 :)

@michaelheidler
Copy link

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

@khaderaque
Copy link

khaderaque commented Jan 3, 2017

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.

@thabutters
Copy link

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.

@ninjawaffulz
Copy link

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.

@ReneW70
Copy link

ReneW70 commented Mar 7, 2017

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;

}

@mirjotoca
Copy link

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!

@bluecooldragons
Copy link

bluecooldragons commented Apr 27, 2017

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?

@pietmarcus
Copy link

If you get the error about the --outputformat parameter, change line 41 to:
system swfextract => '-j', $id, '-o', "$dir/$id.jpg", $swf;

@Meik7
Copy link

Meik7 commented Nov 4, 2017

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.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment