#RoGer CGI Module v 2.5 (Mar 29, 1999) package rgcgi; use CGI qw/:standard/; use DBI; use English; sub new { my $class = shift; my $self = {}; # set default values # These variables are used in the looped area $self->{loop_start_mark} = ''; # starting point of the looping area $self->{loop_end_mark} = ''; # ending point of the looping area $self->{records_per_page} = -1; # Number of records displayed per page, if < 0 means print every thing in one page $self->{cur_page} = 0; # defines the current page $self->{print_header} = 1; # should method 'show' print the CGI header? (1=yes, 0=no) $self->{use_loop_def} = 1; # shold fill_in_template look for the loop start/end definitions: 1 = yes (default), 0= no $self->{rec_count} = 0; # No of records fetched by 'interpret_loop' func $self->{rs_cur_rec} = undef; # Current record in the record set $self->{BOF} = undef; $self->{EOF} = undef; $self->{undef_char} = '-'; # String to use when a loop var is not defined (used in put_in_loop_data) # These variables are used with the Page Navigator $self->{nav_prev_str} = 'prev'; $self->{nav_next_str} = 'next'; $self->{nav_pagelist_str} = 'page_list'; $self->{nav_target} = __FILE__; # File name of the current script. $self->{nav_prev_img} = 'resources/prev.jpg'; $self->{nav_next_img} = 'resources/next.jpg'; $self->{nav_no_prev_img} = 'resources/no_prev.jpg'; $self->{nav_no_next_img} = 'resources/no_next.jpg'; bless $self; } ########################################## # Returns the module version number sub version { return '2.5f' } ########################################### # Prints an error message using the Error Template, then exits. sub print_error { my $self = shift; my $error_msg; $error_msg = @_[0] if @_; if ($self->{print_header}) { print header; } # $self->{Error_template} = "error_template.html"; if ($self->{Error_template} ne undef) { open (dbIN, $self->{Error_template}) or print header,"In Print_Error: Can't open HTML templete file ($self->{Error_template})"; $self->{ErrorDataString} = undef; while () { $self->{ErrorDataString} .= $_; } close dbIN; } else #if error template file is not defined -> use the default HTML template { $self->{ErrorDataString} = '

Error! : $error_msg;

