#!/usr/local/bin/perl
# 
# $Id: as400-include.pl,v 1.1.1.1 2002/03/01 21:50:52 valerio Exp $
#
# This script is copyrighted
# Copyright (c) 2002 Valerio Di Giampietro
# Valerio@DiGiampietro.com
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# Common procedures to access the as400 via Expect module
# (in a unmanned way)
#
#
# $Log: as400-include.pl,v $
# Revision 1.1.1.1  2002/03/01 21:50:52  valerio
# Imported sources
#
#
#
#======================================================================
# THIS MODULE USE SOME GLOBAL VARIABLES:
#    $as400      Hostname (or ip address) of the AS/400 host to contact
#    $x3270      Expect handle of the AS/400 connection
#    $user       User profile used to logon to the AS/400
#    $password   User's password to logon to the AS400
# this two variables are initialized outside of this include file!
#======================================================================
#
use Expect;
$Expect::Log_Stdout=0; # On by default.

#
#======================================================================
#  timeout     print an error message and exit
#======================================================================
#
sub timeout {
  print STDERR "Unexpected timeout\n";
  exit 2;
}
#
#======================================================================
# x3270_die    print the last AS400 screen and die
#======================================================================
#
sub x3270_die {
    my $s;
    print STDERR "----------- Last AS/400 Screen\n";
    $s=x3270_asciiscreen();
    print STDERR "$s";
    print STDERR "-------------------------------\n";
    print STDERR @_;
    die;
}
#
#======================================================================
#  x3270_connect   Connet to the AS400 (only connection no logon)
#                  return 1 on success, 0 on failure
#======================================================================
#
sub x3270_connect {
    print STDERR "Connecting to: $as400\n";
    print $x3270 "Connect($as400)\n";
    print $x3270 "Wait()\n";
    unless ($x3270->expect(30,'-re', "U F U C.$as400.*")) {
	return 0;
    }
    print STDERR "-->x3270_connect: connected\n";
    return 1;
}
#
#======================================================================
#  x3270_login    logon to the AS400
#                 return 1 on success, 0 on failure
#======================================================================
# 
sub x3270_login {
    my $corb=x3270_ascii(1,69,8);
    my ($scr,$days);
    print STDERR "Findig S65DD4AA found:$corb:\n" if $debug;
    if ($corb ne "S65DD4AA") {
	print STDERR "-->x3270_login: Login Screen not found\n";
	return 0;
    };
    print STDERR "-->x3270_login: Found Login screen\n";
    print $x3270 "String($user)\nTab()\nString($password)\nEnter()\n";

    ######
    ### skip unusual screens
    ######
    $scr= x3270_asciiscreen();
    while ($scr =~ /Press Enter to continue/m) {
	print $x3270 "Enter()\n";
	print STDERR "-->x3270_login: Sent Enter to continue\n";
	$scr=x3270_asciiscreen();
    }
    ### end of skipping unusual screens
    $_=&x3270_ascii(0,32,16);
    if ($_ ne "AS/400 Main Menu") {
	print STDERR "-->x3270_login: AS/400 main menu not found\n";
	return 0;
    }
    print STDERR "-->x3270_login: found AS/400 Main Menu\n";
    return 1;
}
#
#======================================================================
# x3270_asciiscreen    return in a multiline string the full
#                      AS400 screen (25 rows x 80 columns)
#======================================================================
#
sub x3270_asciiscreen {
    return x3270_asciiregion(0,0,24,79);
}
#
#======================================================================
# x3270_asciiregion   return in a multiline string of a region of
#                     the AS/400 screen.
#                     Input parameters:
#                       $r       starting row (0 ... 24)
#                       $c       starting column (0 .. 79)
#                       $rlen    region width
#                       $clen    region height
#======================================================================
#
sub x3270_asciiregion {
    my ($r,$c,$rlen,$clen) = @_;
    my ($res,$i);
    print STDERR "--> x3270_asciiregion (r,c,rlen,clen)=$r,$c,$rlen,$clen\n" if $debug;
    $res='';
    for $i ($r .. $r+$rlen-1) {
	$res .= x3270_ascii($i,$c,$clen);
	$res .= "\n";
    }
    print STDERR "-->x3270_asciiregion begin ----\n" if $debug;
    print STDERR $res if $debug;
    print STDERR "-->x3270_asciiregion end ----\n" if $debug;
    return $res;
}
    
