I have a very light understanding of perl, and could not understanding and update an existing script which used to be pointing to the decommissioned url.
We've a requirement of switchover to a new link.
1. lookup.pl : This script was pointing to an old link, and was retriveing First Name, Last Name etc. Now, we are asked to change to new link which provides the output as provided in the below format.
2. Output.txt : Output Format Example.
Please help in update the lookup.pl script to get the grab the output and present the content to the underlying apps.
Thanks, Pamela
########lookup.pl############
###########output.txt#############!/usr/local/bin/perl #include libraries from /usr/local/lib/perl5/site_perl require "www.pl"; require "wwwurl.pl"; ###################################################################### +########### #include library from same directory as this script # require "process_cgi.pl"; # constants $line_sep = "\r"; ###################################################################### +########### # debugging switch: set to 1 to enable $debug = 1; ###################################################################### +########### $logfile_nm = "/usr/local/etc/httpd/htdocs/is/das/ddac/reg/user_lookup +.log"; #$logfile_nm = "user_lookup.log"; # output the required HTML header print "Content-type: text/html\n\n"; open LOGFILE,">>$logfile_nm" or print("!001",$line_sep,"$! ", $logfile +_nm, $line_sep) , exit(1); @args = ("chmod", "664", $logfile_nm); system(@args); if ($debug){ print LOGFILE ("-------------------- DEBUG VALUES ---------------- +-------------------\n"); } print LOGFILE "\n\nConnection from " . $ENV{"REMOTE_ADDR"}; #if ($debug) { # foreach $key (keys %ENV){ # print LOGFILE "\n$key = $ENV{$key}"; # } #} # First line of output is status of lookup request # <status symbol char(1)><Additional data char string> # <*=Incomplete data><Number of matches> BCD lookup returns only the f +irst 28 matches # <!=Error><Error code and/or description> # <space=Success><Number of matches> # Subsequent out put lines are the matches in the following format: # <Last name>|<First name>|<initial>|<Company name>|<SBU>|<Function>|< +Location>|<Country>|<Phone>|E-mail address> # carriage return(\r) is used as the line separator # parse the input; expecting three input fields: FNAME=<first name> # LNAME=<last name> and COMP_CD=<D for dup | O for non-dup> # LNAME and COMP_CD are required; assumption is that front end does va +lidity # However if COMP_CD is not valid then D will be assumed. &parse_input(*fields); if ($debug) { print LOGFILE ("\n INPUT Last name : $fields{'LNAME'}"); print LOGFILE ("\n INPUT First name: $fields{'FNAME'}"); print LOGFILE ("\n INPUT Initial : $fields{'INITIAL'}"); } if ($fields{'LNAME'} eq "") { print("!004",$line_sep,"Last name is a required field, Please enter + your last name", $line_sep); print(LOGFILE "\n" . "Last name is a required field, Please enter y +our last name"); exit; } if ($fields{'FNAME'} eq "" and $fields{'INITIAL'} ne "") { print("!005",$line_sep,"You have entered your middle initial, Pleas +e enter your first name", $line_sep); print(LOGFILE "\n" . "You have entered your middle initial, Please +enter your first name"); exit; } if ($fields{'PROD_NM'} eq "") { $fields{'PROD_NM'} = "ddac32"; } if ($debug) { print LOGFILE "INPUT Parameters\n"; @keys = keys %fields; @values = values %fields; while (@keys) { print LOGFILE pop(@keys), '=', pop(@values), "\n"; } } ###################################################################### +################ # Remove spaces from LNAME + # ###################################################################### +################ $input = $fields{'LNAME'}; $input =~ s/[ \t]+/%20/g; print LOGFILE ("\nReplace spaces in last name: $input \n"); ###################################################################### +################ if (uc($fields{'COMP_CD'}) ne "O") { # call BCD.pl script for lookup in dup BCD # Set up the necessary variable to do the request if ($fields{'INITIAL'} eq "") { $tmp_str = "firstname=" . $fields{'FNAME'}; } else { $tmp_str = "firstname=" . $fields{'FNAME'} . "+" . $fields{'INIT +IAL'}; } #$tmp_str =~ s/([^a-zA-Z0-9_.-=])/&EscapeChar($1)/eg; # $thestring = $tmp_str . "&lastname=" . $fields{'LNAME'}; $thestring = $tmp_str . "&lastname=" . $input; &PrintDebug("thestring=$thestring\n"); $BCDscript = "/usr/local/etc/httpd/cgi-bin/BCD.pl"; # specify the +path to the main form script $BCDcall = "http://www1.lvs.dup.com/cgi-bin/BCD.pl"; $marker = "!MARKER!"; $thestring .= "&" . &PackNameValue("actionURL", $marker); # Add act +ion URL, alias "marker" $url = $BCDcall . "?" . $thestring; local($method) = 'GET'; local($content) = ""; local($headers) = ''; local(%headers) = (); local($headers{'User-Agent'}) = "sitepost.cgi/1.0 libwww-perl/0.40" +; local($headers{'Content-Type'}) = "application/x-www-form-urlencode +d"; #$headers{'Content-Length'} = 0; local($timeout) = 90; &PrintDebug("<p>Verifying URL: $method, $url, %headers, $content, $ +timeout<br>\n"); # Send the request local($respcode) = &www'request($method, $url, *headers, *content, +$timeout); &PrintDebug("Response code = $respcode<br>\n"); if ($respcode != 200) { # Return error code print "!002$line_sep$respcode BCD lookup failed$line_sep"; print(LOGFILE "\n" . "BCD lookup failed respcode = " . $respcode +); exit; } @response = split(/$marker\?/,$content); # Determine if sure BCD lookup not incomplete $incomplete = " "; $incomplete = "*" if ($response[0] =~ /incomplete/); # check number of responses; only return the first 25 if more than +25 if ($#response > 25) { $incomplete = "*"; $#response = 25 if ($#response > 25); } # Print out number of matches $matchcount = $#response; print $incomplete, $matchcount, $line_sep; # iterate through each valid person returned from BCD for ($i=1; $i <= $#response; $i++) { # extract BCD info up to first quote @tmp = split(/"/, $response[$i]); $match = $tmp[0]; # print out match number and tag/value pairs &PrintDebug($match); %BCD = (); $ENV{'REQUEST_METHOD'} = "GET"; $ENV{'QUERY_STRING'} = $match; &parse_input(*BCD); # convert escaped characters (spaces and %nn hex) to their equi +valent while (($key,$value) = each %BCD) { # convert + to ' ' $value =~ tr/+/ /; $value =~ tr/\r/ /; $value =~ tr/\n/ /; # convert escaped characters (spaces and %nn hex) to their +equivalent $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ tr/|/ /; $value =~ tr/\r/ /; $value =~ tr/\n/ /; $BCD{$key} = $value; } if ($debug) { @keys = keys %BCD; @values = values %BCD; while (@keys) { print LOGFILE pop(@keys), '=', pop(@values), "\n"; } } # parse the BCDname field into lastname, firstname, and middle i +nitial $last_name = ""; $first_name = ""; $initial = ""; &PrintDebug("\nBCDname=" . $BCD{'BCDNAME'}); ($first_name,$initial,$last_name) = split(/ /,$BCD{'BCDNAME'},3) +; &PrintDebug("\nfirst_name=" . $first_name); &PrintDebug("\nlast_name=(" . $last_name . ")"); &PrintDebug("\ninitial=(" . $initial . ")"); if ($last_name eq "") { $last_name = $initial; $initial = ""; } # parse location to get country, assumption is that country is l +ast comma separated field @loc = split(/,/,$BCD{'LOCATION'}); $loc_cnt = @loc; $BCD_loc = ""; if ($loc_cnt > 1) { $BCD_ctry = @loc[$loc_cnt-1]; $BCD_ctry =~ s/^\s+//; # remove leading blanks if any @loc[$loc_cnt-1] = ""; $BCD_loc = join(',',@loc); $BCD_loc =~ tr/,/ /; chop $BCD_loc; } else { $BCD_ctry = ""; $BCD_loc = $BCD{'LOCATION'}; } $output_str = $last_name . "|" # Last name . $first_name . "|" # First name . $initial . "|" # Initial . "dup" . "|" # Company Name . $BCD{'DEPARTMENT'} . "|" # SBU . "" . "|" # Function . $BCD_loc . "|" # Location . $BCD_ctry . "|" # Country . $BCD{'PHONE'} . "|" # phone . $BCD{'INTRANET-EMAIL'}; # E-mail address print $output_str, $line_sep; } } # read the 'non dup' authorized users file maintained by Service Contr +ol else { # $uaf_nm = "ddac32.uaf"; $uaf_nm = "/usr/local/etc/httpd/htdocs/is/das/ddac/" . lc($fields{' +PROD_NM'}) . ".uaf"; $lname_pattern = "^" . $fields{'LNAME'}; $fname_pattern = "^" . $fields{'FNAME'}; $initial_pattern = "^" . $fields{'INITIAL'}; open (ddacusers, $uaf_nm) or print("!003$line_sep$! ", $uaf_nm, $li +ne_sep) , print(LOGFILE "\n$! " . $uaf_nm) ,exit(1);; $match_cnt = 0; $incomplete = " "; while (<ddacusers>) { chomp; # remove trailing newline ($Flag,$Lname,$Fname,$Init,$Company,$SBU,$Func,$Loc,$Country,$Ph +one,$Email)=split(/,/,$_); if ($Flag eq '1') { if ($match_cnt == 25) { $incomplete = "*"; last; } $Lname =~ s/^\s+//; # remove leading blanks if any $Fname =~ s/^\s+//; # remove leading blanks if any $Init =~ s/^\s+//; # remove leading blanks if any if ($Lname =~ m/$lname_pattern/i && $Fname =~ m/$fname_pattern/i && $Init =~ m/$initial_pattern/i){ $mtchd_lname[$match_cnt] = $Lname; $mtchd_fname[$match_cnt] = $Fname; $mtchd_initial[$match_cnt] = $Init; $mtchd_company[$match_cnt] = $Company; $mtchd_sbu[$match_cnt] = $SBU; $mtchd_func[$match_cnt] = $Func; $mtchd_loc[$match_cnt] = $Loc; $mtchd_ctry[$match_cnt] = $Country; $mtchd_phone[$match_cnt] = $Phone; $mtchd_email[$match_cnt] = $Email; ++$match_cnt; } } } close (ddacusers); &PrintDebug("\nmatch_cnt=" . $match_cnt); if ($match_cnt > 0) { print $incomplete, $match_cnt, $line_sep; for ($i=0; $i < $match_cnt; $i++) { $output_str = $mtchd_lname[$i] . "|" # Last name . $mtchd_fname[$i] . "|" # First name . $mtchd_initial[$i] . "|" # Initial . $mtchd_company[$i] . "|" # Company Name . $mtchd_sbu[$i] . "|" # SBU . $mtchd_func[$i] . "|" # Function . $mtchd_loc[$i] . "|" # Location . $mtchd_ctry[$i] . "|" # Country . $mtchd_phone[$i] . "|" # phone . $mtchd_email[$i]; # E-mail address + print $output_str, $line_sep; } } else { print " ", $match_cnt, $line_sep; } close LOGFILE; } sub PackNameValue { local($name, $value) = @_; # translate anything not [a-zA-Z0-9] into %xx for both $name and $ +value $name =~ s/([^a-zA-Z0-9_.-])/&EscapeChar($1)/eg; $value =~ s/([^a-zA-Z0-9_.-])/&EscapeChar($1)/eg; # translate all spaces to + for both $name and $value $name =~ s/\%20/+/g; $value =~ s/\%20/+/g; # create the return string $string = $name . '=' . $value; $string; } ###################################################################### +## # Subroutine: EscapeChar # Converts a character to its appropriate CGI escape character ###################################################################### +## sub EscapeChar { local($char) = @_; local($dec) = ord($char); $res = "%" . &ConvertDecToHex($dec); $res; } ###################################################################### +## # Subroutine: ConvertDecToHex # Converts a decimal value to its hexadecimal equivalent ###################################################################### +## sub ConvertDecToHex { local($dec) = @_; local($hex) = ""; local($cvtstr) = "0123456789ABCDEF"; $man = int($dec / 16); $rem = int($dec - $man * 16); $hex = substr($cvtstr, $man, 1) . substr($cvtstr, $rem, 1); $hex; } ###################################################################### +## # Subroutine: PrintDebug # Prints debugging information to the log file if the debug switch is +ON ###################################################################### +## sub PrintDebug { local($string) = @_; print LOGFILE $string . "\n" if ($debug); } #process_cgi.pl. A Perl library for CGI processing. sub form_method { $method=$ENV{'REQUEST_METHOD'}; } sub print_header { if (!defined(@_)) { print "Content-type: text/html\n\n"; } else { print "Location: @_\n\n"; } } ###################################################################### +## # PARSE INPUT + # ###################################################################### +## sub parse_input { print LOGFILE "\n--- About to Parse Input ---\n" if ($debug); if (defined(@_)){ local(*input)=@_; } else { local(*input)="*cgiinput"; } local ($form_data,@pairs); if (&form_method eq 'POST') { read(STDIN,$form_data,$ENV{'CONTENT_LENGTH'}) or print(LOGFILE "\ +n $! " . "STDIN" . "\n"); } else { $form_data=$ENV{"QUERY_STRING"}; } # &PrintDebug("\nSTDIN=" . $form_data); ###################################################################### +################# # Following 'if' statement only applies when debugging in the UNIX env +ironment and # when supplying input via the command line. if ((length($form_data)<=1)) { $form_data = <>; # Read input file supplied on the co +mmand-line. } ###################################################################### +################ @pairs=split(/&/,$form_data); foreach $item(@pairs) { ($key,$content)=split (/=/,$item,2); $key = uc($key); $content=~tr/+/ /; $content=~ s/%(..)/pack("c",hex($1))/ge; if (!defined($input{$key})) { $input{$key}=$content; } else { $input{$key} .= "\0$content"; } } return 1; }
<?xml version="1.0" encoding="UTF-8" ?> - <ns2:PeopleflexSearchResponse ns1:encodingStyle="http://schemas.xmls +oap.org/soap/encoding/" xmlns:ns1="http://schemas.xmlsoap.org/soap/en +velope/" xmlns:ns2="http://www.calendra.com/namespaces/services"> - <people soapenc:arrayType="xsd:anyType[1]" xmlns:soapenc="http://sch +emas.xmlsoap.org/soap/encoding/" xmlns:xsi="http://www.w3.org/2001/XM +LSchema-instance" xsi:type="soapenc:Array"> - <item xmlns:ns3="people" xsi:type="ns3:people"> <UIDattr xsi:type="xsd:string">Kk7046</UIDattr> <businessCategoryattr xsi:type="xsd:string">XXX LLP</businessCategor +yattr> <cattr xsi:type="xsd:string">IN</cattr> <cnattr xsi:type="xsd:string">John Smith</cnattr> <coattr xsi:type="xsd:string">USA</coattr> <displayNameattr xsi:type="xsd:string">John Smith</displayNameattr> <eisAdminSupervisorattr xsi:type="xsd:string">um7030</eisAdminSuperv +isorattr> <eisBusinessUnitattr xsi:type="xsd:string">G000044</eisBusinessUnita +ttr> <eisEpassIDattr xsi:type="xsd:string">kk7046</eisEpassIDattr> <eisFuncSupervisorattr xsi:nil="true" xsi:type="xsd:string" /> <eisIdentityTypeattr xsi:type="xsd:string">Contractor</eisIdentityTy +peattr> <eisInternetMailAddressattr xsi:type="xsd:string">xyz@usa.example.co +m</eisInternetMailAddressattr> <eisIntranetMailAddressattr xsi:type="xsd:string">IYER2AR@nanotes1.e +mail.example.com</eisIntranetMailAddressattr> <eisLegalEntityCodeattr xsi:nil="true" xsi:type="xsd:string" /> <eisNotesIDattr xsi:type="xsd:string">OU=Contractor/OU=AE/O=DuPont</ +eisNotesIDattr> <eisOrgInfoattr xsi:type="xsd:string">Constructs</eisOrgInfoattr> <eisOrganizationalUnitattr xsi:nil="true" xsi:type="xsd:string" /> <eisOtherEmailattr xsi:type="xsd:string">XYZ@example.com</eisOtherEm +ailattr> <eisOtherPhoneattr xsi:type="xsd:string">11113166</eisOtherPhoneattr +> <eisPlatformattr xsi:nil="true" xsi:type="xsd:string" /> <eisRegionattr xsi:type="xsd:string">EUROPE</eisRegionattr> <eisSORattr xsi:type="xsd:string">EISValidated</eisSORattr> <eisSiteCodeattr xsi:nil="true" xsi:type="xsd:string" /> <eisSiteNameattr xsi:nil="true" xsi:type="xsd:string" /> <eisSuffixattr xsi:nil="true" xsi:type="xsd:string" /> <eisWorkAddress1attr xsi:type="xsd:string">Company</eisWorkAddress1a +ttr> <eisWorkAddress2attr xsi:type="xsd:string">West</eisWorkAddress2attr +> <eisWorkCityattr xsi:type="xsd:string">NY City</eisWorkCityattr> <facsimileTelephoneNumberattr xsi:nil="true" xsi:type="xsd:string" / +> <givenNameattr xsi:type="xsd:string">John</givenNameattr> <initialsattr xsi:type="xsd:string">Smith</initialsattr> <lattr xsi:type="xsd:string">ISC1</lattr> <mailattr xsi:type="xsd:string">acd@example.com</mailattr> <mobileattr xsi:type="xsd:string">+01-992099999</mobileattr> <ouattr xsi:type="xsd:string">(Information Technology)</ouattr> <pagerattr xsi:nil="true" xsi:type="xsd:string" /> <postalCodeattr xsi:type="xsd:string">00987</postalCodeattr> <roomNumberattr xsi:type="xsd:string">xyx</roomNumberattr> <snattr xsi:type="xsd:string"></snattr> <stattr xsi:type="xsd:string"></stattr> <telephoneNumberattr xsi:nil="true" xsi:type="xsd:string" /> </item> </people> </ns2:PeopleflexSearchResponse>
In reply to Perl Question by Anonymous Monk
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |