"Fossies" - the Fresh Open Source Software Archive

Member "MagickStudio-1.9.6/scripts/MagickStudio.cgi" (14 Feb 2021, 147872 Bytes) of package /linux/www/MagickStudio-1.9.6.tar.gz:


The requested HTML page contains a <FORM> tag that is unusable on "Fossies" in "automatic" (rendered) mode so that page is shown as HTML source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "MagickStudio.cgi": 1.9.5_vs_1.9.6.

A hint: This file contains one or more very long lines, so maybe it is better readable using the pure text view mode that shows the contents as wrapped lines within the browser window.


    1 #!/usr/bin/perl
    2 #
    3 ###############################################################################
    4 #                                                                             #
    5 #                                                                             #
    6 #                                                                             #
    7 #                 M   M   AAA    GGGG  IIIII   CCCC  K   K                    #
    8 #                 MM MM  A   A  G        I    C      K  K                     #
    9 #                 M M M  AAAAA  G GG     I    C      KKK                      #
   10 #                 M   M  A   A  G   G    I    C      K  K                     #
   11 #                 M   M  A   A   GGG   IIIII   CCCC  K   K                    #
   12 #                                                                             #
   13 #                 SSSSS  TTTTT  U   U  DDDD   IIIII   OOO                     #
   14 #                 SS       T    U   U  D   D    I    O   O                    #
   15 #                  SSS     T    U   U  D   D    I    O   O                    #
   16 #                    SS    T    U   U  D   D    I    O   O                    #
   17 #                 SSSSS    T     UUU   DDDD   IIIII   OOO                     #
   18 #                                                                             #
   19 #                                                                             #
   20 #                Image Convert, Edit, and Compose on the Web                  #
   21 #                                                                             #
   22 #                                                                             #
   23 #                           Software Design                                   #
   24 #                             John Cristy                                     #
   25 #                            November 1997                                    #
   26 #                                                                             #
   27 #                                                                             #
   28 #  Copyright (C) 1999-2020 ImageMagick Studio LLC, a non-profit organization  #
   29 #  dedicated to making software imaging solutions freely available.           #
   30 #                                                                             #
   31 #  You may not use this file except in compliance with the License.  You may  #
   32 #  obtain a copy of the License at                                            #
   33 #                                                                             #
   34 #    https://imagemagick.org/script/license.php                               #
   35 #                                                                             #
   36 #  Unless required by applicable law or agreed to in writing, software        #
   37 #  distributed under the License is distributed on an "AS IS" BASIS,          #
   38 #  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.   #
   39 #  See the License for the specific language governing permissions and        #
   40 #  limitations under the License.                                             #
   41 #                                                                             #
   42 ###############################################################################
   43 #
   44 #  Magick Studio is a Web interface to PerlMagick that can read and write
   45 #  many of the more popular image formats including JPEG, TIFF, PNM, GIF, and
   46 #  Photo CD.  In addition you can interactively resize, rotate, sharpen, color
   47 #  reduce, or add special effects to your image and save the completed work in
   48 #  the same or differing image format.
   49 #
   50 #
   51 
   52 BEGIN {
   53   use File::Basename;
   54   $dir=dirname($0);
   55   chdir $dir or die "Can't chdir to $dir: $!\n";
   56   # safe now
   57   push @INC, '.';
   58 }
   59 
   60 use CGI;
   61 use CGI::Carp qw/fatalsToBrowser/;
   62 use Sys::Hostname;
   63 use MagickStudio;
   64 use strict;
   65 
   66 #
   67 # Global variable declarations.
   68 #
   69 my($action, %Functions, $header, $length, $prefix, $q, %seen, $timer,
   70    $user_agent);
   71 
   72 our($ContactInfo, $Debug, $DefaultFont, $DocumentDirectory, $DocumentRoot,
   73     $ExampleImage, $ExpireCache, $ExpireThreshold, $HashDigestSalt, $IconSize,
   74     $LoadAverageThreshold, $MaxFilesize, $MaxImageArea, $MaxImageExtent,
   75     $MaxWorkFiles, $MinExpireAge, $RedirectURL, $SponsorIcon, $SponsorURL,
   76     $Timeout);
   77 
   78 #
   79 # Change these variables to reflect your environment.
   80 #
   81 #$ENV{'ftp_proxy'}='http://webproxy.imagemagick.org/';
   82 #$ENV{'http_proxy'}='http://webproxy.imagemagick.org/';
   83 $ENV{DISPLAY}="$ENV{REMOTE_HOST}:0" if $ENV{REMOTE_HOST};
   84 $ENV{LD_LIBRARY_PATH}='/usr/lib:/usr/openwin/lib:/usr/local/lib';
   85 $ENV{MAGICK_FONT_PATH}=$DocumentRoot . $DocumentDirectory . "/fonts";
   86 $ENV{MAGICK_PRECISION}=15;
   87 $ENV{PATH}='/bin:/usr/bin:/usr/openwin/bin:/usr/local/bin';
   88 $ENV{TMPDIR}=$DocumentRoot . $DocumentDirectory . "/tmp";
   89 
   90 #
   91 # Annotate image.
   92 #
   93 sub Annotate
   94 {
   95   use Image::Magick;
   96 
   97   no strict 'refs';
   98 
   99   my($antialias, $density, $direction, $fill, $font, $geometry, $gravity,
  100     $image, $kerning, $interline_spacing, $interword_spacing, $path,
  101     $pointsize, $rotate, $scale, $skew_x, $skew_y, $status, $stroke,
  102     $strokewidth, $text, $translate, $undercolor);
  103 
  104   #
  105   # Read image.
  106   #
  107   $path=Untaint($q->param('Path'));
  108   chdir($path) || Error('Your image has expired',$path);
  109   $image=Image::Magick->new;
  110   $status=$image->Read("$path/MagickStudio.mpc");
  111   Error($status) if $#$image < 0;
  112   #
  113   # Annotate image.
  114   #
  115   $antialias='false';
  116   $antialias='true' if $q->param('Antialias') eq 'on';
  117   $density='90';
  118   $density=$q->param('Density') if $q->param('Density');
  119   $direction=$q->param('Direction');
  120   $fill='none';
  121   $fill=$q->param('Fill') if $q->param('Fill');
  122   getstore(Untaint($q->param('FontURL')),'MagickStudio.ttf')
  123     unless $q->param('FontURL') eq 'http://';
  124   $font="\@MagickStudio.ttf" if -e 'MagickStudio.ttf';
  125   $font=($image->QueryFont($q->param('Font')))[10] unless -e 'MagickStudio.ttf';
  126   $geometry='+0+0';
  127   $geometry=$q->param('Geometry') if $q->param('Geometry');
  128   $gravity=$q->param('Gravity');
  129   $pointsize=int($q->param('Pointsize'));
  130   $kerning=0.0;
  131   $kerning=$q->param('Kerning') if $q->param('Kerning');
  132   $interline_spacing=0.0;
  133   $interline_spacing=$q->param('InterlineSpacing') if
  134     $q->param('InterlineSpacing');
  135   $interword_spacing=0.0;
  136   $interword_spacing=$q->param('InterwordSpacing') if
  137     $q->param('InterwordSpacing');
  138   $rotate=0.0;
  139   $rotate=$q->param('Rotate') if $q->param('Rotate');
  140   $scale='0.0, 0.0';
  141   $scale=$q->param('Scale') if $q->param('Scale');
  142   $stroke='none';
  143   $stroke=$q->param('Stroke') if $q->param('Stroke');
  144   $skew_x=0.0;
  145   $skew_x=$q->param('SkewX') if $q->param('SkewX');
  146   $skew_y=0.0;
  147   $skew_y=$q->param('SkewY') if $q->param('SkewY');
  148   $strokewidth=1;
  149   $strokewidth=$q->param('StrokeWidth') if $q->param('StrokeWidth');
  150   $text=$q->param('Text');
  151   $translate='0.0, 0.0';
  152   $translate=$q->param('Translate') if $q->param('Translate');
  153   $undercolor='none';
  154   $undercolor=$q->param('Undercolor') if $q->param('Undercolor');
  155   if ($q->param('Polaroid') eq 'on')
  156     {
  157       $image->Polaroid(caption=>$text,font=>$font,fill=>$fill,stroke=>$stroke,
  158         strokewidth=>$strokewidth,pointsize=>$pointsize,angle=>$rotate,
  159         gravity=>$gravity,background=>$q->param('BackgroundColor'));
  160     }
  161   else
  162     {
  163       $image->Annotate(text=>$text,geometry=>$geometry,font=>$font,fill=>$fill,
  164         stroke=>$stroke,strokewidth=>$strokewidth,undercolor=>$undercolor,
  165         pointsize=>$pointsize,density=>$density,gravity=>$gravity,
  166         kerning=>$kerning,'interline-spacing'=>$interline_spacing,
  167         'interword-spacing'=>$interword_spacing,translate=>$translate,
  168         scale=>$scale,rotate=>$rotate,skewX=>$skew_x,skewY=>$skew_y,
  169         antialias=>$antialias,direction=>$direction);
  170     }
  171   #
  172   # Write image.
  173   #
  174   CreateWorkDirectory(1);
  175   Header(GetTitle($image));
  176   $status=$image->Write(filename=>'MagickStudio.mpc');
  177   Error($status) if "$status";
  178   ViewForm($image);
  179 }
  180 
  181 #
  182 # Annotate image form.
  183 #
  184 sub AnnotateForm
  185 {
  186   my(@fonts, $image);
  187 
  188   #
  189   # Display annotate form.
  190   #
  191   Header(GetTitle(undef));
  192   print <<XXX;
  193 <p class="lead magick-description">To <a href="$DocumentDirectory/Annotate.html" target="help">annotate</a> your image with text, enter your text and location below and press <code>annotate</code>.  There are additional optional attributes below.  Set them as appropriate.</p>
  194 XXX
  195   ;
  196   print $q->start_form(-class=>'form-horizontal');
  197   print $q->hidden(-name=>'CacheID'), "\n";
  198   print $q->hidden(-name=>'SessionID'), "\n";
  199   print $q->hidden(-name=>'Path'), "\n";
  200   print $q->hidden(-name=>'ToolType'), "\n";
  201   print $q->hidden(-name=>'Name'), "\n";
  202   print $q->hidden(-name=>'Magick'), "\n";
  203   print "<dt>Text:</dt>\n";
  204   print '<dd>', $q->textarea(-class=>'form-control',-name=>'Text',-columns=>50,
  205     -rows=>3), "</dd><br />\n";
  206   print "<dd><table class=\"table table-condensed table-striped\">\n";
  207   print "<tr>\n";
  208   print "<th>Offset</th>\n";
  209   print "<th>Gravity</th>\n";
  210   print "</tr>\n";
  211   print "<tr>\n";
  212   print '<td>', $q->textfield(-class=>'form-control',-name=>'Geometry',
  213     -size=>25,-value=>'+0+0'), "</td>\n";
  214   my @types=Image::Magick->QueryOption('gravity');
  215   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Gravity',
  216     -values=>[@types],-default=>'SouthEast'), "</td>\n";
  217   print "</tr>\n";
  218   print '</table></dd><br />';
  219   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
  220     -value=>'annotate'), ' your image or ', $q->reset(-name=>'reset',
  221     -class=>'btn btn-warning'), " the form.<br /><br />\n";
  222   print "<br />\n";
  223   print "<fieldset>\n";
  224   print "<legend>Annotate Properties</legend>\n";
  225   print "<dl><dd>\n";
  226   print "<table class=\"table table-condensed table-striped\">\n";
  227   print "<tr>\n";
  228   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Fill Color</a></th>\n";
  229   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Stroke Color</a></th>\n";
  230   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Undercolor</a></th>\n";
  231   print "</tr>\n";
  232   print "<tr>\n";
  233   print '<td>', $q->textfield(-class=>'form-control',-name=>'Fill',
  234     -value=>'white',-size=>25), "</td>\n";
  235   print '<td>', $q->textfield(-class=>'form-control',-name=>'Stroke',
  236     -value=>'none',-size=>25), "</td>\n";
  237   print '<td>', $q->textfield(-class=>'form-control',-name=>'Undercolor',
  238     -value=>'none',-size=>25), "</td>\n";
  239   print "</tr>\n";
  240   print '</table></dd><br />';
  241   print "<dd><table class=\"table table-condensed table-striped\">\n";
  242   print "<tr>\n";
  243   print "<th>PointSize</th>\n";
  244   print "<th>Density</th>\n";
  245   print "<th>Stroke Width</th>\n";
  246   print "</tr>\n";
  247   print "<tr>\n";
  248   print '<td>', $q->textfield(-class=>'form-control',-name=>'Pointsize',
  249     -value=>'24',-size=>25), "</td>\n";
  250   print '<td>', $q->textfield(-class=>'form-control',-name=>'Density',
  251     -value=>'90',-size=>25), "</td>\n";
  252   print '<td>', $q->textfield(-class=>'form-control',-name=>'StrokeWidth',
  253     -value=>'0',-size=>25), "</td>\n";
  254   print "</tr>\n";
  255   print '</table></dd><br />';
  256   print "<dd><table class=\"table table-condensed table-striped\">\n";
  257   print "<tr>\n";
  258   print "<th>Kerning</th>\n";
  259   print "<th>Interline Spacing</th>\n";
  260   print "<th>Interword Spacing</th>\n";
  261   print "</tr>\n";
  262   print "<tr>\n";
  263   print '<td>', $q->textfield(-class=>'form-control',-name=>'Kerning',
  264     -value=>'0',-size=>25), "</td>\n";
  265   print '<td>', $q->textfield(-class=>'form-control',-name=>'InterlineSpacing',
  266     -value=>'0',-size=>25), "</td>\n";
  267   print '<td>', $q->textfield(-class=>'form-control',-name=>'InterwordSpacing',
  268     -value=>'0',-size=>25), "</td>\n";
  269   print "</tr>\n";
  270   print '</table></dd><br />';
  271   print "<dd><table class=\"table table-condensed table-striped\">\n";
  272   print "<tr>\n";
  273   print "<th><a href=\"$DocumentDirectory/fonts/\">Font</a></th>\n";
  274   print "<th>Direction</th>\n";
  275   print "</tr>\n";
  276   print "<tr>\n";
  277   $image=new Image::Magick;
  278   @fonts=$image->QueryFont();
  279   print '<td>', $q->scrolling_list(-class=>'form-control',-name=>'Font',
  280     -values=>[@fonts],-size=>10), "</td><br />\n";
  281   my @types=Image::Magick->QueryOption('direction');
  282   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Direction',
  283     -values=>[@types]), "</td>\n";
  284   print "</tr>\n";
  285   print "<tr>\n";
  286   print '<td>', $q->textfield(-class=>'form-control',-name=>'FontURL',
  287     -value=>'http://',-size=>25), "</td><br />\n";
  288   print "</tr>\n";
  289   print '</table></dd><br />';
  290   print "<dd><table class=\"table table-condensed table-striped\">\n";
  291   print "<tr>\n";
  292   print "<th>Translate</th>\n";
  293   print "<th>Scale</th>\n";
  294   print "<th>Rotate</th>\n";
  295   print "</tr>\n";
  296   print "<tr>\n";
  297   print '<td>', $q->textfield(-class=>'form-control',-name=>'Translate',
  298     -value=>'0.0, 0.0',-size=>25), "</td>\n";
  299   print '<td>', $q->textfield(-class=>'form-control',-name=>'Scale',
  300     -value=>'1.0, 1.0',-size=>25), "</td>\n";
  301   print '<td>', $q->textfield(-class=>'form-control',-name=>'Rotate',
  302     -value=>'0.0',-size=>25), "</td>\n";
  303   print "</tr>\n";
  304   print '</table><br />';
  305   print "<dd><table class=\"table table-condensed table-striped\">\n";
  306   print "<tr>\n";
  307   print "<th>Skew X</th>\n";
  308   print "<th>Skew Y</th>\n";
  309   print "</tr>\n";
  310   print "<tr>\n";
  311   print '<td>', $q->textfield(-class=>'form-control',-name=>'SkewX',
  312     -value=>'0.0',-size=>25), "</td>\n";
  313   print '<td>', $q->textfield(-class=>'form-control',-name=>'SkewY',
  314     -value=>'0.0',-size=>25), "</td>\n";
  315   print "</tr>\n";
  316   print '</table></dd><br />';
  317   print "<dd><table class=\"table table-condensed table-striped\">\n";
  318   print "<tr>\n";
  319   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Background Color</a></th>\n";
  320   print "</tr>\n";
  321   print "<tr>\n";
  322   print '<td>', $q->textfield(-class=>'form-control',-name=>'BackgroundColor',
  323     -value=>'none', -size=>25), "</td>\n";
  324   print "</tr>\n";
  325   print '</table></dd><br />';
  326   print "<dt>Miscellaneous options:</dt>\n";
  327   print '<dd>', $q->checkbox(-name=>'Antialias',
  328     -label=>' antialias text.',-checked=>'true'), "</dd>\n";
  329   print '<dd>', $q->checkbox(-name=>'Polaroid',
  330     -label=>' simulate a Polaroid picture.'), "</dd>\n";
  331   print "</dd></dl>\n";
  332   print "</fieldset>\n";
  333   print $q->end_form, "\n";
  334   print <<XXX;
  335 XXX
  336   ;
  337   Trailer(1);
  338 }
  339 
  340 #
  341 # Suspend service during restricted hours.
  342 #
  343 sub CheckStudioHours
  344 {
  345   my($hour, $url);
  346 
  347   $hour=(localtime)[2];
  348   return unless ($hour >= 18) && ($hour < 23);
  349   $url=$q->self_url . "&Action=" . $action;
  350   Header("Please Stand By...",-refresh=>"600; URL=$url");
  351   print <<XXX;
  352 <code>ImageMagick Studio</code> has restricted access from 6PM until 11PM EST.
  353 We have temporarily <i>suspended</i> the processing of your image.
  354 Shortly after 11PM, processing <var>automagically</var> continues and your image is
  355 returned.
  356 XXX
  357   ;
  358   Trailer(undef);
  359 }
  360 
  361 #
  362 # Suspend service if Studio is too busy.
  363 #
  364 sub CheckStudioStatus
  365 {
  366   my($load_average, $refresh_rate, $url);
  367 
  368   $load_average=GetLoadAverage();
  369   return unless $load_average > 2*$LoadAverageThreshold;
  370   $refresh_rate=int($load_average);
  371   $url=$q->self_url . "&Action=" . $action;
  372   Header("Please Stand By...",-refresh=>"$refresh_rate; URL=$url",
  373     -status=>'502 Service Temporarily Overloaded');
  374   print <<XXX;
  375 <code>ImageMagick Studio</code> is busy serving other requests.  We have temporarily
  376 <i>suspended</i> the processing of your image.  The current studio status is:
  377 <br />
  378 <center>
  379 <table class=\"table table-condensed table-striped\">
  380 <tr>
  381   <th>Load Average</th>
  382   <th>Threshold</th>
  383 </tr>
  384 
  385 <tr>
  386   <td align=center>$load_average</td>
  387   <td align=center>$LoadAverageThreshold</td>
  388 </tr>
  389 </table>
  390 </center>
  391 <br />
  392 When the studio load average becomes less than the threshold, processing
  393 <var>automagically</var> continues and your image is returned.  The studio status will
  394 be refreshed in $refresh_rate seconds.
  395 XXX
  396   ;
  397   Trailer(undef);
  398 }
  399 
  400 #
  401 # Choose a MagickStudio tool.
  402 #
  403 sub ChooseTool
  404 {
  405   my ($function, $tooltype, %Tools);
  406 
  407   %Tools=
  408   (
  409     'Upload'=>\&Upload,
  410     'Download'=>\&Download,
  411     'View'=>\&View,
  412     'Identify'=>\&Identify,
  413     'Colormap'=>\&Colormap,
  414     'Resize'=>\&Resize,
  415     'Transform'=>\&Transform,
  416     'Enhance'=>\&Enhance,
  417     'Effects'=>\&Effects,
  418     'FX'=>\&Effects,
  419     'Decorate'=>\&Decorate,
  420     'Annotate'=>\&Annotate,
  421     'Draw'=>\&Draw,
  422     'Composite'=>\&Composite,
  423     'Compare'=>\&Compare,
  424     'Comment'=>\&Comment
  425   );
  426 
  427   $tooltype=$q->param('ToolType');
  428   View() unless defined($tooltype);
  429   Error('Unable to mogrify image','path is not defined')
  430     unless $q->param('Path');
  431   SaveQueryState($q->param('SessionID'),$tooltype);
  432   $function=$Tools{$tooltype};
  433   &$function() if defined($function);
  434   Error('Request failed due to malformed query');
  435 }
  436 
  437 #
  438 # Colormap image.
  439 #
  440 sub Colormap
  441 {
  442   use Image::Magick;
  443 
  444   my($colors, $colorspace, $dither, $global_colormap, $image, $levels,
  445     $measure_error, %options, $parameter, $path, $status, $transparent_color);
  446 
  447   #
  448   # Read image.
  449   #
  450   $path=Untaint($q->param('Path'));
  451   chdir($path) || Error('Your image has expired',$path);
  452   $image=Image::Magick->new;
  453   $status=$image->Read("$path/MagickStudio.mpc");
  454   Error($status) if $#$image < 0;
  455   #
  456   # Quantize image.
  457   #
  458   grep($options{$_}++,$q->param('Options'));
  459   $colors=$q->param('Parameter');
  460   $dither='false';
  461   $dither='true' if $options{'dither'};
  462   $global_colormap='false';
  463   $global_colormap='true' if $options{'global colormap'};
  464   $colorspace='sRGB';
  465   $colorspace='Gray' if $options{'gray'};
  466   $colorspace=$q->param('Colorspace') if $q->param('Colorspace');
  467   $measure_error='False';
  468   $measure_error='True' if $options{'measure error'};
  469   $parameter=$q->param('Parameter');
  470   $transparent_color='none';
  471   $transparent_color=$q->param('TransparentColor') if
  472     $q->param('TransparentColor');
  473   if ($options{'black & white'})
  474     {
  475       $colors='2';
  476       $colorspace='Gray';
  477     }
  478   $colorspace='Transparent' if $options{'preserve transparent pixels'};
  479   if ($options{'map to clipboard'})
  480     {
  481       my($colorcube, $filename);
  482 
  483       #
  484       # Map to the clipboard image.
  485       #
  486       $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
  487         $q->param('SessionID') . '.mpc';
  488       $colorcube=Image::Magick->new;
  489       $status=$colorcube->Read($filename);
  490       Error($status) if $#$colorcube < 0;
  491       $image->Remap(image=>$colorcube);
  492     }
  493   if ($options{'netscape color cube'})
  494     {
  495       my($colorcube);
  496 
  497       #
  498       # Map to the Netscape colorcube.
  499       #
  500       $colorcube=Image::Magick->new;
  501       $status=$colorcube->Read('netscape:');
  502       Error($status) if $#$colorcube < 0;
  503       $image->Remap(image=>$colorcube);
  504     }
  505   for ($levels=1; (($levels+1)*($levels+1)*($levels+1)) < $colors; $levels++)
  506   {
  507   }
  508   $image->OrderedDither($parameter) if $options{'ordered dither'};
  509   $image->Posterize(levels=>$levels,dither=>$dither) if $options{'posterize'};
  510   $image->Segment(colorspace=>$colorspace) if $options{'segment'};
  511   $image->Kmeans($parameter) if $options{'kmeans'};
  512   $image->Quantize(colors=>$colors,dither=>$dither,colorspace=>$colorspace,
  513     'transparent-color'=>$transparent_color,measure_error=>$measure_error);
  514   #
  515   # Write image.
  516   #
  517   CreateWorkDirectory(1);
  518   Header(GetTitle($image));
  519   $status=$image->Write(filename=>'MagickStudio.mpc');
  520   Error($status) if "$status";
  521   ViewForm($image);
  522 }
  523 
  524 #
  525 # Colormap form.
  526 #
  527 sub ColormapForm
  528 {
  529   my(@OptionTypes);
  530 
  531   @OptionTypes=
  532   [
  533     'black & white',
  534     'dither',
  535     'global colormap',
  536     'gray',
  537     'kmeans',
  538     'measure error',
  539     'map to clipboard',
  540     'netscape color cube',
  541     'ordered dither',
  542     'posterize',
  543     'preserve transparent pixels',
  544     'segment'
  545   ];
  546 
  547   #
  548   # Display Colormap form.
  549   #
  550   Header(GetTitle(undef));
  551   print <<XXX;
  552 <p class="lead magick-description">You have a number of options for creating or changing the image <a href="$DocumentDirectory/Colormap.html" target="help">colormap</a>.  You can reduce the number of colors in your image, dither, or convert to gray colors.  To create or modify your image's colormap, check one or more options below.  Next, press <code>quantize</code> to continue.</p>
  553 XXX
  554   ;
  555   print $q->start_form(-class=>'form-horizontal');
  556   print $q->hidden(-name=>'CacheID'), "\n";
  557   print $q->hidden(-name=>'SessionID'), "\n";
  558   print $q->hidden(-name=>'Path'), "\n";
  559   print $q->hidden(-name=>'ToolType'), "\n";
  560   print $q->hidden(-name=>'Name'), "\n";
  561   print $q->hidden(-name=>'Magick'), "\n";
  562   print $q->hidden(-name=>'Action',-class=>'btn btn-primary',
  563     -value=>'quantize'), "\n";
  564   print "<dt>Parameter:</dt>\n";
  565   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Parameter',
  566     -size=>25,-value=>'256'), "</dd><br />\n";
  567   print "<dt>Choose from these options:</dt>\n";
  568   print '<dd>', $q->checkbox_group(-name=>'Options',-values=>@OptionTypes,
  569     -columns=>3,-default=>'dither'), "</dd><br />\n";
  570   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
  571     -value=>'quantize'), ' your image or ', $q->reset(-name=>'reset',
  572     -class=>'btn btn-warning'), " the form.<br /><br />\n";
  573   print "<br />\n";
  574   print "<fieldset>\n";
  575   print "<legend>Transform Properties</legend>\n";
  576   print "<dl><dd>\n";
  577   print "<table class=\"table table-condensed table-striped\">\n";
  578   print "<tr>\n";
  579   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Transparent Color</a></th>\n";
  580   print "<th><a href=\"$DocumentDirectory/Colorspace.html\" target=\"help\">Colorspace</a></th>\n";
  581   print "</tr>\n";
  582   print "<tr>\n";
  583   print '<td>', $q->textfield(-class=>'form-control',-name=>'TransparentColor',
  584     -value=>'none',-size=>25), "</td>\n";
  585   my @types=Image::Magick->QueryOption('colorspace');
  586   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Colorspace',
  587     -values=>[@types],-default=>'sRGB'), "</td>\n";
  588   print "</tr>\n";
  589   print '</table><br />';
  590   print "</dd></dl>\n";
  591   print "</fieldset>\n";
  592   print $q->end_form, "\n";
  593   print <<XXX;
  594 <br /> <br /> <br /> <br /> <br /> <br />
  595 XXX
  596   ;
  597   Trailer(1);
  598 }
  599 
  600 #
  601 # Comment.
  602 #
  603 sub Comment
  604 {
  605   use Digest::SHA3;
  606 
  607   no strict 'subs';
  608 
  609   my($digest, $filename, $path, $remote_host);
  610 
  611   local(*DATA);
  612 
  613   umask(002);
  614   $path=$DocumentRoot . $DocumentDirectory . "/comments";
  615   $digest=Digest::SHA3->new(512);
  616   $digest->add($HashDigestSalt,$q->remote_addr(),time(),{},rand(),$$);
  617   $filename=$path . '/' . $digest->hexdigest . '.txt';
  618   open(DATA,">$filename") || Error('Unable to save your comments',$filename);
  619   $remote_host='localhost';
  620   $remote_host=$q->remote_host() if $q->remote_host();
  621   print DATA "Host: ", GetHostname($remote_host), "\n";
  622   print DATA "Address: ", $q->remote_addr(), "\n" if $q->remote_addr();
  623   print DATA "Ident: ", $q->remote_ident(), "\n" if $q->remote_ident();
  624   print DATA "User: ", $q->remote_user(), "\n" if $q->remote_user();
  625   print DATA "Name: ", $q->user_name(), "\n" if  $q->user_name();
  626   print DATA "Agent: ", $q->user_agent(), "\n" if $q->user_agent();
  627   print DATA "Time: ", scalar(localtime), "\n";
  628   print DATA "Comment:\n\n", $q->param('Comment'), "\n";
  629   close(DATA);
  630   #
  631   # Show comments.
  632   #
  633   $|=1;
  634   print $q->header(-charset=>'UTF-8');
  635   print $q->start_html(-title=>"ImageMagick Studio Comment Form",
  636     -style=>{-src=>"$DocumentDirectory/assets/magick-css.php"},
  637     -author=>$ContactInfo,-bgcolor=>'#FFFFFF',-encoding=>'UTF-8'), "\n";
  638   print <<XXX;
  639 <br />
  640 <center>
  641 <a href="$SponsorURL" target="sponsor">
  642   <img src="$DocumentDirectory/images/$SponsorIcon" alt="[sponsor]" align=right border="0" vspace="45" /></a>
  643 <img alt="ImageMagick Studio" src="$DocumentDirectory/images/magick.png" align=bottom width="114" height="118" border="0" />
  644 </center>
  645 <p><hr /></p>
  646 XXX
  647   ;
  648   print "<dl>\n";
  649   print "<dl>\n";
  650   print "<dt>You said:<br />\n";
  651   print '<dd><ul><pre class=\"highlight\"><samp>', $q->param('Comment'),
  652     "</samp></pre></ul><br />\n";
  653   print "<dt>An administrator will review your comment soon.  Thanks.\n";
  654   print "</dl>\n";
  655   print "</dl>\n";
  656   Trailer(1);
  657 }
  658 
  659 #
  660 # Comment form.
  661 #
  662 sub CommentForm
  663 {
  664   #
  665   # Display Comment form.
  666   #
  667   $|=1;
  668   print $q->header(-charset=>'UTF-8');
  669   print $q->start_html(-title=>"ImageMagick Studio Comment Form",
  670     -style=>{-src=>"$DocumentDirectory/assets/magick-css.php"},
  671     -author=>$ContactInfo,-bgcolor=>'#FFFFFF',-encoding=>'UTF-8'), "\n";
  672   print <<XXX;
  673 <br />
  674 <center>
  675 <a href="$SponsorURL" target="sponsor">
  676   <img src="$DocumentDirectory/images/$SponsorIcon" alt="[sponsor]" align=right border="0" vspace="45" /></a>
  677 <img alt="ImageMagick Studio" src="$DocumentDirectory/images/magick.png" align=bottom width="114" height="118" border="0" />
  678 </center>
  679 <p><hr /></p>
  680 If you have a comment or problem with <code>ImageMagick Studio</code>, enter
  681 any details below and press <code>send</code>.  Be sure to include a valid e-mail
  682 address if you require a response.
  683 XXX
  684   ;
  685   $q->delete('Comment');
  686   print $q->start_form(-class=>'form-horizontal');
  687   print $q->hidden(-name=>'CacheID'), "\n";
  688   print $q->hidden(-name=>'SessionID'), "\n";
  689   print $q->hidden(-name=>'Path'), "\n";
  690   print $q->hidden(-name=>'ToolType'), "\n";
  691   print $q->hidden(-name=>'Name'), "\n";
  692   print $q->hidden(-name=>'Magick'), "\n";
  693   print "<dl>\n";
  694   print "<dl>\n";
  695   print '<dd>', $q->textarea(-class=>'form-control',-name=>'Comment',
  696     -columns=>50,-rows=>10,-wrap=>'horizontal'), "<br />\n";
  697   print "</dl>\n";
  698   print "</dl>\n";
  699   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
  700     -value=>'send'), ' your comment or ', $q->reset(-name=>'reset',
  701     -class=>'btn btn-warning'), " the form.\n";
  702   print $q->end_form, "\n";
  703   print <<XXX;
  704 XXX
  705   ;
  706   print "<p><hr /></p>\n";
  707   print $q->end_html;
  708   exit;
  709 }
  710 
  711 #
  712 # Compare image.
  713 #
  714 sub Compare
  715 {
  716   no strict 'refs';
  717 
  718   use Image::Magick;
  719   use File::Copy;
  720 
  721   my($channel, $compare, $extent, @extents, $filename, $fuzz, $i, $image,
  722     $metric, $path, $status);
  723 
  724   #
  725   # Read image.
  726   #
  727   $path=Untaint($q->param('Path'));
  728   chdir($path) || Error('Your image has expired',$path);
  729   $image=Image::Magick->new;
  730   $status=$image->Read("$path/MagickStudio.mpc");
  731   Error($status) if $#$image < 0;
  732   #
  733   # Read compare image.
  734   #
  735   if ($q->param('CompareURL')) {
  736     $filename=Untaint($q->param('CompareURL'));
  737     getstore($filename,'MagickStudio.dat');
  738   } else {
  739     $filename=Untaint($q->param('CompareFile')) if $q->param('CompareFile');
  740     $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
  741       $q->param('SessionID') if $q->param('Clipboard') eq 'on';
  742     copy($q->upload('CompareFile'),'MagickStudio.dat') ||
  743       copy(\*$filename,'MagickStudio.dat') ||
  744         (getstore($filename,'MagickStudio.dat') eq '200') ||
  745           Error('Unable to compare image',$filename);
  746   }
  747   Error('Unable to read image file',$filename)
  748     unless (-f 'MagickStudio.dat') && (-s 'MagickStudio.dat');
  749   Error('Image size exceeds maximum allowable',$filename)
  750     unless (-s 'MagickStudio.dat') < (1024*$MaxFilesize);
  751   $compare=Image::Magick->new;
  752   @extents=$compare->Ping("MagickStudio.dat");
  753   $extent=0;
  754   for ($i=0; $i < $#extents; $i+=4) { $extent+=$extents[$i]*$extents[$i+1]; }
  755   Error('Image extent exceeds maximum allowable') if $extent &&
  756     ($extent > (1024*$MaxImageExtent));
  757   $status=$compare->Read('MagickStudio.dat');
  758   Error("unable to read your image",$filename) if $#$compare < 0;
  759   unlink('MagickStudio.dat');
  760   Error('Image width or height differ') if $image->Get('width') ne
  761    $compare->Get('width');
  762   Error('Image width or height differ') if $image->Get('height') ne
  763    $compare->Get('height');
  764   #
  765   # Compare image.
  766   #
  767   $channel=$q->param('ChannelType');
  768   $metric=$q->param('MetricType');
  769   $fuzz="0.0";
  770   $fuzz=>$q->param('Fuzz') if $q->param('Fuzz');
  771   my $difference_image=$image->Compare(image=>$compare,metric=>$metric,
  772     channel=>$channel,fuzz=>$fuzz);
  773   if (ref($difference_image))
  774     {
  775       undef $image;
  776       $image=$difference_image;
  777     }
  778   #
  779   # Write image.
  780   #
  781   CreateWorkDirectory(1);
  782   Header(GetTitle($image));
  783   $status=$image->Write(filename=>'MagickStudio.mpc');
  784   Error($status) if "$status";
  785   ViewForm($image);
  786 }
  787 
  788 #
  789 # Compare image form.
  790 #
  791 sub CompareForm
  792 {
  793   my($action);
  794 
  795   #
  796   # Compare image form.
  797   #
  798   Header(GetTitle(undef));
  799   print <<XXX;
  800 <p class="lead magick-description">To <a href="$DocumentDirectory/Compare.html" target="help">compare</a> your image, press <code>Choose File</code> and select your image file or enter the Uniform Resource Locator of your image.  Next, choose the location of the compare image and the type of compare operation.  Finally, press <code>compare</code> to continue.</p>
  801 XXX
  802   ;
  803   $action=$q->script_name() . "?CacheID=" . $q->param('CacheID') .
  804     ";Action=compare";
  805   print $q->start_multipart_form(-action=>$action,-class=>'form-horizontal');
  806   print $q->hidden(-name=>'SessionID'), "\n";
  807   print $q->hidden(-name=>'Path'), "\n";
  808   print $q->hidden(-name=>'ToolType'), "\n";
  809   print $q->hidden(-name=>'Name'), "\n";
  810   print $q->hidden(-name=>'Magick'), "\n";
  811   print "<dt><a href=\"$DocumentDirectory/Filename.html\" target=\"help\">",
  812     "Filename</a>:</dt>\n";
  813   print '<dd>', $q->filefield(-name=>'CompareFile',-size=>50,-maxlength=>1024),
  814     "</dd><br />\n";
  815   print "<dt><a href=\"$DocumentDirectory/URL.html\" target=\"help\">",
  816     "URL</a>:</dt>\n";
  817   print '<dd>', $q->textfield(-class=>'form-control',-name=>'CompareURL',
  818     -size=>50), "</dd><br />\n";
  819   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
  820     -value=>'compare'), ' your image or ', $q->reset(-name=>'reset',
  821     -class=>'btn btn-warning'), " the form.<br /><br />\n";
  822   print "<br />\n";
  823   print "<fieldset>\n";
  824   print "<legend>Compare Properties</legend>\n";
  825   print "<dl><dd>\n";
  826   print "<table class=\"table table-condensed table-striped\">\n";
  827   print "<tr>\n";
  828   print "<th><a href=\"$DocumentDirectory/Fuzz.html\" target=\"help\">Fuzz</a></th>\n";
  829   print "<th><a href=\"$DocumentDirectory/Metric.html\" target=\"help\">Metric</a></th>\n";
  830   print "<th><a href=\"$DocumentDirectory/Channel.html\" target=\"help\">Channel Type</a></th>\n";
  831   print "</tr>\n";
  832   print "<tr>\n";
  833   print '<td>', $q->textfield(-class=>'form-control',-name=>'Fuzz',-size=>25,
  834     -value=>'0%'), "</td>\n";
  835   my @types=Image::Magick->QueryOption('metric');
  836   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'MetricType',
  837     -values=>[@types],-default=>'NCC'), "</td>\n";
  838   my @channels=Image::Magick->QueryOption('channel');
  839   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'ChannelType',
  840     -values=>[@channels],default=>'Default'), "</td>\n";
  841   print "</tr>\n";
  842   print '</table><br />';
  843   print "</dd></dl>\n";
  844   print "<dt>Miscellaneous options:</dt>\n";
  845   print '<dd> ', $q->checkbox(-name=>'Clipboard',
  846     -label=>' use clipboard image as source for compare.'), "</dd>\n";
  847   print "</fieldset>\n";
  848   print $q->end_form, "\n";
  849   print <<XXX;
  850 <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br />
  851 XXX
  852   ;
  853   Trailer(1);
  854 }
  855 
  856 #
  857 # Composite image.
  858 #
  859 sub Composite
  860 {
  861   no strict 'refs';
  862 
  863   use Image::Magick;
  864   use File::Copy;
  865 
  866   my($color, $compose, $composite, $extent, @extents, $filename, $gravity,
  867      $geometry, $i, $image, $path, $opacity, $rotate, $slice, $status, $tile);
  868 
  869   #
  870   # Read image.
  871   #
  872   $path=Untaint($q->param('Path'));
  873   chdir($path) || Error('Your image has expired',$path);
  874   $image=Image::Magick->new;
  875   $status=$image->Read("$path/MagickStudio.mpc");
  876   Error($status) if $#$image < 0;
  877   #
  878   # Read composite image.
  879   #
  880   if ($q->param('CompositeURL')) {
  881     $filename=Untaint($q->param('CompositeURL'));
  882     getstore($filename,'MagickStudio.dat');
  883   } else {
  884     $filename=Untaint($q->param('CompositeFile')) if $q->param('CompositeFile');
  885     $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
  886       $q->param('SessionID') if $q->param('Clipboard') eq 'on';
  887     copy($q->upload('CompositeFile'),'MagickStudio.dat') ||
  888       copy(\*$filename,'MagickStudio.dat') ||
  889         (getstore($filename,'MagickStudio.dat') eq '200') ||
  890           Error('Unable to composite image',$filename);
  891   }
  892   Error('Unable to read image file',$filename)
  893     unless (-f 'MagickStudio.dat') && (-s 'MagickStudio.dat');
  894   Error('Image size exceeds maximum allowable',$filename)
  895     unless (-s 'MagickStudio.dat') < (1024*$MaxFilesize);
  896   $composite=Image::Magick->new;
  897   @extents=$composite->Ping("MagickStudio.dat");
  898   $extent=0;
  899   for ($i=0; $i < $#extents; $i+=4) { $extent+=$extents[$i]*$extents[$i+1]; }
  900   Error('Image extent exceeds maximum allowable') if $extent &&
  901     ($extent > (1024*$MaxImageExtent));
  902   $status=$composite->Read('MagickStudio.dat');
  903   Error("unable to read your image",$filename) if $#$composite < 0;
  904   unlink('MagickStudio.dat');
  905   #
  906   # Composite image.
  907   #
  908   if (($#$image == 0) && ($#$composite > 0))
  909     {
  910       my($delay);
  911 
  912       #
  913       # Composite an animation on a background image.
  914       #
  915       $i=$#$composite-$#$image+1;
  916       $image=$image->Morph(frames=>$i);
  917       for ($i=0; $image->[$i]; $i++)
  918       {
  919         $delay=$composite->[$i]->Get('delay');
  920         $image->Set(delay=>$delay) if $delay;
  921       }
  922     }
  923   $color='none';
  924   $color=$q->param('BackgroundColor') if $q->param('BackgroundColor');
  925   $compose=$q->param('ComposeType');
  926   $geometry='+0+0';
  927   $geometry=$q->param('Geometry') if $q->param('Geometry');
  928   $gravity='Undefined';
  929   $gravity=$q->param('Gravity') if $q->param('Gravity');
  930   $rotate=0.0;
  931   $rotate=$q->param('Rotate') if $q->param('Rotate');
  932   $tile=0;
  933   $tile=$q->param('Tile') eq 'on' if $q->param('Tile');
  934   for ($i=0; $image->[$i]; $i++)
  935   {
  936     $slice=$composite->[$i % ($#$composite+1)];
  937     $slice->Resize(width=>$image->[$i]->Get('width'),
  938       height=>$image->[$i]->Get('height')) if $q->param('Resize') eq 'on';
  939     $image->[$i]->Composite(compose=>$compose,image=>$slice,gravity=>$gravity,
  940       geometry=>$geometry,rotate=>$rotate,color=>$color,tile=>$tile);
  941   }
  942   #
  943   # Write image.
  944   #
  945   CreateWorkDirectory(1);
  946   Header(GetTitle($image));
  947   $status=$image->Write(filename=>'MagickStudio.mpc');
  948   Error($status) if "$status";
  949   ViewForm($image);
  950 }
  951 
  952 #
  953 # Composite image form.
  954 #
  955 sub CompositeForm
  956 {
  957   my($action);
  958 
  959   #
  960   # Composite image form.
  961   #
  962   Header(GetTitle(undef));
  963   print <<XXX;
  964 <p class="lead magick-description">To <a href="$DocumentDirectory/Composite.html" target="help">composite</a> your image, press <code>Browse</code> and select your image file or enter the Uniform Resource Locator of your image.  Next, choose the location of the composite image and the type of composite operation.  Finally, press <code>composite</code> to continue.</p>
  965 XXX
  966   ;
  967   $action=$q->script_name() . "?CacheID=" . $q->param('CacheID') .
  968     ";Action=composite";
  969   print $q->start_multipart_form(-action=>$action,-class=>'form-horizontal');
  970   print $q->hidden(-name=>'SessionID'), "\n";
  971   print $q->hidden(-name=>'Path'), "\n";
  972   print $q->hidden(-name=>'ToolType'), "\n";
  973   print $q->hidden(-name=>'Name'), "\n";
  974   print $q->hidden(-name=>'Magick'), "\n";
  975   print "<dt><a href=\"$DocumentDirectory/Filename.html\" target=\"help\">",
  976     "Filename</a>:</dt>\n";
  977   print '<dd>', $q->filefield(-name=>'CompositeFile',-size=>50,
  978     -maxlength=>1024), "</dd><br />\n";
  979   print "<dt><a href=\"$DocumentDirectory/URL.html\" target=\"help\">",
  980     "URL</a>:</dt>\n";
  981   print '<dd>', $q->textfield(-class=>'form-control',-name=>'CompositeURL',
  982     -size=>50), "</dd><br />\n";
  983   print "<dd><table class=\"table table-condensed table-striped\">\n";
  984   print "<tr>\n";
  985   print "<th>Offset</th>\n";
  986   print "<th>Gravity</th>\n";
  987   print "</tr>\n";
  988   print "<tr>\n";
  989   print '<td>', $q->textfield(-class=>'form-control',-name=>'Geometry',
  990     -size=>25,-value=>'+0+0'), "</td>\n";
  991   my @types=Image::Magick->QueryOption('gravity');
  992   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Gravity',
  993     -values=>[@types],-default=>'Center'), "</td>\n";
  994   print "</tr>\n";
  995   print '</table></dd><br />';
  996   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
  997     -value=>'composite'), ' your image or ', $q->reset(-name=>'reset',
  998     -class=>'btn btn-warning'), " the form.<br /><br />\n";
  999   print "<br />\n";
 1000   print "<fieldset>\n";
 1001   print "<legend>Composite Properties</legend>\n";
 1002   print "<dl><dd>\n";
 1003   print "<table class=\"table table-condensed table-striped\">\n";
 1004   print "<tr>\n";
 1005   print "<th>Blend</th>\n";
 1006   print "<th>Compose</th>\n";
 1007   print "</tr>\n";
 1008   print "<tr>\n";
 1009   print '<td>', $q->textfield(-class=>'form-control',-name=>'Blend',-size=>25,
 1010     -value=>'0%'), "</td>\n";
 1011   my @types=Image::Magick->QueryOption('compose');
 1012   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'ComposeType',
 1013     -values=>[@types],-default=>'SrcOver'), "</td>\n";
 1014   print "</tr>\n";
 1015   print '</table></dd><br />';
 1016   print "<dd><table class=\"table table-condensed table-striped\">\n";
 1017   print "<tr>\n";
 1018   print "<th>Rotate</th>\n";
 1019   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">",
 1020     "Background Color</a></th>\n";
 1021   print "</tr>\n";
 1022   print "<tr>\n";
 1023   print '<td>', $q->textfield(-class=>'form-control',-name=>'Rotate',-size=>25,
 1024     -value=>'0.0'), "</td>\n";
 1025   print '<td>', $q->textfield(-class=>'form-control',-name=>'BackgroundColor',
 1026     -value=>'none',-size=>25), "</td>\n";
 1027   print "</tr>\n";
 1028   print '</table></dd><br />';
 1029   print "<dt>Miscellaneous options:</dt>\n";
 1030   print '<dd> ', $q->checkbox(-name=>'Tile',
 1031     -label=>' tile across and down the image canvas.'), "</dd>\n";
 1032   print '<dd> ', $q->checkbox(-name=>'Resize',
 1033     -label=>' resize to fit.'),"</dd>\n";
 1034   print '<dd> ', $q->checkbox(-name=>'Clipboard',
 1035     -label=>' use clipboard image as source for composite.'), "</dd>\n";
 1036   print "</dd></dl>\n";
 1037   print "</fieldset>\n";
 1038   print $q->end_form, "\n";
 1039   print <<XXX;
 1040 XXX
 1041   ;
 1042   Trailer(1);
 1043 }
 1044 
 1045 #
 1046 # Create a temporary work area for image files.
 1047 #
 1048 sub CreateWorkDirectory
 1049 {
 1050   use Digest::SHA3;
 1051 
 1052   my($check) = @_;
 1053 
 1054   my($digest, $path);
 1055 
 1056 #  CheckStudioHours();
 1057   CheckStudioStatus() if $check;
 1058   $path=$DocumentRoot . $DocumentDirectory . '/workarea';
 1059   chdir($path) || Error('Your image has expired',$path);
 1060   umask(002);
 1061   $digest=Digest::SHA3->new(512);
 1062   $digest->add($HashDigestSalt,$q->remote_addr(),time(),{},rand(),$$);
 1063   $path.='/' . $digest->hexdigest;
 1064   $ENV{TMPDIR}=$path;
 1065   mkdir($path,0775);
 1066   chdir($path) || Error('Your image has expired',$path);
 1067   $q->param(-name=>'Path',-value=>$path);
 1068 }
 1069 
 1070 #
 1071 # Decorate image.
 1072 #
 1073 sub Decorate
 1074 {
 1075   use Image::Magick;
 1076 
 1077   my($color, $compose, $geometry, $image, $path, $status);
 1078 
 1079   #
 1080   # Read image.
 1081   #
 1082   $path=Untaint($q->param('Path'));
 1083   chdir($path) || Error('Your image has expired',$path);
 1084   $image=Image::Magick->new;
 1085   $status=$image->Read("$path/MagickStudio.mpc");
 1086   Error($status) if $#$image < 0;
 1087   #
 1088   # Decorate image.
 1089   #
 1090   $compose=$q->param('ComposeType');
 1091   $image->Set(compose=>$compose);
 1092   $geometry='+0+0';
 1093   $geometry=$q->param('Geometry') if $q->param('Geometry');
 1094   $color='none';
 1095   $color=$q->param('Color') if $q->param('Color');
 1096   $image->Border(geometry=>$geometry,bordercolor=>$color,compose=>$compose)
 1097     if $q->param('Option') eq 'border *';
 1098   $image->Frame(geometry=>$geometry,fill=>$color,compose=>$compose)
 1099     if $q->param('Option') eq 'frame *';
 1100   $image->Raise(geometry=>$geometry,raise=>'true')
 1101     if $q->param('Option') eq 'raise *';
 1102   $image->Raise(geometry=>$geometry,raise=>'False')
 1103     if $q->param('Option') eq 'sunken *';
 1104   #
 1105   # Write image.
 1106   #
 1107   CreateWorkDirectory(1);
 1108   Header(GetTitle($image));
 1109   $status=$image->Write(filename=>'MagickStudio.mpc');
 1110   Error($status) if "$status";
 1111   ViewForm($image);
 1112 }
 1113 
 1114 #
 1115 # Decorate image form.
 1116 #
 1117 sub DecorateForm
 1118 {
 1119   my @OptionTypes=
 1120   [
 1121     'border *',
 1122     'frame *',
 1123     'raise *',
 1124     'sunken *'
 1125   ];
 1126 
 1127   #
 1128   # Display Decorate form.
 1129   #
 1130   Header(GetTitle(undef));
 1131   print <<XXX;
 1132 <p class="lead magick-description">To <a href="$DocumentDirectory/Decorate.html" target="help">decorate</a> your image with a border or frame, set your options below and press <code>decorate</code>.</p>
 1133 XXX
 1134   ;
 1135   print $q->start_form(-class=>'form-horizontal');
 1136   print $q->hidden(-name=>'CacheID'), "\n";
 1137   print $q->hidden(-name=>'SessionID'), "\n";
 1138   print $q->hidden(-name=>'Path'), "\n";
 1139   print $q->hidden(-name=>'ToolType'), "\n";
 1140   print $q->hidden(-name=>'Name'), "\n";
 1141   print $q->hidden(-name=>'Magick'), "\n";
 1142   print "<dt>Decoration geometry:</dt>\n";
 1143   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Geometry',
 1144     -size=>25,-value=>'15x15+3+3'), "</dd><br />\n";
 1145   print "<dt><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Color</a>:</dt>\n";
 1146   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Color',-size=>25,
 1147     -value=>'gray'), "</dd><br />\n";
 1148   print "<dt>Choose from these decorations:</dt>\n";
 1149   print '<dd>', $q->radio_group(-name=>'Option',-values=>@OptionTypes,
 1150     -columns=>5,-default=>'frame *'), "</dd><br />\n";
 1151   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
 1152     -value=>'decorate'), ' your image or ', $q->reset(-name=>'reset',
 1153     -class=>'btn btn-warning'), " the form.<br /><br />\n";
 1154   print "<br />\n";
 1155   print "<fieldset>\n";
 1156   print "<legend>Decorate Properties</legend>\n";
 1157   print "<dl><dd>\n";
 1158   print "<table class=\"table table-condensed table-striped\">\n";
 1159   print "<tr>\n";
 1160   print "<th>Compose</th>\n";
 1161   print "</tr>\n";
 1162   print "<tr>\n";
 1163   my @types=Image::Magick->QueryOption('compose');
 1164   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'ComposeType',
 1165     -values=>[@types],-default=>'SrcOver'), "</td>\n";
 1166   print "</tr>\n";
 1167   print '</table><br />';
 1168   print "</dd></dl>\n";
 1169   print "</fieldset>\n";
 1170   print $q->end_form, "\n";
 1171   print <<XXX;
 1172 <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br />
 1173 XXX
 1174   ;
 1175   Trailer(1);
 1176 }
 1177 
 1178 #
 1179 # Download the image in the same or differing image format.
 1180 #
 1181 sub Download
 1182 {
 1183   use Image::Magick;
 1184 
 1185   my($basename, $coalesce, $format, $height, $hostname, $i, $image, $montage,
 1186      $path, $prefix, $size, $status, $url, $username, $value, $width, $x, $y);
 1187 
 1188   #
 1189   # Read image.
 1190   #
 1191   $path=Untaint($q->param('Path'));
 1192   chdir($path) || Error('Your image has expired',$path);
 1193   $image=Image::Magick->new;
 1194   $status=$image->Read("$path/MagickStudio.mpc");
 1195   Error($status) if $#$image < 0;
 1196   #
 1197   # Write image.
 1198   #
 1199   CreateWorkDirectory(undef);
 1200   Header(GetTitle($image));
 1201   $status=$image->Write(filename=>'MagickStudio.mpc');
 1202   Error($status) if "$status";
 1203   #
 1204   # Convert the image to the selected format.
 1205   #
 1206   $image->Set(page=>'0x0+0+0') if $q->param('Repage') eq 'on';
 1207   $image->Strip() if $q->param('Strip') eq 'on';
 1208   $value=$q->param('Type');
 1209   $image->Set(type=>$value) if $value ne 'Implicit';
 1210   $value=$q->param('Channel');
 1211   $image->Separate($value) unless $value eq 'All';
 1212   $image->Set(font=>$DefaultFont);
 1213   $value=$q->param('Compress');
 1214   $image->Set(compression=>$value) if $value ne 'Default';
 1215   $value=$q->param('Page'); $value=~s/ //g;
 1216   $image->Set(page=>$value) if length($value) > 0;
 1217   $value=$q->param('Delay');
 1218   $image->Set(delay=>$value) if length($value) > 0;
 1219   $value=$q->param('Depth');
 1220   $image->Set(depth=>$value) if length($value) > 0;
 1221   $value=$q->param('Dispose');
 1222   $image->Set(dispose=>$value) unless $value eq 'Undefined';
 1223   $value=$q->param('Loop');
 1224   $image->Set(loop=>$value) if length($value) > 0;
 1225   $value=$q->param('Quality');
 1226   $image->Set(quality=>$value) if length($value) > 0;
 1227   $value=$q->param('Interlace');
 1228   $image->Set(interlace=>$value);
 1229   $value=$q->param('Preview');
 1230   $image->Set(preview=>$value);
 1231   $image->Set(pointsize=>10);
 1232   $image->Set(adjoin=>1);
 1233   $image->Set(adjoin=>0) if $q->param('Option') eq 'single file';
 1234   $image->Set(colorspace=>'CMYK') if
 1235     $q->param('CMYK') && ($q->param('CMYK') eq 'on');
 1236   $value=$q->param('Alpha');
 1237   $image->Set(alpha=>$value) unless $value eq 'Undefined';
 1238   $value=$q->param('Comment');
 1239   $image->Comment($value) if length($value) > 0;
 1240   if ($q->param('Option') eq 'append')
 1241     {
 1242       my($append_image);
 1243 
 1244       $value='True';
 1245       $value='False' if $q->param('Stack') eq 'on';
 1246       $image=$image->Append(stack=>$value);
 1247       if (ref($append_image))
 1248         {
 1249           #
 1250           # Append the image sequence.
 1251           #
 1252           undef $image;
 1253           $image=$append_image;
 1254         }
 1255     }
 1256   if ($q->param('Option') eq 'smush')
 1257     {
 1258       my($offset,$smush_image);
 1259 
 1260       $offset=$q->param('offset');
 1261       $value='True';
 1262       $value='False' if $q->param('Stack') eq 'on';
 1263       $image=$image->Smush(stack=>$value,offset=>$offset);
 1264       if (ref($smush_image))
 1265         {
 1266           #
 1267           # Smush the image sequence.
 1268           #
 1269           undef $image;
 1270           $image=$smush_image;
 1271         }
 1272     }
 1273   $prefix='';
 1274   $prefix=$q->param('Option') . ':' if
 1275     ($q->param('Option') eq 'histogram') || ($q->param('Option') eq 'preview');
 1276   $basename=$q->param('Name');
 1277   $format='png';
 1278   if (length($q->param('Passphrase')) > 0)
 1279     {
 1280       my($passphrase);
 1281 
 1282       $passphrase=$q->param('Passphrase');
 1283       $image->Encipher($passphrase);
 1284     }
 1285   $coalesce=$image->Coalesce();
 1286   if ($#$coalesce > 0)
 1287     {
 1288       $format='gif';
 1289       $coalesce->Set(loop=>0,delay=>800) if $coalesce->Get('iterations') == 1;
 1290       $image=$coalesce if $q->param('Coalesce') eq 'on';
 1291     }
 1292   $status=$coalesce->Write("$basename.$format");
 1293   Error($status) if "$status";
 1294   $format=$q->param('Magick');
 1295   $format=$q->param('Format') if $q->param('Format');
 1296   $format='jpg' if $format =~ /jpeg/;
 1297   $image->Set(magick=>$format);
 1298   for ($i=0; $image->[$i]; $i++)
 1299   { $image->[$i]->Set(scene=>$i); }
 1300   if ($q->param('Option') eq 'clipboard')
 1301     {
 1302       my($clipboard, $filename);
 1303 
 1304       #
 1305       # Paste file to clipboard.
 1306       #
 1307       $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 1308         $q->param('SessionID');
 1309       $status=$image->Write(filename=>"$filename.mpc");
 1310       Error($status) if "$status";
 1311       $clipboard=$image->Clone();
 1312       $clipboard->Resize($IconSize);
 1313       $status=$clipboard->Write("$filename.gif");
 1314       Error($status) if "$status";
 1315     }
 1316   if ($#$image > 0)
 1317     {
 1318       $status=$image->Write(filename=>"$prefix$basename.$format",adjoin=>1);
 1319       Error($status) if "$status";
 1320       $status=$image->Write(filename=>'Animate.gif',adjoin=>1);
 1321       Error($status) if "$status";
 1322     }
 1323   if (($q->param('Option') ne 'single file') || ($#$image == 0))
 1324     {
 1325       $status=$image->Write("$prefix$basename.$format");
 1326       Error($status) if "$status";
 1327     }
 1328   else
 1329     {
 1330       my($filename);
 1331 
 1332       $filename="$prefix$basename" . '%d.' . "$format";
 1333       $status=$image->Write(filename=>$filename);
 1334       Error($status) if "$status";
 1335     }
 1336   if (($q->param('Option') eq 'histogram') ||
 1337       ($q->param('Option') eq 'preview'))
 1338     {
 1339       undef @$image;
 1340       $status=$image->Read("$basename.$format");
 1341       Error($status) if $#$image < 0;
 1342       $status=$image->Write("$basename.$format");
 1343       Error($status) if "$status";
 1344     }
 1345   #
 1346   # Label image.
 1347   #
 1348   for ($i=0; $image->[$i]; $i++)
 1349   {
 1350     $image->[$i]->Label($image->[$i]->Get('filename'));
 1351     next if $i == 0;
 1352     $image->[$i]->Label($image->[$i]->Get('scene')) if
 1353       $image->[0]->Get('filename') eq $image->[$i]->Get('filename');
 1354   }
 1355   $montage=$image->Montage(background=>'#efefef',borderwidth=>0,
 1356     geometry=>'120x120+2+2>',gravity=>'Center',font=>$DefaultFont,
 1357     fill=>'black',transparent=>'#efefef');
 1358   Error($montage) if !ref($montage);
 1359   $montage->Set(page=>'0x0+0+0');
 1360   $status=$montage->Write('MagickStudio.gif');
 1361   Error($status) if "$status";
 1362   #
 1363   # Display images to the user.
 1364   #
 1365   $url=substr($q->param('Path'),length($DocumentRoot));
 1366   print <<XXX;
 1367 <p>Here is your converted image (or images).  Click on any image to view or precede your click by the shift key to download it to your local area or press <code>upload</code> to transfer the image to a remote site.</p>
 1368 <center>
 1369 XXX
 1370   ;
 1371   if ($#$image > 0)
 1372     {
 1373       #
 1374       # Display animated image.
 1375       #
 1376       ($width,$height)=$image->Get('width','height');
 1377       print <<XXX;
 1378 <p><a href="$url/$basename.$format"> <img alt="$basename.$format" src="$url/Animate.gif" width=$width height=$height border="0" /></a></p>
 1379 XXX
 1380   ;
 1381     }
 1382   ($width,$height)=$montage->Get('width','height');
 1383   print <<XXX;
 1384 <p><img ismap usemap=#Montage src="$url/MagickStudio.gif" width=$width height=$height border="0" /></p>
 1385 <map name=Montage>
 1386 XXX
 1387   ;
 1388   $montage->Get('montage')=~/(\d+\.*\d*)x(\d+\.*\d*)\+(\d+\.*\d*)\+(\d+\.*\d*)/;
 1389   $width=$1;
 1390   $height=$2;
 1391   $x=$3;
 1392   $y=$4;
 1393   for (split(/\xff/,$montage->Get('directory')))
 1394   {
 1395     print "  <area href=\"$url/$_\"", " shape=rect coords=$x,$y,",
 1396       $x+$width-1, ',', $y+$height-1, " target=\"", rand($timer+$$), "\">\n";
 1397     $x+=$width;
 1398     if ($x >= $montage->Get('width'))
 1399       {
 1400         $x=0;
 1401         $y+=$height;
 1402       }
 1403   }
 1404   $hostname=$q->server_name();
 1405   print <<XXX;
 1406 </map>
 1407 <br /> <br /> <br />
 1408 </center>
 1409 XXX
 1410   ;
 1411   print "* <i>this image was saved to the ImageMagick Studio clipboard.</i><br />"
 1412     if $q->param('Option') eq 'clipboard';
 1413   #
 1414   # Image upload form.
 1415   #
 1416   RestoreQueryState($q->param('SessionID'),$q->param('Path'),'FileTransfer');
 1417   print $q->start_form(-class=>'form-horizontal');
 1418   print $q->hidden(-name=>'CacheID'), "\n";
 1419   print $q->hidden(-name=>'SessionID'), "\n";
 1420   print $q->hidden(-name=>'Path'), "\n";
 1421   print $q->hidden(-name=>'ToolType'), "\n";
 1422   print $q->hidden(-name=>'Name'), "\n";
 1423   print $q->hidden(-name=>'Magick'), "\n";
 1424   print $q->hidden(-name=>'Action',-class=>'btn btn-primary',
 1425     -value=>'upload'), "\n";
 1426   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
 1427     -value=>'upload'), ' your image to a remote site or ', $q->reset(
 1428     -name=>'reset',-class=>'btn btn-warning'), " the form.<br /><br />\n";
 1429   print "<br />\n";
 1430   print "<fieldset>\n";
 1431   print "<legend>Upload Properties</legend>\n";
 1432   print "<dl>\n";
 1433   $hostname=GetHostname($q->remote_host());
 1434   print "<dt><a href=\"$DocumentDirectory/Upload.html\" target=\"help\">FTP server name</a>:\n";
 1435   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Hostname',
 1436     -size=>50,-value=>$hostname), "<br />\n";
 1437   print "<dt><a href=\"$DocumentDirectory/Upload.html\" target=\"help\">Account name</a>:\n";
 1438   $username='anonymous';
 1439   $username=$q->remote_user() if $q->remote_user();
 1440   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Username',
 1441     -size=>25,-value=>$username), "<br />\n";
 1442   print "<dt><a href=\"$DocumentDirectory/Upload.html\" target=\"help\">Account password</a>:\n";
 1443   print '<dd>', $q->password_field(-name=>'Password',-size=>25), "<br />\n";
 1444   print "<dt><a href=\"$DocumentDirectory/Upload.html\" target=\"help\">Upload directory</a>:\n";
 1445   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Directory',
 1446     -size=>50), "<br />\n";
 1447   print "<dt><a href=\"$DocumentDirectory/Upload.html\" target=\"help\">Filename</a>:\n";
 1448   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Filename',
 1449     -size=>50, -value=>"$basename.$format"), "<br />\n";
 1450   print "</dl>\n";
 1451   print "</fieldset>\n";
 1452   print $q->end_form, "\n";
 1453   Trailer(undef);
 1454 }
 1455 
 1456 #
 1457 # Download image form.
 1458 #
 1459 sub DownloadForm
 1460 {
 1461   my($format, @formats, $image, @OptionTypes, $path, $status);
 1462 
 1463   @OptionTypes=
 1464   [
 1465     'append',
 1466     'clipboard',
 1467     'histogram',
 1468     'multi-frame file',
 1469     'preview',
 1470     'single file',
 1471     'smush'
 1472   ];
 1473 
 1474   #
 1475   # Read image.
 1476   #
 1477   $path=Untaint($q->param('Path'));
 1478   chdir($path) || Error('Your image has expired',$path);
 1479   $image=Image::Magick->new;
 1480   $status=$image->Read("$path/MagickStudio.mpc");
 1481   Error($status) if $#$image < 0;
 1482   #
 1483   # Display Download form.
 1484   #
 1485   Header(GetTitle($image));
 1486   print <<XXX;
 1487 <p class="lead magick-description">Choose an <a href="$DocumentDirectory/Download.html" target="help">output</a> image format and set any optional image attributes below.  Some attributes are only relevant to specific output formats.  Next, press <code>output</code> to convert your image to the selected format.  The image is converted and you are given an opportunity to download it to your local area.</p>
 1488 XXX
 1489   ;
 1490   print $q->start_form(-class=>'form-horizontal');
 1491   print $q->hidden(-name=>'CacheID'), "\n";
 1492   print $q->hidden(-name=>'SessionID'), "\n";
 1493   print $q->hidden(-name=>'Path'), "\n";
 1494   print $q->hidden(-name=>'ToolType'), "\n";
 1495   print $q->hidden(-name=>'Name'), "\n";
 1496   print $q->hidden(-name=>'Magick'), "\n";
 1497   print $q->hidden(-name=>'Action',-class=>'btn btn-primary',-value=>'output'),
 1498     "\n";
 1499   print "<dt><a href=\"$DocumentDirectory/Format.html\" target=\"help\">Format</a>:</dt>\n";
 1500   $format=$q->param('Magick');
 1501   @formats=$image->QueryFormat();
 1502   print '<dd>', $q->scrolling_list(-class=>'form-control',-name=>'Format',
 1503     -values=>[@formats],-size=>7,-default=>$format), "</dd><br />\n";
 1504   print "<dt><a href=\"$DocumentDirectory/Storage.html\" target=\"help\">Storage type</a>:</dt>\n";
 1505   print '<dd>', $q->radio_group(-name=>'Option',-values=>@OptionTypes,
 1506     -columns=>3,-default=>'multi-frame file'), "</dd><br />\n";
 1507   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
 1508     -value=>'output'), ' your image or ', $q->reset(-name=>'reset',
 1509     -class=>'btn btn-warning'), " the form.<br /><br />\n";
 1510   print "<br />\n";
 1511   print "<fieldset>\n";
 1512   print "<legend>Download Properties</legend>\n";
 1513   print "<dl><dd>\n";
 1514   print "<table class=\"table table-condensed table-striped\">\n";
 1515   print "<tr>\n";
 1516   print "<th>Image Type</th>\n";
 1517   print "<th>Compress</th>\n";
 1518   print "<th><a href=\"$DocumentDirectory/Channel.html\" target=\"help\">Channel</a></th>\n";
 1519   print "<th>Alpha</th>\n";
 1520   print "</tr>\n";
 1521   print "<tr>\n";
 1522   my @types=Image::Magick->QueryOption('type');
 1523   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Type',
 1524     -values=>[@types]), "</td>\n";
 1525   my @types=Image::Magick->QueryOption('compress');
 1526   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Compress',-values=>[@types]), "</td>\n";
 1527   my @channels=Image::Magick->QueryOption('channel');
 1528   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Channel',
 1529     -values=>[@channels],-default=>'All'), "</td>\n";
 1530   my @types=Image::Magick->QueryOption('Alpha');
 1531   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Alpha',
 1532     -values=>[@types],-default=>'Undefined'), "</td>\n";
 1533   print "</tr>\n";
 1534   print "</table><br />\n";
 1535   print "<table class=\"table table-condensed table-striped\">\n";
 1536   print "<tr>\n";
 1537   print "<th>Dispose</th>\n";
 1538   print "<th><a href=\"$DocumentDirectory/Interlace.html\" target=\"help\">Interlace</a></th>\n";
 1539   print "<th>Preview</th>\n";
 1540   print "</tr>\n";
 1541   print "<tr>\n";
 1542   my @types=Image::Magick->QueryOption('dispose');
 1543   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Dispose',
 1544     -values=>[@types],-default=>'Undefined'), "</td>\n";
 1545   my @types=Image::Magick->QueryOption('interlace');
 1546   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Interlace',
 1547     -values=>[@types],-default=>'None'), "</td>\n";
 1548   my @types=Image::Magick->QueryOption('preview');
 1549   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Preview',
 1550     -values=>[@types]), "</td>\n";
 1551   print "</tr>\n";
 1552   print "</table><br />\n";
 1553   print "<table class=\"table table-condensed table-striped\">\n";
 1554   print "<tr>\n";
 1555   print "<th><a href=\"$DocumentDirectory/Delay.html\" target=\"help\">Delay</a></th>\n";
 1556   print "<th><a href=\"$DocumentDirectory/Loop.html\" target=\"help\">Loop</a></th>\n";
 1557   print "<th><a href=\"$DocumentDirectory/Quality.html\" target=\"help\">Quality</a></th>\n";
 1558   print "</tr>\n";
 1559   print "<tr>\n";
 1560   print '<td>', $q->textfield(-class=>'form-control',-name=>'Delay',-size=>15,
 1561     -value=>$image->Get('delay')), "</td>\n";
 1562   print '<td>', $q->textfield(-class=>'form-control',-name=>'Loop',-size=>15,
 1563     -value=>$image->Get('loop')), "</td>\n";
 1564   print '<td>', $q->textfield(-class=>'form-control',-name=>'Quality',-size=>15,
 1565     -value=>$image->Get('quality')), "</td>\n";
 1566   print "</tr>\n";
 1567   print "</table><br />\n";
 1568   print "<dt>Image Depth</dt>\n";
 1569   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Depth',-size=>25,
 1570     -value=>$image->Get('depth')), "</dd><br />\n";
 1571   print "<dt>Smush Offset</dt>\n";
 1572   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Offset',-size=>25,
 1573     -value=>2), "</dd><br />\n";
 1574   print "<dt><a href=\"$DocumentDirectory/Page.html\" target=\"help\">",
 1575     "Page Geometry</a></dt>\n";
 1576   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Page',-size=>25),
 1577     "</dd><br />\n";
 1578   print "<dt><a href=\"$DocumentDirectory/Passphrase.html\" target=\"help\">",
 1579     "Passphrase</a></dt>\n";
 1580   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Passphrase',
 1581     -size=>25), "</dd><br />\n";
 1582   print "<dt>Comment:</dt>\n";
 1583   print '<dd>', $q->textarea(-class=>'form-control',-name=>'Comment',
 1584     -columns=>50,-rows=>3,-value=>$image->Get('comment')), "</dd><br />\n";
 1585   print "<dt> Miscellaneous options:</dt>\n";
 1586   print '<dd>', $q->checkbox(-name=>'Repage',
 1587     -label=>' reset page geometry.'), "</dd>\n";
 1588   print '<dd>', $q->checkbox(-name=>'Coalesce',
 1589     -checked=>'true',-label=>' coalesce multi-frame images.'), "</dd>\n";
 1590   print '<dd>', $q->checkbox(-name=>'Strip',
 1591     -label=>' strip image of any comments or profiles.'), "</dd>\n";
 1592   print '<dd> ', $q->checkbox(-name=>'CMYK',
 1593     -label=>' save image as CMYK pixels (JPEG, TIFF, PS, PDF, PSD)'), "</dd>\n";
 1594   print '<dd> ', $q->checkbox(-name=>'Stack',
 1595     -label=>' stack images left-to-right (when storage type is append)'),
 1596     "</dd>\n";
 1597   print "</dd></dl>\n";
 1598   print "</fieldset>\n";
 1599   print $q->end_form, "\n";
 1600   print <<XXX;
 1601 XXX
 1602   ;
 1603   Trailer(undef);
 1604 }
 1605 
 1606 #
 1607 # Draw image.
 1608 #
 1609 sub Draw
 1610 {
 1611   use Image::Magick;
 1612 
 1613   my($antialias, $fill, $image, $path, $points, $primitive, $rotate, $scale,
 1614     $skew_x, $skew_y, $status, $stroke, $strokewidth, $translate, $x, $y);
 1615 
 1616   #
 1617   # Read image.
 1618   #
 1619   $path=Untaint($q->param('Path'));
 1620   chdir($path) || Error('Your image has expired',$path);
 1621   $image=Image::Magick->new;
 1622   $status=$image->Read("$path/MagickStudio.mpc");
 1623   Error($status) if $#$image < 0;
 1624   #
 1625   # Draw image.
 1626   #
 1627   $antialias='false';
 1628   $antialias='true' if $q->param('Antialias') eq 'on';
 1629   $fill='none';
 1630   $fill=$q->param('Fill') if $q->param('Fill');
 1631   $points='+10+10 +60+60';
 1632   $points=$q->param('Coordinates') if $q->param('Coordinates');
 1633   $primitive=$q->param('Primitive');
 1634   $rotate=0.0;
 1635   $rotate=$q->param('Rotate') if $q->param('Rotate');
 1636   $scale='0.0, 0.0';
 1637   $scale=$q->param('Scale') if $q->param('Scale');
 1638   $skew_x=0.0;
 1639   $skew_x=$q->param('SkewX') if $q->param('SkewX');
 1640   $skew_y=0.0;
 1641   $skew_y=$q->param('SkewY') if $q->param('SkewY');
 1642   $stroke='none';
 1643   $stroke=$q->param('Stroke') if $q->param('Stroke');
 1644   $strokewidth=1;
 1645   $strokewidth=$q->param('StrokeWidth') if $q->param('StrokeWidth');
 1646   $translate='0.0, 0.0';
 1647   $translate=$q->param('Translate') if $q->param('Translate');
 1648   $x=0;
 1649   $y=0;
 1650   ($x,$y)=split(/[ ,]+/,$q->param('Translate')) if $q->param('Translate');
 1651   if (!$q->param('Tile') || ($q->param('Tile') ne 'on'))
 1652     {
 1653       $image->Draw(primitive=>$primitive,fill=>$fill,stroke=>$stroke,
 1654         strokewidth=>$strokewidth,points=>$points,x=>$x,y=>$y,
 1655         translate=>$translate,scale=>$scale,rotate=>$rotate,skewX=>$skew_x,
 1656         skewY=>$skew_y,antialias=>$antialias);
 1657     }
 1658   else
 1659     {
 1660       my($filename, $tile);
 1661 
 1662       $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 1663         $q->param('SessionID') . '.mpc';
 1664       $tile=Image::Magick->new;
 1665       $status=$tile->Read($filename);
 1666       Error($status) if $#$tile < 0;
 1667       $image->Draw(primitive=>$primitive,fill=>$fill,stroke=>$stroke,
 1668         strokewidth=>$strokewidth,tile=>$tile,points=>$points,x=>$x,y=>$y,
 1669         translate=>$translate,scale=>$scale,rotate=>$rotate,skewX=>$skew_x,
 1670         skewY=>$skew_y,antialias=>$antialias);
 1671     }
 1672   #
 1673   # Write image.
 1674   #
 1675   CreateWorkDirectory(1);
 1676   Header(GetTitle($image));
 1677   $status=$image->Write(filename=>'MagickStudio.mpc');
 1678   Error($status) if "$status";
 1679   ViewForm($image);
 1680 }
 1681 
 1682 #
 1683 # Draw image form.
 1684 #
 1685 sub DrawForm
 1686 {
 1687   #
 1688   # Display draw form.
 1689   #
 1690   Header(GetTitle(undef));
 1691   print <<XXX;
 1692 <p class="lead magick-description">To <a href="$DocumentDirectory/Draw.html" target="help">draw</a> on your image, choose a drawing primitive, define it with coordinates, and press <code>draw</code>.  There are additional optional attributes below.  Set them as appropriate.</p>
 1693 XXX
 1694   ;
 1695   print $q->start_form(-class=>'form-horizontal');
 1696   print $q->hidden(-name=>'CacheID'), "\n";
 1697   print $q->hidden(-name=>'SessionID'), "\n";
 1698   print $q->hidden(-name=>'Path'), "\n";
 1699   print $q->hidden(-name=>'ToolType'), "\n";
 1700   print $q->hidden(-name=>'Name'), "\n";
 1701   print $q->hidden(-name=>'Magick'), "\n";
 1702   print "<dt>Primitive:</dt>\n";
 1703   my @types=Image::Magick->QueryOption('primitive');
 1704   print '<dd>', $q->popup_menu(-class=>'form-control',-name=>'Primitive',
 1705     -values=>[@types],-default=>'Line'), "</dd><br />\n";
 1706   print "<dt>Coordinates:</dt>\n";
 1707   print '<dd>', $q->textarea(-class=>'form-control',-name=>'Coordinates',
 1708     -columns=>50,-rows=>2,-value=>'+10+10  +60+60',-wrap=>'horizontal'),
 1709     "</dd><br />\n";
 1710   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
 1711     -value=>'draw'), ' on your image or ', $q->reset(-name=>'reset',
 1712     -class=>'btn btn-warning'), " the form.<br /><br />\n";
 1713   print "<br />\n";
 1714   print "<fieldset>\n";
 1715   print "<legend>Draw Properties</legend>\n";
 1716   print "<dl><dd>\n";
 1717   print "<table class=\"table table-condensed table-striped\">\n";
 1718   print "<tr>\n";
 1719   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Fill Color</a></th>\n";
 1720   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Stroke Color</a></th>\n";
 1721   print "<th>Stroke Width</th>\n";
 1722   print "</tr>\n";
 1723   print "<tr>\n";
 1724   print '<td>', $q->textfield(-class=>'form-control',-name=>'Fill',
 1725     -value=>'white',-size=>25),"</td>\n";
 1726   print '<td>', $q->textfield(-class=>'form-control',-name=>'Stroke',
 1727     -value=>'none',-size=>25), "</td>\n";
 1728   print '<td>', $q->textfield(-class=>'form-control',-name=>'StrokeWidth',
 1729     -size=>25,-value=>'1'), "</td>\n";
 1730   print "</tr>\n";
 1731   print '</table></dd><br />';
 1732   print "<dd><table class=\"table table-condensed table-striped\">\n";
 1733   print "<tr>\n";
 1734   print "<th>Translate</th>\n";
 1735   print "<th>Scale</th>\n";
 1736   print "<th>Rotate</th>\n";
 1737   print "</tr>\n";
 1738   print "<tr>\n";
 1739   print '<td>', $q->textfield(-class=>'form-control',-name=>'Translate',
 1740     -value=>'0.0, 0.0',-size=>25), "</td>\n";
 1741   print '<td>', $q->textfield(-class=>'form-control',-name=>'Scale',
 1742     -value=>'1.0, 1.0',-size=>25), "</td>\n";
 1743   print '<td>', $q->textfield(-class=>'form-control',-name=>'Rotate',
 1744     -value=>'0.0',-size=>25), "</td>\n";
 1745   print "</tr>\n";
 1746   print '</table><br />';
 1747   print "<dd><table class=\"table table-condensed table-striped\">\n";
 1748   print "<tr>\n";
 1749   print "<th>Skew X</th>\n";
 1750   print "<th>Skew Y</th>\n";
 1751   print "</tr>\n";
 1752   print "<tr>\n";
 1753   print '<td>', $q->textfield(-class=>'form-control',-name=>'SkewX',
 1754     -value=>'0.0',-size=>25), "</td>\n";
 1755   print '<td>', $q->textfield(-class=>'form-control',-name=>'SkewY',
 1756     -value=>'0.0',-size=>25), "</td>\n";
 1757   print "</tr>\n";
 1758   print '</table></dd><br />';
 1759   print "<dt>Miscellaneous options:</dt>\n";
 1760   print '<dd> ', $q->checkbox(-name=>'Tile',
 1761     -label=>' paint the drawing primitive with the clipboard image.'),
 1762     "</dd>\n";
 1763   print '<dd>', $q->checkbox(-name=>'Antialias',
 1764     -label=>' antialias text.',-checked=>'true'), "</dd>\n";
 1765   print "</dd></dl>\n";
 1766   print "</fieldset>\n";
 1767   print $q->end_form, "\n";
 1768   print <<XXX;
 1769 XXX
 1770   ;
 1771   Trailer(1);
 1772 }
 1773 
 1774 #
 1775 # Effects image.
 1776 #
 1777 sub Effects
 1778 {
 1779   use Image::Magick;
 1780 
 1781   my($channel, $filename, $image, $parameter, $path, $status);
 1782 
 1783   # Read image.
 1784   #
 1785   $path=Untaint($q->param('Path'));
 1786   chdir($path) || Error('Your image has expired',$path);
 1787   $image=Image::Magick->new;
 1788   $status=$image->Read("$path/MagickStudio.mpc");
 1789   Error($status) if $#$image < 0;
 1790   #
 1791   # Effects image.
 1792   #
 1793   $parameter=$q->param('Parameter');
 1794   $channel=$q->param('Channel');
 1795   $image->Set('virtual-pixel'=>$q->param('VirtualPixelMethod')) if
 1796     $q->param('VirtualPixelMethod');
 1797   $image->Set(label=>$q->param('Label')) if $q->param('Label');
 1798   $image->AdaptiveBlur(geometry=>"$parameter",channel=>$channel) if
 1799     $q->param('Option') eq 'adaptive blur *';
 1800   $image->AdaptiveSharpen(geometry=>"$parameter",channel=>$channel) if
 1801     $q->param('Option') eq 'adaptive sharpen *';
 1802   $image->BilateralBlur(geometry=>"$parameter",channel=>$channel) if
 1803     $q->param('Option') eq 'bilateral blur *';
 1804   $image->BlackThreshold(geomery=>"$parameter",channel=>$channel) if
 1805     $q->param('Option') eq 'black threshold *';
 1806   $image->Blur(geometry=>"$parameter",channel=>$channel) if
 1807     $q->param('Option') eq 'blur *';
 1808   $image->Charcoal("$parameter") if $q->param('Option') eq 'charcoal drawing *';
 1809   if ($q->param('Option') eq 'clut')
 1810     {
 1811       my($channel, $source);
 1812 
 1813       $channel=$q->param('Channel');
 1814       $source=Image::Magick->new;
 1815       $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 1816         $q->param('SessionID') . '.mpc';
 1817       $status=$source->Read($filename);
 1818       Error($status) if $#$source < 0;
 1819       if ($channel eq 'All')
 1820         { $image->Clut(image=>$source); }
 1821       else
 1822         { $image->Clut(image=>$source,channel=>$channel); }
 1823       Error($image) if !ref($image);
 1824     }
 1825   $image->ConnectedComponents("$parameter") if $q->param('Option') eq
 1826     'connected components *';
 1827   if ($q->param('Option') eq 'convolve *')
 1828     {
 1829       my(@coefficients);
 1830 
 1831       @coefficients=split(/[ ,]+/,$parameter);
 1832       $image->Convolve(\@coefficients);
 1833     }
 1834   $image->Despeckle() if $q->param('Option') eq 'despeckle';
 1835   if ($q->param('Option') eq 'distort *')
 1836     {
 1837       my(@points, $method);
 1838 
 1839       @points=split(/[ ,]+/,$parameter);
 1840       $method=$q->param('DistortType');
 1841       $image->Distort(method=>$method,points=>\@points);
 1842     }
 1843   if ($q->param('Option') eq 'evaluate *')
 1844     {
 1845       my(@values, $operator);
 1846 
 1847       @values=split(/[ ,]+/,$parameter);
 1848       $operator=$q->param('EvaluateType');
 1849       $image->Evaluate(operator=>$operator,value=>\@values);
 1850     }
 1851   if ($q->param('Option') eq 'function *')
 1852     {
 1853       my(@parameters, $function);
 1854 
 1855       @parameters=split(/[ ,]+/,$parameter);
 1856       $function=$q->param('FunctionType');
 1857       $image->Function(function=>$function,parameters=>\@parameters);
 1858     }
 1859   $image->CannyEdge("$parameter") if $q->param('Option') eq 'canny edge *';
 1860   $image->Edge("$parameter") if $q->param('Option') eq 'edge detect *';
 1861   $image->Emboss(geometry=>$parameter) if $q->param('Option') eq 'emboss *';
 1862   $image->ForwardFourierTransform("$parameter") if
 1863     $q->param('Option') eq 'forward Fourier transform';
 1864   if ($q->param('Option') eq 'Channel F(x) *')
 1865     {
 1866       my($channel);
 1867 
 1868       $channel=$q->param('Channel');
 1869       if ($q->param('Clipboard') ne 'on')
 1870         {
 1871           my $fx;
 1872 
 1873           if ($channel eq 'All')
 1874             { $image = $image->ChannelFx(expression=>$parameter); }
 1875           else
 1876             { $image = $image->ChannelFx(channel=>$channel,
 1877               expression=>$parameter); }
 1878           Error($image) if !ref($image);
 1879         }
 1880       else
 1881         {
 1882           my($source);
 1883 
 1884           #
 1885           # Read clipboard image.
 1886           #
 1887           $source=Image::Magick->new;
 1888           $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 1889             $q->param('SessionID') . '.mpc';
 1890           $status=$source->Read($filename);
 1891           Error($status) if $#$source < 0;
 1892           if ($channel eq 'All')
 1893             { $image->ChannelFx(image=>$source,expression=>$parameter); }
 1894           else
 1895             {
 1896               $image->ChannelFx(image=>$source,channel=>$channel,
 1897                 expression=>$parameter);
 1898             }
 1899           Error($image) if !ref($image);
 1900         }
 1901     }
 1902   if ($q->param('Option') eq 'F(x) *')
 1903     {
 1904       my($channel);
 1905 
 1906       $channel=$q->param('Channel');
 1907       if ($q->param('Clipboard') ne 'on')
 1908         {
 1909           my $fx;
 1910 
 1911           if ($channel eq 'All')
 1912             { $image = $image->Fx(expression=>$parameter); }
 1913           else
 1914             { $image = $image->Fx(channel=>$channel,expression=>$parameter); }
 1915           Error($image) if !ref($image);
 1916         }
 1917       else
 1918         {
 1919           my($source);
 1920 
 1921           #
 1922           # Read clipboard image.
 1923           #
 1924           $source=Image::Magick->new;
 1925           $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 1926             $q->param('SessionID') . '.mpc';
 1927           $status=$source->Read($filename);
 1928           Error($status) if $#$source < 0;
 1929           if ($channel eq 'All')
 1930             { $image->Fx(image=>$source,expression=>$parameter); }
 1931           else
 1932             {
 1933               $image->Fx(image=>$source,channel=>$channel,
 1934                 expression=>$parameter);
 1935             }
 1936           Error($image) if !ref($image);
 1937         }
 1938     }
 1939   $image->GaussianBlur(geometry=>"$parameter",channel=>$channel) if
 1940     $q->param('Option') eq 'gaussian blur *';
 1941   if ($q->param('Option') eq 'hald-clut')
 1942     {
 1943       my($channel, $source);
 1944 
 1945       $channel=$q->param('Channel');
 1946       $source=Image::Magick->new;
 1947       $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 1948         $q->param('SessionID') . '.mpc';
 1949       $status=$source->Read($filename);
 1950       Error($status) if $#$source < 0;
 1951       if ($channel eq 'All')
 1952         { $image->HaldClut(image=>$source); }
 1953       else
 1954         { $image->HaldClut(image=>$source,channel=>$channel); }
 1955       Error($image) if !ref($image);
 1956     }
 1957   $image->HoughLine("$parameter") if $q->param('Option') eq 'hough line *';
 1958   $image->Implode("$parameter") if $q->param('Option') eq 'implode *';
 1959   $image->InverseFourierTransform("$parameter") if
 1960     $q->param('Option') eq 'inverse Fourier transform';
 1961   $image->Kuwahara(geometry=>"$parameter",channel=>$channel) if
 1962     $q->param('Option') eq 'kuwahara *';
 1963   $image->MeanShift("$parameter") if $q->param('Option') eq 'mean shift *';
 1964   $image->Mode("$parameter") if $q->param('Option') eq 'mode *';
 1965   if ($q->param('Option') eq 'morph *')
 1966     {
 1967       my($morph_image);
 1968 
 1969       if (($#$image+1) == 1)
 1970         {
 1971           #
 1972           # Read clipboard image.
 1973           #
 1974           $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 1975             $q->param('SessionID') . '.mpc';
 1976           $status=$image->Read($filename);
 1977           Error($status) if $#$image < 0;
 1978         }
 1979       $morph_image=$image->Morph(frames=>$parameter);
 1980       if (ref($morph_image))
 1981         {
 1982           #
 1983           # Replace image sequence with morph sequence.
 1984           #
 1985           undef $image;
 1986           $image=$morph_image;
 1987         }
 1988     }
 1989   if ($q->param('Option') eq 'morphology *')
 1990     {
 1991       my($method);
 1992 
 1993       $method=$q->param('MorphologyMethod');
 1994       $image->Morphology(kernel=>$parameter,method=>$method,channel=>$channel);
 1995     }
 1996   if ($q->param('Option') eq 'mosaic')
 1997     {
 1998       my($mosaic_image);
 1999 
 2000       if (($#$image+1) == 1)
 2001         {
 2002           #
 2003           # Read clipboard image.
 2004           #
 2005           $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 2006             $q->param('SessionID') . '.mpc';
 2007           $status=$image->Read($filename);
 2008           Error($status) if $#$image < 0;
 2009         }
 2010       $mosaic_image=$image->Mosaic();
 2011       if (ref($mosaic_image))
 2012         {
 2013           #
 2014           # Replace image sequence with mosaic sequence.
 2015           #
 2016           undef $image;
 2017           $image=$mosaic_image;
 2018         }
 2019     }
 2020   $image->MotionBlur(geometry=>"$parameter",channel=>$channel) if
 2021     $q->param('Option') eq 'motion blur *';
 2022   $image->MedianFilter("$parameter") if
 2023     $q->param('Option') eq 'median filter *';
 2024   $image->OilPaint("$parameter") if $q->param('Option') eq 'oil paint *';
 2025   if ($q->param('Option') eq 'color-matrix *')
 2026     {
 2027       my(@coefficients);
 2028 
 2029       @coefficients=split(/[ ,]+/,$parameter);
 2030       $image->ColorMatrix(\@coefficients);
 2031     }
 2032   $image->RangeThreshold(geomery=>"$parameter",channel=>$channel) if
 2033     $q->param('Option') eq 'range threshold *';
 2034   $image->ReduceNoise("$parameter") if $q->param('Option') eq 'reduce noise *';
 2035   $image->RotationalBlur(geometry=>"$parameter",channel=>$channel) if
 2036     $q->param('Option') eq 'rotational blur *';
 2037   $image->SelectiveBlur(geometry=>"$parameter",channel=>$channel) if
 2038     $q->param('Option') eq '-class=>"checkbox",selective blur *';
 2039   $image->SepiaTone("$parameter") if $q->param('Option') eq 'sepia tone *';
 2040   $image->Shade(geometry=>$parameter,gray=>'false')
 2041     if $q->param('Option') eq 'shade *';
 2042   $image->Shade(geometry=>$parameter,gray=>'true')
 2043     if $q->param('Option') eq 'gray shade *';
 2044   if ($q->param('Option') eq 'shadow *')
 2045     {
 2046       my($mosaic_image, $shadow_image);
 2047 
 2048       #
 2049       # Simulate an image shadow
 2050       #
 2051       $shadow_image=$image->Clone();
 2052       $shadow_image->Set(background=>$q->param('BackgroundColor'));
 2053       $shadow_image->Shadow("$parameter");
 2054       $shadow_image->Set(background=>'none');
 2055       push(@$shadow_image,@$image);
 2056       $mosaic_image=$shadow_image->Mosaic();
 2057       if (ref($mosaic_image))
 2058         {
 2059           #
 2060           # Replace image sequence with mosaic sequence.
 2061           #
 2062           undef $image;
 2063           $image=$mosaic_image;
 2064         }
 2065     }
 2066   $image->Sharpen(geometry=>"$parameter",channel=>$channel) if
 2067     $q->param('Option') eq 'sharpen *';
 2068   $image->Sketch("$parameter") if $q->param('Option') eq 'sketch *';
 2069   $image->Solarize("$parameter") if $q->param('Option') eq 'solarize *';
 2070   $image->Spread("$parameter") if $q->param('Option') eq 'spread *';
 2071   if ($q->param('Option') eq 'stegano *')
 2072     {
 2073       my($clipboard);
 2074 
 2075       #
 2076       # Read clipboard image.
 2077       #
 2078       $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 2079         $q->param('SessionID') . '.mpc';
 2080       $clipboard=Image::Magick->new(size=>"256x256+$parameter");
 2081       $status=$clipboard->Read($filename);
 2082       Error("unable to stegano image, no clipboard image") if $#$clipboard < 0;
 2083       $image->Stegano(image=>$clipboard);
 2084     }
 2085   if ($q->param('Option') eq 'stereo')
 2086     {
 2087       my($stereo);
 2088 
 2089       $stereo=$image->Clone();
 2090       $stereo->Roll('+4+4');
 2091       $image->Stereo(image=>$stereo);
 2092     }
 2093   $image->Swirl("$parameter") if $q->param('Option') eq 'swirl *';
 2094   $image->AdaptiveThreshold("$parameter") if
 2095     $q->param('Option') eq 'adaptive threshold *';
 2096   $image->AutoThreshold() if $q->param('Option') eq 'auto-threshold';
 2097   $image->Threshold(threshold=>"$parameter",channel=>$channel) if
 2098     $q->param('Option') eq 'threshold *';
 2099   $image->Tint(fill=>$q->param('FillColor'),opacity=>$parameter) if
 2100     $q->param('Option') eq 'tint';
 2101   $image->UnsharpMask(geometry=>"$parameter",channel=>$channel) if
 2102     $q->param('Option') eq 'unsharp mask *';
 2103   $image->Vignette(geometry=>"$parameter",background=>
 2104     $q->param('BackgroundColor')) if $q->param('Option') eq 'vignette *';
 2105   $image->Wave("$parameter") if $q->param('Option') eq 'wave *';
 2106   $image->WaveletDenoise("$parameter") if
 2107     $q->param('Option') eq 'wavelet denoise *';
 2108   $image->WhiteThreshold(threshold=>"$parameter",channel=>$channel) if
 2109     $q->param('Option') eq 'white threshold *';
 2110   $image->Set(page=>'0x0+0+0') if $q->param('Repage') eq 'on';
 2111   #
 2112   # Write image.
 2113   #
 2114   CreateWorkDirectory(1);
 2115   Header(GetTitle($image));
 2116   $status=$image->Write(filename=>'MagickStudio.mpc');
 2117   Error($status) if "$status";
 2118   ViewForm($image);
 2119 }
 2120 
 2121 #
 2122 # Effects form.
 2123 #
 2124 sub EffectsForm
 2125 {
 2126   my @OptionTypes=
 2127   [
 2128     'adaptive blur *',
 2129     'adaptive sharpen *',
 2130     'adaptive threshold *',
 2131     'auto-threshold',
 2132     'bilateral blur *',
 2133     'black threshold *',
 2134     'blur *',
 2135     'canny edge *',
 2136     'despeckle',
 2137     'edge detect *',
 2138     'emboss *',
 2139     'gaussian blur *',
 2140     'gray shade *',
 2141     'hough line *',
 2142     'kuwahara *',
 2143     'mean shift *',
 2144     'median filter *',
 2145     'mode *',
 2146     'motion blur *',
 2147     'range threshold *',
 2148     'reduce noise *',
 2149     'rotational blur *',
 2150     'selective blur *',
 2151     'shade *',
 2152     'sharpen *',
 2153     'spread *',
 2154     'threshold *',
 2155     'unsharp mask *',
 2156     'white threshold *'
 2157   ];
 2158 
 2159   #
 2160   # Display Effects form.
 2161   #
 2162   Header(GetTitle(undef));
 2163   print <<XXX;
 2164 <p class="lead magick-description">To <a href="$DocumentDirectory/Effects.html" target="help">effect</a> your image, enter your effects parameter and method.  Note, only methods denoted with an asterisk require a parameter value.  Next, press <code>effect</code> to continue.</p>
 2165 XXX
 2166   ;
 2167   print $q->start_form(-class=>'form-horizontal');
 2168   print $q->hidden(-name=>'CacheID'), "\n";
 2169   print $q->hidden(-name=>'SessionID'), "\n";
 2170   print $q->hidden(-name=>'Path'), "\n";
 2171   print $q->hidden(-name=>'ToolType'), "\n";
 2172   print $q->hidden(-name=>'Name'), "\n";
 2173   print $q->hidden(-name=>'Magick'), "\n";
 2174   print $q->hidden(-name=>'Action',-class=>'btn btn-primary',-value=>'effect'),
 2175     "\n";
 2176   print "<dt>Parameter:</dt>\n";
 2177   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Parameter',
 2178     -size=>25,-value=>'0.0x1.0'), "</dd><br />\n";
 2179   print "<dt>Choose from these effects:</dt>\n";
 2180   print '<dd>', $q->radio_group(-name=>'Option',-values=>@OptionTypes,
 2181     -columns=>3), "</dd><br />\n";
 2182   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
 2183     -value=>'effect'), ' your image or ', $q->reset(-name=>'reset',
 2184     -class=>'btn btn-warning'), " the form.<br /><br />\n";
 2185   print "<br />\n";
 2186   print "<fieldset>\n";
 2187   print "<legend>Effects Properties</legend>\n";
 2188   print "<dl><dd>\n";
 2189   print "<table class=\"table table-condensed table-striped\">\n";
 2190   print "<tr>\n";
 2191   print "<th>Virtual Pixel Method</th>\n";
 2192   print "<th><a href=\"$DocumentDirectory/Channel.html\" target=\"help\">Channel</a></th>\n";
 2193   print "</tr>\n";
 2194   print "<tr>\n";
 2195   my @methods=Image::Magick->QueryOption('virtual-pixel');
 2196   print '<td>', $q->popup_menu(-class=>'form-control',
 2197     -name=>'VirtualPixelMethod',-values=>[@methods]), "</td>\n";
 2198   my @channels=Image::Magick->QueryOption('channel');
 2199   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Channel',
 2200     -values=>[@channels],-default=>'Default'), "</td>\n";
 2201   print "</tr>\n";
 2202   print '</table><br />';
 2203   print "</dd></dl>\n";
 2204   print "</fieldset>\n";
 2205   print $q->end_form, "\n";
 2206   print <<XXX;
 2207 <br /> <br /> <br />
 2208 XXX
 2209   ;
 2210   Trailer(1);
 2211 }
 2212 
 2213 #
 2214 # Enhance image.
 2215 #
 2216 sub Enhance
 2217 {
 2218   use Image::Magick;
 2219 
 2220   my($channel, $image, $parameter, $path, $status);
 2221 
 2222   #
 2223   # Read image.
 2224   #
 2225   $path=Untaint($q->param('Path'));
 2226   chdir($path) || Error('Your image has expired',$path);
 2227   $image=Image::Magick->new;
 2228   $status=$image->Read("$path/MagickStudio.mpc");
 2229   Error($status) if $#$image < 0;
 2230   #
 2231   # Enhance image.
 2232   #
 2233   $parameter=$q->param('Parameter');
 2234   $channel=$q->param('Channel');
 2235   if ($q->param('clipboard as CLUT'))
 2236     {
 2237       my($clut, $filename);
 2238 
 2239       #
 2240       # Use clipboard image as CLUT.
 2241       #
 2242       $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 2243         $q->param('SessionID') . '.mpc';
 2244       $clut=Image::Magick->new;
 2245       $status=$clut->Read($filename);
 2246       Error($status) if $#$clut < 0;
 2247       $image->Remap(image=>$clut,channel=>$channel);
 2248     }
 2249   $image->Set('virtual-pixel'=>$q->param('VirtualPixelMethod')) if
 2250     $q->param('VirtualPixelMethod');
 2251   $image->AutoGamma() if $q->param('Option') eq 'auto-gamma';
 2252   $image->AutoLevel() if $q->param('Option') eq 'auto-level';
 2253   $image->BrightnessContrast(geometry=>$parameter,channel=>$channel) if
 2254     $q->param('Option') eq 'brightness-contrast *';
 2255   $image->CLAHE("$parameter") if $q->param('Option') eq 'calhe *';
 2256   $image->Contrast(sharpen=>'true') if $q->param('Option') eq 'spiff';
 2257   $image->Contrast(sharpen=>'false') if $q->param('Option') eq 'dull';
 2258   $image->ContrastStretch(geometry=>$parameter,channel=>$channel) if
 2259     $q->param('Option') eq 'contrast-stretch *';
 2260   $image->Equalize(channel=>$channel) if $q->param('Option') eq 'equalize';
 2261   $image->Gamma(gamma=>$parameter,channel=>$channel) if
 2262     $q->param('Option') eq 'gamma *';
 2263   $image->Level(levels=>$parameter,channel=>$channel) if
 2264     $q->param('Option') eq 'level *';
 2265   $image->LinearStretch($parameter) if $q->param('Option') eq
 2266     'linear-stretch *';
 2267   $image->Modulate(hue=>$parameter) if $q->param('Option') eq 'hue *';
 2268   $image->Modulate(saturation=>$parameter)
 2269     if $q->param('Option') eq 'saturation *';
 2270   $image->Modulate(brightness=>$parameter)
 2271     if $q->param('Option') eq 'brightness *';
 2272   $image->Normalize(channel=>$channel) if $q->param('Option') eq 'normalize';
 2273   $image->Negate(channel=>$channel) if $q->param('Option') eq 'negate';
 2274   $image->SigmoidalContrast(geometry=>$parameter,channel=>$channel) if
 2275     $q->param('Option') eq 'sigmoidal-contrast *';
 2276   #
 2277   # Write image.
 2278   #
 2279   CreateWorkDirectory(1);
 2280   Header(GetTitle($image));
 2281   $status=$image->Write(filename=>'MagickStudio.mpc');
 2282   Error($status) if "$status";
 2283   ViewForm($image);
 2284 }
 2285 
 2286 #
 2287 # Enhance form.
 2288 #
 2289 sub EnhanceForm
 2290 {
 2291   my @OptionTypes=
 2292   [
 2293     'auto-gamma',
 2294     'auto-level',
 2295     'brightness *',
 2296     'brightness-contrast *',
 2297     'clahe *',
 2298     'clipboard as CLUT',
 2299     'contrast-stretch *',
 2300     'dull',
 2301     'equalize',
 2302     'gamma *',
 2303     'hue *',
 2304     'level *',
 2305     'linear-stretch *',
 2306     'negate',
 2307     'normalize',
 2308     'saturation *',
 2309     'spiff',
 2310     'sigmoidal-contrast *'
 2311   ];
 2312 
 2313   #
 2314   # Display Enhancement form.
 2315   #
 2316   Header(GetTitle(undef));
 2317   print <<XXX;
 2318 <p>To <a href="$DocumentDirectory/Enhance.html" target="help">enhance</a> your image, enter your enhancement parameter and method.  Note, only methods denoted with an asterisk require a parameter value.  Next, press <code>enhance</code> to continue.</p>
 2319 XXX
 2320   ;
 2321   print $q->start_form(-class=>'form-horizontal');
 2322   print $q->hidden(-name=>'CacheID'), "\n";
 2323   print $q->hidden(-name=>'SessionID'), "\n";
 2324   print $q->hidden(-name=>'Path'), "\n";
 2325   print $q->hidden(-name=>'ToolType'), "\n";
 2326   print $q->hidden(-name=>'Name'), "\n";
 2327   print $q->hidden(-name=>'Magick'), "\n";
 2328   print $q->hidden(-name=>'Action',-class=>'btn btn-primary',
 2329     -value=>'enhance'), "\n";
 2330   print "<dt>Parameter:</dt>\n";
 2331   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Parameter',
 2332     -size=>25,-value=>'1.6'), "</dd><br />\n";
 2333   print "<dt>Choose from these enhancements:</dt>\n";
 2334   print '<dd>', $q->radio_group(-name=>'Option',-values=>@OptionTypes,
 2335     -columns=>3,-default=>'gamma *'), "</dd><br />\n";
 2336   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
 2337     -value=>'enhance'), ' your image or ', $q->reset(-name=>'reset',
 2338     -class=>'btn btn-warning'), " the form.<br /><br />\n";
 2339   print "<br />\n";
 2340   print "<fieldset>\n";
 2341   print "<legend>Enhance Properties</legend>\n";
 2342   print "<dl><dd>\n";
 2343   print "<table class=\"table table-condensed table-striped\">\n";
 2344   print "<tr>\n";
 2345   print "<th>Virtual Pixel Method</th>\n";
 2346   print "<th><a href=\"$DocumentDirectory/Channel.html\" target=\"help\">Channel</a></th>\n";
 2347   print "</tr>\n";
 2348   print "<tr>\n";
 2349   my @methods=Image::Magick->QueryOption('virtual-pixel');
 2350   print '<td>', $q->popup_menu(-class=>'form-control',
 2351     -name=>'VirtualPixelMethod',-values=>[@methods]), "</td>\n";
 2352   my @channels=Image::Magick->QueryOption('channel');
 2353   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Channel',
 2354     -values=>[@channels],-default=>'Default'), "</td>\n";
 2355   print "</tr>\n";
 2356   print '</table><br />';
 2357   print "</dd></dl>\n";
 2358   print "</fieldset>\n";
 2359   print $q->end_form, "\n";
 2360   print <<XXX;
 2361 <br /> <br /> <br />
 2362 XXX
 2363   ;
 2364   Trailer(1);
 2365 }
 2366 
 2367 #
 2368 # Display an error.
 2369 #
 2370 sub Error
 2371 {
 2372   my($message,$qualifier) = @_;
 2373 
 2374   Header($message) unless $header;
 2375   $qualifier="" unless $qualifier;
 2376   print <<XXX;
 2377 <center>
 2378 <img src="$DocumentDirectory/images/stop.png" width="48" height="48" border="0" />
 2379 </center>
 2380 <br /> <br />
 2381 <dl>
 2382 <dt><font face="Arial,Helvetica" size=+2>$message:</font>
 2383 <br />
 2384 <dd><font face="Arial,Helvetica" size=+1>$qualifier</font>
 2385 <br />
 2386 <dd><font face="Arial,Helvetica" size=+0>$!</font>
 2387 </dl>
 2388 <br /> <br />
 2389 <center>
 2390 <img src="$DocumentDirectory/images/stop.png" width="48" height="48" border="0" />
 2391 </center>
 2392 <br />
 2393 <br />
 2394 <br />
 2395 Press <code>Back</code> to correct the error or press a tab above to continue.
 2396 XXX
 2397   ;
 2398   Trailer(0);
 2399   die $message;
 2400 }
 2401 
 2402 #
 2403 # Expire files in the workarea that are older than some threshold.
 2404 #
 2405 sub ExpireFiles
 2406 {
 2407   my($path, $age) = @_;
 2408 
 2409   use File::Path;
 2410 
 2411   my(@files, $number_files);
 2412 
 2413   local(*DIR);
 2414 
 2415   chdir($path) || Error('Your image has expired',$path);
 2416   opendir(DIR,".");
 2417   @files=readdir(DIR);
 2418   closedir(DIR);
 2419   $number_files=$#files+1;
 2420   for (@files)
 2421   {
 2422     next if /^\./;
 2423     next if /^index.html/;
 2424     next if (time()-(stat($_))[9]) < $age;
 2425     rmtree($_,0,1);
 2426     $number_files--;
 2427   }
 2428   ExpireFiles($path,$age/2) if
 2429     ($number_files > $MaxWorkFiles) && ($age > $MinExpireAge);
 2430 }
 2431 
 2432 #
 2433 # Fetch all the images from an HTTP directory.
 2434 #
 2435 sub PursueLink
 2436 {
 2437   my($prefix, $type, $quote, $url, $base, $depth) = @_;
 2438 
 2439   $url=url($url,$base)->abs;
 2440   $prefix . $quote . FetchImages($url,$type,$depth) . $quote;
 2441 }
 2442 
 2443 sub FetchImages
 2444 {
 2445   my($url, $type, $depth) = @_;
 2446 
 2447   use URI::URL;
 2448   use LWP::UserAgent;
 2449   use LWP::MediaTypes qw(media_suffix);
 2450 
 2451   my($base, $content, $content_type, $name, $plain_url, $result, $seen,
 2452     $suffix);
 2453 
 2454   $url=url($url) unless ref($url);
 2455   if ($depth == 0)
 2456     {
 2457       #
 2458       # Limit to URLs below this one.
 2459       #
 2460       $user_agent=new LWP::UserAgent;
 2461       $user_agent->agent('MagickStudio/1.0 ' . $user_agent->agent);
 2462       $user_agent->env_proxy if $ENV{'http_proxy'};
 2463       $prefix=url($url);
 2464       eval
 2465       {
 2466         $prefix->eparams(undef);
 2467         $prefix->equery(undef);
 2468       };
 2469       $_=$prefix->epath;
 2470       s|[^/]+$||;
 2471       $prefix->epath($_);
 2472       $prefix=$prefix->as_string;
 2473       %seen=();
 2474       $length=0;
 2475       FetchImages($url,$type,$depth+1);
 2476       return(undef);
 2477     }
 2478   $type||='a';
 2479   $type='img' if $type eq 'body';
 2480   $depth||=0;
 2481   return($url->as_string) if $url->scheme eq 'mailto';
 2482   $plain_url=$url->clone;
 2483   $plain_url->frag(undef);
 2484   $seen=$seen{$plain_url->as_string};
 2485   if ($seen)
 2486     {
 2487       my($fragment);
 2488 
 2489       #
 2490       # We have already seen this document.
 2491       #
 2492       $fragment=$url->frag;
 2493       $seen.="#$fragment" if defined($fragment);
 2494       return($seen);
 2495     }
 2496   return($url) if $depth > 2;  # no recursion
 2497   return $url->as_string if ($type ne 'img') and
 2498     ($url->as_string !~ /^\Q$prefix/o);
 2499   #
 2500   # Fetch image.
 2501   #
 2502   $result=$user_agent->request(HTTP::Request->new(GET=>$url));
 2503   if (!$result->is_success)
 2504     {
 2505       $seen{$plain_url->as_string}="*BAD*";
 2506       return("*BAD*");
 2507     }
 2508   $content=$result->content;
 2509   $content_type=$result->content_type;
 2510   #
 2511   # Construct an image name.
 2512   #
 2513   $url=$result->request->url;
 2514   $url=url($url) unless ref($url);
 2515   $name=$url->path;
 2516   $name=~s|.*/||;
 2517   $name=~s|\..*||;
 2518   $name="index" unless length($name);
 2519   $suffix=media_suffix($content_type);
 2520   $name.=".$suffix" if $suffix;
 2521   $seen{$plain_url->as_string}=$name;
 2522   if ($content_type ne "text/html")
 2523     {
 2524       local(*FILE);
 2525 
 2526       #
 2527       # Save document to disk.
 2528       #
 2529       return($name) if $name eq 'back.gif';
 2530       return($name) if $name eq 'blank.gif';
 2531       return($name) if $name eq 'image2.gif';
 2532       $length+=$result->content_length;
 2533       Error('Image size exceeds maximum allowable',$plain_url->as_string)
 2534         unless $length < (1024*$MaxFilesize);
 2535       open(FILE,">$name") || Error('Unable to write image file',$name);
 2536       binmode(FILE);
 2537       print FILE $content;
 2538       close(FILE);
 2539       return($name);
 2540     }
 2541   #
 2542   # Follow the links in this HTML document.
 2543   #
 2544   $base=$result->base;
 2545   $content=~s/(<\s*(img|a|body)\b[^>]+\b(?:src|href|background)\s*=\s*)(["']?)([^>\s]+)\3/PursueLink($1,lc($2),$3,$4,$base,$depth+1)/gie;       #";
 2546   return($name);
 2547 }
 2548 
 2549 #
 2550 # File transfer the image to a remote FTP server.
 2551 #
 2552 sub FileTransfer
 2553 {
 2554   use Image::Magick;
 2555   use URI::URL;
 2556   use URI::Escape;
 2557   use LWP::UserAgent;
 2558   use LWP::MediaTypes qw(media_suffix);
 2559 
 2560   my($basename, $directory, $content, $filename, $format, $hostname,
 2561      $image, $password, $path, $request, $response, $status, $url,
 2562      $user_agent, $username);
 2563 
 2564   #
 2565   # Read image.
 2566   #
 2567   SaveQueryState($q->param('SessionID'),'FileTransfer');
 2568   $path=Untaint($q->param('Path'));
 2569   chdir($path) || Error('Your image has expired',$path);
 2570   $image=Image::Magick->new;
 2571   $status=$image->Read("$path/MagickStudio.mpc");
 2572   $basename=$q->param('Name');
 2573   $format=$q->param('Magick');
 2574   Error($status) if $#$image < 0;
 2575   #
 2576   # Construct FTP URL.
 2577   #
 2578   $action='output';
 2579   $hostname=GetHostname($q->remote_host());
 2580   $hostname=$q->param('Hostname') if $q->param('Hostname');
 2581   $username='anonymous';
 2582   $username=$q->param('Username') if $q->param('Username');
 2583   $password="$username\@$hostname";
 2584   $password=$q->param('Password') if $q->param('Password');
 2585   $directory=uri_escape($q->param('Directory'),"^A-Za-z0-9") if ($q->param('Directory'));
 2586   $filename="$basename.$format";
 2587   $filename=uri_escape($q->param('Filename'),"^A-Za-z0-9") if $q->param('Filename');
 2588   $url="ftp://$hostname/$filename";
 2589   $url="ftp://$hostname/$directory/$filename" if $q->param('Directory');
 2590   $q->delete('Password');
 2591   $q->delete('Filename');
 2592   SaveQueryState($q->param('SessionID'),'FileTransfer');
 2593   #
 2594   # Upload image.
 2595   #
 2596   $user_agent=new LWP::UserAgent;
 2597   $user_agent->agent('MagickStudio/1.0 ' . $user_agent->agent);
 2598   $user_agent->env_proxy if $ENV{'ftp_proxy'};
 2599   $user_agent->timeout($Timeout);
 2600   $request=HTTP::Request->new(PUT=>$url);
 2601   $request->header('Content-Type','C');
 2602   $request->authorization_basic($username,$password);
 2603   $request->proxy_authorization_basic($username,$password);
 2604   $image->Set(magick=>$format);
 2605   $request->content($image->ImageToBlob());
 2606   $response=$user_agent->request($request);
 2607   Error(uri_unescape($url),$response->error_as_HTML) unless
 2608     $response->is_success;
 2609   Warning('Image uploaded',uri_unescape($url));
 2610 }
 2611 
 2612 #
 2613 # Special Effects form.
 2614 #
 2615 sub FXForm
 2616 {
 2617   my @OptionTypes =
 2618   [
 2619     'channel F(x) *',
 2620     'charcoal drawing *',
 2621     'clut',
 2622     'color-matrix *',
 2623     'connected components *',
 2624     'convolve *',
 2625     'distort *',
 2626     'evaluate *',
 2627     'forward Fourier transform',
 2628     'function *',
 2629     'F(x) *',
 2630     'hald-clut',
 2631     'implode *',
 2632     'inverse Fourier transform',
 2633     'morph *',
 2634     'morphology *',
 2635     'mosaic',
 2636     'oil paint *',
 2637     'sepia tone *',
 2638     'shadow *',
 2639     'sketch *',
 2640     'solarize *',
 2641     'stegano *',
 2642     'stereo',
 2643     'swirl *',
 2644     'tint',
 2645     'vignette *',
 2646     'wave *',
 2647     'wavelet denoise *'
 2648   ];
 2649 
 2650   #
 2651   # Display Effects form.
 2652   #
 2653   Header(GetTitle(undef));
 2654   print <<XXX;
 2655 <p class="lead magick-description">To add special <a href="$DocumentDirectory/FX.html" target="help">effects</a> to your image, enter your effects parameter and method.  Note, only methods denoted with an asterisk require a parameter value.  Next, press <code>effect</code> to continue.</p>
 2656 XXX
 2657   ;
 2658   print $q->start_form(-class=>'form-horizontal');
 2659   print $q->hidden(-name=>'CacheID'), "\n";
 2660   print $q->hidden(-name=>'SessionID'), "\n";
 2661   print $q->hidden(-name=>'Path'), "\n";
 2662   print $q->hidden(-name=>'ToolType'), "\n";
 2663   print $q->hidden(-name=>'Name'), "\n";
 2664   print $q->hidden(-name=>'Magick'), "\n";
 2665   print $q->hidden(-name=>'Action',-class=>'btn btn-primary',-value=>'effect'),
 2666     "\n";
 2667   print "<dt>Parameter:</dt>\n";
 2668   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Parameter',
 2669     -size=>25,-value=>'60'), "</dd><br />\n";
 2670   print "<dt>Choose from these special effects:</dt>\n";
 2671   print '<dd>', $q->radio_group(-name=>'Option',-values=>@OptionTypes,
 2672     -columns=>3,-default=>'swirl *'), "</dd><br />\n";
 2673   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
 2674     -value=>'effect'), ' your image or ', $q->reset(-name=>'reset',
 2675     -class=>'btn btn-warning'), " the form.<br /><br />\n";
 2676   print "<br />\n";
 2677   print "<fieldset>\n";
 2678   print "<legend>F/X Properties</legend>\n";
 2679   print "<dl><dd>\n";
 2680   print "<table class=\"table table-condensed table-striped\">\n";
 2681   print "<tr>\n";
 2682   print "<th>Distort Type</th>\n";
 2683   print "<th>Evaluate Type</th>\n";
 2684   print "<th>Function Type</th>\n";
 2685   print "</tr>\n";
 2686   print "<tr>\n";
 2687   my @distorts=Image::Magick->QueryOption('distort');
 2688   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'DistortType',
 2689     -values=>[@distorts],-default=>'Arc'), "</td>\n";
 2690   my @operators=Image::Magick->QueryOption('evaluate');
 2691   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'EvaluateType',
 2692     -values=>[@operators], -default=>'Sin'), "</td>\n";
 2693   my @functions=Image::Magick->QueryOption('function');
 2694   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'FunctionType',
 2695     -values=>[@functions],-default=>'Sin'), "</td>\n";
 2696   print "</tr>\n";
 2697   print '</table><br />';
 2698   print "<table class=\"table table-condensed table-striped\">\n";
 2699   print "<tr>\n";
 2700   print "<th>Morphology Method</th>\n";
 2701   print "<th>Virtual Pixel Method</th>\n";
 2702   print "<th><a href=\"$DocumentDirectory/Channel.html\" target=\"help\">Channel</a></th>\n";
 2703   print "</tr>\n";
 2704   print "<tr>\n";
 2705   my @methods=Image::Magick->QueryOption('morphology');
 2706   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'MorphologyMethod',
 2707     -values=>[@methods]), "</td>\n";
 2708   my @methods=Image::Magick->QueryOption('virtual-pixel');
 2709   print '<td>', $q->popup_menu(-class=>'form-control',
 2710     -name=>'VirtualPixelMethod',-values=>[@methods]), "</td>\n";
 2711   my @channels=Image::Magick->QueryOption('channel');
 2712   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Channel',
 2713     -values=>[@channels],-default=>'Default'), "</td>\n";
 2714   print "</tr>\n";
 2715   print "</tr>\n";
 2716   print "<table class=\"table table-condensed table-striped\">\n";
 2717   print "<tr>\n";
 2718   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Background Color</a></th>\n";
 2719   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Fill Color</a></th>\n";
 2720   print "</tr>\n";
 2721   print "<tr><br />\n";
 2722   print '<td>', $q->textfield(-class=>'form-control',-name=>'BackgroundColor',
 2723     -value=>'black', -size=>25), "</td>\n";
 2724   print '<td>', $q->textfield(-class=>'form-control',-name=>'FillColor',
 2725     -value=>'white',-size=>25), "</td>\n";
 2726   print "</tr>\n";
 2727   print '</table><br />';
 2728   print "<dt> Miscellaneous options:</dt>\n";
 2729   print '<dd>', $q->checkbox(-name=>'Repage',
 2730     -checked=>'true',-label=>' reset page geometry.'), "</dd>\n";
 2731   print '<dd>', $q->checkbox(-name=>'Clipboard',
 2732     -label=>' use clipboard image as source for F(x).'),"</dd>\n";
 2733   print "</dd></dl>\n";
 2734   print "</fieldset>\n";
 2735   print $q->end_form, "\n";
 2736   print <<XXX;
 2737 XXX
 2738   ;
 2739   Trailer(1);
 2740 }
 2741 
 2742 #
 2743 # Return hostname from host address.
 2744 #
 2745 sub GetAddress
 2746 {
 2747   use Socket;
 2748 
 2749   my($hostname) = @_;
 2750 
 2751   my $address = inet_ntoa(
 2752     scalar gethostbyname( $hostname || 'localhost' )
 2753   );
 2754   $address;
 2755 }
 2756 
 2757 #
 2758 # Return hostname from host address.
 2759 #
 2760 sub GetHostname
 2761 {
 2762   my($hostname) = @_;
 2763 
 2764   my($address);
 2765 
 2766   $address=pack("C4",split(/\./,$hostname));
 2767   $hostname=(gethostbyaddr($address,2))[0];
 2768   $hostname;
 2769 }
 2770 
 2771 #
 2772 # Return the average number of jobs in the run queue over the last minute.
 2773 #
 2774 sub GetLoadAverage
 2775 {
 2776   my($load_average, $os);
 2777 
 2778   unless ($os = $^O)
 2779   {
 2780     require Config;
 2781     $os=$Config::Config{'osname'};
 2782   }
 2783   $load_average=0;
 2784   return if $os =~ /Win/i;
 2785   if (!(-e "/proc/loadavg"))
 2786     { $load_average=`uptime` =~ /average:\s+(\S+),/; }
 2787   else
 2788     {
 2789       local(*DATA);
 2790 
 2791       open(DATA,"/proc/loadavg");
 2792       $load_average=<DATA>;
 2793       close(DATA);
 2794     }
 2795   $load_average+0.0;
 2796 }
 2797 
 2798 #
 2799 # Generate the standard HTML title.
 2800 #
 2801 sub GetTitle
 2802 {
 2803   use Image::Magick;
 2804 
 2805   my($image) = @_;
 2806 
 2807   my($height, $title, $width);
 2808 
 2809   if ($image)
 2810     { ($width,$height)=$image->Get('columns','rows'); }
 2811   else
 2812     {
 2813       my($format, $path, $size);
 2814 
 2815       $path=Untaint($q->param('Path'));
 2816       $image=Image::Magick->new;
 2817       ($width,$height,$size,$format)=$image->Ping("$path/MagickStudio.mpc");
 2818     }
 2819   $title=$q->param('Name') . '.' . $q->param('Magick') .  '  ' .  $width .
 2820     'x' . $height;
 2821   $title;
 2822 }
 2823 
 2824 #
 2825 # Print the standard HTML header with the MagickStudio logo.
 2826 #
 2827 sub Header
 2828 {
 2829   my($title, @attributes) = @_;
 2830 
 2831   my($cacheID, $magick, $name, $p, $path, $script, $sessionID, %tools,
 2832      $tooltype, $url);
 2833 
 2834   #
 2835   # Initialize tool types.
 2836   #
 2837   $tools{'Annotate'}='';
 2838   $tools{'Colormap'}='';
 2839   $tools{'Compare'}='';
 2840   $tools{'Composite'}='';
 2841   $tools{'Decorate'}='';
 2842   $tools{'Download'}='';
 2843   $tools{'Draw'}='';
 2844   $tools{'Effects'}='';
 2845   $tools{'Enhance'}='';
 2846   $tools{'FX'}='';
 2847   $tools{'Identify'}='';
 2848   $tools{'Resize'}='';
 2849   $tools{'Transform'}='';
 2850   $tools{'Upload'}='';
 2851   $tools{'View'}='';
 2852   $q->param(-name=>'ToolType',-value=>'View') unless
 2853     defined($q->param('ToolType'));
 2854   $tooltype=$q->param('ToolType');
 2855   $tools{$tooltype}.='active';
 2856   #
 2857   # Print the standard HTML header with the MagickStudio logo.
 2858   #
 2859   $header=1;
 2860   $|=1;
 2861   print $q->header(-charset=>'UTF-8',-expires=>$ExpireCache,@attributes), "\n";
 2862   print $q->start_html(
 2863     -meta=>{
 2864       'charset'=>'utf-8', 
 2865       'viewport'=>'width=device-width, initial-scale=1'
 2866     },
 2867     -head=>[
 2868       "<link rel=\"icon\" href=\"$DocumentDirectory/images/wand.png\"/>",
 2869       "<link rel=\"shortcut icon\" href=\"$DocumentDirectory/images/wand.ico\" type=\"image/x-icon\"/>"
 2870     ],
 2871     -title=>$title,-author=>$ContactInfo,-encoding=>'UTF-8',
 2872     -style=>{-src=>"$DocumentDirectory/assets/magick-css.php"}), "\n";
 2873   $script=$q->script_name;
 2874   $cacheID=$q->param('CacheID');
 2875   $sessionID=$q->param('SessionID');
 2876   $path=$q->param('Path');
 2877   $name=$q->param('Name');
 2878   $magick=$q->param('Magick');
 2879   $url=$q->script_name;
 2880   $url.='?CacheID=' . $q->param('CacheID') if $q->param('CacheID');
 2881   $url.=';SessionID=' . $q->param('SessionID') if $q->param('SessionID');
 2882   $url.=';Path=' . $q->param('Path') if  $q->param('Path');
 2883   $url.=';Name=' . $q->param('Name') if  $q->param('Name');
 2884   $url.=';Magick=' . $q->param('Magick') if  $q->param('Magick');
 2885   $url.=';Action=mogrify';
 2886   print <<XXX;
 2887   <nav class="navbar navbar-expand-md navbar-dark bg-dark fixed-top">
 2888   <div class="container-fluid">
 2889     <a class="navbar-brand" href="$DocumentDirectory/"><img class="d-block" id="icon" alt="ImageMagick Online Studio" width="32" height="32" src="$DocumentDirectory/images/wand.ico"/></a>
 2890     <button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#magick-navbars" aria-controls="magick-navbars" aria-expanded="false" aria-label="Toggle navigation">
 2891       <span class="navbar-toggler-icon"></span>
 2892     </button>
 2893 
 2894     <div class="collapse navbar-collapse" id="magick-navbars">
 2895       <form class="d-flex" action="$script">
 2896         <input type="hidden" name="CacheID" value="$cacheID" />
 2897         <input type="hidden" name="SessionID" value="$sessionID" />
 2898         <input type="hidden" name="Path" value="$path" />
 2899         <input type="hidden" name="Name" value="$name" />
 2900         <input type="hidden" name="Magick" value="$magick" />
 2901         <input type="hidden" name="ToolType" value="Upload" />
 2902         <button class="btn btn-outline-success" type="submit">Upload</button>
 2903       </form>
 2904       <ul class="navbar-nav me-auto mb-2 mb-md-0">
 2905         <li class="nav-item dropdown">
 2906           <a class="nav-link dropdown-toggle  $tools{'View'} $tools{'Identify'}" href="#" id="view" data-bs-toggle="dropdown" aria-expanded="false">View</a>
 2907           <ul class="dropdown-menu" aria-labelledby="nav-items-view">
 2908             <li><a class="dropdown-item" href="$url;ToolType=View">View</a></li>
 2909             <li><a class="dropdown-item" href="$url;ToolType=Identify">Identify</a></li>
 2910           </ul>
 2911         </li>
 2912         <li class="nav-item dropdown">
 2913           <a class="nav-link dropdown-toggle $tools{'Transform'} $tools{'Resize'}" href="#" id="transform" data-bs-toggle="dropdown" aria-expanded="false">Transform</a>
 2914           <ul class="dropdown-menu" aria-labelledby="nav-items-transform">
 2915             <li><a class="dropdown-item" href="$url;ToolType=Transform">Transform</a></li>
 2916             <li><a class="dropdown-item" href="$url;ToolType=Resize">Resize</a></li>
 2917           </ul>
 2918         </li>
 2919         <li class="nav-item dropdown">
 2920           <a class="nav-link dropdown-toggle $tools{'Effects'} $tools{'F/X'} $tools{'Enhance'} $tools{'Colormap'}" href="#" id="effects" data-bs-toggle="dropdown" aria-expanded="false">Effects</a>
 2921           <ul class="dropdown-menu" aria-labelledby="nav-items-effects">
 2922             <li><a class="dropdown-item" href="$url;ToolType=Effects">Effects</a></li>
 2923             <li><a class="dropdown-item" href="$url;ToolType=FX">F/X</a></li>
 2924             <li><a class="dropdown-item" href="$url;ToolType=Enhance">Enhance</a></li>
 2925             <li><a class="dropdown-item" href="$url;ToolType=Colormap">Colormap</a></li>
 2926           </ul>
 2927         </li>
 2928         <li class="nav-item dropdown">
 2929           <a class="nav-link dropdown-toggle $tools{'Decorate'} $tools{'Annotate'} $tools{'Draw'}" href="#" id="decorate" data-bs-toggle="dropdown" aria-expanded="false">Decorate</a>
 2930           <ul class="dropdown-menu" aria-labelledby="nav-items-decorate">
 2931             <li><a class="dropdown-item" href="$url;ToolType=Decorate">Decorate</a></li>
 2932             <li><a class="dropdown-item" href="$url;ToolType=Annotate">Annotate</a></li>
 2933             <li><a class="dropdown-item" href="$url;ToolType=Draw">Draw</a></li>
 2934           </ul>
 2935         </li>
 2936         <li class="nav-item dropdown">
 2937           <a class="nav-link dropdown-toggle $tools{'Composite'} $tools{'Compare'}" href="#" id="composite" data-bs-toggle="dropdown" aria-expanded="false">Composite</a>
 2938           <ul class="dropdown-menu" aria-labelledby="nav-items-composite">
 2939             <li><a class="dropdown-item" href="$url;ToolType=Composite">Composite</a></li>
 2940             <li><a class="dropdown-item" href="$url;ToolType=Compare">Compare</a></li>
 2941           </ul>
 2942         </li>
 2943       </ul>
 2944       <form class="d-flex" action="$script">
 2945         <input type="hidden" name="Action" value="mogrify" />
 2946         <input type="hidden" name="CacheID" value="$cacheID" />
 2947         <input type="hidden" name="SessionID" value="$sessionID" />
 2948         <input type="hidden" name="Path" value="$path" />
 2949         <input type="hidden" name="Name" value="$name" />
 2950         <input type="hidden" name="Magick" value="$magick" />
 2951         <input type="hidden" name="ToolType" value="Download" />
 2952         <button class="btn btn-outline-success" type="submit">Download</button>
 2953       </form>
 2954     </div>
 2955   </div>
 2956   </nav>
 2957 <div class="container">
 2958   <script async="async" src="//pagead2.googlesyndication.com/pagead/js/adsbygoogle.js"></script>
 2959   <ins class="adsbygoogle"
 2960     style="display:block"
 2961     data-ad-client="ca-pub-3129977114552745"
 2962     data-ad-slot="6345125851"
 2963     data-full-width-responsive="true"
 2964     data-ad-format="horizontal"></ins>
 2965   <script>
 2966     (adsbygoogle = window.adsbygoogle || []).push({});
 2967   </script>
 2968 </div>
 2969 <main class="container">
 2970     <div class="magick-template">
 2971 XXX
 2972   ;
 2973   print <<XXX;
 2974 XXX
 2975   ;
 2976 }
 2977 
 2978 #
 2979 # Identify an image.
 2980 #
 2981 sub Identify
 2982 {
 2983   use Image::Magick;
 2984 
 2985   my($class, $filename, $format, $height, $image, $images, $matte,
 2986     $magick, $path, $status, $width, $x);
 2987 
 2988   #
 2989   # Read image.
 2990   #
 2991   $path=Untaint($q->param('Path'));
 2992   chdir($path) || Error('Your image has expired',$path);
 2993   $images=Image::Magick->new(precision=>6);
 2994   $status=$images->Read("$path/MagickStudio.mpc");
 2995   Error($status) if $#$images < 0;
 2996   $magick=$q->param('Magick');
 2997   $filename=$q->param('Name') . '.' . $magick;
 2998   $images->Set(filename=>$filename,magick=>$magick);
 2999   #
 3000   # Display image on web page.
 3001   #
 3002   Header(GetTitle($images));
 3003   print <<XXX;
 3004 <p class="lead magick-description">Here is a detailed description of your image, <code>$filename</code>:</p>
 3005 XXX
 3006   ;
 3007   print "<ul><pre class=\"pre-scrollable\"><samp>";
 3008   $images->Identify();
 3009   print "</samp></pre></ul>\n";
 3010   Trailer(1);
 3011 }
 3012 
 3013 #
 3014 # Choose the appropriate Web page based on the ToolType parameter.
 3015 #
 3016 sub Mogrify
 3017 {
 3018   my ($function, $tooltype, %Tools);
 3019 
 3020   %Tools=
 3021   (
 3022     'Upload'=>\&UploadForm,
 3023     'View'=>\&ViewForm,
 3024     'Identify'=>\&Identify,
 3025     'Download'=>\&DownloadForm,
 3026     'Colormap'=>\&ColormapForm,
 3027     'Resize'=>\&ResizeForm,
 3028     'Transform'=>\&TransformForm,
 3029     'Enhance'=>\&EnhanceForm,
 3030     'Effects'=>\&EffectsForm,
 3031     'FX'=>\&FXForm,
 3032     'Decorate'=>\&DecorateForm,
 3033     'Annotate'=>\&AnnotateForm,
 3034     'Draw'=>\&DrawForm,
 3035     'Composite'=>\&CompositeForm,
 3036     'Compare'=>\&CompareForm,
 3037     'Comment'=>\&CommentForm
 3038   );
 3039 
 3040   $tooltype=$q->param('ToolType');
 3041   View() unless defined($tooltype);
 3042   Error('Unable to view image','no path is defined') unless $q->param('Path');
 3043   RestoreQueryState($q->param('SessionID'),$q->param('Path'),$tooltype);
 3044   $function=$Tools{$tooltype};
 3045   &$function() if defined($function);
 3046   Error('Request failed due to malformed query');
 3047 }
 3048 
 3049 #
 3050 # Resize image.
 3051 #
 3052 sub Resize
 3053 {
 3054   use Image::Magick;
 3055 
 3056   my($blur, $filter, $geometry, $image, $montage, $path, $status, $support,
 3057     $value);
 3058 
 3059   #
 3060   # Read image.
 3061   #
 3062   $path=Untaint($q->param('Path'));
 3063   chdir($path) || Error('Your image has expired',$path);
 3064   $image=Image::Magick->new;
 3065   $status=$image->Read("$path/MagickStudio.mpc");
 3066   Error($status) if $#$image < 0;
 3067   #
 3068   # Resize image.
 3069   #
 3070   $image->Set(gravity=>$q->param('Gravity'));
 3071   $q->param('Geometry') =~ /(\d+)\D*(\d*)/;
 3072   Error('Image area exceeds maximum allowable') if $1 && $2 &&
 3073     (($1*$2) > (1024*$MaxImageArea));
 3074   Error('Image area exceeds maximum allowable') if $1 && !$2 &&
 3075     (($1*$1) > (1024*$MaxImageArea));
 3076   $geometry='100%';
 3077   $geometry=$q->param('Geometry') if $q->param('Geometry');
 3078   $filter='Undefined';
 3079   $filter=$q->param('FilterType') if $q->param('FilterType');
 3080   $support='0.0';
 3081   $support=$q->param('SupportFactor') if $q->param('SupportFactor');
 3082   $blur='1.0';
 3083   $blur=$q->param('BlurFactor') if $q->param('BlurFactor');
 3084   $image->AdaptiveResize(geometry=>$geometry,filter=>$filter,blur=>$blur) if
 3085     $q->param('Algorithm') eq 'adaptive resize *';
 3086   $image->LiquidRescale(geometry=>$geometry) if
 3087     $q->param('Algorithm') eq 'liquid rescale *';
 3088   $image->Resize(geometry=>$geometry,filter=>$filter,blur=>$blur) if
 3089     $q->param('Algorithm') eq 'resize *';
 3090   $image->Scale($geometry) if $q->param('Algorithm') eq 'scale *';
 3091   $image->Sample($geometry) if $q->param('Algorithm') eq 'sample *';
 3092   $image->Magnify() if $q->param('Algorithm') eq 'double size';
 3093   $image->Minify() if $q->param('Algorithm') eq 'half size';
 3094   $image->Extent(geometry=>$geometry,background=>$q->param('BackgroundColor'))
 3095     if $q->param('Algorithm') eq 'extent *';
 3096   $image->Resample(density=>$geometry,filter=>$filter,blur=>$blur) if
 3097     $q->param('Algorithm') eq 'resample *';
 3098   $image->Thumbnail($geometry) if $q->param('Algorithm') eq 'thumbnail *';
 3099   #
 3100   # Write image.
 3101   #
 3102   CreateWorkDirectory(1);
 3103   Header(GetTitle($image));
 3104   $status=$image->Write(filename=>'MagickStudio.mpc');
 3105   Error($status) if "$status";
 3106   ViewForm($image);
 3107 }
 3108 
 3109 #
 3110 # Resize image form.
 3111 #
 3112 sub ResizeForm
 3113 {
 3114   use Image::Magick;
 3115 
 3116   my($height, $image, @OptionTypes, $path, $width);
 3117 
 3118   @OptionTypes=
 3119   [
 3120     'resize *',
 3121     'adaptive resize *',
 3122     'double size',
 3123     'extent *',
 3124     'half size',
 3125     'liquid rescale *',
 3126     'resample *',
 3127     'sample *',
 3128     'scale *',
 3129     'thumbnail *'
 3130   ];
 3131 
 3132   #
 3133   # Read image.
 3134   #
 3135   $path=Untaint($q->param('Path'));
 3136   chdir($path) || Error('Your image has expired',$path);
 3137   $image=Image::Magick->new;
 3138   ($width,$height)=$image->Ping("$path/MagickStudio.mpc");
 3139   $q->delete('Geometry');
 3140   #
 3141   # Display Resize form.
 3142   #
 3143   Header(GetTitle($image));
 3144   print <<XXX;
 3145 <p class="lead magick-description">To <a href="$DocumentDirectory/Resize.html" target="help">resize</a> your image, specify the desired size and scaling method.  Note, only methods denoted with an asterisk require a parameter value.  Next, press <code>resize</code> to continue.</p>
 3146 XXX
 3147   ;
 3148   print $q->start_form(-class=>'form-horizontal');
 3149   print $q->hidden(-name=>'CacheID'), "\n";
 3150   print $q->hidden(-name=>'SessionID'), "\n";
 3151   print $q->hidden(-name=>'Path'), "\n";
 3152   print $q->hidden(-name=>'ToolType'), "\n";
 3153   print $q->hidden(-name=>'Name'), "\n";
 3154   print $q->hidden(-name=>'Magick'), "\n";
 3155   print $q->hidden(-name=>'Action',-class=>'btn btn-primary',-value=>'resize'),
 3156     "\n";
 3157   print "<dt>Image size:</dt>\n";
 3158   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Geometry',
 3159     -size=>25,-value=>"$width" . 'x' . "$height"), "</dd><br />\n";
 3160   print "<dt>Choose from these scaling methods:</dt>\n";
 3161   print '<dd>', $q->radio_group(-name=>'Algorithm',-values=>@OptionTypes,
 3162     -columns=>3), "</dd><br />\n";
 3163   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
 3164     -value=>'resize'), ' your image or ', $q->reset(-name=>'reset',
 3165     -class=>'btn btn-warning'), " the form.<br /><br />\n";
 3166   print "<br />\n";
 3167   print "<fieldset>\n";
 3168   print "<legend>Resize Properties</legend>\n";
 3169   print "<dl><dd>\n";
 3170   print "<table class=\"table table-condensed table-striped\">\n";
 3171   print "<tr>\n";
 3172   print "<th>Filter</th>\n";
 3173   print "<th>Support</th>\n";
 3174   print "<th>Blur</th>\n";
 3175   print "</tr>\n";
 3176   print "<tr>\n";
 3177   my @types=Image::Magick->QueryOption('filter');
 3178   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Primitive',
 3179     -values=>[@types]), "</td>\n";
 3180   print '<td>', $q->textfield(-class=>'form-control',-name=>'SupportFactor',
 3181     -size=>25,-value=>'0.0'), "</td>\n";
 3182   print '<td>', $q->textfield(-class=>'form-control',-name=>'BlurFactor',
 3183     -size=>25,-value=>'1.0'), "</td>\n";
 3184   print "</tr>\n";
 3185   print '</table><br />';
 3186   print "<dd><table class=\"table table-condensed table-striped\">\n";
 3187   print "<tr>\n";
 3188   print "<th>Gravity</th>\n";
 3189   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">",
 3190     "Background Color</a></th>\n";
 3191   print "</tr>\n";
 3192   print "<tr>\n";
 3193   my @types=Image::Magick->QueryOption('gravity');
 3194   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Gravity',
 3195     -values=>[@types]), "</td>\n";
 3196   print '<td>', $q->textfield(-class=>'form-control',-name=>'BackgroundColor',
 3197     -value=>'none', -size=>25), "</td>\n";
 3198   print "</tr>\n";
 3199   print '</table></dd><br />';
 3200   print "</dd></dl>\n";
 3201   print "</fieldset>\n";
 3202   print $q->end_form, "\n";
 3203   print <<XXX;
 3204 <br /> <br />
 3205 XXX
 3206   ;
 3207   Trailer(1);
 3208 }
 3209 
 3210 #
 3211 # Restore query state from a file.
 3212 #
 3213 sub RestoreQueryState
 3214 {
 3215   no strict 'subs';
 3216 
 3217   my($session, $path, $tooltype) = @_;
 3218 
 3219   my($filename);
 3220 
 3221   local(*DATA);
 3222 
 3223   $filename=Untaint($DocumentRoot . $DocumentDirectory .
 3224     "/session_info/$session.$tooltype");
 3225   open(DATA,$filename) || return;
 3226   $q=CGI->new(DATA);
 3227   close(DATA);
 3228   $q->param(-name=>'Path',-value=>$path);
 3229 }
 3230 
 3231 #
 3232 # Save query state to a file.
 3233 #
 3234 sub SaveQueryState
 3235 {
 3236   no strict 'subs';
 3237 
 3238   my($session, $tooltype) = @_;
 3239 
 3240   my($filename, $path, $remote_host);
 3241 
 3242   local(*DATA);
 3243 
 3244   $path=$DocumentRoot . $DocumentDirectory . "/session_info";
 3245   $filename=Untaint("$path/$session.$tooltype");
 3246   open(DATA,">$filename") || Error('Unable to view image',$filename);
 3247   $q->save(DATA);
 3248   print DATA "pid: $$\n";
 3249   print DATA "image locator: ", $q->param('File'), "\n" if $q->param('File');
 3250   print DATA "image locator: ", $q->param('URL'), "\n" if $q->param('URL');
 3251   $remote_host='localhost';
 3252   $remote_host=$q->remote_host() if $q->remote_host();
 3253   print DATA "server name: ", $q->server_name(), "\n" if $q->server_name();
 3254   print DATA "remote host: ", GetHostname($remote_host), "\n";
 3255   print DATA "remote addr: ", $q->remote_addr(), "\n" if $q->remote_addr();
 3256   print DATA "remote ident: ", $q->remote_ident(), "\n" if $q->remote_ident();
 3257   print DATA "remote user: ", $q->remote_user(), "\n" if $q->remote_user();
 3258   print DATA "user name: ", $q->user_name(), "\n" if  $q->user_name();
 3259   print DATA "user agent: ", $q->user_agent(), "\n" if $q->user_agent();
 3260   print DATA "time stamp: ", scalar(localtime), "\n";
 3261   close(DATA);
 3262 }
 3263 
 3264 #
 3265 # Print the standard HTML trailer.
 3266 #
 3267 sub Trailer
 3268 {
 3269   my($display) = @_;
 3270 
 3271   my($home, $load_average, $url);
 3272 
 3273   print <<XXX;
 3274   </div>
 3275 </main>
 3276 XXX
 3277   ;
 3278   #
 3279   # Display home and comment icon.
 3280   #
 3281   $url=$q->script_name;
 3282   $load_average=GetLoadAverage();
 3283   $home="$DocumentDirectory/images/home-go.png";
 3284   $home="$DocumentDirectory/images/home-caution.png"
 3285     if $load_average >= ($LoadAverageThreshold/3);
 3286   $home="$DocumentDirectory/images/home-stop.png"
 3287     if $load_average >= (2*$LoadAverageThreshold/3);
 3288   print <<XXX;
 3289   <footer class="magick-footer">
 3290   <div class="container-fluid">
 3291 XXX
 3292   ;
 3293   if ($display)
 3294     {
 3295       my($filename, $height, $image, $path, $url, $width);
 3296 
 3297       #
 3298       # Display image and clipboard icon.
 3299       #
 3300       $image=Image::Magick->new;
 3301       $path="";
 3302       $path=Untaint($q->param('Path')) if $q->param('Path');
 3303       $filename="$path/MagickStudio.gif";
 3304       if (-e $filename)
 3305         {
 3306           ($width,$height)=$image->Ping("$filename" . '[0]');
 3307           $url=substr($path,length($DocumentRoot));
 3308           print "<img alt=\"image icon\" src=\"$url/MagickStudio.gif\" ",
 3309             "border=\"0\" width=\"$width\" height=\"$height\" ",
 3310             "class=\"img-thumbnail img-fluid float-start\"/>\n";
 3311         }
 3312       $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 3313         $q->param('SessionID') . '.gif';
 3314       if (-e $filename)
 3315         {
 3316           ($width,$height)=$image->Ping("$filename" . '[0]');
 3317           print "<img alt=\"clipboard icon\" src=\"$DocumentDirectory/",
 3318             "clipboard/", $q->param('SessionID'), ".gif\" border=\"0\" ",
 3319             "width=\"$width\" height=\"$height\" ",
 3320             "class=\"img-thumbnail img-fluid float-start\"/>\n";
 3321         }
 3322     }
 3323   print <<XXX;
 3324     <div class="nav-link">
 3325       <p><a href="#">Back to top</a> •
 3326          <a href="https://github.com/ImageMagick/ImageMagick/discussions">Community</a> •
 3327          <a href="https://github.com/sponsors/ImageMagick?o=esb">Donate</a></p>
 3328     </div>
 3329 XXX
 3330   print <<XXX;
 3331     <p><small>&copy; 1999-2021 ImageMagick Studio LLC</small></p>
 3332   </div>
 3333   </footer>
 3334   <!-- Javascript assets -->
 3335   <script src="$DocumentDirectory/assets/magick-js.php"></script>
 3336 XXX
 3337   ;
 3338   if ($Debug)
 3339     {
 3340       my($name);
 3341 
 3342       #
 3343       # Display debugging information for an administrator.
 3344       #
 3345       print "<center><h3>CGI State Information</h3></center>\n";
 3346       print "Script:\n";
 3347       print '<dd>', $0, "<br />\n";
 3348       print "Action:\n";
 3349       print '<dd>', $action, "<br />\n";
 3350       print "Time:\n";
 3351       print '<dd>', time-$timer, "s<br />\n";
 3352       print "Query state:\n";
 3353       print '<dd>', $q->query_string, "<br />\n";
 3354       print $q->Dump;
 3355       print "<br />\n";
 3356       print "Environment state:\n";
 3357       print "<ul>\n";
 3358       print "<li><code>SponsorURL</code>: ", $SponsorURL, "<br />\n";
 3359       print "<li><code>SponsorIcon</code>: ", $SponsorIcon, "<br />\n";
 3360       print "<li><code>accept</code>: ", $q->Accept(), "<br />\n";
 3361       print "<li><code>auth type</code>: ", $q->auth_type(), "<br />\n";
 3362       print "<li><code>raw cookie</code>: ", $q->raw_cookie(), "<br />\n";
 3363       print "<li><code>path info</code>: ", $q->path_info(), "<br />\n";
 3364       print "<li><code>path translated</code>: ", $q->path_translated(), "<br />\n";
 3365       print "<li><code>referer</code>: ", $q->referer(), "<br />\n";
 3366       print "<li><code>local addr</code>: ", GetAddress($q->virtual_host()), "<br />\n";
 3367       print "<li><code>remote addr</code>: ", $q->remote_addr(), "<br />\n";
 3368       print "<li><code>remote ident</code>: ", $q->remote_ident(), "<br />\n";
 3369       print "<li><code>remote host</code>: ", GetHostname($q->remote_host()), "<br />\n";
 3370       print "<li><code>remote user</code>: ", $q->remote_user(), "<br />\n";
 3371       print "<li><code>request method</code>: ", $q->request_method(), "<br />\n";
 3372       print "<li><code>script name</code>: ", $q->script_name(), "<br />\n";
 3373       print "<li><code>server name</code>: ", $q->server_name(), "<br />\n";
 3374       print "<li><code>server software</code>: ", $q->server_software(), "<br />\n";
 3375       print "<li><code>server port</code>: ", $q->server_port(), "<br />\n";
 3376       print "<li><code>temporary directory</code>: ", $ENV{TMPDIR}, "<br />\n";
 3377       print "<li><code>user agent</code>: ", $q->user_agent(), "<br />\n";
 3378       print "<li><code>user name</code>: ", $q->user_name(), "<br />\n";
 3379       print "<li><code>virtual host</code>: ", $q->virtual_host(), "<br />\n";
 3380       print "<li><code>environment</code>: ", $q->http(), "<br />\n";
 3381       print "<li><code>time stamp</code>: ", scalar(localtime), "<br />\n";
 3382       print "</ul>\n";
 3383     }
 3384   print $q->end_html;
 3385   exit;
 3386 }
 3387 
 3388 #
 3389 # Transform image.
 3390 #
 3391 sub Transform
 3392 {
 3393   use Image::Magick;
 3394 
 3395   my($color, $image, $parameter, $path, $status);
 3396 
 3397   #
 3398   # Read image.
 3399   #
 3400   $path=Untaint($q->param('Path'));
 3401   chdir($path) || Error('Your image has expired',$path);
 3402   $image=Image::Magick->new;
 3403   $status=$image->Read("$path/MagickStudio.mpc");
 3404   Error($status) if $#$image < 0;
 3405   #
 3406   # Transform image.
 3407   #
 3408   $parameter=$q->param('Parameter');
 3409   $image->Set(fuzz=>$q->param('Fuzz')) if $q->param('Fuzz');
 3410   $image->Set(background=>$q->param('BackgroundColor'));
 3411   $image->Set(gravity=>$q->param('Gravity'));
 3412   $image->AffineTransform([split(/[ ,]+/,$parameter)]) if
 3413     $q->param('Option') eq 'affine *';
 3414   $image->AutoOrient() if $q->param('Option') eq 'auto-orient';
 3415   $image->Trim() if $q->param('Option') eq 'trim';
 3416   $image->Crop("$parameter") if $q->param('Option') eq 'crop *';
 3417   $image->Chop("$parameter") if $q->param('Option') eq 'chop *';
 3418   $image=$image->Coalesce() if $q->param('Option') eq 'coalesce';
 3419   $image->Colorspace($q->param('Colorspace')) if
 3420     $q->param('Option') eq 'colorspace';
 3421   $image->Deconstruct() if $q->param('Option') eq 'deconstruct';
 3422   $image->Deskew($parameter) if $q->param('Option') eq 'deskew';
 3423   $image=$image->Flatten() if $q->param('Option') eq 'flatten';
 3424   $image->Flop() if $q->param('Option') eq 'flop';
 3425   $image->Flip() if $q->param('Option') eq 'flip';
 3426   $image=$image->Layers(method=>$q->param('LayerMethod')) if
 3427     $q->param('Option') eq 'layers';
 3428   $image->Rotate(90) if $q->param('Option') eq 'rotate right';
 3429   $image->Rotate(-90) if $q->param('Option') eq 'rotate left';
 3430   $color='none';
 3431   $color=$q->param('BackgroundColor') if $q->param('BackgroundColor');
 3432   $image->Rotate(degrees=>$parameter,background=>$color) if
 3433     $q->param('Option') eq 'rotate *';
 3434   $image->Shave("$parameter") if $q->param('Option') eq 'shave *';
 3435   $image->Shear("$parameter") if $q->param('Option') eq 'shear *';
 3436   $image->Splice("$parameter") if $q->param('Option') eq 'splice *';
 3437   $image->Roll("$parameter") if $q->param('Option') eq 'roll *';
 3438   $image->Set(page=>'0x0+0+0') if $q->param('Repage') eq 'on';
 3439   $image->Transpose() if $q->param('Option') eq 'transpose';
 3440   $image->Transverse() if $q->param('Option') eq 'transverse';
 3441   $image->UniqueColors() if $q->param('Option') eq 'unique colors';
 3442   #
 3443   # Write image.
 3444   #
 3445   CreateWorkDirectory(1);
 3446   Header(GetTitle($image));
 3447   $status=$image->Write(filename=>'MagickStudio.mpc');
 3448   Error($status) if "$status";
 3449   ViewForm($image);
 3450 }
 3451 
 3452 #
 3453 # Transform image form.
 3454 #
 3455 sub TransformForm
 3456 {
 3457   my @OptionTypes=
 3458   [
 3459     'affine *',
 3460     'auto-orient',
 3461     'chop *',
 3462     'colorspace',
 3463     'coalesce',
 3464     'crop *',
 3465     'deconstruct',
 3466     'deskew',
 3467     'flatten',
 3468     'flip',
 3469     'flop',
 3470     'layers',
 3471     'roll *',
 3472     'rotate *',
 3473     'rotate left',
 3474     'rotate right',
 3475     'shave *',
 3476     'shear *',
 3477     'splice *',
 3478     'transpose',
 3479     'transverse',
 3480     'trim',
 3481     'unique colors'
 3482   ];
 3483 
 3484   #
 3485   # Display Transform form.
 3486   #
 3487   Header(GetTitle(undef));
 3488   print <<XXX;
 3489 <p class="lead magick-description">To <a href="$DocumentDirectory/Transform.html" target="help">transform</a> your image, enter your transform parameter and method.  Note, only methods denoted with an asterisk require a parameter value.  Next, press <code>transform</code> to continue.</p>
 3490 XXX
 3491   ;
 3492   print $q->start_form(-class=>'form-horizontal');
 3493   print $q->hidden(-name=>'CacheID'), "\n";
 3494   print $q->hidden(-name=>'SessionID'), "\n";
 3495   print $q->hidden(-name=>'Path'), "\n";
 3496   print $q->hidden(-name=>'ToolType'), "\n";
 3497   print $q->hidden(-name=>'Name'), "\n";
 3498   print $q->hidden(-name=>'Magick'), "\n";
 3499   print $q->hidden(-name=>'Action',-class=>'btn btn-primary',-value=>'resize'),
 3500     "\n";
 3501   print "<dt>Parameter:</dt>\n";
 3502   print '<dd>', $q->textfield(-class=>'form-control',-name=>'Parameter',
 3503     -size=>25), "</dd><br />\n";
 3504   print "<dt>Choose from these transforms:</dt>\n";
 3505   print '<dd>', $q->radio_group(-name=>'Option',-values=>@OptionTypes,
 3506     -columns=>3,-default=>'trim'), "</dd><br />\n";
 3507   print 'Press to ', $q->submit(-name=>'Action',-class=>'btn btn-primary',
 3508     -value=>'transform'), ' your image or ', $q->reset(-name=>'reset',
 3509     -class=>'btn btn-warning'), " the form.<br /><br />\n";
 3510   print "<br />\n";
 3511   print "<fieldset>\n";
 3512   print "<legend>Transform Properties</legend>\n";
 3513   print "<dl><dd>\n";
 3514   print "<table class=\"table table-condensed table-striped\">\n";
 3515   print "<tr>\n";
 3516   print "<th><a href=\"$DocumentDirectory/Fuzz.html\" target=\"help\">Fuzz</a></th>\n";
 3517   print "<th>Gravity</th>\n";
 3518   print "</tr>\n";
 3519   print "<tr>\n";
 3520   print '<td>', $q->textfield(-class=>'form-control',-name=>'Fuzz',-size=>25,
 3521     -value=>'0%'), "</td>\n";
 3522   my @types=Image::Magick->QueryOption('gravity');
 3523   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Gravity',
 3524     -values=>[@types]), "</td>\n";
 3525   print "</tr>\n";
 3526   print "<tr>\n";
 3527   print "<th><a href=\"$DocumentDirectory/Colorspace.html\" target=\"help\">Colorspace</a></th>\n";
 3528   print "</tr>\n";
 3529   print "<tr>\n";
 3530   my @types=Image::Magick->QueryOption('colorspace');
 3531   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'Colorspace',
 3532     -values=>[@types],-default=>'sRGB'), "</td>\n";
 3533   print "<tr>\n";
 3534   print '</table><br />';
 3535   print "<table class=\"table table-condensed table-striped\">\n";
 3536   print "<tr>\n";
 3537   print "<th>Layer Method</th>\n";
 3538   print "<th><a href=\"$DocumentDirectory/Color.html\" target=\"help\">Background Color</a></th>\n";
 3539   print "</tr>\n";
 3540   print "<tr>\n";
 3541   my @types=Image::Magick->QueryOption('layers');
 3542   print '<td>', $q->popup_menu(-class=>'form-control',-name=>'LayerMethod',
 3543     -values=>[@types],-default=>'Optimize'), "</td>\n";
 3544   print '<td>', $q->textfield(-class=>'form-control',-name=>'BackgroundColor',
 3545     -value=>'none',-size=>25), "</td>\n";
 3546   print "</tr>\n";
 3547   print '</table><br />';
 3548   print "<dt> Miscellaneous options:</dt>\n";
 3549   print '<dd>', $q->checkbox(-name=>'Repage',
 3550     -checked=>'true',-label=>' reset page geometry.'), "</dd>\n";
 3551   print "</dd></dl>\n";
 3552   print "</fieldset>\n";
 3553   print $q->end_form, "\n";
 3554   print <<XXX;
 3555 XXX
 3556   ;
 3557   Trailer(1);
 3558 }
 3559 
 3560 #
 3561 # Untaint Perl variable.
 3562 #
 3563 sub Untaint
 3564 {
 3565   my($filename) = @_;
 3566 
 3567   if ($filename =~ /\&\;\`\'\"\|*?\~\<\>\^()\[\]\{\}\$\n\r/)
 3568     {
 3569       $filename=~s/\&\;\`\'\"\|*?\~\<\>\^()\[\]\{\}\$\n\r/\?/g;
 3570       Error('Your filename contains prohibited characters',$filename);
 3571     }
 3572   $filename;
 3573 }
 3574 
 3575 #
 3576 # Upload image.
 3577 #
 3578 sub Upload
 3579 {
 3580   no strict 'refs';
 3581   no strict 'subs';
 3582 
 3583   use Image::Magick;
 3584   use LWP::Simple;
 3585   use File::Basename;
 3586   use File::Copy;
 3587   use Digest::SHA3;
 3588 
 3589   my(@attributes, $basename, $digest, $extent, @extents, $filename, $format,
 3590      $i, $image, $magick, $path, $session, $status, $scene);
 3591 
 3592   #
 3593   # Expire files.
 3594   #
 3595   $path=$DocumentRoot . $DocumentDirectory;
 3596   ExpireFiles("$path/workarea",$ExpireThreshold);
 3597   ExpireFiles("$path/clipboard",$ExpireThreshold);
 3598   ExpireFiles("$path/tmp",$ExpireThreshold);
 3599   ExpireFiles("$path/session_info",7*$ExpireThreshold);
 3600   ExpireFiles("$path/comments",14*$ExpireThreshold);
 3601   #
 3602   # Read image.
 3603   #
 3604   Error('You must specify either an image filename or URL') unless
 3605     ($q->param('File') || $q->param('URL') || $q->param('Meta'));
 3606   CreateWorkDirectory(undef);
 3607   $path=$q->param('Path');
 3608   $format='';
 3609   $format=$q->param('Format') . ':'
 3610     if ($q->param('Format') && ($q->param('Format') ne 'Implicit'));
 3611   $scene='';
 3612   $scene='[' . $q->param('Scene') . ']' if $q->param('Scene');
 3613   $image=Image::Magick->new;
 3614   $image->Set(font=>$DefaultFont);
 3615   $image->Set(density=>$q->param('Density')) if $q->param('Density');
 3616   $image->Set(size=>$q->param('SizeGeometry')) if $q->param('SizeGeometry');
 3617   if ($q->param('File'))
 3618     {
 3619       #
 3620       # Copy data file to workarea.
 3621       #
 3622       $filename=Untaint($q->param('File'));
 3623       copy($q->upload('File'),'MagickStudio.dat') ||
 3624         copy(\*$filename,'MagickStudio.dat') ||
 3625           getstore($filename,'MagickStudio.dat');
 3626       if (-z 'MagickStudio.dat')
 3627         {
 3628           $q->param('SizeGeometry')=~/(\d+)\D*(\d*)/;
 3629           Error('Image area exceeds maximum allowable') if $1 && $2 &&
 3630             (($1*$2) > (1024*$MaxImageArea));
 3631           Error('Image area exceeds maximum allowable') if $1 && !$2 &&
 3632             (($1*$1) > (1024*$MaxImageArea));
 3633           $filename=$DocumentRoot . $DocumentDirectory . '/clipboard/' .
 3634             $q->param('SessionID') . '.mpc' if $filename eq 'clipboard:';
 3635           $format=$q->param('Format') . ':' if $q->param('Format');
 3636           $status=$image->Read("$format$filename$scene");
 3637           Error($status) if $#$image < 0;
 3638           $status=$image->Write('MagickStudio.dat');
 3639           Error($status) if "$status";
 3640           $format='';
 3641         }
 3642     }
 3643   else
 3644     {
 3645       if ($q->param('URL'))
 3646         {
 3647           $filename=Untaint($q->param('URL'));
 3648           if (!($filename =~ /\/$/))
 3649             {
 3650               #
 3651               # Copy HTTP content to MagickStudio.dat.
 3652               #
 3653               getstore($filename,'MagickStudio.dat');
 3654               if ((-f 'MagickStudio.dat') && (-s 'MagickStudio.dat'))
 3655                 {
 3656                   if (($filename =~ /.html$/) || ($filename =~ /.htm$/))
 3657                     {
 3658                       #
 3659                       # Convert HTML content to Postscript.
 3660                       #
 3661                       @extents=$image->Ping("$filename");
 3662                       $extent=0;
 3663                       for ($i=0; $i < $#extents; $i+=4)
 3664                         { $extent+=$extents[$i]*$extents[$i+1]; }
 3665                       Error('Image extents exceeds maximum allowable') if
 3666                         $extent && ($extent > (1024*$MaxImageExtent));
 3667                       $status=$image->Read($filename);
 3668                       Error($status) if $#$image < 0;
 3669                       $status=$image->Write('MagickStudio.dat');
 3670                       Error($status) if "$status";
 3671                     }
 3672                 }
 3673             }
 3674           else
 3675             {
 3676               #
 3677               # Copy all images in HTTP directory to MagickStudio.dat.
 3678               #
 3679               FetchImages($filename,undef,0);
 3680               @extents=$image->Ping("*");
 3681               $extent=0;
 3682               for ($i=0; $i < $#extents; $i+=4)
 3683                 { $extent+=$extents[$i]*$extents[$i+1]; }
 3684               Error('Image extents exceeds maximum allowable') if $extent &&
 3685                 ($extent > (1024*$MaxImageExtent));
 3686               $status=$image->Read("*");