RgCGI '.version().' '; } $self->{ErrorDataString} =~ s/\$error_msg;/$error_msg/ig; # /i = search case in-sensitive print $self->{ErrorDataString}; exit(0); } # - - - - set the error message template sub error_template { my $self = shift; $self->{Error_template} = @_[0] if @_; return $self->{Error_template}; } ####################################################################### # - - - - - - - - - - - - - - - - - - - - open template file sub output_template { my $self = shift; if (@_) { $self->{template_file_name} = @_[0]; open (dbIN, $self->{template_file_name}) or $self->print_error("Can't open HTML templete file ($self->{template_file_name})"); while () { $self->{DataString} .= $_; } $self->{Original_template} = $self->{DataString}; # save the data string, so that we can restore it late if we want (may need it when implementing Fast CGI) close dbIN; } else { return $self->{template_file_name}; } } # - - - - - - - - - - - - - - - - - Reload the output template (copies the original from mem -> will work faster then re-opening the template from file) sub reload_output_template { my $self = shift; $self->{DataString} = $self->{Original_template}; } # - - - - - - - - - - - - - - - - - - - - should method 'show' dispaly the CGI header? (1=yes, 0=no) sub will_print_header { my $self = shift; $self->{print_header} = @_[0] if @_; return $self->{print_header}; } # - - - - - - - - - - - - - - - - - - - - display the html code sub show { my $self = shift; if ($self->{print_header}) { print header.$self->{DataString}; } else { print $self->{DataString}; } } ###################################################################### ###################################################################### ## ## This part contains methods to establish the DB connection ## ###################################################################### ###################################################################### sub dbdriver { my $self = shift; $self->{dbdriver} = @_[0] if @_; # if called with arg. return $self->{dbdriver}; } sub dbdatabase { my $self = shift; $self->{dbdatabase} = @_[0] if @_; return $self->{dbdatabase}; } sub dbuser { my $self = shift; $self->{dbuser} = @_[0] if @_; return $self->{dbuser}; } sub dbpassword { my $self = shift; $self->{dbpassword} = @_[0] if @_; return $self->{dbpassword}; } sub dbconnect { my $self = shift; $self->{dsn_str} = "$self->{dbdriver}:$self->{dbdatabase}"; $self->{dbh} = DBI->connect($self->{dsn_str},$self->{dbuser},$self->{dbpassword}) or $self->print_error("Can't connect to database"); } ##################################################################### ##################################################################### ## ## M e t h o d s a n d P r o p e r t i e s t o H a n d l e V a r i a b l e s. ## ##################################################################### ##################################################################### # - - - - - - - - - - - - - - - - - - - - declare the variable definitions sub set_var_defs { my $self = shift; local %H_hold = @_; # can't use 'my' here -> still don't know why. undef($self->{H_var_defs}); foreach $element ( keys %H_hold) { $self->{H_var_defs}->{$element} = H_hold->{$element}; } } # - - - - - - - - - - - - - - - - - - - - define values of variables sub set_const_defs { my $self = shift; local %H_hold = @_; # can't use 'my' here -> still don't know why. undef($self->{H_const_defs}); foreach $element ( keys %H_hold) { $self->{H_const_defs}->{$element} = H_hold->{$element}; } } # - - - - - - - - - - - - - - - - - - Fetch the variable values (must be called after method 'interpret_var') # Will return variable values defined in set_var_defs or constant values defined in set_const_defs sub get_val { my $self = shift; my $var_name = shift; if ($self->{H_var_vals}->{$var_name} ne undef) { return $self->{H_var_vals}->{$var_name} ; } else { return $self->{H_const_defs}->{$var_name}; } } # - - - - - - - - - - - - - - - - - - - - Method to intepret varibles and variable definitions # It will interpret vars defined by set_var_defs sub interpret_vars { my $self = shift; my ($key, $value); my ($statement, @hold); my ($skip, $skip_count, $prev_skip_count, $done); $prev_skip_count = -1; # make it -1 => will make it pass the while condition on it's first loop $skip_count=0; undef($self->{H_var_vals}); # while loop until all var defs are processed or until there are no more var defs that can be # processed. # when $done = 'yes' => all the var defs are processed # when $skip_count = $prev_skip_count => there are some var defs that can not be processed, # because there are unknown vars being used. while( ($done ne 'yes') && ($skip_count != $prev_skip_count) ) { $prev_skip_count = $skip_count; $skip_count = 0; # reset the skip count $done = 'yes'; # restore the default value foreach $key (keys %{$self->{H_var_defs}}) { # First, put in any previous calculated vars in to the var_defs #if value for $key is already calculated -> go on to the next one. if ($self->{H_var_vals}->{$key} ne undef) { next; } # check each var reference in the current var definition. # if any of them are still undefined then skip to the next var def. # (it will come back later and, hopfully, by that time all the vars referenced will be defined) foreach $var ($self->{H_var_defs}->{$key} =~ m/\$(\w+?);/) { if ( ($self->{H_var_vals}->{$var} eq undef) && ($self->{H_const_defs}->{$var} eq undef) ) # modified in v 1.01 { $skip = 'yes'; # indicates that it should skip to the next var definition $skip_count++; # records the number of var defs skiped. $done = 'no'; # incicates that there are still var definition not processed last; } } if ($skip eq 'yes') { $skip = 'no'; # restore the default value next; } # New part changed in v 1.01 foreach $var ($self->{H_var_defs}->{$key} =~ m/\$(\w+?);/) { if ($self->{H_var_vals}->{$var} ne undef) # if the variable is in the H_var_vals hash { $self->{H_var_defs}->{$key} =~ s/\$(\w+?);/$self->{H_var_vals}->{$1}/g; } else # else the variable *must* be in the H_const_defs hash { $self->{H_var_defs}->{$key} =~ s/\$(\w+?);/$self->{H_const_defs}->{$1}/g; } } # $self->{H_var_defs}->{$key} =~ s/\$(\w+);/$self->{H_var_vals}->{$1}/g; # old backup from 1.0 # Second, check the var def to see weather it is an SQL command or an Expression # SQL command supported here only begins with select. if ($self->{H_var_defs}->{$key} =~ m/^selec/) { $statement = $self->{H_var_defs}->{$key}; $self->{sth} = $self->{dbh}->prepare($statement); if ( !($self->{rc} = $self->{sth}->execute) ) { $self->print_error("IN interpret_vars: Error selecting data from database: ".$self->{sth}->errstr); } @hold = $self->{sth}->fetchrow_array; $self->{H_var_vals}->{$key} = $hold[0]; } else { $self->{H_var_vals}->{$key} = eval($self->{H_var_defs}->{$key}); } } } } ################################### # Transfers the variable/constant values to the template file. sub vars_fill_template { my $self = shift; #Now, put them in the HTML template file foreach $var ($self->{DataString} =~ m/\$(\w+?);/g) { if ($self->{H_var_vals}->{$var} ne undef) # if the variable is not in H_var_vals => look in H_const_defs { $self->{DataString} =~ s/\$$var;/$self->{H_var_vals}->{$var}/; } elsif ($self->{H_const_defs}->{$var} ne undef) # if the var in not in H_const_defs => skip it { $self->{DataString} =~ s/\$$var;/$self->{H_const_defs}->{$var}/; } } } # # # # # # # # # # # # # # # # # # # # # # # # # # ## # # # # # # # # Place a variable in the template. # INPUT: Name, Value -> Name = name of variable, Value -> value that will be placed # OUTPUT: none # # example=> place("stu_name","Roger"); # will find the variable string '$stu_name;' in the template and replace it with the word 'Roger' sub place { my $self = shift; my $var_name = shift; my $var_val = shift; $self->{DataString} =~ s/\$$var_name;/$var_val/ig; } ##################################################################### ##################################################################### ## ## M e t h o d s a n d P r o p e r t i e s t o Q u e r y D a t a b a s e . ## ##################################################################### ##################################################################### # - - - - - - - - - - - - - - - - - - - - declare the SQL statement to use with the looped area sub record_source { my $self = shift; $self->{SQL_statement} = @_[0] if @_; return $self->{SQL_statement}; } # refresh the buffer with the records defined in 'record source' # output : number of records selected sub rs_refresh { my $self = shift; $self->{sth} = $self->{dbh}->prepare($self->{SQL_statement}); if ( !($self->{rc} = $self->{sth}->execute) ) { $self->print_error("In rs_refresh: Error selecting data from database : ".$self->{sth}->errstr); } $rec_no = 0; # current record $self->{sql_loop_data} = undef; # clears any old data while ($Hdict = $self->{sth}->fetchrow_hashref) { $self->{sql_loop_data}[$rec_no++] = $Hdict; } $self->{rec_count} = $rec_no; # record count $self->{rs_cur_rec} = undef; $self->{BOF} = 0 if ($self->{rec_count} > 0); $self->{EOF} = 0 if ($self->{rec_count} > 0); $self->{BOF} = 1 if ($self->{rec_count} == 0); $self->{EOF} = 1 if ($self->{rec_count} == 0); return ($self->{rec_count}); } # append records defined in 'record source' to the buffer # Output: number of records selected by the current command sub rs_append { my $self = shift; $self->{sth} = $self->{dbh}->prepare($self->{SQL_statement}); if ( !($self->{rc} = $self->{sth}->execute) ) { $self->print_error("In rs_refresh: Error selecting data from database : ".$self->{sth}->errstr); } $rec_no = $self->{rec_count}; # last record while ($Hdict = $self->{sth}->fetchrow_hashref) { $self->{sql_loop_data}[$rec_no++] = $Hdict; } my $recs_affected = $rec_no - $self->{rec_count}; $self->{rec_count} = $rec_no; # record count $self->{rs_cur_rec} = undef; $self->{BOF} = 0 if ($self->{rec_count} > 0); $self->{EOF} = 0 if ($self->{rec_count} > 0); $self->{BOF} = 1 if ($self->{rec_count} == 0); $self->{EOF} = 1 if ($self->{rec_count} == 0); return ($recs_affected); } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Clears the record set buffer # INPUT/OUTPUT => none # sub rs_clear_buffer { my $self = shift; undef($self->{sql_loop_data}); $self->{rec_count} = 0; } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Adds a record to the record set buffer # INPUT: a Hash that holds the record # OUTPUT: returns the total number of records in the record set buffer sub rs_add_new { my $self = shift; local %H_hold = @_; # can't use 'my' here -> still don't know why. my $element; foreach $element ( keys %H_hold) { $self->{sql_loop_data}[$self->{rec_count}]->{$element} = $H_hold{$element}; } $self->{rec_count}++; return $self->{rec_count}; } ## = = = = = = = = = = = = = = = = = = = = = = = = = = = = ## Methods to navigate through the Record Set ## = = = = = = = = = = = = = = = = = = = = = = = = = = = = # move to first record sub rs_move_first { my $self = shift; $self->{rs_cur_rec} = 0; $self->{BOF} = 0 if ($self->{rec_count} > 0); $self->{EOF} = 0 if ($self->{rec_count} > 0); $self->{BOF} = 1 if ($self->{rec_count} == 0); $self->{EOF} = 1 if ($self->{rec_count} == 0); } # move to last record sub rs_move_last { my $self = shift; $self->{rs_cur_rec} = $self->{rec_count} - 1 if ($self->{rec_count} > 0);; $self->{BOF} = 0 if ($self->{rec_count} > 0); $self->{EOF} = 0 if ($self->{rec_count} > 0); $self->{BOF} = 1 if ($self->{rec_count} == 0); $self->{EOF} = 1 if ($self->{rec_count} == 0); } #move to the next record sub rs_move_next { my $self = shift; if ($self->{rs_cur_rec} ne undef) { if ($self->{rs_cur_rec} < $self->{rec_count} - 1 ) { $self->{rs_cur_rec}++; } else { $self->{rs_cur_rec}++; $self->{EOF} = 1; # EOF flag indicates that the current record is beyond the last record } } else { $self->print_error("Error in rs_move_next: No current record"); } } #move to the previous record sub rs_move_previous { my $self = shift; if ($self->{rs_cur_rec} ne undef) { if ($self->{rs_cur_rec} > 0) { $self->{rs_cur_rec}--; } else { $self->{rs_cur_rec}--; $self->{BOF} = 1; # BOF flag indicates that the current record is less than 0 } } else { $self->print_error("Error in rs_move_previous: No current record"); } } # BOF is true (1) when current record is before the first record sub BOF { my $self = shift; return $self->{BOF}; } # EOF is true (1) when current record is beyond the last record. sub EOF { my $self = shift; return $self->{EOF}; } # set / get the field in the current record # usage: rs_field("Field name",["Value"]) # # "Field name" => The field name you want. # "Value" => New value of that field. # # Example: # rs_field("ID") => returns the value of 'ID' field of the current record # rs_field("ID","3506444") => Sets the value of 'ID' field to '3506444' sub rs_field { my $self = shift; my $t_field = shift; my $t_value = shift; $self->{sql_loop_data}[$self->{rs_cur_rec}]->{$t_field} = $t_value if ($t_value ne undef); return $self->{sql_loop_data}[$self->{rs_cur_rec}]->{$t_field}; } ## ## = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = # rs_use_loop_def => get/set the 'use loop def' flag # : if set to true (default) will tell rgcgi to look for loop start/end position in the template file # : if set to false will tell rgcgi to use the entire template as the loop data, and will # fill in only the first record of the record set. And will not replace variables that # are not defined with 'undef char' sub rs_use_loop_def { my $self= shift; $self->{use_loop_def} = @_[0] if @_; return $self->{use_loop_def}; } # - - - - - - - - - - - - - - - - - - - - Method to put in the loop data sub rs_fill_template { my $self = shift; my($pre_script, $post_script, $script); my ($Hold, $real_script); my ($var); my (%Hdict); my ($rec_count, $rec_track); # rec_count is used to count the rec no in the current page # rec_track is used to track the current rec no of the entire recordset. # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # if use_loop_def is false => we use the entire template as the loop data if (!$self->{use_loop_def}) { $script = $self->{DataString}; $Hdict = $self->{sql_loop_data}[0]; foreach $var ($script =~ m/\$(\w+?);/g) { if ($Hdict->{$var} ne undef) { $script =~ s/\$$var;/$Hdict->{$var}/g; } } $self->{DataString} = $script; } else # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # if use_loop_def is TRUE => we must look for the loop start and end position { # Search for the keyword that identifies the beggining point of the script to be processed. if ( !($self->{DataString} =~ m/$self->{loop_start_mark}/i) ) { $self->print_error("Template format error: Can't find loop start position ($self->{loop_start_mark})"); } $pre_script = $PREMATCH; $post_script = $POSTMATCH; # Search for the keyword that identifies the end point of the script to be processed. if ( !($post_script =~ m/$self->{loop_end_mark}/i) ) { $self->print_error("Template format error: Can't find loop end position ($self->{loop_end_mark})"); } $script = $PREMATCH; $post_script = $POSTMATCH; #so now, # $pre_script = Header script #$script = script to be processed. # $post_script = Footer script # - - - - - - - - - - - - - - - - - - - - $rec_no = 1; # no of record in current page for ($rec_track=0 ; $rec_track < $self->{rec_count} ; $rec_track++) { $Hdict = $self->{sql_loop_data}[$rec_track]; # print "Title $rec_track = ".$Hdict->{title}."\n"; if ( ($self->{cur_page} == int($rec_track/$self->{records_per_page})) || $self->{records_per_page} < 0) # if current record is in range OR records_per_page < 0 (means print all recs in one page) { $Hold = $script; $Hold =~ s/\$no;/$rec_no/g; # find any counters with format $no; and put record number in to it. foreach $var ($Hold =~ m/\$(\w+?);/g) { if ($Hdict->{$var} ne undef) { $Hold =~ s/\$$var;/$Hdict->{$var}/g; } else # if the variable is not in our dictionary => put in the char defined in $self->{undef_char} { $Hold =~ s/\$$var;/$self->{undef_char}/g; } } $real_script .= $Hold; $rec_no++; } # - - - - - - remarked because we want $self->{rec_count} contains the total number of records we have fetched (v.1.01) # if ( (int($self->{rec_count}/$self->{records_per_page}) > $self->{cur_page}) && $self->{records_per_page} > 0) # if cur rec past the recs we want to display, then we can stop # { last; # } } $self->{DataString} = $pre_script.$real_script.$post_script; } } # - - - - - - - - - - - - - - - - - - - - declare the string to be used when a loop var is not defined. defalut is '-' sub undef_char { my $self = shift; $self->{undef_char} = @_[0] if @_; return $self->{undef_char}; } # - - - - - - - - - - - - - - - - - - - - Method to set the loope mark points sub loop_start_string { my $self = shift; $self->{loop_start_mark} = @_[0] if @_; return $self->{loop_start_mark}; } sub loop_end_string { my $self = shift; $self->{loop_end_mark} = @_[0] if @_; return $self->{loop_end_mark}; } # - - - - - - returns the number of rows selected by the most recent select command sub rs_rec_count { my $self = shift; return $self->{rec_count}; } # Adds a constant field to the Record Set # Input: Constant field name, field value; # output: None sub rs_add_const { my $self = shift; my $field_name = shift; my $field_value = shift; my $i; for ($i=0 ; $i < $self->rs_rec_count ; $i++) { $self->{sql_loop_data}[$i]->{$field_name} = $field_value; } } ##################################################################### ##################################################################### ## ## M e t h o d s a n d P r o p e r t i e s t o H a n d l e P a g e N a v i g a t o r. ## ##################################################################### ##################################################################### # - - - - - - - - - - - - - - - - - - - - Method to set/get the current page sub cur_page { my $self = shift; $self->{cur_page} = @_[0] if @_; return $self->{cur_page}; } # - - - - - - - - - - - - - - - - - - - - Method to set/get number of records per page sub records_per_page { my $self = shift; $self->{records_per_page} = @_[0] if @_; return $self->{records_per_page}; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Set NAVIGATOR parameters # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # - - - - - - - - - - - - - - - - - - - - Method to set/get page navigators 'previous page' string sub nav_prev_str { my $self = shift; $self->{nav_prev_str} = @_[0] if @_; return $self->{nav_prev_str}; } # - - - - - - - - - - - - - - - - - - - - Method to set/get page navigators 'next page' string sub nav_next_str { my $self = shift; $self->{nav_next_str} = @_[0] if @_; return $self->{nav_next_str}; } # - - - - - - - - - - - - - - - - - - - - Method to set/get page navigators 'page list' string sub nav_pagelist_str { my $self = shift; $self->{nav_pagelist_str} = @_[0] if @_; return $self->{nav_pagelist_str}; } # - - - - - - - - - - - - - - - - - - - - Method to set/get the table name in the Database which page navigator is working with # We need to know the table we are working with to find the total number of records in that table. sub nav_table_name { my $self = shift; $self->{nav_table_name} = @_[0] if @_; return $self->{nav_table_name}; } # - - - - - - - - - - - - - - - - - - - - Method to set/get page navigators target (usually is the name of the current script) sub nav_target { my $self = shift; $self->{nav_target} = @_[0] if @_; return $self->{nav_target}; } # - - - - - - - - - - - - - - - - - Get/Set image to use for the Previous button sub nav_prev_img { my $self = shift; $self->{nav_prev_img} = @_[0] if @_; return $self->{nav_prev_img}; } # - - - - - - - - - - - - - - - - - Get/Set image to use for the Next button sub nav_next_img { my $self = shift; $self->{nav_next_img} = @_[0] if @_; return $self->{nav_next_img}; } # - - - - - - - - - - - - - - - - - Get/Set image to use for the No Previous button sub nav_no_prev_img { my $self = shift; $self->{nav_no_prev_img} = @_[0] if @_; return $self->{nav_no_prev_img}; } # - - - - - - - - - - - - - - - - - Get/Set image to use for the No Next button sub nav_no_next_img { my $self = shift; $self->{nav_no_next_img} = @_[0] if @_; return $self->{nav_no_next_img}; } # - - - - - - - - - - - - - - - - - - - - Method to generate the page navigator sub interpret_navigator { my $self = shift; my ($statement, @hold, $rec_count, $cur_page); my ($cgi_script_name) =$self->{nav_target}; my ($prev_img) = $self->{nav_prev_img}; my ($next_img) = $self->{nav_next_img}; my ($no_prev_img) = $self->{nav_no_prev_img}; my ($no_next_img) = $self->{nav_no_next_img}; my ($prev_str, $next_str, $page_navigator_str); my ($page_count); #------------ 1. gen the Prev Arrow ------------------- $cur_page = $self->{cur_page}; if ( $cur_page > 0 ) { $prev_str = '

