1 | #!/usr/bin/perl -w
|
---|
2 | use warnings;
|
---|
3 | use strict;
|
---|
4 |
|
---|
5 | use Image::Magick;
|
---|
6 | use File::HomeDir;
|
---|
7 | use MIME::Base64;
|
---|
8 |
|
---|
9 | package montage
|
---|
10 | {
|
---|
11 | my $image = Image::Magick->new;
|
---|
12 |
|
---|
13 | sub new
|
---|
14 | {
|
---|
15 | my $class = shift;
|
---|
16 | my $self = {};
|
---|
17 | bless($self, $class);
|
---|
18 | return $self;
|
---|
19 | }
|
---|
20 |
|
---|
21 | sub command
|
---|
22 | {
|
---|
23 | return "Montage";
|
---|
24 | }
|
---|
25 |
|
---|
26 | sub do
|
---|
27 | {
|
---|
28 | my $home = File::HomeDir->my_home;
|
---|
29 |
|
---|
30 | if (! -d "$home/DIY_Streetview/thumbs")
|
---|
31 | {
|
---|
32 | system("mkdir $home/DIY_Streetview/thumbs");
|
---|
33 | }
|
---|
34 |
|
---|
35 | my $imagepath = $_[1];
|
---|
36 | my $filename = $imagepath;
|
---|
37 | $imagepath =~ s/\.?\.//g; # Stop a Local File system Exploit, and error when the File path doesn't exist. Plus when did I ever use . in GUIDS!
|
---|
38 | $imagepath =~ s/-/\//g;
|
---|
39 |
|
---|
40 | if ($imagepath eq "" | ! -d "$home/DIY_Streetview/images/$imagepath")
|
---|
41 | {
|
---|
42 | print $main::socket "{ \"success\":false }\n";
|
---|
43 | print "ERR: Montage Set ID '$filename' doesn't exist\n";
|
---|
44 | }
|
---|
45 | else
|
---|
46 | {
|
---|
47 | if (! -f "$home/DIY_Streetview/thumbs/$filename.png")
|
---|
48 | {
|
---|
49 | undef @$image; #Send ImageMagick's Internal Image list to the moon. Since it doesn't behave and clean itself up.
|
---|
50 |
|
---|
51 | my ($DIR, @files);
|
---|
52 | opendir ($DIR, "$home/DIY_Streetview/images/$imagepath");
|
---|
53 | @files = grep(m/.*\.png$/, readdir($DIR));
|
---|
54 | closedir($DIR);
|
---|
55 |
|
---|
56 | if (scalar(@files) == 0)
|
---|
57 | {
|
---|
58 | print $main::socket "{ \"success\":false }\n";
|
---|
59 | print "ERR: Montage Set ID '$filename' has no images.\n";
|
---|
60 | }
|
---|
61 | else
|
---|
62 | {
|
---|
63 |
|
---|
64 | my $count = 0;
|
---|
65 | while ($count < scalar(@files))
|
---|
66 | {
|
---|
67 | my $image_file;
|
---|
68 | my $cur_file = $files[$count];
|
---|
69 | my $file_ref;
|
---|
70 | open($file_ref, "$home/DIY_Streetview/images/$imagepath/$cur_file");
|
---|
71 | $image->Read(file=>\*$file_ref);
|
---|
72 | close($file_ref);
|
---|
73 | $count++;
|
---|
74 | }
|
---|
75 |
|
---|
76 |
|
---|
77 | if (defined @$image)
|
---|
78 | {
|
---|
79 | my $montage = $image->Montage();
|
---|
80 | print "Montage file for '$filename' doesn't exist... Generating Montage...\n";
|
---|
81 | $montage->Write(filename=>"$home/DIY_Streetview/thumbs/$filename.png");
|
---|
82 |
|
---|
83 | }
|
---|
84 | else
|
---|
85 | {
|
---|
86 | print "ImageMagick failed to load any images.";
|
---|
87 | print $main::socket "{ \"success\":false }\n";
|
---|
88 | }
|
---|
89 | }
|
---|
90 | }
|
---|
91 |
|
---|
92 | if (-f "$home/DIY_Streetview/thumbs/$filename.png")
|
---|
93 | {
|
---|
94 | print "Sending requested Montage to the client...\n";
|
---|
95 | my $b64image;
|
---|
96 | open ($b64image, "$home/DIY_Streetview/thumbs/$filename.png") or die "$!";
|
---|
97 | my $raw_string = do{ local $/ = undef; <$b64image>; };
|
---|
98 | my $encoded = MIME::Base64::encode_base64( $raw_string, ''); # Making sure the output is a little as possible. (Even though there is 33% overhead in Base64 encoded string.)
|
---|
99 | print $main::socket "{ \"success\":true, \"image_data\":\"$encoded\" }\n";
|
---|
100 | print "Sent requested Montage to the client.\n";
|
---|
101 | }
|
---|
102 | }
|
---|
103 | }
|
---|
104 |
|
---|
105 |
|
---|
106 | sub doupstart
|
---|
107 | {
|
---|
108 | return 0;
|
---|
109 | }
|
---|
110 |
|
---|
111 | sub help
|
---|
112 | {
|
---|
113 | return "usage: Montage:<setID>.\nFinds and combines images to make a single image of thumbnails, and returns that image in a BASE64 representation.";
|
---|
114 | }
|
---|
115 |
|
---|
116 | sub defaultsettings
|
---|
117 | {
|
---|
118 | return undef;
|
---|
119 | }
|
---|
120 |
|
---|
121 | 1;
|
---|
122 | }
|
---|