#!/usr/bin/perl -w
#--------------------------------------------------------------
# This example PERL script:
# - calls the MAG_SL program from https://x-server.gmca.aps.anl.gov/
# - gets and saves the data.
# The example is equivalent to the following page:
# https://x-server.gmca.aps.anl.gov/cgi/www_form.pl?template=MAG_sl_fig4.htm
#
# PERL interpreter is available by default on UNIX and MAC OS. Freeware
# PERL distribution for Windows can be installed either as a part of Cygwin
# (https://www.cygwin.com), or as a standalone package available from
# ActiveState (https://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
# (https://www.cpan.org/).
#
# This example script can be freely distributed and modified without any
# restrictions.
#
#			Author: Sergey Stepanov
#
# Version-1.0:  2006/11/10
# Version-1.1:  2012/12/16		changed to use associated array %FORM
# Version-2.0:  2022/07/31		modified to work with Cloudflare
#--------------------------------------------------------------
  use strict;
  use warnings 'all';
  use LWP::UserAgent;
  use LWP::Protocol::https;
# use URI::Escape;      		# can be used as an alternative to home-made &encode_url_string

  select STDOUT; $|=1;			# set unbuffered output

  my ($url, $prg, $unzip, %FORM);
  my ($ua, $request, $response);
  my ($name, $buffer, $jobID);
  my ($error_text, $status);

### General parameters:
  $url   = 'https://x-server.gmca.aps.anl.gov';
  $prg   = $url.'/cgi/mag_form.pl?';
  $unzip = $url.'/cgi/wwwunzip.pl?';

  $FORM{'comment1'} = 'Template: Perl script';

### X-rays:
  $FORM{'xway'}     = 2;		# 1=wavelength, 2=energy, 3=line type
  $FORM{'wave'}     = 7.243;		# works with xway=1 or xway=2