'; } else { $prev_str = '

'; } $self->{DataString} =~ s/\$$self->{nav_prev_str};/$prev_str/g; #------------ 2. gen the Navigator page numbers ------------------- # print "nav_table_name = ".$self->{nav_table_name}."\n"; #get the total number of records $statement = 'select count(*) from '.$self->{nav_table_name}; $self->{sth} = $self->{dbh}->prepare($statement); if ( !($self->{rc} = $self->{sth}->execute) ) { $self->print_error("In interpret_nav: Error selecting data from database: ".$self->{sth}->errstr); } @hold = $self->{sth}->fetchrow_array; $rec_count = $hold[0]; $page_count = 0; while ($rec_count > 0) { if ($cur_page != $page_count) { $page_navigator_str .= ''.($page_count+1).' '; } else { $page_navigator_str .= ($page_count+1).' '; } $page_count++; $rec_count -= $self->{records_per_page}; if ($page_count%20 == 19) # limits the page per line to 20 { $page_navigator_str .= "
"; } } $self->{DataString} =~ s/\$$self->{nav_pagelist_str};/$page_navigator_str/g; #------------ 3. gen the Next arrow ------------------- $rec_count = $hold[0]; # restrore the number of records if (int(($rec_count-1)/$self->{records_per_page}) != $cur_page) { $next_str = '

