First, consider <CODE> tags instead of <PRE>. It word wraps.
If I understand you correctly, you don't want perl to interpret what you're writing to the file. In that case, use single quotes (') instead of double-quotes ("). You may also want to use something like <<EOF to write a bunch of output.
Here's what your code may end up looking like:
#####Create Perl upload script
open(FILE, ">$basedir$q_brieftitle/upload.cgi")
|| &diedebug("$header Could not create file "
. "$basedir$q_brieftitle/upload.cgi: $! . "
. "It's possible that your web server will not "
. "let me create files even if I own the directory. "
. "If you have chmodded $basedir$q_brieftitle/ "
. "to 777 and you are still getting this message, "
. "then you will need to create your quizzes and "
. "answerfiles by hand. :( $footer");
flock(FILE, 2);
&get_date;
# Note the single quotes in the next line...
print FILE <<'EOF';
#!/usr/bin/perl
$basedir = "/home/sites/stuff/users/web/up2";
$allowall = "yes";
$theext = ".gif";
$donepage = "http://www.yourpage.com/";
## DO NOT EDIT OR COPY BELOW THIS LINE ##
use CGI;
$onnum = 1;
while ($onnum != 11) {
my $req = new CGI;
my $file = $req->param("FILE$onnum");
if ($file ne "") {
my $fileName = $file;
$fileName =~ s!^.*(\\|\/)!!;
$newmain = $fileName;
if ($allowall ne "yes") {
if (lc(substr($newmain,length($newmain) - 4,4)) ne $theext){
$filenotgood = "yes";
}
}
if ($filenotgood ne "yes") {
open (OUTFILE, ">$basedir/$fileName");
print "$basedir/$fileName";
while (my $bytesread = read($file, my $buffer, 1024)) {
print OUTFILE $buffer;
}
close (OUTFILE);
}
}
$onnum++;
}
print "Content-type: text/html\n";
print "Location:$donepage\n\n";
EOF
close(FILE);
Cheers,
Shendal
| [reply] [d/l] |
Thank you! That did the trick! Which brings me to another question...how can I adjust the script so that the $basedir will always point to the directory where the script is newly written? Or possibly add a $subdir variable? If so, how can I accomplish this?
thank you
koa
i want to learn
| [reply] |
Ummm, I'm not exactly sure what $basedir is supposed to mean. Perhaps something like this will show you a solution?
#!/usr/bin/perl -w
use strict; # always
use File::Basename;
my $prog = $^X;
my $basedir = dirname($prog);
print "prog : $prog\n";
print "basedir: $basedir\n";
Which outputs:
prog : /usr/bin/perl
basedir: /usr/bin
Cheers,
Shendal
| [reply] [d/l] [select] |
I would also like the script to write the upload.cgi program but am running into difficulties with the variables conflicting with the main program. Is there a way to have the script written to the newly created directory without conflict? Is there a way to "Shield" the $variables?
You should look into using modules. See perlman:perlmod, perlman:perllib and perlman:perlboot.
You can put your subroutines and variables into their own package, which "shields" them from other packages (in that they are in their own namespace. The program can trample any namespace it wants, but polite programs only change variables in their own namespaces)
| [reply] |
here is something I've tried to make out of your code.
I hope, that helps a bit :-))
The vars ending with usr_specific I left empty, so the produced script will redirect to your localhosts root dir when that blank.
#!/usr/bin/perl -w
use strict;
$|++;
use CGI qw/:all /;
use CGI::Carp qq/fatalsToBrowser/;
my ($q, $basedir, $q_brieftitle, @stored, @output, $line, $rights);
my ($dir_usr_specific, $rights_usr_specific, $filetypes_usr_specific,
+$domain_usr_specific);
$q = CGI->new();
print $q->header();
print $q->start_html();
#####Create Perl upload script
$basedir = "..";
$q_brieftitle = "/cgi-bin";
# user sepcific definitions go here
$rights = '$basedir = "/home/sites/stuff/users/'.$dir_usr_specific.'";
+';
$rights .= '$allowall = "'.$rights_usr_specific.'";';
$rights .= '$theext = ".'.$filetypes_usr_specific.'";';
$rights .= '$donepage = "'.$domain_usr_specific.'";';
# end user sepcific definitions
open (FILE, ">$basedir$q_brieftitle/upload.cgi") || die "blah";
#flock(FILE, 2);
# process
@stored = <DATA>;
foreach $line (@stored)
{
push @output, $line;
if ($line =~ /^\# usr_spec_def/i)
{
foreach $_ (split (";", $rights))
{
push @output, $_.";\n";
}
}
}
print FILE @output;
close FILE;
print $q->code(pre(@output)), end_html();
# the folllowing DATA section could also be somewhere in a file
__DATA__
#!/usr/bin/perl
use strict;
$|++;
use CGI qw/:all/;
my ($basedir, $allowall, $theext, $donepage, $req, $onnum);
## DO NOT EDIT OR COPY ABOVE THIS LINE :-) ##
# usr_spec_def
## DO NOT EDIT OR COPY BELOW THIS LINE##
$req = CGI->new();
$onnum = 1;
while ($onnum != 11)
{
my ($bytesread, $buffer, $filenotgood);
my $file = $req->param("FILE$onnum");
if ($file)
{
my $fileName = $file;
$fileName =~ s!^.*(\|\/)!!;
my $newmain = $fileName;
if ($allowall ne "yes")
{
if (lc(substr($newmain,length($newmain) - 4,4)) ne $theext
+)
{
$filenotgood = "yes";
}
}
if ($filenotgood ne "yes")
{
open (OUTFILE, ">$basedir/$fileName") || die "failed";
print $req->p("$basedir/$fileName");
while ($bytesread = read($file, $buffer, 1024))
{
print OUTFILE $buffer;
}
close OUTFILE;
}
}
$onnum++;
}
print $req->redirect($donepage);
when I was looking on your code, it was quite helpful to me, that this one gives the content of the created file to the browser(screen).
I hope by now, I understood, what you are trying to do :-))
have a nice day | [reply] [d/l] |
You will also want to look at the "Here Document" style
of quoting. It's very nice for large blocks of text that
you are going to print out. Lord knows where the docs are
for it in the "perldoc" hierarchy, it's pg.43 in Camel2ed.
--
$you = new YOU;
honk() if $you->love(perl)
| [reply] |
I would recommend using File::Copy instead of writing the script by hand. The syntax is simply: Copy("from file", "to file") Also, you could check directories for read/write access using if (-w $file && -r $file) and chmod() the directory if necessary.
| [reply] |