[ Team LiB ] |
6.8 Loading and Reloading ModulesYou often need to reload modules in development and production environments. mod_perl tries hard to avoid unnecessary module reloading, but sometimes (especially during the development process) we want some modules to be reloaded when modified. The following sections discuss issues related to module loading and reloading. 6.8.1 The @INC Array Under mod_perlUnder mod_perl, @INC can be modified only during server startup. After each request, mod_perl resets @INC's value to the one it had before the request. If mod_perl encounters a statement like the following: use lib qw(foo/bar); it modifies @INC only for the period during which the code is being parsed and compiled. Afterward, @INC is reset to its original value. Therefore, the only way to change @INC permanently is to modify it at server startup. There are two ways to alter @INC at server startup:
To make sure that you have set @INC correctly, configure perl-status into your server, as explained in Chapter 21. Follow the "Loaded Modules" item in the menu and look at the bottom of the generated page, where the contents of @INC are shown: @INC = /home/httpd/mymodules /home/httpd/perl /usr/lib/perl5/5.6.1/i386-linux /usr/lib/perl5/5.6.1 /usr/lib/perl5/site_perl/5.6.1/i386-linux /usr/lib/perl5/site_perl/5.6.1 /usr/lib/perl5/site_perl . /home/httpd/httpd_perl/ /home/httpd/httpd_perl/lib/perl As you can see in our setup, we have two custom directories prepended at the beginning of the list. The rest of the list contains standard directories from the Perl distribution, plus the $ServerRoot and $ServerRoot/lib/perl directories appended at the end (which mod_perl adds automatically). 6.8.2 Reloading Modules and Required FilesWhen working with mod_cgi, you can change the code and rerun the CGI script from your browser to see the changes. Since the script isn't cached in memory, the server starts up a new Perl interpreter for each request, which loads and recompiles the script from scratch. The effects of any changes are immediate. The situation is different with mod_perl, since the whole idea is to get maximum performance from the server. By default, the server won't spend time checking whether any included library modules have been changed. It assumes that they weren't, thus saving the time it takes to stat( ) the source files from any modules and libraries you use( ) and require( ) in your script. If the scripts are running under Apache::Registry, the only check that is performed is to see whether your main script has been changed. If your scripts do not use( ) or require( ) any other Perl modules or packages, there is nothing to worry about. If, however, you are developing a script that includes other modules, the files you use( ) or require( ) aren't checked for modification, and you need to do something about that. There are a couple of techniques to make a mod_perl-enabled server recognize changes in library modules. They are discussed in the following sections. 6.8.2.1 Restarting the serverThe simplest approach is to restart the server each time you apply some change to your code. Restarting techniques are covered in Chapter 5. After restarting the server about 50 times, you will tire of it and look for other solutions. 6.8.2.2 Using Apache::StatINCHelp comes from the Apache::StatINC module. When Perl pulls in a file with require( ), it stores the full pathname as a value in the global hash %INC with the filename as the key. Apache::StatINC looks through %INC and immediately reloads any file that has been updated on the disk. To enable this module, add these two lines to httpd.conf: PerlModule Apache::StatINC PerlInitHandler Apache::StatINC To be sure it really works, turn on debug mode on your development system by adding PerlSetVar StatINCDebug On to your configuration file. You end up with something like this: PerlModule Apache::StatINC PerlInitHandler Apache::StatINC <Location /perl> SetHandler perl-script PerlHandler Apache::Registry Options ExecCGI PerlSendHeader On PerlSetVar StatINCDebug On </Location> Be aware that only the modules located in @INC are reloaded on change, and you can change @INC only before the server has been started (in the startup file). Note the following trap: because ".", the current directory, is in @INC, Perl knows how to require( ) files with pathnames relative to the current script's directory. After the code has been parsed, however, the server doesn't remember the path. So if the code loads a module MyModule located in the directory of the script and this directory is not in @INC, you end up with the following entry in %INC: 'MyModule.pm' => 'MyModule.pm' When Apache::StatINC tries to check whether the file has been modified, it won't be able to find the file, since MyModule.pm is not in any of the paths in @INC. To correct this problem, add the module's location path to @INC at server startup. 6.8.2.3 Using Apache::ReloadApache::Reload is a newer module that comes as a drop-in replacement for Apache::StatINC. It provides extra functionality and is more flexible. To make Apache::Reload check all the loaded modules on each request, just add the following line to httpd.conf: PerlInitHandler Apache::Reload To reload only specific modules when these get changed, three alternatives are provided: registering the module implicitly, registering the module explicitly, and setting up a dummy file to touch whenever you want the modules reloaded. To use implicit module registration, turn off the ReloadAll variable, which is on by default: PerlInitHandler Apache::Reload PerlSetVar ReloadAll Off and add the following line to every module that you want to be reloaded on change: use Apache::Reload; Alternatively, you can explicitly specify modules to be reloaded in httpd.conf: PerlInitHandler Apache::Reload PerlSetVar ReloadModules "Book::Foo Book::Bar Foo::Bar::Test" Note that these are split on whitespace, but the module list must be in quotes, or Apache will try to parse the parameter list itself. You can register groups of modules using the metacharacter *: PerlSetVar ReloadModules "Foo::* Bar::*" In the above example, all modules starting with Foo:: and Bar:: will become registered. This feature allows you to assign all the modules in a project using a single pattern. The third option is to set up a file that you can touch to cause the reloads to be performed: PerlSetVar ReloadTouchFile /tmp/reload_modules Now when you're happy with your changes, simply go to the command line and type: panic% touch /tmp/reload_modules If you set this, and don't touch the file, the reloads won't happen (regardless of how the modules have been registered). This feature is very convenient in a production server environment, but compared to a full restart, the benefits of preloaded modules memory-sharing are lost, since each child will get its own copy of the reloaded modules. Note that Apache::Reload might have a problem with reloading single modules containing multiple packages that all use pseudo-hashes. The solution: don't use pseudo-hashes. Pseudo-hashes will be removed from newer versions of Perl anyway. Just like with Apache::StatInc, if you have modules loaded from directories that are not in @INC, Apache::Reload will fail to find the files. This is because @INC is reset to its original value even if it gets temporarily modified in the script. The solution is to extend @INC at server startup to include all the directories from which you load files that aren't in the standard @INC paths. 6.8.2.4 Using dynamic configuration filesSometimes you may want an application to monitor its own configuration file and reload it when it is altered. But you don't want to restart the server for these changes to take effect. The solution is to use dynamic configuration files. Dynamic configuration files are especially useful when you want to provide administrators with a configuration tool that modifies an application on the fly. This approach eliminates the need to provide shell access to the server. It can also prevent typos, because the administration program can verify the submitted modifications. It's possible to get away with Apache::Reload and still have a similar small overhead for the stat( ) call, but this requires the involvement of a person who can modify httpd.conf to configure Apache::Reload. The method described next has no such requirement. 6.8.2.4.1 Writing configuration filesWe'll start by describing various approaches to writing configuration files, and their strengths and weaknesses. If your configuration file contains only a few variables, it doesn't matter how you write the file. In practice, however, configuration files often grow as a project develops. This is especially true for projects that generate HTML files, since they tend to demand many easily configurable settings, such as the location of headers, footers, templates, colors, and so on. A common approach used by CGI programmers is to define all configuration variables in a separate file. For example: $cgi_dir = '/home/httpd/perl'; $cgi_url = '/perl'; $docs_dir = '/home/httpd/docs'; $docs_url = '/'; $img_dir = '/home/httpd/docs/images'; $img_url = '/images'; # ... many more config params here ... $color_hint = '#777777'; $color_warn = '#990066'; $color_normal = '#000000'; The use strict; pragma demands that all variables be declared. When using these variables in a mod_perl script, we must declare them with use vars in the script, so we start the script with: use strict; use vars qw($cgi_dir $cgi_url $docs_dir $docs_url # ... many more config params here .... $color_hint $color_warn $color_normal ); It is a nightmare to maintain such a script, especially if not all features have been coded yet—we have to keep adding and removing variable names. Since we're writing clean code, we also start the configuration file with use strict;, so we have to list the variables with use vars here as well—a second list of variables to maintain. Then, as we write many different scripts, we may get name collisions between configuration files. The solution is to use the power of Perl's packages and assign a unique package name to each configuration file. For example, we might declare the following package name: package Book::Config0; Now each configuration file is isolated into its own namespace. But how does the script use these variables? We can no longer just require( ) the file and use the variables, since they now belong to a different package. Instead, we must modify all our scripts to use the configuration variables' fully qualified names (e.g., referring to $Book::Config0::cgi_url instead of just $cgi_url). You may find typing fully qualified names tedious, or you may have a large repository of legacy scripts that would take a while to update. If so, you'll want to import the required variables into any script that is going to use them. First, the configuration package has to export those variables. This entails listing the names of all the variables in the @EXPORT_OK hash. See Example 6-21. Example 6-21. Book/Config0.pmpackage Book::Config0; use strict; BEGIN { use Exporter ( ); @Book::HTML::ISA = qw(Exporter); @Book::HTML::EXPORT = qw( ); @Book::HTML::EXPORT_OK = qw($cgi_dir $cgi_url $docs_dir $docs_url # ... many more config params here .... $color_hint $color_warn $color_normal); } use vars qw($cgi_dir $cgi_url $docs_dir $docs_url # ... many more config params here .... $color_hint $color_warn $color_normal ); $cgi_dir = '/home/httpd/perl'; $cgi_url = '/perl'; $docs_dir = '/home/httpd/docs'; $docs_url = '/'; $img_dir = '/home/httpd/docs/images'; $img_url = '/images'; # ... many more config params here ... $color_hint = "#777777'; $color_warn = "#990066'; $color_normal = "#000000'; A script that uses this package will start with this code: use strict; use Book::Config0 qw($cgi_dir $cgi_url $docs_dir $docs_url # ... many more config params here .... $color_hint $color_warn $color_normal ); use vars qw($cgi_dir $cgi_url $docs_dir $docs_url # ... many more config params here .... $color_hint $color_warn $color_normal ); Whoa! We now have to update at least three variable lists when we make a change in naming of the configuration variables. And we have only one script using the configuration file, whereas a real-life application often contains many different scripts. There's also a performance drawback: exported variables add some memory overhead, and in the context of mod_perl this overhead is multiplied by the number of server processes running. There are a number of techniques we can use to get rid of these problems. First, variables can be grouped in named groups called tags. The tags are later used as arguments to the import( ) or use( ) calls. You are probably familiar with: use CGI qw(:standard :html); We can implement this quite easily, with the help of export_ok_tags( ) from Exporter. For example: BEGIN { use Exporter ( ); use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS ); @ISA = qw(Exporter); @EXPORT = ( ); @EXPORT_OK = ( ); %EXPORT_TAGS = ( vars => [qw($firstname $surname)], subs => [qw(reread_conf untaint_path)], ); Exporter::export_ok_tags('vars'); Exporter::export_ok_tags('subs'); } In the script using this configuration, we write: use Book::Config0 qw(:subs :vars); Subroutines are exported exactly like variables, since symbols are what are actually being exported. Notice we don't use export_tags( ), as it exports the variables automatically without the user asking for them (this is considered bad style). If a module automatically exports variables with export_tags( ), you can avoid unnecessary imports in your script by using this syntax: use Book::Config0 ( ); You can also go even further and group tags into other named groups. For example, the :all tag from CGI.pm is a group tag of all other groups. It requires a little more effort to implement, but you can always save time by looking at the solution in CGI.pm's code. It's just a matter of an extra code to expand all the groups recursively. As the number of variables grows, however, your configuration will become unwieldy. Consider keeping all the variables in a single hash built from references to other scalars, anonymous arrays, and hashes. See Example 6-22. Example 6-22. Book/Config1.pmpackage Book::Config1; use strict; BEGIN { use Exporter ( ); @Book::Config1::ISA = qw(Exporter); @Book::Config1::EXPORT = qw( ); @Book::Config1::EXPORT_OK = qw(%c); } use vars qw(%c); %c = ( dir => { cgi => '/home/httpd/perl', docs => '/home/httpd/docs', img => '/home/httpd/docs/images', }, url => { cgi => '/perl', docs => '/', img => '/images', }, color => { hint => '#777777', warn => '#990066', normal => '#000000', }, ); Good Perl style suggests keeping a comma at the end of each list. This makes it easy to add new items at the end of a list. Our script now looks like this: use strict; use Book::Config1 qw(%c); use vars qw(%c); print "Content-type: text/plain\n\n"; print "My url docs root: $c{url}{docs}\n"; The whole mess is gone. Now there is only one variable to worry about. The one small downside to this approach is auto-vivification. For example, if we write $c{url}{doc} by mistake, Perl will silently create this element for us with the value undef. When we use strict;, Perl will tell us about any misspelling of this kind for a simple scalar, but this check is not performed for hash elements. This puts the onus of responsibility back on us, since we must take greater care. The benefits of the hash approach are significant. Let's make it even better by getting rid of the Exporter stuff completely, removing all the exporting code from the configuration file. See Example 6-23. Example 6-23. Book/Config2.pmpackage Book::Config2; use strict; use vars qw(%c); %c = ( dir => { cgi => '/home/httpd/perl', docs => '/home/httpd/docs', img => '/home/httpd/docs/images', }, url => { cgi => '/perl', docs => '/', img => '/images', }, color => { hint => '#777777', warn => '#990066', normal => '#000000', }, ); Our script is modified to use fully qualified names for the configuration variables it uses: use strict; use Book::Config2 ( ); print "Content-type: text/plain\n\n"; print "My url docs root: $Book::Config2::c{url}{docs}\n"; To save typing and spare the need to use fully qualified variable names, we'll use a magical Perl feature to alias the configuration variable to a script's variable: use strict; use Book::Config2 ( ); use vars qw(%c); *c = \%Book::Config2::c; print "Content-type: text/plain\n\n"; print "My url docs root: $c{url}{docs}\n"; We've aliased the *c glob with a reference to the configuration hash. From now on, %Book::Config2::c and %c refer to the same hash for all practical purposes. One last point: often, redundancy is introduced in configuration variables. Consider: $cgi_dir = '/home/httpd/perl'; $docs_dir = '/home/httpd/docs'; $img_dir = '/home/httpd/docs/images'; It's obvious that the base path /home/httpd should be moved to a separate variable, so only that variable needs to be changed if the application is moved to another location on the filesystem. $base = '/home/httpd'; $cgi_dir = "$base/perl"; $docs_dir = "$base/docs"; $img_dir = "$docs_dir/images"; This cannot be done with a hash, since we cannot refer to its values before the definition is completed. That is, this will not work: %c = ( base => '/home/httpd', dir => { cgi => "$c{base}/perl", docs => "$c{base}/docs", img => "$c{base}{docs}/images", }, ); But nothing stops us from adding additional variables that are lexically scoped with my( ). The following code is correct: my $base = '/home/httpd'; %c = ( dir => { cgi => "$base/perl", docs => "$base/docs", img => "$base/docs/images", }, ); We've learned how to write configuration files that are easy to maintain, and how to save memory by avoiding importing variables in each script's namespace. Now let's look at reloading those files. 6.8.2.4.2 Reloading configuration filesFirst, lets look at a simple case, in which we just have to look after a simple configuration file like the one below. Imagine a script that tells you who is the patch pumpkin of the current Perl release.[2] (Pumpkin is a whimsical term for the person with exclusive access to a virtual "token" representing a certain authority, such as applying patches to a master copy of some source.)
use CGI ( ); use strict; my $firstname = "Jarkko"; my $surname = "Hietaniemi"; my $q = CGI->new; print $q->header(-type=>'text/html'); print $q->p("$firstname $surname holds the patch pumpkin" . "for this Perl release."); The script is very simple: it initializes the CGI object, prints the proper HTTP header, and tells the world who the current patch pumpkin is. The name of the patch pumpkin is a hardcoded value. We don't want to modify the script every time the patch pumpkin changes, so we put the $firstname and $surname variables into a configuration file: $firstname = "Jarkko"; $surname = "Hietaniemi"; 1; Note that there is no package declaration in the above file, so the code will be evaluated in the caller's package or in the main:: package if none was declared. This means that the variables $firstname and $surname will override (or initialize) the variables with the same names in the caller's namespace. This works for global variables only—you cannot update variables defined lexically (with my( )) using this technique. Let's say we have started the server and everything is working properly. After a while, we decide to modify the configuration. How do we let our running server know that the configuration was modified without restarting it? Remember, we are in production, and a server restart can be quite expensive. One of the simplest solutions is to poll the file's modification time by calling stat( ) before the script starts to do real work. If we see that the file was updated, we can force a reconfiguration of the variables located in this file. We will call the function that reloads the configuration reread_conf( ) and have it accept the relative path to the configuration file as its single argument. Apache::Registry executes a chdir( ) to the script's directory before it starts the script's execution. So if your CGI script is invoked under the Apache::Registry handler, you can put the configuration file in the same directory as the script. Alternatively, you can put the file in a directory below that and use a path relative to the script directory. However, you have to make sure that the file will be found, somehow. Be aware that do( ) searches the libraries in the directories in @INC. use vars qw(%MODIFIED); sub reread_conf { my $file = shift; return unless defined $file; return unless -e $file and -r _; my $mod = -M _; unless (exists $MODIFIED{$file} and $MODIFIED{$file} = = $mod) { unless (my $result = do $file) { warn "couldn't parse $file: $@" if $@; warn "couldn't read $file: $!" unless defined $result; warn "couldn't run $file" unless $result; } $MODIFIED{$file} = $mod; # Update the MODIFICATION times } } Notice that we use the = = comparison operator when checking the file's modification timestamp, because all we want to know is whether the file was changed or not. When the require( ), use( ), and do( ) operators successfully return, the file that was passed as an argument is inserted into %INC. The hash element key is the name of the file, and the element's value is the file's path. When Perl sees require( ) or use( ) in the code, it first tests %INC to see whether the file is already there and thus loaded. If the test returns true, Perl saves the overhead of code rereading and recompiling; however, calling do( ) will load or reload the file regardless of whether it has been previously loaded. We use do( ), not require( ), to reload the code in this file because although do( ) behaves almost identically to require( ), it reloads the file unconditionally. If do( ) cannot read the file, it returns undef and sets $! to report the error. If do( ) can read the file but cannot compile it, it returns undef and sets an error message in $@. If the file is successfully compiled, do( ) returns the value of the last expression evaluated. The configuration file can be broken if someone has incorrectly modified it. Since we don't want the whole service using that file to be broken that easily, we trap the possible failure to do( ) the file and ignore the changes by resetting the modification time. If do( ) fails to load the file, it might be a good idea to send an email about the problem to the system administrator. However, since do( ) updates %INC like require( ) does, if you are using Apache::StatINC it will attempt to reload this file before the reread_conf( ) call. If the file doesn't compile, the request will be aborted. Apache::StatINC shouldn't be used in production anyway (because it slows things down by stat( )ing all the files listed in %INC), so this shouldn't be a problem. Note that we assume that the entire purpose of this function is to reload the configuration if it was changed. This is fail-safe, because if something goes wrong we just return without modifying the server configuration. The script should not be used to initialize the variables on its first invocation. To do that, you would need to replace each occurrence of return( ) and warn( ) with die( ). We've used the above approach with a huge configuration file that was loaded only at server startup and another little configuration file that included only a few variables that could be updated by hand or through the web interface. Those variables were initialized in the main configuration file. If the webmaster breaks the syntax of this dynamic file while updating it by hand, it won't affect the main (write-protected) configuration file and won't stop the proper execution of the programs. In the next section, we will see a simple web interface that allows us to modify the configuration file without the risk of breaking it. Example 6-24 shows a sample script using our reread_conf( ) subroutine. Example 6-24. reread_conf.pluse vars qw(%MODIFIED $firstname $surname); use CGI ( ); use strict; my $q = CGI->new; print $q->header(-type => 'text/plain'); my $config_file = "./config.pl"; reread_conf($config_file); print $q->p("$firstname $surname holds the patch pumpkin" . "for this Perl release."); sub reread_conf { my $file = shift; return unless defined $file; return unless -e $file and -r _; my $mod = -M _; unless ($MODIFIED{$file} and $MODIFIED{$file} == $mod) { unless (my $result = do $file) { warn "couldn't parse $file: $@" if $@; warn "couldn't read $file: $!" unless defined $result; warn "couldn't run $file" unless $result; } $MODIFIED{$file} = $mod; # Update the MODIFICATION time } } You should be using (stat $file)[9] instead of -M $file if you are modifying the $^T variable. This is because -M returns the modification time relative to the Perl interpreter startup time, set in $^T. In some scripts, it can be useful to reset $^T to the time of the script invocation with "local $^T = time( )". That way, -M and other -X file status tests are performed relative to the script invocation time, not the time the process was started. If your configuration file is more sophisticated—for example, if it declares a package and exports variables—the above code will work just as well. Variables need not be import( )ed again: when do( ) recompiles the script, the originally imported variables will be updated with the values from the reloaded code. 6.8.2.4.3 Dynamically updating configuration filesThe CGI script below allows a system administrator to dynamically update a configuration file through a web interface. This script, combined with the code we have just seen to reload the modified files, gives us a system that is dynamically reconfigurable without having to restart the server. Configuration can be performed from any machine that has a browser. Let's say we have a configuration file like the one in Example 6-25. Example 6-25. Book/MainConfig.pmpackage Book::MainConfig; use strict; use vars qw(%c); %c = ( name => "Larry Wall", release => "5.000", comments => "Adding more ways to do the same thing :)", other => "More config values", colors => { foreground => "black", background => "white", }, machines => [qw( primary secondary tertiary )], ); We want to make the variables name, release, and comments dynamically configurable. We'll need a web interface with an input form that allows modifications to these variables. We'll also need to update the configuration file and propagate the changes to all the currently running processes. Let's look at the main stages of the implementation:
The only part that seems hard to implement is a configuration file update, for a couple of reasons. If updating the file breaks it, the whole service won't work. If the file is very big and includes comments and complex data structures, parsing the file can be quite a challenge. So let's simplify the task. If all we want is to update a few variables, why don't we create a tiny configuration file containing just those variables? It can be modified through the web interface and overwritten each time there is something to be changed, so that we don't have to parse the file before updating it. If the main configuration file is changed, we don't care, because we don't depend on it any more. The dynamically updated variables will be duplicated in the main file and the dynamic file. We do this to simplify maintenance. When a new release is installed, the dynamic configuration file won't exist—it will be created only after the first update. As we just saw, the only change in the main code is to add a snippet to load this file if it exists and was changed. This additional code must be executed after the main configuration file has been loaded. That way, the updated variables will override the default values in the main file. See Example 6-26. 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.pluse 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. |
[ Team LiB ] |