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
  • 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;
}
@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