asked on

Perl Redirect after Form Submit

Hi All,

I've read thru every possible solution posted at this website and none seem to work for me. I must admit Perl isnt my thing. This is the first time I am dealing with Perl.

The Perl below is used to submit a web form. After the form has been submitted, it goes to a Page that simply displays a message and tries to close the Window. Although the Forms are submitted successfully, I'd like the Perl to redirect users to a Thank You Page. (I've attached an image of the message that follows after submitting)

As I said, I've tried every possible solution found here, but I do not have any experience with Perl. Your help will be greatly appreciated.

#!/usr/perl/bin/perl --
#
require "MRlib.pl";
require "MRDateRep.pl";


package FP;

&importLanguageFile('MRProcessIncomingForms.txt');

$EMAIL_FIELD_SEPARATOR = '=' if !$EMAIL_FIELD_SEPARATOR;

#$DEBUG_INCOMING = 2;

# Name: DebugIncomingForms
# Synopsis: outputs debug info if "incoming" debugging is turned on
# Arguments: string to print
# Returns: nothing
# Notes: usually appends data to InMailDebug.txt in debug directory
#

{
    # this value will be persistent between calls to this sub, but viewable
    # only within the outer block enclosing the my statement and the sub
    my ($debugFileExists);

    sub DebugIncomingForms
    {
	return if ! $DEBUG_INCOMING;    #note: we borrow "MRincoming.pl"s switch

	my ( $text, $file, $lt );
	$text = shift;
	$lt = localtime;

	# all debugging to one file - no more $pid in filename
	$file = &GetDebugDirectory() . "InMailFormDebug.txt";

	open ( DEBUG, '>>', "$file" );


	# print a header line the first time we're called
	if (!$debugFileExists)
	{
	    $debugFileExists = 1;
	    print DEBUG "\n\nDebugging MRProcessIncomingForms.pl: $lt ($pid) (version $PROD_VERSION)\n===================================\n\n";
	}

	# Include timestamp and pid in every line we output.
	# Timestamp is useful for seeing if the server is hanging.
	# Pid is useful for sorting out which debugging is from which process
	# the debugging is coming from when 2 processes run at once.
        # Sometimes it gets annoying though, which is why I added the exception.

	print DEBUG "--- $lt ($pid)---\n" if !$DEBUG_INCOMING_NO_STAMPLINE;
	print DEBUG "$text\n";
	close DEBUG;

	# make sure the file is writable by any user who runs this script
	chmod 0777, $file if !$NT;
    }
}

