#!/usr/bin/perl -W
#--------------------------------------------------------------
# This example PERL script:
# - calls the TRDS_SL program from http://x-server.gmca.aps.anl.gov/
# - gets and saves the data.
# The example is equivalent to the following page:
# http://x-server.gmca.aps.anl.gov/cgi/WWW_form.exe?template=TRDS_sl_omega.htm
#
# PERL interpreter is available by default on UNIX and MAC OS. Freeware
# PERL distibution for Windows can be installed either as a part of Cygwin
# (http://www.cygwin.com), or as a standalone package available from
# ActiveState (http://www.activestate.com/).
#
# To access data from remote web site, this script makes use of PERL LWP
# module (WWW library for Perl). The latter is usually a part of standard
# PERL distribution; otherwise it can be freely downloaded from CPAN
# (http://www.cpan.org/).
#
# This example script can be freely distributed and modified without any
# restrictions.
#
#     		Author: Sergey Stepanov
#
# Version-1:  2006/11/08
#--------------------------------------------------------------
  use strict;
  use LWP::Simple;	# World-Wide Web library for Perl (libwww-perl)

### General parameters:
  my $url      = "http://x-server.gmca.aps.anl.gov";
  my $prg      = "${url}/cgi/TRDS_frm.exe?";
  my $unzip    = "${url}/cgi/WWWunzip.exe?";

### X-rays:
  my $xway     = 1;	    # 1 - wavelength, 2 - energy, 3 - line type
  my $wave     = 1.540562;  # works with xway=2 or xway=3
# my $line     = "Cu-Ka1";  # works with xway=3 only
  my $line     = '';	    # works with xway=3 only
  my $ipol     = 1;	    # 1=sigma-polarization; 2=pi-polarization

### Substrate:
  my $subway   = 1;	    # 1=database_code, 2=chemical_formula, 3=x0_value
  my $code     = 'GaAs';    # Database_code: works with subway=1 only
  my $chem     = '';        # Chemical formula: works with subway=2 only
  my $rho      = '';        # Density (g/cm3): required for chemical formula
  my @x0       = (0.,0.);   # Direct input of chi_0: works with subway=3
  my $w0       = 1.;        # Debye-Waller type correction for x0: with any subway

### Database Options for dispersion corrections df1, df2:
### -1 - Automatically choose DB for f',f"
###  0 - Use X0h data (5-25 keV or 0.5-2.5 A) -- recommended for Bragg diffraction.
###  2 - Use Henke data (0.01-30 keV or 0.4-1200 A) -- recommended for soft x-rays.
###  4 - Use Brennan-Cowan data (0.03-700 keV or 0.02-400 A)
  my $df1df2   = -1;

### Substrate surface:
### (only one of the two parameters can be non-zero):
  my $sigma    = 3.;        # rms roughness at substrate interface (Angstrom)

### Type of scan:
###  1: Theta-scans at fixed 2Theta
###  2: Theta-2Theta scans at fixed Theta-offsets
###  3: 2Theta (detector) scans at fixed Theta
###  4: qx scans at fixed qz
  my $scan     = 1;
  my $scanmin  = 0.;	    # minimum scan angle (range)
  my $scanmax  = 2.;        # maximum scan angle (range)
  my $nscan    = 201;       # number of scan points
  my $offmin   = 2.;	    # minimum offset angle (range)
  my $offmax   = 2.;        # maximum offset angle (range)
  my $noff     = 1;         # number of offset points
  my $unis     = 0;	    # scan/offset angle units: 0=degr.,1=min,2=mrad,3=sec,4=urad
  my $unia     = 0;	    # qx,qz units: 0=1/A (do not change!)

### What to compute at the specular rod:
  my $spec     = 1;	    # 0=diffuse scattering, 1=specular reflectivity

### Accelerators:
  my $Fourier = 0;	    # 1=Use K instead of exp(K)-1 (small rms roughness),
                            # 0=use exp(K)-1.
  my $Born    = 0;          # 1=Use semi-Born approximation (ignore scattering
                            # from reflected waves), 0=use DWBA (all waves)

