Developed a perl staging mechanism that acted as a web site staging mechanissm when used in conjunction with Dreamweaver. This script filters pages and publishes them to a live server after an editorial process is completed. This was developed as a low-cost, easily maintained alternative to complicated content management software. This is currently in use by the Joslin Diabetes Clinic cinderella ii dreams come true divx download beetle juice dvd , for whom this was developed.
#!/usr/local/bin/perl # stage.pl # Greg Rushton # 2/11/2000 use File::Copy; use File::Path; $mail_prog = "/usr/lib/sendmail"; $templ_loc = "/path/to/template.html"; $referer = $ENV{'HTTP_REFERER'}; $doc_root = $ENV{'DOCUMENT_ROOT'}; ($new_link = $referer) =~ s{/stage/}{/}; $body = ""; $new_path = ""; $old_path = ""; $now = localtime(time); &get_template; &parse_form; if ($FORM{request_type} eq "review") { &send_review; $body = "Your submission was successfully submitted.<p><small>$now</small>"; &reply_html ($body); } if ($FORM{request_type} eq "publish") { &send_publish; $body = "Your submission was successfully submitted.<p><small>$now</small>"; &reply_html ($body); } if ($FORM{request_type} eq "approve") { if ($FORM{password} eq "batman") { &write_new; $body = "<p><a href="$new_link">Newly published page</a><p>"; &reply_html ($body); &synch_gifs; } else { $error = "Sorry, wrong password"; &reply_error ($error); } } if ($FORM{request_type} eq "revise") { if ($FORM{publisher} == "") { $from = $FORM{editor}; } else { $from = $FROM{publisher}; } &send_revise; $body = "Your revision notice was successfully submitted.<p><small>$now</small>"; &reply_html ($body); } ################################# # This subroutine synchronizes the /gifs/ directory # with the /stage/gifs/ directory so that any images # associated with the staging area will be # automatically copied to the live area. sub synch_gifs { local ($staged_path, $live_path); $staged_path = "/path/to/stage/gifs/"; $live_path = "/path/to/gifs/"; opendir(DIR, $staged_path) || die "Cant open $staged_path directory: $!"; while (defined($file = readdir(DIR))) { if (!-e "$live_path/$file") { copy ("$staged_path/$file", "$live_path/$file") || die "Cant copy $staged_path/$file: $!"; } } closedir (DIR); } ################################# # This subroutine writes the stripped file # to its new location outside of the staging # folder. It just moves the file one directory up # after stripping out the form area. sub write_new { local(@referers, @page_lines); @referers = split ///, $referer; # Remove the http://blah.blah.blah/ from the @referers shift @referers; shift @referers; shift @referers; # Construct the doc path of the file to move $old_path = $doc_root; foreach (@referers) { $old_path .= "/$_"; } # Make the doc path for the new file ($new_path = $old_path) =~ s{/stage}{}; # Test this directory to make sure it exists if (!-e "$new_path") { mkpath ([$new_path], 0, 0777); } # Do the copying, open (OLD, "< $old_path") || die "Cant open $old_path: $!"; flock (OLD, 1) || die "Cant flock $old_path: $!"; while (<OLD>) { push(@page_lines, $_); } close (OLD); # Stripping, &strip_page(@page_lines); # And pasting. open (NEW, "> $new_path") || die "Cant open $new_path: $!"; flock (NEW, 2) || die "Cant flock $new_path: $!"; foreach (@page_lines) { print NEW $_; } close (NEW); } ################################# # Strip out the form area of the page # that calls this script. Run through each # element of the @page_lines array, and delete # it if its between the matched comment tags. sub strip_page { local($pop_flag=0, $counter=0); foreach (@page_lines) { if (m/<!--BEGINPUBFORM-->/) { $pop_flag = 1; } if (m/<!--ENDPUBFORM-->/) { $pop_flag = 0; $_ = ""; } if ($pop_flag){ $_ = ""; } # Modify all errant links to the staging directory. # Needs work on the pattern. Should only look within # anchor tags. Now, it works in all string values. s{/stage/}{/}g; } } ################################# # This subroutine sends out an email to # the editor after a request for # review is made. sub send_review { open(MAIL,"|$mail_prog -t"); print MAIL "To: $FORM\{editor}\n"; print MAIL "From: $FORM\{contributor_email}\n"; print MAIL "Subject: Request for Editor Review\n\n"; print MAIL "-" x 75 . "\n\n"; print MAIL "$FORM\{contributor_name} has requested that you\n"; print MAIL "review the following page: $referer\n"; print MAIL "for publication. Please review and reply.\n\n"; print MAIL "$now\n"; print MAIL "-" x 75 . "\n\n"; close(MAIL); } ################################# # This subroutine sends out an email to # publisher after a request for # publishing is made. sub send_publish { open(MAIL,"|$mail_prog -t"); print MAIL "To: $FORM\{publisher}\n"; print MAIL "From: $FORM\{editor}\n"; print MAIL "Subject: Request for Publication\n\n"; print MAIL "-" x 75 . "\n\n"; print MAIL "$FORM\{editor} has requested that you\n"; print MAIL "review the following page: $referer\n"; print MAIL "for publication. Please review and reply.\n\n"; print MAIL "$now\n"; print MAIL "-" x 75 . "\n\n"; close(MAIL); } ################################# # This subroutine sends out an email to # page authors after a request for # revisions is made. sub send_revise { open(MAIL,"|$mail_prog -t"); print MAIL "To: $FORM\{contributor_email}, $FORM\{editor}\n"; print MAIL "From: $from\n"; print MAIL "Subject: Revision Notification\n\n"; print MAIL "-" x 75 . "\n\n"; print MAIL "$from has requested revisions \n"; print MAIL "for this page citing the following reasons: \n\n"; print MAIL "$FORM\{notes}\n\n"; print MAIL "Please review and re-submit\n"; print MAIL "this page for publication: \n$referer\n\n"; print MAIL "$now\n"; print MAIL "-" x 75 . "\n\n"; close(MAIL); } ################################## # Standard reply html. Pass this subroutine # the $body variable to customize the returned # html. sub reply_html { $template =~ s/<<title>>/Reply/m; $template =~ s/<<bodytext>>/<p>$body</p>/m; print "Content-type: text/html", "\n\n"; print $template; } ################################## # Standard error html. Uses $error variable # to hold the error message. Pass this that # variable to customize the returned html. sub reply_error { $template =~ s/<<title>>/Error/m; $template =~ s/<<bodytext>>/<p>$error</p>/m; print "Content-type: text/html", "\n\n"; print $template; } ################################# # The template is stored in /bin/template.html # This subroutine stores it in $template for # use by other subroutines. Use it and replace # <<title>> with a title, and <<bodytext>> with # text for the body of the page. sub get_template { open (TEMPLATE, "$templ_loc") || die "Cant open $template: $!"; flock (TEMPLATE, 1) || die "Cant flock $template: $!"; while (<TEMPLATE>) { $template .= $_; } close (TEMPLATE) or die "cant close $template: $!"; } ################################# # standard form parser, credit to Agency.com # for this. sub parse_form { # Get the input read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # Split the name-value pairs @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORM{$name} = $value; } }