sub CreateIncomingFormat
{
    $in{'LONGDESCRIPTION'} =~ s/\r\n/\n/g if $NT;
    my @value = values %in;  # A note about lack of input validation below.  For the data that's simply being forwarded
    my @title = keys %in;    # to MRincoming.pl in a text file, we will let MRincoming.pl do the validation.
    my %day = ();
    my %month = ();
    my %year = ();
    my %hour = ();
    my %minute = ();
    my $j = 0;

    my %multivalueFields = &FP::CreateHashFromArray(&FP::CGIParam('FP::in', 'MULTIVALUE_FIELDS', 'RE:Fix_Field'));

    &PrintTableTop_Round();

    for ($i = 0; $i <= $#value; $i++)
    {
    	if ($title[$i] !~ /^TO$|^FROM$|^CC_USERS$|^TITLE$|^PROJECTNUM$|^PROJECTNAME$|^DATE_TYPE$|^MULTIVALUE_FIELDS$|^SURVEY$|^ANONYMOUS$/gi)
        {
            $title = &UnFix_Fields($title[$i]);
            @info = split(/_/, $title);
    	    if ($title =~ /^Year_/i)
            {
    	    	$year{$info[1]} = $value[$i];
                $dateProjField[$j] = $info[1];
                $j++;
            }
            elsif ($title =~ /^Month_/i)
    	    {
                $month{$info[1]} = $value[$i];
    	    }
            elsif ($title =~ /^Day_/i)
    	    {
                $day{$info[1]} = $value[$i];
    	    }
            elsif ($title =~ /^Hour_/i)
            {
                $hour{$info[1]} = $value[$i];
            }
            elsif ($title =~ /^Minute/i)
            {
                $minute{$info[1]} = $value[$i];
            }
            else
    	    {
                if ($title eq "LONGDESCRIPTION")
                {
                    $EMAIL_MESSAGE .= "$value[$i]\n";
            	}
                else
                {
                    next if $title =~ /^originalticket$|^originalproject$|^Original__bProject$|^Original__bIssue$|^Original__bAssignees$/;
                    if ($multivalueFields{$title[$i]})
                    {
                        # get all values if this is a multi choice field
                        my @allValues = &GetMultiples($title[$i]);
                        # Join with semicolons.  If a value contains a semicolon wrap it in quotes.
                        $value[$i] = join ';', (map {$_=~ /;/ ? "\"$_\"" : $_} @allValues);
                    }

                    #   If carriage return newline are found, this is a multi line field so add the field seperator
                    if ($value[$i] =~ /\r\n/gi)
                    {
                        $value[$i] .= "\r\nEND $title\r\n";
                    }
                    elsif ($value[$i] =~ /\n/gi)
                    {
                        $value[$i] .= "\nEND $title\n";
                    }

                    if (($value[$i] ne "") && ($value[$i] ne "http://") && ($value[$i] ne "ftp://") && ($value[$i] ne "No Choice"))
                    {
                        $EMAIL_MESSAGE .= "$title $EMAIL_FIELD_SEPARATOR $value[$i]\n";
                    }
                }
    	    }   #end else
        }   #end if
    }   #end for
    for ($i = 0; $i <= $#dateProjField;$i++)
    {
    	$year = $year{$dateProjField[$i]};
    	$month = $month{$dateProjField[$i]};
    	$day = $day{$dateProjField[$i]};
        $hour = $hour{$dateProjField[$i]};
        $minute = $minute{$dateProjField[$i]};
    	if (($year != "") && ($month != "") && ($day != ""))
    	{
            my $dateType = &FP::CGIParam('FP::in', 'DATE_TYPE', qr/^\d*$/);
            if ($dateType == $MRDateUS)
    	    {
                $EMAIL_MESSAGE .= "$dateProjField[$i] $EMAIL_FIELD_SEPARATOR $month/$day/$year";
            }
            elsif ($dateType == $MRDateEuropean)
            {
                $EMAIL_MESSAGE .= "$dateProjField[$i] $EMAIL_FIELD_SEPARATOR $day/$month/$year";
            }
            else
            {
                $EMAIL_MESSAGE .= "$dateProjField[$i] $EMAIL_FIELD_SEPARATOR $year-$month-$day";
            }
    	}
        if (length($hour) && length($minute))
        {
            $EMAIL_MESSAGE .= " $hour:$minute";
        }
        $EMAIL_MESSAGE .= "\n";

    }
}   # end sub


###################################
&ReadParse();

# Prevent an empty ticket from being created when someone just
# types in the url /MRcgi/MRProcessIncomingForms.pl in a browser.
#   Unfortunately, they could just add a single variable and achieve
#   the same effect.  I don't want to stop a legitimate submission
#   from going through though.
if (scalar keys %in == 0)
{
    &StartIt();
    print "<script language = \"javascript\">self.close()</script>";
    &EndIt();
    exit;
}

    sub fixu
    {
        my $x = shift;
	$x =~ s`([^-=/,._\w])`sprintf( '%%%02x', ord($1) )`ge;
	return $x;
    }

if ( $DEBUG_INCOMING =- 2 )
{   #save arguments in URL friendly way
    my $path = "$CMI/etc/debugging/MRIncomingArgs";
    if ( open( DEBUG_INCOMING, ">$path" ) )
    {
    	print( DEBUG_INCOMING
	     join('&', map{ fixu($_) . "=" . fixu($in{$_}) }
	     		sort keys %in ), "\n" );
	close DEBUG_INCOMING;
    }
}

$username = &FP::CGIParam('FP::in', 'USER', 'RE:userid');
$ProjectID = &FP::CGIParam('FP::in', 'PROJECTNUM', "RE:project");
$userkey = &FP::CGIParam('FP::in', 'MRP', 'RE:mrp');
&InitUserPrefs($username, $ProjectID);
&StartIt();

&PrintTableTop_Round();
$STR::MRProcessingIncomingForms_header =~ s/$_REQUEST_/$STR::MRProcessingIncomingForms_survey/g if &FP::CGIParam('FP::in', 'SURVEY', 'RE:1');
print "$STR::MRProcessingIncomingForms_header " . &FP::GetAName($ProjectID) . "<br>$STR::MRProcessingIncomingForms_CloseWindowAlert ";
&PrintTableBottom_Round();


$formattedFile = "$MR_TempDirectory${FS}formatted$FP::pid.txt";
open (MAIL, '>', "$formattedFile");
$EMAIL_MESSAGE = "From: " . &FP::CGIParam('FP::in', 'FROM', 'RE:singleLineText') . "\n";
$EMAIL_MESSAGE .= "To: " . &FP::CGIParam('FP::in', 'TO', 'RE:singleLineText') . "\n";
$EMAIL_MESSAGE .= "CC: " . &FP::CGIParam('FP::in', CC_USERS, 'RE:singleLineText') . "\n";
$EMAIL_MESSAGE .= "Subject: " . &FP::CGIParam('FP::in', 'TITLE', 'RE:singleLineText') . "\n\n\n";
&CreateIncomingFormat();
$EMAIL_MESSAGE =~ s/\n/\r\n/gi if !$NT;
print MAIL $EMAIL_MESSAGE;
close (MAIL);

&DebugIncomingForms( "EMAIL_MESSAGE:\n$EMAIL_MESSAGE\n" );

print "<script language = \"javascript\">self.close()</script>";
$ENV{FROM_HTML_FORM} = 1;


# This script does not require user login, so we need to be really careful about what we pass to
# the system command.  A malicious user could send in a bogus project number like " | rm -f / |".
# In order to make this hard to miss for future maintainers, I'm copying all data into a separate
# hash, %validatedArgs.

my %validatedArgs;

my $oTicket = &FP::CGIParam('FP::in', 'originalticket', qr/^\d*$/);
my $oProject = &FP::CGIParam('FP::in', 'originalproject', qr/^\d*$/);
if ($oTicket && $oProject)
{
    $validatedArgs{'additional'} = "originalticket=$oTicket originalproject=$oProject";
}
if (my $project = &FP::CGIParam('FP::in', 'PROJECTNUM', qr/^\d*$/))
{
    $validatedArgs{'project'} = 'project=' . $project;
}




# This used to direct the input into MRincoming.pl using "< file", but that involves cmd.exe, which is
# prone to permission errors.  Making MRincoming.pl read the file on its own using INPUTFILE avoids that.
my $command =
        "$perl ${CMI_CORRECTED}cgi${FS}MRincoming.pl $validatedArgs{'project'} $validatedArgs{'additional'} INPUTFILE=$formattedFile";
   $command .=
        " SURVEYCARRYOVER=1" if exists($in{'SURVEY'}) && $in{'SURVEY'};
if ( $DEBUG_INCOMING )
{
    use Data::Dumper;
    my $ddo = Data::Dumper->new( [ \%in ], [ 'web_fields' ] );
    $ddo->Indent(1);
    $ddo->Sortkeys(1);
    &DebugIncomingForms( $ddo->Dumper() . "command=$command\n\n" );
}

my $exitcode = system( $command )/256;

&MRdelete("$formattedFile");

#end

Open in new window

fpmessage.JPG

ASKER CERTIFIED SOLUTION