WebRef   Sitemap · Experts · Tools · Services · Newsletters · About

home / programming / perl / mod_perl / chap6 / 3

[previous] [next]

Practical mod_perl: Chapter 6: Coding with mod_perl in Mind

Sr. Web Developer mediabistro.com US-NY-New York Post A Job | Post A Resume

Developer News Microsoft Shows Off Silverlight 4, IE9 Plans Metasploit Expands Vulnerability Test Framework HyperCard Reborn?

Example 6-26: manage_conf.pl

# remember to run this code in taint mode
use strict;
use vars qw($q %c $dynamic_config_file %vars_to_change %validation_rules);
 
use CGI (  );
 
use lib qw(.);
use Book::MainConfig (  );
*c = \%Book::MainConfig::c;
 
$dynamic_config_file = "./config.pl";
 
# load the dynamic configuration file if it exists, and override the
# default values from the main configuration file
do $dynamic_config_file if -e $dynamic_config_file and -r _;
 
# fields that can be changed and their captions
%vars_to_change =
  (
   'name'     => "Patch Pumpkin's Name",
   'release'  => "Current Perl Release",
   'comments' => "Release Comments",
  );
 
# each field has an associated regular expression
# used to validate the field's content when the
# form is submitted
%validation_rules =
  (
   'name'     => sub { $_[0] =~ /^[\w\s\.]+$/;   },
   'release'  => sub { $_[0] =~ /^\d+\.[\d_]+$/; },
   'comments' => sub { 1;                        },
  );
 
# create the CGI object, and print the HTTP and HTML headers
$q = CGI->new;
print $q->header(-type=>'text/html'), 
      $q->start_html(  );
 
# We always rewrite the dynamic config file, so we want all the
# variables to be passed, but to save time we will only check
# those variables that were changed.  The rest will be retrieved from
# the 'prev_*' values.
my %updates = (  );
foreach (keys %vars_to_change) {
    # copy var so we can modify it
    my $new_val = $q->param($_) || '';
 
    # strip a possible ^M char (Win32)
    $new_val =~ s/\cM//g;
 
    # push to hash if it was changed
    $updates{$_} = $new_val
        if defined $q->param("prev_" . $_)
           and $new_val ne $q->param("prev_" . $_);
}
 
# Note that we cannot trust the previous values of the variables
# since they were presented to the user as hidden form variables,
# and the user could have mangled them. We don't care: this can't do
# any damage, as we verify each variable by rules that we define.
 
# Process if there is something to process. Will not be called if
# it's invoked the first time to display the form or when the form
# was submitted but the values weren't modified (we'll know by
# comparing with the previous values of the variables, which are
# the hidden fields in the form).
 
process_changed_config(%updates) if %updates;
 
show_modification_form(  );
  
