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