#!/usr/bin/perl # Add -wT ? # # See the bottom of this file for the POD documentation. # Search for the string '=head'. # http://www.jurta.org/cgi-bin/igaview.pl?../tanja/2004/20040720_Punane.jpg use strict; use CGI qw(:standard); $| = 1; # enable autoflush use vars qw( $DEBUGGING_IP $charset $im $imw $imh $imname ); BEGIN { if (defined($ENV{'DOCUMENT_ROOT'})) { $charset = "iso-8859-1"; # "koi8-r" print "Content-Type: text/html; charset=$charset\n\n"; # print "Content-Type: text/plain; charset=$charset\n\n"; sub html_show_error { my ($text) = shift; # TODO: if $ENV{'REMOTE_ADDR'} =~ $DEBUGGING_IP { } # if ($DEBUGGING_IP) { # $text = cleanup_input($text); # } else { # $text = ""; # } # my ( $pack, $file, $line, $sub ) = caller(0); # my ($id ) = $file =~ m%([^/]+)$%; # return undef if $file =~ /^\(eval/; print "\n"; print < 500 - Server error!

ERROR 500 - Server error!

The server encountered an internal error and was unable to complete your request.

$text

HERE die @_; }; $SIG{__DIE__} = \&html_show_error; delete @ENV{qw(ENV BASH_ENV IFS PATH)}; # my $query = new CGI; # print $query->header(); # print "

";

    $im = $ENV{'QUERY_STRING'};
    $im =~ tr/+/ /;
    $im =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
  } elsif (defined $ARGV[0]) {
    $im = $ARGV[0];
  }
  if (!$im) {
    die "ERROR: Please specify image file as program argument\n";
  } else {
    $im =~ s(/$)();
  }
}

if ($im =~ m(/([^/]+)$)) {
  $imname = $1
} else {
  $imname = $im
}

if (`identify $im` =~ m((\d+)x(\d+))) {
  ($imw, $imh) = ($1, $2)
} else {
  ($imw, $imh) = (0, 0)
}

print <




$imname






[Fit to window] 
[Full size] 
[800x600] 
[1024x768] 




EOF

1;

__END__

=head1 NAME

igaview - view image files

=head1 SYNOPSIS

    igaview image-file
    http://host/cgi-bin/igaview.pl?image-file

=head1 DESCRIPTION

B displays images.

=head2 OPTIONS

    image-file : the name of a image file.

=head1 NOTES

B can be run stand-alone or from CGI.
When B is used under CGI, it outputs a content-type header.
B detects the fact that it is called under CGI by inspecting
the presense of the value of the 'DOCUMENT_ROOT' environment variable.

=head1 SEE ALSO

B

=head1 AUTHOR

Juri Linkov Ejuri@jurta.org>

=head1 COPYRIGHT

Copyright (C) 2006 Juri Linkov.  All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself or GPL.

;;; Local Variables:
;;; coding: koi8-r
;;; End:

=cut