#
#======================================================================
#  x3270_ascii   return an ascii string from the screen
#                input parameters
#                   $r   starting row (0 .. 24)
#                   $c   starting column (0 .. 79)
#                   $len string length
#======================================================================
# 
sub x3270_ascii {
  my ($s,$t);
  $t=$";
  $"=',';
  print STDERR "--x3270_ascii-->Sending: Ascii(@_)\n" if $debug;
  print $x3270 "Ascii(@_)\n";
  $"=$t;
  $x3270->expect(60,'-re','data: .*') || 
      die "Unexpected error in x3270_ascii";
  $s=$x3270->exp_match();
  #chomp $s;
  print STDERR "--x3270_ascii-->Matching string\n:",$s,":\n***\n" if $debug; 
  $s=~s/data: (.*).$/$1/;
  print STDERR "--x3270_ascii-->Returning\n:",$s,":\n***\n\n" if $debug; 
  return $s;
}
#
#======================================================================
# x3270_gencmd   Execute a generic command, it does expect that after
#                executing the command to receive a command prompt
#                input parameters
#                   $cmd    command string (example "addlible toollib")
#======================================================================
#
sub x3270_gencmd {
    my $cmd=$_[0];
    print STDERR "-->x3270_gencmd: $cmd\n";
    print $x3270 "String(\"$cmd\")\nEnter()\n";
    my $str=x3270_ascii(19,0,5);
    if ($str eq ' ===>') {
	return 1;
    } else {
	print "-->x3270_gencmd str: $str\n";
	return 0;
    }
}
#
#======================================================================
# x3270_prtflayout  print file layout 
#======================================================================
#
sub x3270_prtflayout {
    my($lib,$file)=@_;

    x3270_gencmd("addlible toollib *last") ||
	x3270_die("Error in addlible\n");

    x3270_gencmd("prtffd file($lib/$file)") || 
	x3270_die("Error in prtffd\n");
    
}
#
#======================================================================
# x3270_getsplflist   gives the "wrksplf" command and return 
#                     an array of hashes; each element in the array
#                     is for each spool file; each hash as the
#                     following keys: file, user, device, userdata,
#                                     sts, totalpages, formtype, pty, 
#                                     cdate, ctime, filenbr, job, 
#                                     number, queue, library
#                     input parameters
#                        $usersplf   parameters to the wrksplf command
#                       
#======================================================================
#
sub x3270_getsplflist {
    my $usersplf=$_[0];
    print STDERR "--->x3270_getsplflist\n";
    my ($s,%e,@e,@lst,$void);
    print $x3270 "String(\"wrksplf $usersplf\")\nEnter()\n";
    my $scr1=x3270_asciiscreen();
    print STDERR "(0)\n";
    my $firsttime=1;
    while (($scr1=~/\s+More\.\.\./m) or ($firsttime)) {
	$firsttime=0;
	$scr1=x3270_asciiscreen();
	print STDERR "(0b)\n";
	if (not $scr1=~"Work with All Spooled Files") {
	    print STDERR "(0c)\n";
	    x3270_die("Error in wrksplf\n");
	}
	print STDERR "(2)\n";sleep(1);
	print $x3270 "PA(1)\nPF(11)\n";
	my $scr2=x3270_asciiscreen();
	print STDERR "(3)\n"; sleep(1);
	print $x3270 "PA(1)\nPF(11)\n";
	my $scr3=x3270_asciiscreen();
	my @scr1=split /\n/m,$scr1;
	my @scr2=split /\n/m,$scr2;
	my @scr3=split /\n/m,$scr3;
	for $i (0 .. scalar @scr1) {
	    if ($scr1[$i]=~/^      [A-Z]/) {
		@e=split /\s+/,$scr1[$i];
		($void,$e{file},$e{user},$e{device},$e{userdata},$e{sts},
		 $e{totalpages})=@e;
		
		@e=split /\s+/,$scr2[$i];
		($void, $e{file},$e{user},$e{formtype},$e{pty},$e{cdate},
		 $e{ctime})=@e;
		
		@e=split /\s+/,$scr3[$i];
		($void,$e{file},$e{filenbr},$e{job},$e{user},$e{number},$e{queue},
		 $e{library})=@e;
		
		push @lst,{ %e };
	    }
	}
	print $x3270 "PA(1)\nPF(11)\n";
	print $x3270 "PA(1)\nPF(11)\n";
	print $x3270 "PF(8)\n";
    }
    print $x3270 "PA(1)\nPF(3)\n";
    @x3270_splflst=@lst;
}
#
#======================================================================
# x3270_dspffd    return a mutiline string: the output of the 
#                 dspffd (display file field description) command
#                 input parameters:
#                     $library
#                     $file
#======================================================================
#
sub x3270_dspffd {
    my ($library,$file)=@_;
    my ($s,$scr,@scr,$firsttime);
    print STDERR "--->x3270_dspffd\n";
    print $x3270 "String(\"dspffd file($library/$file)\")\nEnter()\n";
    my $scr=x3270_asciiscreen();
    print STDERR "(0)\n";
    $firsttime=1;
    $s="";
    while (($scr=~/\s+More\.\.\./m) or ($firsttime)) {
	$firsttime=0;
	$scr=x3270_asciiscreen();
	print STDERR "(0b)\n";
	if (not $scr=~"Display Spooled File") {
	    print STDERR "(0c)\n";
	    x3270_die("Error in dspffd\n");
	}
	print STDERR "(2)\n";sleep(1);
	@scr=split /\n/m,$scr;
	$s=$s . join("\n",@scr[5 .. 20]) . "\n";
	print $x3270 "PF(8)\n";
    }
    return $s;
}
1;