# $FORM{'line'}     = 'Cu-Ka1';		# works with xway=3 only
  $FORM{'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
  $FORM{'ipol'}     = 4;		# 1=sigma 2=pi 3=angle 4=circ- 5=circ+
  $FORM{'polangle'} = 0.;		# angle to Sigma-plane for ipol=3 (not used with other ipol)

### Substrate:
  $FORM{'subway'}   = 1;		# 1=database_code, 2=chemical_formula, 3=x0_value
  $FORM{'code'}     = 'Silicon';	# crystal code
  $FORM{'chem'}     = '';		# Chemical formula: works with subway=2 only
  $FORM{'rho'}      = '';		# Density (g/cm3): required for chemical formula
  $FORM{'x0'}       = '(0.,0.)';	# Direct input of chi_0: x0=2*delta (subway=3)
  $FORM{'w0'}       = 1.;		# Debye-Waller type correction for x0

### Substrate surface:
### (only one of the two parameters can be non-zero):
  $FORM{'sigma'}    = 0.;		# rms roughness at surface (Angstrom)
  $FORM{'tr'}       = 0.;		# transition layer thickness (Angstrom)

### Magnetic properties of substrate:
  $FORM{'rhom'}     = 0.;		# the value of share (0.--1.) or density (1/cm^3)
  $FORM{'magway'}   = 1;		# 1: $rhom is share, 2: $rhom is desnsity
### Magnetic orientation components along X,Y,Z (like Miller indices)
  ($FORM{'m1'},$FORM{'m2'},$FORM{'m3'}) = (0, 0, 0);
  $FORM{'F10'}      = '(0.,0.)';	# magnetic amplitude F10 in substrate. Note: '()' are required.
  $FORM{'F11'}      = '(0.,0.)';	# magnetic amplitude F11 in substrate. Note: '()' are required.
  $FORM{'F1T'}      = '(0.,0.)';	# magnetic amplitude F1T in substrate. Note: '()' are required.

### 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.41-1240 A) -- recommended for soft x-rays.
###  4 - Use Brennan-Cowan data (0.03-700 keV or 0.02-413 A)
###  6 - Use Windt data (0.01-100 KeV or 0.12-1240 A)
###  8 - Use Chantler/NIST data (0.01-450 KeV or 0.28-1240 A)
  $FORM{'df1df2'}   = -1;

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

### Magnetic model:
  $FORM{'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):
  $FORM{'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:
  $FORM{'comment1'} = &encode_url_string($FORM{'comment1'});	#can also try &uri_escape from URI::Escape
  $FORM{'line'}     = &encode_url_string($FORM{'line'});        #can also try &uri_escape from URI::Escape
  $FORM{'code'}     = &encode_url_string($FORM{'code'});        #can also try &uri_escape from URI::Escape
  $FORM{'chem'}     = &encode_url_string($FORM{'chem'});        #can also try &uri_escape from URI::Escape
  $FORM{'x0'}       = &encode_url_string($FORM{'x0'});          #can also try &uri_escape from URI::Escape
  $FORM{'F10'}      = &encode_url_string($FORM{'F10'});         #can also try &uri_escape from URI::Escape
  $FORM{'F11'}      = &encode_url_string($FORM{'F11'});         #can also try &uri_escape from URI::Escape
  $FORM{'F1T'}      = &encode_url_string($FORM{'F1T'});         #can also try &uri_escape from URI::Escape
  $FORM{'profile'}  = &encode_url_string($FORM{'profile'});     #can also try &uri_escape from URI::Escape
#-----------------------------------------------------------
### Form URL request:
  $request = '';
  foreach $name (keys %FORM) {
     if ($name ne 'profile') {$request .= '&'.$name.'='.$FORM{$name};}
  }
  $request .= '&profile='.$FORM{'profile'};	# place profile at the end
  $request = substr($request,1);		# remove first '&'

### Request data from the server:
  print STDOUT 'Request string:'."\n".$prg.$request."\n";

  $ua = LWP::UserAgent->new;
  $ua->cookie_jar({});                                                                  # needed by Cloudflare
  $ua->agent('Mozilla/5.0 (X11; Linux x86_64;)');                                       # needed by Cloudflare

  $response = $ua->get($prg.$request);
  if (! $response->is_success) {
     printf STDOUT "\n".'*** Error reading response from the server: %s'."\n", $response->status_line;
     exit 1;
  }
  $buffer = $response->content;
  $buffer =~ s/[\r\n]//g;			# remove CR/LF

### Find job ID on the server:
  if ($buffer =~ /Download ZIPped results:/i) {
### 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 = $buffer;
     $jobID =~ s/^.*Download ZIPped results: <A HREF=\"x-ray\///i;
     $jobID =~ s/\.zip.*$//i;
  } else {
     die '*** Unexpected completion, no job ID found';
  }

  $error_text  = 'images/stop1.gif';
  $status = 0;

### Analyze server response and download the data:
  if ($buffer =~ /${error_text}/i) {
### Erroneous completion:
     print STDOUT 'Request was unsuccessful, job ID='.$jobID."\n";
     $buffer =~ s/^.*${error_text}//i;		# remove all before error message
     $buffer =~ s/^.*<font size=\+1>//i;	# remove all before error message
     $buffer =~ s/<\/font>.*$//i;		# remove all after  error message
     $buffer =~ s/<br>/\n/ig;			# replace HTML tags
     $buffer =~ s/\&nbsp;/ /ig;			# replace HTML tags
     print STDOUT "\n".'ERROR message:'."\n".$buffer."\n";
     print STDOUT 'Saving log: '.$jobID.'.tbl'."\n";
     $status = &getcheckstore($unzip,$jobID,'tbl',0);
     if ($status) {print STDOUT 'Failed to save log: '.$jobID.'.tbl'."\n";}
     $status = 1;
  }
  else {
### Normal completion:
     print STDOUT 'Request was successful, job ID='.$jobID."\n";
     if ($buffer =~ /Display DAT file/i) {
        $status = &getcheckstore($unzip,$jobID,'dat',1);
     } else {
        $status = 1;				# no data
     }
  }

  print STDOUT 'Saving packed results: '.$jobID.'.zip'."\n";
  &getzip($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(@_);
  my $check   = shift(@_); if (!defined $check) {$check=0;}
  my $file = $prefix.'.'.$ext;
  my $url = $unzip.'jobname='.$prefix.'&filext='.$ext;
  print STDOUT 'Saving data: '.$file."\n";
  $response = $ua->get($url);
  if (! $response->is_success) {
     printf STDOUT "\n".'*** Error reading response from ['.$url.']: %s'."\n", $response->status_line;
     return 1;
  }
  my $data = $response->decoded_content(charset=>'none');
# $data =~ s/\015//g;				# Perl for Windows workaround
  if ($check && $data =~ /stop/i) {		# stop1.gif is returned when no data
     print STDOUT '!!! No data on server!'."\n";
     return 1;
  } else {
     open (DAT,'> '.$file) or die 'Cannot open '.$file;
     print DAT ${data};
     close(DAT);
     return 0;
  }
}

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

#sub getzip ($$);
sub  getzip {
  my $url  = shift(@_);
  my $file = shift(@_);
  $response = $ua->get($url);
  if (! $response->is_success) {
     printf STDOUT "\n".'*** Error reading response from ['.$url.']: %s'."\n", $response->status_line;
     return 1;
  }
  my $data = $response->decoded_content(charset=>'none');
  open (DAT,'> '.$file) or die 'Cannot open '.$file;
  binmode(DAT);
  print DAT $data;
  close(DAT);
  return 0;
}

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