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