#!/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 first 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 validity
# 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 your last name");
   exit;
}

if ($fields{'FNAME'} eq "" and $fields{'INITIAL'} ne "") {
   print("!005",$line_sep,"You have entered your middle initial, Please 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{'INITIAL'};
   }
   #$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 action 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-urlencoded";

   #$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 equivalent
      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 initial
      $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 last 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 Control
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, $line_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,$Phone,$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 environment and
# when supplying input via the command line.   

   if ((length($form_data)<=1)) {
        $form_data = <>;          # Read input file supplied on the command-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;
}



##</code><code>##


  <?xml version="1.0" encoding="UTF-8" ?> 
- <ns2:PeopleflexSearchResponse ns1:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:ns1="http://schemas.xmlsoap.org/soap/envelope/" xmlns:ns2="http://www.calendra.com/namespaces/services">
- <people soapenc:arrayType="xsd:anyType[1]" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-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</businessCategoryattr> 
  <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</eisAdminSupervisorattr> 
  <eisBusinessUnitattr xsi:type="xsd:string">G000044</eisBusinessUnitattr> 
  <eisEpassIDattr xsi:type="xsd:string">kk7046</eisEpassIDattr> 
  <eisFuncSupervisorattr xsi:nil="true" xsi:type="xsd:string" /> 
  <eisIdentityTypeattr xsi:type="xsd:string">Contractor</eisIdentityTypeattr> 
  <eisInternetMailAddressattr xsi:type="xsd:string">xyz@usa.example.com</eisInternetMailAddressattr> 
  <eisIntranetMailAddressattr xsi:type="xsd:string">IYER2AR@nanotes1.email.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</eisOtherEmailattr> 
  <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</eisWorkAddress1attr> 
  <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>