"Fossies" - the Fresh Open Source Software Archive

Member "astrocam-2.7.6/pic.pl" (26 May 2009, 2389 Bytes) of package /linux/www/old/astrocam-2.7.6.tgz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl 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. For more information about "pic.pl" see the Fossies "Dox" file reference documentation.

    1 #!/usr/bin/perl -wT
    2 
    3 # pic.pl is distributed under the following license:
    4 #
    5 # Copyright (C) 2007-2008 Steffen Wendzel <steffen (at) ploetner-it (dot) de>
    6 #
    7 # Redistribution and use in source and binary forms, with or without
    8 # modification, are permitted provided that the following conditions
    9 # are met:
   10 # 1. Redistributions of source code must retain the above copyright
   11 #    notice, this list of conditions and the following disclaimer.
   12 # 2. Redistributions in binary form must reproduce the above copyright
   13 #    notice, this list of conditions and the following disclaimer in the
   14 #    documentation and/or other materials provided with the distribution.
   15 #
   16 # THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
   17 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   18 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   19 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
   20 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
   21 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
   22 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
   23 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   24 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
   25 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
   26 # SUCH DAMAGE.
   27 
   28 use strict;
   29 use CGI qw(:standard);
   30 use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
   31 
   32 sub ReadForm {
   33     my %FORM;
   34     foreach my $field (param()) {
   35         $FORM{$field} = param($field);
   36         # check for some bad characters here
   37         unless ($FORM{$field} =~ /^[a-zA-Z0-9\.\:\ \/\-\+\_]+$/) { #\\[\]\{\(\)\&\|]+$/ ) {
   38             die "Insecure Character in \"$FORM{$field}\" found.";
   39         }
   40     }
   41     return %FORM;
   42 }
   43 
   44 my %FORM = ReadForm();
   45 my $picfile = $FORM{"picfile"};
   46 my $refreshtime = $FORM{"refreshtime"};
   47 
   48 if ($refreshtime <= 0 || $refreshtime > 9999999) {
   49     die "refreshtime out of range!";
   50 }
   51 
   52 print header;
   53 print '<html>
   54 <head>
   55     <meta http-equiv="pragma" content="no-cache">
   56     <meta http-equiv="refresh" content="'.$refreshtime.';pic.pl?picfile='.$picfile.'&refreshtime='.$refreshtime.'">
   57     <link rel="stylesheet" type="text/css" href="/design.css" title="primary">
   58 </head>
   59 <body>
   60 <table>
   61 <tr>
   62     <td class="menu">
   63         <img src="'.$picfile.'" alt="current image">
   64     </td>
   65 </tr>
   66 </body>
   67 </html>';