# update the config file, but first validate that the values are
# acceptable
sub process_changed_config {
    my %updates = @_;
 
    # we will list here all variables that don't validate
    my %malformed = (  );
 
    print $q->b("Trying to validate these values<br>");
    foreach (keys %updates) {
        print "<dt><b>$_</b> => <pre>$updates{$_}</pre>";
 
        # now we have to handle each var to be changed very carefully,
        # since this file goes immediately into production!
        $malformed{$_} = delete $updates{$_}
            unless $validation_rules{$_}->($updates{$_});
 
    }   
 
    if (%malformed) {
        print $q->hr,
            $q->p($q->b(qq{Warning! These variables were changed
                           to invalid values. The original
                           values will be kept.})
                 ),
            join ",<br>",
                 map { $q->b($vars_to_change{$_}) . " : $malformed{$_}\n"
                     } keys %malformed;
    }
 
    # Now complete the vars that weren't changed from the
    # $q->param('prev_var') values
    map { $updates{$_} = $q->param('prev_' . $_)
              unless exists $updates{$_} } keys %vars_to_change;
 
    # Now we have all the data that should be written into the dynamic
    # config file
 
    # escape single quotes "'" while creating a file
    my $content = join "\n",
        map { $updates{$_} =~ s/(['\\])/\\$1/g;
              '$c{' . $_ . "} = '" . $updates{$_} . "';\n"
            } keys %updates;
 
    # add '1;' to make require(  ) happy
    $content .= "\n1;";
 
    # keep the dummy result in $res so it won't complain
    eval {my $res = $content};
    if ($@) {
        print qq{Warning! Something went wrong with config file
                 generation!<p> The error was :</p> <br><pre>$@</pre>};
        return;
    }
 
    print $q->hr;
 
    # overwrite the dynamic config file
    my $fh = Apache::gensym(  );
    open $fh, ">$dynamic_config_file.bak"
        or die "Can't open $dynamic_config_file.bak for writing: $!";
    flock $fh, 2; # exclusive lock
    seek $fh, 0, 0; # rewind to the start
    truncate $fh, 0; # the file might shrink!
    print $fh $content;
    close $fh;
 
    # OK, now we make a real file
    rename "$dynamic_config_file.bak", $dynamic_config_file
        or die "Failed to rename: $!";
 
    # rerun it to update variables in the current process! Note that
    # it won't update the variables in other processes. Special
    # code that watches the timestamps on the config file will do this
    # work for each process. Since the next invocation will update the
    # configuration anyway, why do we need to load it here? The reason
    # is simple: we are going to fill the form's input fields with
    # the updated data.
    do $dynamic_config_file;
 
}
 
sub show_modification_form {
 
    print $q->center($q->h3("Update Form"));
  
    print $q->hr,
        $q->p(qq{This form allows you to dynamically update the current
           configuration. You don't need to restart the server in
           order for changes to take an effect}
             );
  
    # set the previous settings in the form's hidden fields, so we
    # know whether we have to do some changes or not
    $q->param("prev_$_", $c{$_}) for keys %vars_to_change;
  
    # rows for the table, go into the form
    my @configs = (  );
  
    # prepare text field entries
    push @configs,
        map {
          $q->td( $q->b("$vars_to_change{$_}:") ),
          $q->td(
           $q->textfield(
                 -name      => $_,
                 -default   => $c{$_},
                 -override  => 1,
                 -size      => 20,
                 -maxlength => 50,
                )
          ),
        } qw(name release);
  
    # prepare multiline textarea entries
    push @configs,
        map {
          $q->td( $q->b("$vars_to_change{$_}:") ),
          $q->td(
           $q->textarea(
                -name     => $_,
                -default  => $c{$_},
                -override => 1,
                -rows     => 10,
                -columns  => 50,
                -wrap     => "HARD",
                )
          ),
        } qw(comments);
  
    print $q->startform(POST => $q->url), "\n",
          $q->center(
              $q->table(map {$q->Tr($_), "\n",} @configs),
              $q->submit('', 'Update!'), "\n",
          ),
          map ({$q->hidden("prev_" . $_, $q->param("prev_".$_)) . "\n" }
               keys %vars_to_change), # hidden previous values
          $q->br, "\n",
          $q->endform, "\n",
          $q->hr, "\n",
          $q->end_html;
  
}

For example, on July 19 2002, Perl 5.8.0 was released. On that date, Jarkko Hietaniemi exclaimed:

The pumpking is dead! Long live the pumpking!

Hugo van der Sanden is the new pumpking for Perl 5.10. Therefore, we run manage_conf.pl and update the data. Once updated, the script overwrites the previous config.pl file with the following content:

$c{release}  =  '5.10';
 
$c{name}  =  'Hugo van der Sanden';
 
$c{comments}  =  'Perl rules the world!';
 
1;

Instead of crafting your own code, you can use the CGI::QuickForm module from CPAN to make the coding less tedious. See Example 6-27.

Example 6-27: manage_conf.pl

use strict;
use CGI qw( :standard :html3 ) ;
use CGI::QuickForm;
use lib qw(.);
use Book::MainConfig (  );
*c = \%Book::MainConfig::c;
 
my $TITLE = 'Update Configuration';
show_form(
    -HEADER => header . start_html( $TITLE ) . h3( $TITLE ),
    -ACCEPT => \&on_valid_form,
    -FIELDS => [
        {
            -LABEL      => "Patch Pumpkin's Name",
            -VALIDATE   => sub { $_[0] =~ /^[\w\s\.]+$/;   },
            -default    => $c{name},
        },
        {
            -LABEL      => "Current Perl Release",
            -VALIDATE   => sub { $_[0] =~ /^\d+\.[\d_]+$/; },
            -default    => $c{release},
        },
        {
            -LABEL      => "Release Comments",
            -default    => $c{comments},
        },
        ],
    );
 
sub on_valid_form {
    # save the form's values
}

That's it. show_form( ) creates and displays a form with a submit button. When the user submits, the values are checked. If all the fields are valid, on_valid_form( ) is called; otherwise, the form is re-presented with the errors highlighted.

home / programming / perl / mod_perl / chap6 / 3

[previous] [next]

Search:

WebMediaBrands Corporate Info

Legal Notices, Licensing, Permissions, Privacy Policy.
Advertise | Newsletters | Shopping | E-mail Offers | Freelance Jobs

Solutions

Whitepapers and eBooks

Microsoft Articles: Visual Studio 2010 Adobe Article: Adobe Helps PHP Developers Create Rich Internet Applications Microsoft Whitepaper: How Windows Server 2008 R2 Helps Optimize IT and Save You Money Adobe Article: Java Developers Finding a Home at Adobe Flex IBM Articles: A Smarter Business Needs Smarter Technology Intel Xeon Processor Increases Server Efficiency and Capabilities Intel Tech Brief: Automated Energy Efficiency for the Intelligent Enterprise Oracle Whitepapers - Innovation for IT Leaders Avaya Article: Communication-Enabled Mashups--Empowering Both Business Owners and IT

Internet.com eBook: IT Manager's Guide to Social Networking Internet.com eBook: Get Ready for Windows 7 Microsoft Article: Expression Web 3--New Features for PHP Developers Whitepapers: Manage Your Business Infrastracture with IBM Whitepaper: Maximize Your Storage Investment with HP Internet.com eBook: Becoming a Better Project Manager Microsoft Article: Stress Free and Efficient Designer/Developer Collaboration MORE WHITEPAPERS, EBOOKS, AND ARTICLES

Webcasts

Webcast: Connecting PHP to Microsoft Technologies Video: Microsoft Partner Program Benefits Video: Windows Azure Debugging Tips SAP BusinessObjects Webcast: Unlock the Power of Reporting with Crystal Reports

IBM Webcast: Speed Business Innovation with Reduced Cost and Risk Video: Deploy Applications on Windows Azure MORE WEBCASTS, PODCASTS, AND VIDEOS

Downloads and eKits

Download: Microsoft Visual Studio 2010 Beta 2 Downloads & Free Trials: Microsoft's New Efficiency Resource Center Get the Windows 7 SDK

Free Trial: Red Gate SQL Backup Pro 6 Iron Speed Designer Application Generator MORE DOWNLOADS, EKITS, AND FREE TRIALS

Tutorials and Demos

Internet.com Hot List: Get the Inside Scoop on the Hottest IT and Developer Products All About Botnets

MORE TUTORIALS, DEMOS AND STEP-BY-STEP GUIDES

The latest from WebReference.com Browse > Site Contents - - - - - Experts * 3D Animation * Design * DHTML * Graphics * HTML * JavaScript * Perl * XML - - - - - Web Resources * Authoring * Design * Internet * Multimedia * Programming * Promotion - - - - - Services * Interviews * Newsletters * Reviews * Search * Tools Rolling Out Your Own HTML Application Version Control · HTML 5: Client-side Storage · Working with Ajax Server Extensions Sitemap · Experts · Tools · Services · Email a Colleague · Contact FREE Newsletters >   The latest from internet.com Wi-Fi Product Watch, November 2009 · Chip Market Recovering From '08 Collapse · Low-Cost Tools to Kickstart Your New Business

Created: March 27, 2003
Revised: July 23, 2003

URL: http://webreference.com/programming/perl/mod_perl/chap6/3