ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

Reading a .CSV file using strtok

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    Reading a .CSV file using strtok

    Code:
         h dftactgrp(*no) actgrp(*caller) option(*srcstmt)
     h bnddir('QC2LE')


     d counter         s              3s 0
     d displayme       s             20
     d isodate         s               d   inz
     d n12             s             12s 0
     d pointer         s               *
     d reply           s              1
     d response        s           4096a
     d rundte          s              6s 0
     d  token          S            160A   varying
     d                 DS


     dstrtok           PR              *   ExtProc('strtok')
     d string                          *   value options(*string)
     d delim                           *   Value Options(*string)


      /free


         response  =  'tree,dog,bird,,cow,horse,flower';
         response = %scanrpl(',,' : ', ,' : response);
         reset counter;
         pointer = strtok(response: ',');


         dow (pointer <> *null);
          counter+=1;
          token = %trim(%str(pointer));
          pointer = strtok(*null: ',');
          displayme = %trim(token);
          dsply displayme reply;
         enddo;


         *inlr = *on;
    Attached Files
    All my answers were extracted from the "Big Dummy's Guide to the As400"
    and I take no responsibility for any of them.

    www.code400.com
    Tags: None
  • #2
    Re: Reading a .CSV file using strtok

    Thanks for that Jamie....
    I took your strtok program mixed in a little Scott Klement's IFS processing and a little Barbra Morris's GetNum to generate this program:

    If you Feed it an IFS path to a .CSV file it should generate "MYFILE" in qtemp.

    What it will do:
    Use record 1 of the .CSV as Field names (first 10 positions)
    Assign field names FLDXXX if record 1 field name is blank
    Change field name to #xxxxxx if it begins with a number
    Replace duplicate field names with #xxxxx
    Analize the data in the .CSV to determine alpha or numeric (no dates)
    Create "MyFile" in qtemp based on the above
    Populate MyFile with data from the .CSV
    RunQry on Myfile so you can check it.

    What it Won't do:
    Remove special characters from field names (-/+ etc)
    Convert to date field or anything but signed numeric or alpha data

    What You need to do....
    Download IFSIO_H from Scott Klement's web site http://www.scottklement.com/
    Modify the copy statement on line 3
    Compile and GO.

    This was done at V6R1 (No %Scanrpl)....It should compile at V5R4 but I'm not sure.

    I'm sure it's not perfect so if you find any flaws...Let Me Know

    Best of Luck
    GLS

    @Jamie .... One small issue with your pgm
    ",fld2,fld3,fld4" will not work it needs to be " ,fld2,fld3,fld4"
    The first position of any record cannot be , it needs to be changed to space comma just like ,, needs to be changed to , ,
    Attached Files
    The problem with quotes on the internet is that it is hard to verify their authenticity.....Abraham Lincoln

    Comment

    • #3
      Re: Reading a .CSV file using strtok

      I turned this into a Blog post...Nice job.


      jamie
      All my answers were extracted from the "Big Dummy's Guide to the As400"
      and I take no responsibility for any of them.

      www.code400.com

      Comment

      • #4
        Re: Reading a .CSV file using strtok

        This reads a folder waiting for .csv type table to arrive.
        once its there it reads it, renames it then moves to folder HISTORY.

        Code:
             H Option( *SrcStmt: *NoDebugIo )  BndDir( 'QC2LE' ) DFTACTGRP(*No)                             
     ?**********************************************************************                        
     ?* Project ID     Date  Pgmr ID  Rev  Description                                              
     ?*                                                                                             
     ?*            11/16/11  JJF       00  program written                                          
     ?*              ** pulls .csv tables from directory:                                           
     ?*                 /home/Reserve_Adjustments/                                                  
     ?*                                                                                             
     ?**********************************************************************                        
      *                                                                                             
      * Directory Entry Structure (dirent)                                                          
      *                                                                                             
     d p_dirent        s               *                                                            
     d dirent          ds                  based(p_dirent)                                          
     d   d_reserv1                   16A                                                            
     d   d_reserv2                   10U 0                                                          
     d   d_fileno                    10U 0                                                          
     d   d_reclen                    10U 0                                                          
     d   d_reserv3                   10I 0                                                          
     d   d_reserv4                    8A                                                            
     d   d_nlsinfo                   12A                                                            
     d     nls_ccsid                 10I 0 OVERLAY(d_nlsinfo:1)                                     
     d     nls_cntry                  2A   OVERLAY(d_nlsinfo:5)                                     
     d     nls_lang                   3A   OVERLAY(d_nlsinfo:7)                                     
     d     nls_reserv                 3A   OVERLAY(d_nlsinfo:10)                                    
     d   d_namelen                   10U 0                                                          
     d   d_name                     640A                                                            
                                                                                                    
      *------------------------------------------------------------                                 
      * Open a Directory                                                                            
      *------------------------------------------------------------                                 
     d opendir         pr              *   EXTPROC('opendir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Read Directory Entry                                                                        
      *------------------------------------------------------------                                 
     d readdir         pr              *   EXTPROC('readdir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Close Directory                                                                             
      *------------------------------------------------------------                                 
     d closedir        pr              *   EXTPROC('closedir')                                      
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Open IFs table                                                                              
      *------------------------------------------------------------                                 
     d open            pr            10i 0   ExtProc('open')                                        
     d   filename                      *     value                                                  
     d   openflags                   10i 0   value                                                  
     d   mode                        10u 0   value options(*nopass)                                 
     d   codepage                    10u 0   value options(*nopass)                                 
      *------------------------------------------------------------                                 
      * Read IFS table                                                                              
      *------------------------------------------------------------                                 
     d read            pr            10i 0   ExtProc('read')                                        
     d   filehandle                  10i 0   value                                                  
     d   datareceived                  *     value                                                  
     d   nbytes                      10u 0   value                                                  
      *------------------------------------------------------------                                 
      * Close IFs table                                                                             
      *------------------------------------------------------------                                 
     d close           pr            10i 0   ExtProc('close')                                       
     d   filehandle                  10i 0   value                                                  
      *------------------------------------------------------------                                 
      * read ifs table  - internal procedure                                                        
      *------------------------------------------------------------                                 
     d RdIfsFil        pr           256a                                                            
     d  FileName                    256a   const                                                    
      *------------------------------------------------------------                                 
      * Delay - sleep function                                                                      
      *------------------------------------------------------------                                 
     d sleep           pr            10i 0 ExtProc( 'sleep' )                                       
     d  seconds                      10u 0 Value                                                    
      *------------------------------------------------------------                                 
      * Command - run a command                                                                     
      *------------------------------------------------------------                                 
     d $command        pr                  extpgm('QCMDEXC')                                        
     d   command                    256                                                             
     d   length                      15  5                                                          
      *------------------------------------------------------------                                 
      * Grab the date in LongFormat                                                                 
      *------------------------------------------------------------                                 
     d CEEDATE         pr                  opdesc                                                   
     d   Lilian                      10i 0                                                          
     d   picture                  65535A   const options(*varsize)                                  
     d   OutputDate               65535A   const options(*varsize)                                  
     d   Feedback                    12a   options(*omit)                                           
      *------------------------------------------------------------                                 
      * a few local variables...                                                                    
                                                                                                    
     d BaseDate        s               d   inz(D'1582-10-14')                                       
     d cmdlength       s             15  5                                                          
     d cmdstring       s            256                                                             
     d count           s              3  0                                                          
     d cr              c                   Const(x'0D')                                             
     d data            s          65535A                                                            
     d Data_Rec        s          65535A                                                            
     d datasize        s              5  0                                                          
     d dh              s               *                                                            
     d Eol             c                   Const(x'0D25')                                           
     d Error_Flag      s              1A   INZ('0')                                                 
     d File            s            256                                                             
     d FileName        s            256    varying                                                  
     d FolderNames     s            256    dim(50)                                                  
     d Fp              s             10i 0                                                          
     d KeepLooping     s               n   inz('1')                                                 
     d lf              C                   Const(x'25')                                             
     d MyNewName       s            265    varying                                                  
     d N               s              5  0                                                          
     d nDays           s             10i 0                                                          
      * values for oflag parameter, used by open()                                                  
     d O_RDONLY        s             10i 0   inz(1)                                                 
     d O_TEXTDATA      s             10i 0   inz(16777216)                                          
                                                                                                    
     d Oflag           s             10i 0                                                          
     d Omode           s             10u 0                                                          
     d PathName        s             26                                                             
     d Q               s              1    inz('''')                                                
     d R               S              5  0                                                          
     d Rc              S             10i 0                                                          
     d ReturnData      s             12                                                             
     d SleepSeconds    s             10i 0 inz(1)                                                   
     d ta              s              3  0                                                          
     d Today           s               d   inz(*SYS)                                                
                                                                                                    
         // entire document stored in here                                                          
     d MyData          ds                  qualified  inz                                           
     d  bighunkdata               65535                                                             
     d   OneSlice                    60    dim(1000) overlay(bighunkdata:*next)                     
      *------------------------------------------------------                                       
      * MAIN LINE                                                                                   
      *------------------------------------------------------                                       
                                                                                                    
      /free                                                                                         
                                                                                                    
                // program will loop until outside force                                            
                // stops it.                                                                        
              dow KeepLooping;                                                                      
                                                                                                    
               exsr $GetFileName;                                                                   
               if ta > *zeros;                                                                      
                // read the tables one at a time                                                    
                for count = 1 to ta;                                                                
                 filename = foldernames(count);                                                     
                 Error_flag = rdifsfil(Filename);                                                   
                 //exsr $MoveToHistory;                                                             
                endfor;                                                                             
               endif;                                                                               
                                                                                                    
               // Delay job for a number of seconds then start                                      
               // the process all over again.                                                       
               sleep(SleepSeconds);                                                                 
                                                                                                    
              enddo;                                                                                
                                                                                                    
           *inlr = *on;                                                                             
                                                                                                    
           //-------------------------------------------                                            
           // $GetFileName - get the next csv table                                                 
           //-------------------------------------------                                            
             begsr $GetFileName;                                                                    
                                                                                                    
               clear filename;                                                                      
                // tables will hold all the names of the tables                                     
               clear TA;                                                                            
               clear folderNames;                                                                   
                                                                                                    
                // loop on the directory                                                            
                // Step1: Open up the directory.                                                    
               PathName = '/home/Reserve_Adjustments/';                                             
               dh = opendir(%addr(PathName));                                                       
               if dh <> *NULL;                                                                      
                                                                                                    
                // Step2: Read each entry from the directory (in a loop)                            
                p_dirent = readdir(dh);                                                             
                                                                                                    
                dow p_dirent <> *NULL;                                                              
                 if d_namelen < 256;                                                                
                  FileName = %subst(d_name:1:d_namelen);                                            
                  // process only csv files                                                         
                  // even MT directory contains folders:                                            
                  // o .                                                                            
                  // o ..                                                                           
                  if %scan('.csv':Filename) > *zeros;                                               
                   ta+=1;                                                                           
                   foldernames(ta) = %trim(pathname) + %trim(filename);                             
                  endif;                                                                            
                 endif;                                                                             
                  p_dirent = readdir(dh);                                                           
                enddo;                                                                              
               endif;                                                                               
                                                                                                    
               // Step3: Close the directory to reprocess                                           
               closedir(dh);                                                                        
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
           // $MoveToHistory - move processed table to                                              
           //                  history                                                              
           //-------------------------------------------                                            
                                                                                                    
             begsr $MoveToHistory;                                                                  
                                                                                                    
              //  *****  Rename the file  *****                                                     
              // RNM OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              // NEWOBJ('SomeNewName.csv')                                                          
              // *like: November16_2011_114547.csv                                                  
                                                                                                    
                                                                                                    
                 nDays = %diff(today : baseDate : *days);                                           
                 ceedate(nDays:'Mmmmmmmmmm':ReturnData:*OMIT);                                      
                                                                                                    
                 MyNewName = %trim(ReturnData)  +                                                   
                 %char(%subdt(Today:*days)) + '_' +                                                 
                 %char(%subdt(Today:*years)) + '_' +                                                
                 %ScanRpl('.' : '' :                                                                
                 %char(%time())) + '.csv';                                                          
                                                                                                    
                 cmdstring = 'RNM OBJ(' + Q + %trim(PathName) +                                     
                             %trim(filename) + Q + ')' +                                            
                             ' NEWOBJ(' + Q + %trim(MyNewName) +                                    
                             Q + ')';                                                               
                                                                                                    
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
                                                                                                    
              //  *****  Move file to history  *****                                                
              // MOV OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              //  TODIR('/home/Reserve_Adjustments/history/')                                       
                                                                                                    
                 cmdstring = 'MOV OBJ(' + Q + %trim(PathName) +                                     
                             %trim(MyNewName) + Q + ')' +                                           
                             ' TODIR(' + Q + %trim(PathName) + 'History/' +                         
                             Q + ')';                                                               
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
                                                                                                    
      /end-free                                                                                     
                                                                                                    
      *-------------------------------------------------------------                                
      *    RdIfsFil - Subprocedure To Read The IFS File                                             
      *-------------------------------------------------------------                                
     p RdIfsFil        B                   Export                                                   
     d RdIfsFil        PI           256A                                                            
     d  FileName                    256A   Const                                                    
     d CharsRead       S             10i 0                                                          
     d CurChar         S              1                                                             
     d Eof             C                   const(x'00')                                             
                                                                                                    
      /free                                                                                         
             Oflag = O_Rdonly + O_Textdata;                                                         
             // need whole path here                                                                
             File = %trim(FileName) + x'00';                                                        
             Fp = open(%addr(File): Oflag);                                                         
                                                                                                    
             if  Fp < 0;                                                                            
              Error_Flag = *On;                                                                     
              Return  Error_Flag;                                                                   
             Endif;                                                                                 
                                                                                                    
             R = 0;                                                                                 
             N = 0;                                                                                 
             dou  CurChar = Eof;                                                                    
              exsr getChar;                                                                         
              R+=1;                                                                                 
              %Subst(Data: R: 1) = CurChar;                                                         
                                                                                                    
              if CurChar = X'25';                                                                   
               %Subst(Data: R: 1)  = *blanks;                                                       
              endif;                                                                                
                                                                                                    
              select;                                                                               
               when  R = 256 or CurChar = X'25';                                                    
                                                                                                    
           // if you find the  code then we still have more data in                                 
           // memory  and we need to process that remaining data.                                   
                                                                                                    
                if  CurChar = X'25';                                                                
                 %Subst(Data: R: 1)  = *blanks;                                                     
                endif;                                                                              
                                                                                                    
            // one record is here                                                                   
                clear  R;                                                                           
                clear  Data;                                                                        
                                                                                                    
              endsl;                                                                                
             enddo;                                                                                 
                                                                                                    
             Return    Error_Flag;                                                                  
                                                                                                    
          //---------------------------------------------------------                               
          //  GetChar - Process IFS Record, One Character At A Time                                 
          //---------------------------------------------------------                               
             begsr GetChar;                                                                         
                                                                                                    
               //  If input buffer is empty, or all characters have been                            
               //    processed, refill the input buffer.                                            
              if N = CharsRead;                                                                     
               CharsRead = Read(Fp:%Addr(Data_Rec): 2560);                                          
               N = *Zero;                                                                           
              endif;                                                                                
                                                                                                    
               // Get the next character in the input buffer.                                       
              if CharsRead <= 0;                                                                    
               CurChar = Eof;                                                                       
              else;                                                                                 
               N+=1;                                                                                
               CurChar = %Subst(Data_Rec: N: 1);                                                    
               select;                                                                              
                when  CurChar = *blanks or CurChar = cr  or  CurChar = lf;                          
                 mydata.bighunkdata = %trim(mydata.bighunkdata) + '|';                              
                other;                                                                              
                 mydata.Bighunkdata = %trim(mydata.bighunkdata) +                                   
                 %trim(Curchar);                                                                    
                endsl;                                                                              
              endif;                                                                                
                                                                                                    
             endsr;                                                                                 
                                                                                                    
         //---------------------------------------------------------                                
      /end-free                                                                                     
                                                                                                    
     p RdIfsFil        E                                                                            
     H Option( *SrcStmt: *NoDebugIo )  BndDir( 'QC2LE' ) DFTACTGRP(*No)                             
     ?**********************************************************************                        
     ?* Project ID     Date  Pgmr ID  Rev  Description                                              
     ?*                                                                                             
     ?*            11/16/11  JJF       00  program written                                          
     ?*              ** pulls .csv tables from directory:                                           
     ?*                 /home/Reserve_Adjustments/                                                  
     ?*                                                                                             
     ?**********************************************************************                        
      *                                                                                             
      * Directory Entry Structure (dirent)                                                          
      *                                                                                             
     d p_dirent        s               *                                                            
     d dirent          ds                  based(p_dirent)                                          
     d   d_reserv1                   16A                                                            
     d   d_reserv2                   10U 0                                                          
     d   d_fileno                    10U 0                                                          
     d   d_reclen                    10U 0                                                          
     d   d_reserv3                   10I 0                                                          
     d   d_reserv4                    8A                                                            
     d   d_nlsinfo                   12A                                                            
     d     nls_ccsid                 10I 0 OVERLAY(d_nlsinfo:1)                                     
     d     nls_cntry                  2A   OVERLAY(d_nlsinfo:5)                                     
     d     nls_lang                   3A   OVERLAY(d_nlsinfo:7)                                     
     d     nls_reserv                 3A   OVERLAY(d_nlsinfo:10)                                    
     d   d_namelen                   10U 0                                                          
     d   d_name                     640A                                                            
                                                                                                    
      *------------------------------------------------------------                                 
      * Open a Directory                                                                            
      *------------------------------------------------------------                                 
     d opendir         pr              *   EXTPROC('opendir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Read Directory Entry                                                                        
      *------------------------------------------------------------                                 
     d readdir         pr              *   EXTPROC('readdir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Close Directory                                                                             
      *------------------------------------------------------------                                 
     d closedir        pr              *   EXTPROC('closedir')                                      
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Open IFs table                                                                              
      *------------------------------------------------------------                                 
     d open            pr            10i 0   ExtProc('open')                                        
     d   filename                      *     value                                                  
     d   openflags                   10i 0   value                                                  
     d   mode                        10u 0   value options(*nopass)                                 
     d   codepage                    10u 0   value options(*nopass)                                 
      *------------------------------------------------------------                                 
      * Read IFS table                                                                              
      *------------------------------------------------------------                                 
     d read            pr            10i 0   ExtProc('read')                                        
     d   filehandle                  10i 0   value                                                  
     d   datareceived                  *     value                                                  
     d   nbytes                      10u 0   value                                                  
      *------------------------------------------------------------                                 
      * Close IFs table                                                                             
      *------------------------------------------------------------                                 
     d close           pr            10i 0   ExtProc('close')                                       
     d   filehandle                  10i 0   value                                                  
      *------------------------------------------------------------                                 
      * read ifs table  - internal procedure                                                        
      *------------------------------------------------------------                                 
     d RdIfsFil        pr           256a                                                            
     d  FileName                    256a   const                                                    
      *------------------------------------------------------------                                 
      * Delay - sleep function                                                                      
      *------------------------------------------------------------                                 
     d sleep           pr            10i 0 ExtProc( 'sleep' )                                       
     d  seconds                      10u 0 Value                                                    
      *------------------------------------------------------------                                 
      * Command - run a command                                                                     
      *------------------------------------------------------------                                 
     d $command        pr                  extpgm('QCMDEXC')                                        
     d   command                    256                                                             
     d   length                      15  5                                                          
      *------------------------------------------------------------                                 
      * Grab the date in LongFormat                                                                 
      *------------------------------------------------------------                                 
     d CEEDATE         pr                  opdesc                                                   
     d   Lilian                      10i 0                                                          
     d   picture                  65535A   const options(*varsize)                                  
     d   OutputDate               65535A   const options(*varsize)                                  
     d   Feedback                    12a   options(*omit)                                           
      *------------------------------------------------------------                                 
      * a few local variables...                                                                    
                                                                                                    
     d BaseDate        s               d   inz(D'1582-10-14')                                       
     d cmdlength       s             15  5                                                          
     d cmdstring       s            256                                                             
     d count           s              3  0                                                          
     d cr              c                   Const(x'0D')                                             
     d data            s          65535A                                                            
     d Data_Rec        s          65535A                                                            
     d datasize        s              5  0                                                          
     d dh              s               *                                                            
     d Eol             c                   Const(x'0D25')                                           
     d Error_Flag      s              1A   INZ('0')                                                 
     d File            s            256                                                             
     d FileName        s            256    varying                                                  
     d FolderNames     s            256    dim(50)                                                  
     d Fp              s             10i 0                                                          
     d KeepLooping     s               n   inz('1')                                                 
     d lf              C                   Const(x'25')                                             
     d MyNewName       s            265    varying                                                  
     d N               s              5  0                                                          
     d nDays           s             10i 0                                                          
      * values for oflag parameter, used by open()                                                  
     d O_RDONLY        s             10i 0   inz(1)                                                 
     d O_TEXTDATA      s             10i 0   inz(16777216)                                          
                                                                                                    
     d Oflag           s             10i 0                                                          
     d Omode           s             10u 0                                                          
     d PathName        s             26                                                             
     d Q               s              1    inz('''')                                                
     d R               S              5  0                                                          
     d Rc              S             10i 0                                                          
     d ReturnData      s             12                                                             
     d SleepSeconds    s             10i 0 inz(1)                                                   
     d ta              s              3  0                                                          
     d Today           s               d   inz(*SYS)                                                
                                                                                                    
         // entire document stored in here                                                          
     d MyData          ds                  qualified  inz                                           
     d  bighunkdata               65535                                                             
     d   OneSlice                    60    dim(1000) overlay(bighunkdata:*next)                     
      *------------------------------------------------------                                       
      * MAIN LINE                                                                                   
      *------------------------------------------------------                                       
                                                                                                    
      /free                                                                                         
                                                                                                    
                // program will loop until outside force                                            
                // stops it.                                                                        
              dow KeepLooping;                                                                      
                                                                                                    
               exsr $GetFileName;                                                                   
               if ta > *zeros;                                                                      
                // read the tables one at a time                                                    
                for count = 1 to ta;                                                                
                 filename = foldernames(count);                                                     
                 Error_flag = rdifsfil(Filename);                                                   
                 //exsr $MoveToHistory;                                                             
                endfor;                                                                             
               endif;                                                                               
                                                                                                    
               // Delay job for a number of seconds then start                                      
               // the process all over again.                                                       
               sleep(SleepSeconds);                                                                 
                                                                                                    
              enddo;                                                                                
                                                                                                    
           *inlr = *on;                                                                             
                                                                                                    
           //-------------------------------------------                                            
           // $GetFileName - get the next csv table                                                 
           //-------------------------------------------                                            
             begsr $GetFileName;                                                                    
                                                                                                    
               clear filename;                                                                      
                // tables will hold all the names of the tables                                     
               clear TA;                                                                            
               clear folderNames;                                                                   
                                                                                                    
                // loop on the directory                                                            
                // Step1: Open up the directory.                                                    
               PathName = '/home/Reserve_Adjustments/';                                             
               dh = opendir(%addr(PathName));                                                       
               if dh <> *NULL;                                                                      
                                                                                                    
                // Step2: Read each entry from the directory (in a loop)                            
                p_dirent = readdir(dh);                                                             
                                                                                                    
                dow p_dirent <> *NULL;                                                              
                 if d_namelen < 256;                                                                
                  FileName = %subst(d_name:1:d_namelen);                                            
                  // process only csv files                                                         
                  // even MT directory contains folders:                                            
                  // o .                                                                            
                  // o ..                                                                           
                  if %scan('.csv':Filename) > *zeros;                                               
                   ta+=1;                                                                           
                   foldernames(ta) = %trim(pathname) + %trim(filename);                             
                  endif;                                                                            
                 endif;                                                                             
                  p_dirent = readdir(dh);                                                           
                enddo;                                                                              
               endif;                                                                               
                                                                                                    
               // Step3: Close the directory to reprocess                                           
               closedir(dh);                                                                        
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
           // $MoveToHistory - move processed table to                                              
           //                  history                                                              
           //-------------------------------------------                                            
                                                                                                    
             begsr $MoveToHistory;                                                                  
                                                                                                    
              //  *****  Rename the file  *****                                                     
              // RNM OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              // NEWOBJ('SomeNewName.csv')                                                          
              // *like: November16_2011_114547.csv                                                  
                                                                                                    
                                                                                                    
                 nDays = %diff(today : baseDate : *days);                                           
                 ceedate(nDays:'Mmmmmmmmmm':ReturnData:*OMIT);                                      
                                                                                                    
                 MyNewName = %trim(ReturnData)  +                                                   
                 %char(%subdt(Today:*days)) + '_' +                                                 
                 %char(%subdt(Today:*years)) + '_' +                                                
                 %ScanRpl('.' : '' :                                                                
                 %char(%time())) + '.csv';                                                          
                                                                                                    
                 cmdstring = 'RNM OBJ(' + Q + %trim(PathName) +                                     
                             %trim(filename) + Q + ')' +                                            
                             ' NEWOBJ(' + Q + %trim(MyNewName) +                                    
                             Q + ')';                                                               
                                                                                                    
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
                                                                                                    
              //  *****  Move file to history  *****                                                
              // MOV OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              //  TODIR('/home/Reserve_Adjustments/history/')                                       
                                                                                                    
                 cmdstring = 'MOV OBJ(' + Q + %trim(PathName) +                                     
                             %trim(MyNewName) + Q + ')' +                                           
                             ' TODIR(' + Q + %trim(PathName) + 'History/' +                         
                             Q + ')';                                                               
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
                                                                                                    
      /end-free                                                                                     
                                                                                                    
      *-------------------------------------------------------------                                
      *    RdIfsFil - Subprocedure To Read The IFS File                                             
      *-------------------------------------------------------------                                
     p RdIfsFil        B                   Export                                                   
     d RdIfsFil        PI           256A                                                            
     d  FileName                    256A   Const                                                    
     d CharsRead       S             10i 0                                                          
     d CurChar         S              1                                                             
     d Eof             C                   const(x'00')                                             
                                                                                                    
      /free                                                                                         
             Oflag = O_Rdonly + O_Textdata;                                                         
             // need whole path here                                                                
             File = %trim(FileName) + x'00';                                                        
             Fp = open(%addr(File): Oflag);                                                         
                                                                                                    
             if  Fp < 0;                                                                            
              Error_Flag = *On;                                                                     
              Return  Error_Flag;                                                                   
             Endif;                                                                                 
                                                                                                    
             R = 0;                                                                                 
             N = 0;                                                                                 
             dou  CurChar = Eof;                                                                    
              exsr getChar;                                                                         
              R+=1;                                                                                 
              %Subst(Data: R: 1) = CurChar;                                                         
                                                                                                    
              if CurChar = X'25';                                                                   
               %Subst(Data: R: 1)  = *blanks;                                                       
              endif;                                                                                
                                                                                                    
              select;                                                                               
               when  R = 256 or CurChar = X'25';                                                    
                                                                                                    
           // if you find the  code then we still have more data in                                 
           // memory  and we need to process that remaining data.                                   
                                                                                                    
                if  CurChar = X'25';                                                                
                 %Subst(Data: R: 1)  = *blanks;                                                     
                endif;                                                                              
                                                                                                    
            // one record is here                                                                   
                clear  R;                                                                           
                clear  Data;                                                                        
                                                                                                    
              endsl;                                                                                
             enddo;                                                                                 
                                                                                                    
             Return    Error_Flag;                                                                  
                                                                                                    
          //---------------------------------------------------------                               
          //  GetChar - Process IFS Record, One Character At A Time                                 
          //---------------------------------------------------------                               
             begsr GetChar;                                                                         
                                                                                                    
               //  If input buffer is empty, or all characters have been                            
               //    processed, refill the input buffer.                                            
              if N = CharsRead;                                                                     
               CharsRead = Read(Fp:%Addr(Data_Rec): 2560);                                          
               N = *Zero;                                                                           
              endif;                                                                                
                                                                                                    
               // Get the next character in the input buffer.                                       
              if CharsRead <= 0;                                                                    
               CurChar = Eof;                                                                       
              else;                                                                                 
               N+=1;                                                                                
               CurChar = %Subst(Data_Rec: N: 1);                                                    
               select;                                                                              
                when  CurChar = *blanks or CurChar = cr  or  CurChar = lf;                          
                 mydata.bighunkdata = %trim(mydata.bighunkdata) + '|';                              
                other;                                                                              
                 mydata.Bighunkdata = %trim(mydata.bighunkdata) +                                   
                 %trim(Curchar);                                                                    
                endsl;                                                                              
              endif;                                                                                
                                                                                                    
             endsr;                                                                                 
                                                                                                    
         //---------------------------------------------------------                                
      /end-free                                                                                     
                                                                                                    
     p RdIfsFil        E
        Attached Files
        All my answers were extracted from the "Big Dummy's Guide to the As400"
        and I take no responsibility for any of them.

        www.code400.com

        Comment

        Previous template Next
        Working...
        X