### Roughness models and parameters:
### See bried documentation at
### http://x-server.gmca.aps.anl.gov/TRDS_sl.html
  my $Lh   = 1000.;	    # lateral correlation length of roughness in Angstrem
  my $jagg = 1.;	    # rougness jaggedness (acceptable range: 0.1-1)
  my $Lv   = '';	    # vertical correlation length of roughness in Angstrem
  my $skew = 0.;	    # angle of skew rougness correlation between interfaces
  my $uniw = 0;		    # skew angle units: 0=degr.,1=min,2=mrad,3=sec,4=urad
### Hint:
### The script can be called in a loop or
### from a fitting program. Then, it may be
### helpful to pass some parameters to the
### script as command line arguments:
# my $Lh   = $ARGV[0];
# my $jagg = $ARGV[1];

### Affine-type rougness models (see basic theory in Sinha,Sirota,Garoff,Stanley,
### Phys.Rev.B, 38 (1988) 2297, and program implementation details in Kaganer,
### Stepanov, Koehler, Physica B, 221, (1996) 33).
###   1: Uncorrelated roughness
###   2: Completely correlated roughness
###   3: Ming's model -- Ming,Krol,Soo,Kao,Park,Wang, Phys.Rev.B 47 (1993) 16373.
###   4: Lagally's model -- Phang,Savage,Kariotis,Lagally, J.Appl.Phys. 74 (1993) 3181.
###   5: Holy's model -- Holy,Baumbach, Phys.Rev.B 49 (1994) 10669.
###   6: Spiller's model (*very slow!*) -- Spiller,Stearns,Krumrey, J.Appl.Phys. 74 (1993) 107.
### Models of scattering from atomic steps at vicinal interfaces (see details in
### Kondrashkina,Stepanov,Opitz,Schmidbauer,Koehler,Hey,Wassermeier,Novikov,
### Phys.Rev.B, 56 (1997) 10469).
###   7: Classic Pukite's model -- Pukite,Lent,Cohen, Surf.Sci. 161 (1985) 39.
###   8: Smoothed Pukite's model -- Pukite,Lent,Cohen, Surf.Sci. 161 (1985) 39.
###   9: Pershan's model -- Rabedeau,Tidswell,Pershan,Bevk,Freer, Appl.Phys.Lett. 59 (1991) 3422.
  my $model = 2;
  my $Lh2   = '';	    # lateral size of vertically correlated roughness
			    # in Angstem for Lagally's model.
  my $Qm     = 0.;	    # miscut angle for all scattering-from-steps models (7-9)
  my $unim   = 0;	    # miscut angle units: 0=degr.,1=min,2=mrad,3=sec,4=urad
  my $add    = 0;	    # add affine roughness to scattering-from-steps models (7-9)
  my $stepH  = 0.;	    # effect.rms height of steps (Angstrem) for smoothed Pukite's model (8)
  my $spread = 0.;	    # terraces size spread (Angstrem) for Pershan's model (9)

### Surface layer profile
### (can also be read from
## a filename specified in
### the command line):
  my $profile = '';
### This is an example of non-empty profile:
### (use with care because the length of calculations
### is proportional to the 4th power of the number of
### layers, n^4). Long calculations may not return
### results within browser timeout. There is a way to
### detouch them from the browser session, but this
### script does not implement detouched sessions.
#  my $profile = '
# t=20 w0=0.5 sigma=5   !surface oxide, organic contamination or dust
# period=3
# t=100 code=GaAs sigma=4
# t=70 code=AlAs sigma=4
# end period
# ';

### Encode strings that may contain illegal characters for CGI:
  $line     = &encode_url_string($line);
  $code     = &encode_url_string($code);
  $chem     = &encode_url_string($chem);
  $profile  = &encode_url_string($profile);
#-----------------------------------------------------------
### Submit task:
  my $address=${prg}.
	    "&xway=${xway}".
            "&wave=${wave}".
            "&line=${line}".
            "&ipol=${ipol}".
            "&subway=${subway}".
            "&code=${code}".
            "&chem=${chem}".
            "&rho=${rho}".
            "&x0=(${x0[0]},${x0[1]})".
            "&w0=${w0}".
            "&df1df2=${df1df2}".
            "&sigma=${sigma}".
            "&scan=${scan}".
            "&scanmin=${scanmin}".
            "&scanmax=${scanmax}".
            "&nscan=${nscan}".
            "&offmin=${offmin}".
            "&offmax=${offmax}".
            "&noff=${noff}".
            "&unis=${unis}".
            "&unia=${unia}".
            "&spec=${spec}".
            "&Fourier=${Fourier}".
            "&Born=${Born}".
            "&Lh=${Lh}".
            "&jagg=${jagg}".
            "&Lv=${Lv}".
            "&skew=${skew}".
            "&uniw=${uniw}".
            "&model=${model}".
            "&Lh2=${Lh2}".
            "&Qm=${Qm}".
            "&unim=${unim}".
            "&add=${add}".
            "&stepH=${stepH}".
            "&spread=${spread}".
            "&watch=0".
            "&profile=${profile}";

