#!/usr/bin/perl use strict; use warnings; use CGI; use Time::Local; use utils::generator qw(:SURVEYS); use constant { ALLOWED_REFS => "", SURVEY_ID_PARAM => "surveyid", UNIQ_ID_PARAM => "uniq_id", PID_PARAM => "pid", }; my $cgi = new CGI; # Get sub id. my $subid = $cgi->param("subid"); #my $subid = 1; my $ref = ""; # Get referring website. #my $ref = $cgi->param("ref"); #my ($cgi, $CONFIG, $DEBUG, $template, $datetime, $db, $server_type, $server_name) = &init_webcnp('survey.pl'); my $surveyid="JPVT_Survey"; my $uniq_id = 2359344222; # Check for a valid id - 9 digits for test or alphanum otherwise. The num part is compulsory. # They prepend Z to their test links, however those have < 9 digits. # So here we check for a match of at least one digit. if($subid =~ m/[0-9]{1,10}/) { my $base_url = "https://webcnp.med.upenn.edu/surveys"; my $hst = generate_subid_hash($subid); my $next = $base_url ."/survey.pl?surveyid=".$surveyid ."&uniq_id=".$uniq_id ."&pid=".$subid ."&hst=".$hst; print $cgi->redirect(-uri=>$next); exit; print STDERR $hst . "\n"; } # We have an invalid id here, only happens when we do not have a digit. # Also, this url is private so except for our collaborators no one else can use it. else { # We gotta do something in this case print STDERR "Incorrect link for Japanese study. Invalid subid " . $subid; # Fail safe by redirecting to home page. # We could also redirect to a 404 page, however ids are generated and not created. print $cgi->redirect(-uri=>"https://webcnp.med.upenn.edu/"); exit; } 1;