I'm trying to use the random_image.pl program from the nms-cgi project
on sourceforge.net.
This line has me baffled:
if ( $baseurl !~ m%/$% )
I don't understand the function of the percent symbols.
I hope someone can explain what it's doing.
Here's the complete program:
1 #! /usr/bin/perl -wT
2 #
3 # $Id: rand_image.pl,v 1.11 2002/10/21 19:37:36 nickjc Exp $
4 #
5
6 use strict;
7 use CGI qw(redirect header);
8 use Fcntl qw(:DEFAULT :flock);
9 use vars qw($DEBUGGING $done_headers);
10
11 # Configuration
12
13 #
14 # $DEBUGGING must be set in a BEGIN block in order to have it be set before
15 # the program is fully compiled.
16 # This should almost certainly be set to 0 when the program is 'live'
17 #
18
19 BEGIN
20 {
21 $DEBUGGING = 1;
22 }
23
24 # If this is set to 1 then the program will issue a redirect to the image
25 # and $baseurl must be the beginning of the URI where the images reside.
26 # This might not work on all browsers.
27 # If it is set to 0 then the program will send the image to the browser
28 # directly (which is more costly for the server) in which case $basedir
29 # must be the full system path to the directory where the image files are.
30 # It might be necessary to add new extenstion => content type pairs to
31 # the %content_type below if you are using file extenstions that are not
32 # among the defaults.
33
34 my $use_redirect = 0;
35 my $baseurl = 'http://nms-test.gellyfish.com/images/';
36 my $basedir = '/var/www/nms-test/images/';
37
38 # Your image files here.
39
40 my @files = qw(
41 foo.jpg
42 bah.png
43 );
44
45 my $uselog = 0; # 1 = YES; 0 = NO
46 my $logfile = '/path/to/piclog';
47
48 # End configuration
49
50 # Might need to add to content types mapping extensions
51
52 my %content_types = (
53 jpg => 'image/jpeg',
54 gif => 'image/gif',
55 png => 'image/png'
56 );
57
58 # We need finer control over what gets to the browser and the CGI::Carp
59 # set_message() is not available everywhere :(
60 # This is basically the same as what CGI::Carp does inside but simplified
61 # for our purposes here.
62
63 BEGIN
64 {
65 sub fatalsToBrowser
66 {
67 my ( $message ) = @_;
68
69 if ( $DEBUGGING )
70 {
71 $message =~ s/</</g;
72 $message =~ s/>/>/g;
73 }
74 else
75 {
76 $message = '';
77 }
78
79 my ( $pack, $file, $line, $sub ) = caller(0);
80 my ($id ) = $file =~ m%([^/]+)$%;
81
82 return undef if $file =~ /^\(eval/;
83
84 print "Content-Type: text/html\n\n" unless $done_headers;
85
86 print <<EOERR;
87 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
88 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd";>
89 <html xmlns="http://www.w3.org/1999/xhtml";>
90 <head>
91 <title>Error</title>
92 </head>
93 <body>
94 <h1>Application Error</h1>
95 <p>
96 An error has occurred in the program
97 </p>
98 <p>
99 $message
100 </p>
101 </body>
102 </html>
103 EOERR
104 die @_;
105 };
106
107 $SIG{__DIE__} = \&fatalsToBrowser;
108 }
109
110
111 my $pic = $files[rand @files];
112
113 # Log Image
114 if ($uselog) {
115 sysopen (LOG, $logfile, O_RDWR|O_APPEND|O_CREAT)
116 or die "Can't open logfile: $!\n";
117 flock(LOG, LOCK_EX)
118 or die "Can't lock logfile: $!\n";
119 print LOG "$pic\n";
120 close (LOG)
121 or die "Can't close logfile: $!\n";
122 }
123
124 if ( $use_redirect )
125 {
126 if ( $baseurl !~ m%/$% )
127 {
128 $baseurl .= '/';
129 }
130 print redirect("$baseurl$pic");
131 $done_headers++;
132 }
133 else
134 {
135 if ( $basedir !~ m%/$% )
136 {
137 $basedir .= '/';
138 }
139
140 my ( $extension ) = $pic =~ /\.(\S+)$/;
141
142 my $ctype = $content_types{$extension} || 'image/png';
143
144 open INFILE, "<$basedir$pic" or die "Can't open $basedir$pic - $!";
145 binmode INFILE;
146 local $/;
147
148 my $image = <INFILE>;
149 close INFILE;
150
151 print header(-type => $ctype),
152 $image;
153 }
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