### Request X0h data from the server:
  print STDOUT "Request string:\n${address}\n";
  my $buffer = get($address);
  $buffer =~ s/[\015\012]//g;		# remove CR/LF

### Find job ID on the server:
  my $jobID = $buffer;
  if ( $buffer =~ /Download ZIPped results:/ ) {
### Remove all text before and after job name in the string like:
### Download ZIPped results: <A HREF="/x-ray/TDSxxxxx.zip">TDSxxxxx.zip</A>
    $jobID =~ s/^.*Download ZIPped results: <A HREF=\"\/x-ray\///;
    $jobID =~ s/\.zip.*$//;
  } else {
    die "Unexpected completion, no job ID found\n";
  }

  my $data_found = 0;
  my $status     = 0;
  my $error_text = "/images/stop.gif";

### Analyze server response and download data:
  if ($buffer =~ /${error_text}/ ) {
### Erroneous completion:
     print STDOUT "Request was unsuccessfull, job ID=${jobID}\n";
     $buffer =~ s/^.*${error_text}//;	# remove all before error message
     $buffer =~ s/^.*<font size=\+1>//;	# remove all before error message
     $buffer =~ s/<\/font>.*$//;	# remove all after  error message
     $buffer =~ s/<br>/\n/g;		# replace HTML tags
     $buffer =~ s/\&nbsp;/ /g;		# replace HTML tags
     print STDOUT "Saving log: ${jobID}.tbl\n";
     &getstore("${unzip}jobname=${jobID}&filext=TBL","${jobID}.tbl");
     print STDOUT "\nERROR message:\n${buffer}\n";
     $status = 1;
  }
  else {
### Normal completion:
     print STDOUT "Request was successfull, job ID=${jobID}\n";
     if ( $buffer =~ /Display DAT file/ ) {
        $status = &getcheckstore($unzip,$jobID,"dat");
	if (! $status) {$data_found++;}
     } else {
	$status = 1;			# no data
     }
### GRD files are produced for 2D maps only ($nscan>1 && $noff>1):
     if ( $buffer =~ /Display GRD file/ ) {
        $status = &getcheckstore($unzip,"${jobID}","grd");
	if (! $status) {$data_found++;}
     }
     if ($data_found == 0) {$status = 1;}	# no data
  }

  print STDOUT "Saving packed results: ${jobID}.zip\n";
  &getstore("${url}/x-ray/${jobID}.zip","${jobID}.zip");
  print STDOUT "Done!\n";
  exit $status;

############################################################################

#sub encode_url_string ($);
sub encode_url_string {
    my $KeepUnencoded  = 'a-zA-Z 0-9_\\-@.=';
    my ($toencode) = @_;
### ord - find a character's numeric representation
### "^": if not in the Unencoded list
    $toencode=~s/([^$KeepUnencoded])/sprintf("%%%02X",ord($1))/ego;
### Change spaces to "+":
    $toencode=~s/ /+/gm;
    return $toencode;
}

############################################################################

#sub getcheckstore ($$$);
sub  getcheckstore {
  my $unzip   = shift(@_);
  my $prefix  = shift(@_);
  my $ext     = shift(@_);
  print STDOUT "Saving data: ${prefix}.${ext}\n";
  my $data = get("${unzip}jobname=${prefix}&filext=${ext}");
  $data =~ s/\015//g;			# Perl for Windows workaround
  if ( $data =~ /stop/ ) {		# stop1.gif is returned when no data
     print STDOUT "!!! No data on server!\n";
     return 1;
  } else {
     open (DAT,"> ${prefix}.${ext}") or die "Cannot open ${prefix}.${ext}";
     print DAT ${data};
     close(DAT);
     return 0;
  }
}

############################################################################