'; } else { $next_str = '

'; } $self->{DataString} =~ s/\$$self->{nav_next_str};/$next_str/g; #------------ Done ------------------------ } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # S E C T I O N 2 : H T M L F O R M P A R S E R # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Contents # target_form - get/set the form we want to work with (work with all if undef) # fvalue - get/set various form value. # fcheck - checks a checkbox/radio # funcheck - unchecks a checkbox/radio # ftextarea - get/set value of a textarea # fselect - selects a single item in a combo box # fmselect - selects multiple items in a combo box # funselect - unselects an item in a combo box. # insert_option - inserts an element to a combo box. # remove_block - removes a block the HTML template # target_form - get/set the form we want to work with (work with all if undef) # Input - the form that we want to work with: indentified by giving the script name that # the form will execute # example: target_form("user_admin.pl"); sub target_form { my $self = shift; $self->{target_form} = @_[0] if @_; return $self->{target_form}; } # fvalue : get/set a form input value. # syntax: fvalue("Input type", "Name", ["New Value"]); # # "Input type" can be => text, password, checkbox, radio, submit, reset, hidden # "Name" name of the form element. # "New Value" new value of the form element # Example: # fvalue("text","address") => will return the value of a 'text' input with the name 'address'. # fvalue("text","address","Dept. Computer Engineering") => will set the value of a 'text' input with the name 'address' to 'Dept. Computer Engineering' sub fvalue { my $self = shift; my $type = shift; my $name = shift; my $new_val = shift; # new_val will be undef if now value is passed my $fdata, $pre_match,$post_match, $form_item; my $pre_form, $post_form; # the value tag must have " around its value # e.g. value = roger => incorrect # value = "roger" => correct $fdata = $self->{DataString}; # ��ҡ�˹� Form ��ͧ�� Ժ��੾�� form �� process if ($self->{target_form} ne undef) { $fdata =~ m/<\s*FORM\s*ACTION\s*=\s*"$self->{target_form}" .*?<\/FORM>/si; $pre_form = $PREMATCH; $post_form = $POSTMATCH; $fdata = $MATCH; } foreach $form_item ($fdata =~ m/<\s*input.*?>/sgi) # search for tags { #separate the input sting (HTML file) in ot three parts $form_item =~ s/\$/\\\$/; # escape the $ char if there is any. $fdata =~ m/$form_item/si; $pre_match = $PREMATCH; $post_match = $POSTMATCH; if ($form_item =~ m/type\s*=\s*?"$type"/si) # check the type of the current input { if ($form_item =~ m/name\s*=\s*"$name"/si) # check the name of the current input { if ($new_val ne undef) # if a new value is provided { if ($form_item =~ m/value/si) # Search for the value tag { $form_item =~ s/value\s*=\s*".*?"/value="$new_val"/si; # replace the old value with the new one. } else # if value tag does not exist -> add one { $form_item =~ s/>/ value="$new_val">/; } $form_item =~ s/\\\$/\$/; # un-escape the $ char if there is any. $fdata = $pre_match.$form_item.$post_match; # recombine the input string (HTML file) # last; } else # read the value { return undef if !($form_item =~ m/value/si); $form_item =~ s/<.*value\s*=.*?"(.*?)".*>/\1/si; $form_item =~ s/\\\$/\$/; # un-escape the $ char if there is any. return $form_item; } } } } if ($self->{target_form} ne undef) { $self->{DataString} = $pre_form.$fdata.$post_form; } else { $self->{DataString} = $fdata; } } # fcheck : checks a checkbox or radio (Inserts a 'checked = 1' string in the code). # syntax: fcheck("Form Type", "Name",["value"]); # # "Form Type" can be => checkbox, radio # "Name" name of the form element. # "Value" value of the form element. # Example: # fcheck("checkbox","item1","0") => will check the checkbox named 'item1' and with a value of 0 # fcheck("checkbox","item1") => will check the checkbox named 'item1'. If there are many checkboxes named 'item1' the first will be checked # fcheck("radio","pay_cache","yes") => will check the radio named 'pay_cache' and with a value 'yes'. # Note: when you use the fcheck command with a radio input, the module will uncheck all other radios with the same name for you. sub fcheck { my $self = shift; my $type = shift; my $name = shift; my $value = shift; my $fdata, $pre_match,$post_match, $form_item; $fdata = $self->{DataString}; # ��ҡ�˹� Form ��ͧ�� Ժ��੾�� form �� process if ($self->{target_form} ne undef) { $fdata =~ m/<\s*FORM\s*ACTION\s*=\s*"$self->{target_form}" .*?<\/FORM>/si; $pre_form = $PREMATCH; $post_form = $POSTMATCH; $fdata = $MATCH; } foreach $form_item ($fdata =~ m/<\s*input.*?>/sgi) # search for tags { $form_item =~ s/\$/\\\$/; # escape the $ char if there is any. $fdata =~ m/$form_item/si; $pre_match = $PREMATCH; $post_match = $POSTMATCH; if ($form_item =~ m/.*type\s*=.*?"$type"/si) # check type { if ($form_item =~ m/.*name\s*=\s*?"$name"/si) # check name { if ( ($form_item =~ m/.*value\s*=\s*?"$value"/si) || ($value eq undef) ) # check value { if ($form_item =~ m/checked/si) # if there is a value tag already { $form_item =~ s/checked\s*=\s*".*?"/checked="1"/si; } else # if value tag does not exist -> add one { $form_item =~ s/>/ checked="1">/; } $form_item =~ s/\\\$/\$/; # un-escape the $ char if there is any. $fdata = $pre_match.$form_item.$post_match; # last; } } } } # This second loop is to uncheck the radio's that are not supposed to be checked. (only one radio # is allowed to be checked at a time. So, when we choose to check one we should clear the # others). if ($type eq "radio") { foreach $form_item ($fdata =~ m/<\s*input.*?>/sgi) # search for tags { $form_item =~ s/\$/\\\$/; # escape the $ char if there is any. $fdata =~ m/$form_item/si; $pre_match = $PREMATCH; $post_match = $POSTMATCH; if ($form_item =~ m/.*type\s*=.*?"$type"/si) { if ($form_item =~ m/.*name\s*=\s*?"$name"/si) { if (! ($form_item =~ m/.*value\s*=\s*?"$value"/si) ) { if ($form_item =~ m/checked/si) { $form_item =~ s/checked\s*=\s*".*?"//si; } $form_item =~ s/\\\$/\$/; # un-escape the $ char if there is any. $fdata = $pre_match.$form_item.$post_match; # last; } } } } } if ($self->{target_form} ne undef) { $self->{DataString} = $pre_form.$fdata.$post_form; } else { $self->{DataString} = $fdata; } } # funcheck : un-checks a checkbox or radio (Inserts a 'checked = 0' string in the code). # syntax: funcheck("Form Type", "Name",["value"]); # # "Form Type" can be => checkbox, radio # "Name" name of the form element. # "Value" value of the form element, needed if type is radio. # Example: # funcheck("checkbox","item1") => will un-check the checkbox named 'item1'. If there are many checkboxes named 'item1' the first will be unchecked # funcheck("radio","pay_cache","yes") => will un-check the radio named 'pay_cache' and with a value 'yes'. sub funcheck { my $self = shift; my $type = shift; my $name = shift; my $fdata, $pre_match,$post_match, $form_item; $fdata = $self->{DataString}; # ��ҡ�˹� Form ��ͧ�� Ժ��੾�� form �� process if ($self->{target_form} ne undef) { $fdata =~ m/<\s*FORM\s*ACTION\s*=\s*"$self->{target_form}" .*?<\/FORM>/si; $pre_form = $PREMATCH; $post_form = $POSTMATCH; $fdata = $MATCH; } foreach $form_item ($fdata =~ m/<\s*input.*?>/sgi) # search for tags { $form_item =~ s/\$/\\\$/; # escape the $ char if there is any. $fdata =~ m/$form_item/si; $pre_match = $PREMATCH; $post_match = $POSTMATCH; if ($form_item =~ m/.*type\s*=.*?"$type"/si) { if ($form_item =~ m/.*name\s*=\s*?"$name"/si) { if ( ($form_item =~ m/.*value\s*=\s*?"$value"/si) || ($value eq undef) ) # check value { if ($form_item =~ m/checked/si) { $form_item =~ s/checked\s*=\s*".*?"//si; } $form_item =~ s/\\\$/\$/; # un-escape the $ char if there is any. $fdata = $pre_match.$form_item.$post_match; # last; } } } } if ($self->{target_form} ne undef) { $self->{DataString} = $pre_form.$fdata.$post_form; } else { $self->{DataString} = $fdata; } } # ftextarea: Get/Set the value of a textarea # syntax: ftextarea("Name",["value"]); # # "Name" name of the textarea. # "Value" new value of the textarea. # Example: # ftextarea("comments"); => will return the value of a textarea named 'comments'. # ftextarea("comments","very good"); => will set the value of a textarea named 'comments' to 'very good'. sub ftextarea { my $self = shift; my $name = shift; my $new_val = shift; my $fdata, $pre_match,$post_match, $form_item; $fdata = $self->{DataString}; # ��ҡ�˹� Form ��ͧ�� Ժ��੾�� form �� process if ($self->{target_form} ne undef) { $fdata =~ m/<\s*FORM\s*ACTION\s*=\s*"$self->{target_form}" .*?<\/FORM>/si; $pre_form = $PREMATCH; $post_form = $POSTMATCH; $fdata = $MATCH; } foreach $form_item ($fdata =~ m/<\s*textarea.*?>.*?<\s*\/textarea.*?>/sgi) # search for tags { $form_item =~ s/\$/\\\$/; # escape the $ char if there is any. $fdata =~ m/$form_item/si; $pre_match = $PREMATCH; $post_match = $POSTMATCH; if ($form_item =~ m/<.*name\s*=\s*?"$name".*?>.*?)(.*?)(<\s*\/textarea.*?>)/\1$new_val\3/si; $form_item =~ s/\\\$/\$/; # un-escape the $ char if there is any. $fdata = $pre_match.$form_item.$post_match; # last; } else # read the value { $form_item =~ s/(<\s*textarea.*?>)(.*?)(<\s*\/textarea.*?>)/\2/si; $form_item =~ s/\\\$/\$/; # un-escape the $ char if there is any. return $form_item; } } } if ($self->{target_form} ne undef) { $self->{DataString} = $pre_form.$fdata.$post_form; } else { $self->{DataString} = $fdata; } } # fselect: allow you to select an item in a combo box # syntax: fselect("Name","value"); # # "Name" name of the combo box. # "Value" value of the item you want to select # Example: # fselect("sex","male"); => will select the 'male' item of the 'sex' combo box. # Note: when you select an item with fselect, it will unselect all other items in the combo box for you. sub fselect { my $self = shift; my $name = shift; my $target = shift; my $fdata, $pre_match,$post_match, $form_item,$select_item; my $sub_pre_match, $sub_post_match; $fdata = $self->{DataString}; # ��ҡ�˹� Form ��ͧ�� Ժ��੾�� form �� process if ($self->{target_form} ne undef) { $fdata =~ m/<\s*FORM\s*ACTION\s*=\s*"$self->{target_form}" .*?<\/FORM>/si; $pre_form = $PREMATCH; $post_form = $POSTMATCH; $fdata = $MATCH; } foreach $form_item ($fdata =~ m/<\s*select.*?>.*?<\s*\/select.*?>/sgi) # search for tags { $form_item =~ s/\$/\\\$/; # escape the $ char if there is any. $fdata =~ m/$form_item/si; $pre_match = $PREMATCH; $post_match = $POSTMATCH; if ($form_item =~ m/<.*name\s*=\s*?"$name".*?>.*?/sgi) { $form_item =~ m/$select_item/si; $sub_pre_match = $PREMATCH; $sub_post_match = $POSTMATCH; if ($select_item =~ m/<.*?value\s*=\s*"$target".*?>/si) { if (!($select_item =~ m/selected/si)) { $select_item =~ s/>/ selected>/i; } } else { $select_item =~ s/selected//si; } $form_item = $sub_pre_match.$select_item.$sub_post_match; } $form_item =~ s/\\\$/\$/; # un-escape the $ char if there is any. $fdata = $pre_match.$form_item.$post_match; # last; } } if ($self->{target_form} ne undef) { $self->{DataString} = $pre_form.$fdata.$post_form; } else { $self->{DataString} = $fdata; } } # fmselect: allow you to make multiple selections in a combo box # syntax: fmselect("Name","value"); # # "Name" name of the combo box. # "Value" value of the item you want to select # Example: # fmselect("componets","keyboard"); => will select the 'keyboard' item of the 'componets' combo box. # (and will not unselect other items that may have been selected before using this command.) sub fmselect { my $self = shift; my $name = shift; my $target = shift; my $fdata, $pre_match,$post_match, $form_item,$select_item; my $sub_pre_match, $sub_post_match; $fdata = $self->{DataString}; # ��ҡ�˹� Form ��ͧ�� Ժ��੾�� form �� process if ($self->{target_form} ne undef) { $fdata =~ m/<\s*FORM\s*ACTION\s*=\s*"$self->{target_form}" .*?<\/FORM>/si; $pre_form = $PREMATCH; $post_form = $POSTMATCH; $fdata = $MATCH; } foreach $form_item ($fdata =~ m/<\s*select.*?>.*?<\s*\/select.*?>/sgi) # search for tags { $form_item =~ s/\$/\\\$/; # escape the $ char if there is any. $fdata =~ m/$form_item/si; $pre_match = $PREMATCH; $post_match = $POSTMATCH; if ($form_item =~ m/<.*name\s*=\s*?"$name".*?>.*?/sgi) { $form_item =~ m/$select_item/si; $sub_pre_match = $PREMATCH; $sub_post_match = $POSTMATCH; if ($select_item =~ m/<.*?value\s*=\s*"$target".*?>/si) { if (!($select_item =~ m/selected/si)) { $select_item =~ s/>/ selected>/i; } } $form_item = $sub_pre_match.$select_item.$sub_post_match; } $form_item =~ s/\\\$/\$/; # un-escape the $ char if there is any. $fdata = $pre_match.$form_item.$post_match; # last; } } if ($self->{target_form} ne undef) { $self->{DataString} = $pre_form.$fdata.$post_form; } else { $self->{DataString} = $fdata; } } # funselect: unselect an item in a combo box # syntax: funselect("Name","value"); # # "Name" name of the combo box. # "Value" value of the item you want to unselect # Example: # funselect("sex","male"); => will unselect the 'male' item of the 'sex' combo box. # Note: This command is usually used together with fmselect command. sub funselect { my $self = shift; my $name = shift; my $target = shift; my $fdata, $pre_match,$post_match, $form_item,$select_item; my $sub_pre_match, $sub_post_match; $fdata = $self->{DataString}; # ��ҡ�˹� Form ��ͧ�� Ժ��੾�� form �� process if ($self->{target_form} ne undef) { $fdata =~ m/<\s*FORM\s*ACTION\s*=\s*"$self->{target_form}" .*?<\/FORM>/si; $pre_form = $PREMATCH; $post_form = $POSTMATCH; $fdata = $MATCH; } foreach $form_item ($fdata =~ m/<\s*select.*?>.*?<\s*\/select.*?>/sgi) # search for tags { $form_item =~ s/\$/\\\$/; # escape the $ char if there is any. $fdata =~ m/$form_item/si; $pre_match = $PREMATCH; $post_match = $POSTMATCH; if ($form_item =~ m/<.*name\s*=\s*?"$name".*?>.*?/sgi) { $form_item =~ m/$select_item/si; $sub_pre_match = $PREMATCH; $sub_post_match = $POSTMATCH; if ($select_item =~ m/<.*?value\s*=\s*"$target".*?>/si) { $select_item =~ s/selected//si; } $form_item = $sub_pre_match.$select_item.$sub_post_match; } $form_item =~ s/\\\$/\$/; # un-escape the $ char if there is any. $fdata = $pre_match.$form_item.$post_match; # last; } } if ($self->{target_form} ne undef) { $self->{DataString} = $pre_form.$fdata.$post_form; } else { $self->{DataString} = $fdata; } } # insert_option: inserts an element in to a combo box # syntax: insert_option("Combo Name","Element Name","value"); # # "Combo Name" name of the combo box. # "ElementName" name of the new element # "Value" value of the new element # Example: # insert_option("Movies","Starwars","01"); => will look for a combo box named "Movies" and # insert an element named "Starwars" with value = "01" sub insert_option { my $self = shift; my $combo_name = shift; my $element_name = shift; my $element_value = shift; my $fdata, $pre_match,$post_match, $form_item,$select_item; my $sub_pre_match, $sub_post_match; $fdata = $self->{DataString}; # ��ҡ�˹� Form ��ͧ�� Ժ��੾�� form �� process if ($self->{target_form} ne undef) { $fdata =~ m/<\s*FORM\s*ACTION\s*=\s*"$self->{target_form}" .*?<\/FORM>/si; $pre_form = $PREMATCH; $post_form = $POSTMATCH; $fdata = $MATCH; $self->print_error("Can't find form with target $self->{target_form}") if $fdata eq undef; } foreach $form_item ($fdata =~ m/<\s*select.*?>.*?<\s*\/select.*?>/sgi) # search for tags { $form_item =~ s/\$/\\\$/; # escape the $ char if there is any. $fdata =~ m/$form_item/si; $pre_match = $PREMATCH; $post_match = $POSTMATCH; if ($form_item =~ m/<.*NAME\s*=\s*?"$combo_name".*?>.*?//sgi; # remove the default element (one without a name and value) if any. $form_item =~ s/<\s*OPTION\s*>//sgi; # remove the default element (one without a name and value and unselected) if any. $form_item =~ s/<\s*\/SELECT>/