#!/usr/bin/perl -W
#--------------------------------------------------------------
# This example PERL script:
# - calls the MAG_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=MAG_sl_fig4.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.0:  2006/11/10
#--------------------------------------------------------------
  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/MAG_form.exe?";
  my $unzip    = "${url}/cgi/WWWunzip.exe?";

### X-rays:
  my $xway     = 2;	    # 1 - wavelength, 2 - energy, 3 - line type
  my $wave     = 7.243;     # works with xway=2 or xway=3
# my $line     = "Cu-Ka1";  # works with xway=3 only
  my $line     = '';	    # works with xway=3 only
### Polarization:
###  1. Incident X-rays are sigma-polarized
###  2. Incident X-rays are pi-polarized
###  3. Incident X-rays are linearly polarized ib the plane defined by angle to Sigma-plane
###  4. Circular- polarization of incident X-rays
###  5. Circular+ polarization of incident X-rays
  my $ipol     = 4;
  my $polangle = 0.;	    # angle to Sigma-plane for ipol=3 (not used with other ipol)

### Substrate:
  my $subway   = 1;	    # 1=database_code, 2=chemical_formula, 3=x0_value
  my $code     = 'Silicon'; # 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: x0=2*delta (subway=3)
  my $w0       = 1.;        # Correction for x0: x0 = w0 * x0 (used with any subway)

### Database Options for dispersion corrections df1, df2
### (used when x0 to be calculated for any layer):
### -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    = 0.;        # rms roughness at surface (Angstrom)
  my $tr       = 0.;        # transition layer thickness (Angstrom)

### Magnetic properties of substrate:
  my $rhom     = 0.;        # the value of share (0.--1.) or density (1/cm^3)
  my $magway   = 1;	    # 1: $rhom is share, 2: $rhom is desnsity
  my @mvector  = (0, 0, 0); # magnetic orientation components along X,Y,Z (like Miller indices)
  my @F10      = (0.,0.);   # magnetic amplitude F10 in substrate
  my @F11      = (0.,0.);   # magnetic amplitude F11 in substrate
  my @F1T      = (0.,0.);   # magnetic amplitude F1T in substrate

### Scan range:
  my $scanmin  = 0.;	    # minimum scan angle or qz(range)
  my $scanmax  = 4.;        # maximum scan angle or qz (range)
  my $unis     = 0;         # scan angle/qz units: 0=degr.,1=min,2=mrad,3=sec,4=urad,1=1/A
  my $nscan    = 4001;      # number of scan points

### Magnetic model:
  my $execprg  = 99;         # 99 = generic (may have numeric problems for hard x-rays)
                            # 98 = hard x-rays (E>6keV)

### Surface layer profile
### (can also be read from
## a filename specified in
### the command line):
  my $profile = "
period=15
code=Gd t=50 F11=(-0.22,9.35) F1T=(0.37,9.65) mshare=1 mvector=(1 0 0)
code=Fe t=35
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}".
            "&polangle=${polangle}".
            "&subway=${subway}".
            "&code=${code}".
            "&chem=${chem}".
            "&rho=${rho}".
            "&x0=(${x0[0]},${x0[1]})".
            "&w0=${w0}".
            "&df1df2=${df1df2}".
            "&sigma=${sigma}".
            "&tr=${tr}".
            "&rhom=${rhom}".
            "&magway=${magway}".
            "&m1=${mvector[0]}&m2=${mvector[1]}&m3=${mvector[2]}".
            "&F10=(${F10[0]},${F10[1]})".
            "&F11=(${F11[0]},${F11[1]})".
            "&F1T=(${F1T[0]},${F1T[1]})".
            "&scanmin=${scanmin}".
            "&scanmax=${scanmax}".
            "&unis=${unis}".
            "&nscan=${nscan}".
            "&execprg=${execprg}".
            "&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/MAGxxxxx.zip">MAGxxxxx.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 the 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++;}
     }
     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;
  }
}

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