PROGRAM Win2Unix;
{-- ***************************************************************************
 -- ** Descr. : Changes file references to all lowercase/uppercase so that there
 -- **          are no problems moving forms application from windows to the
 -- **          file upper/lowercase  sensitive unix enviroment
 -- **
 -- ** MINVERS: requires FormsAPI Master 1.0 Build 222 and up
 -- ***************************************************************************
 -- ** 05/12/01 1.001.00 Initial Creation, muellers@orcl-toolbox.com
 -- ** 17/04/02 1.002.00 fix usage of wrong property D2FP_LIB_SRC to
 -- **                   D2FP_LIB_LOC, muellers@orcl-toolbox.com
 -- ** 17/12/05 1.003.00 ignore calls to OPEN_FORM/etc in comments, muellers@orcl-toolbox.com
 -- ** 23/02/06 1.004.00 change case of filename on save, muellers@orcl-toolbox.com
 -- ** 16/08/12 1.005.00 added Set_xxx_Property calls for ICON_NAME properties, muellers@orcl-toolbox.com
 -- ** 18/08/12 1.006.00 added 2 new menu-related properties and don't change any inherited propes, muellers@orcl-toolbox.com
 -- ***************************************************************************}



{*global script parameters*}
VAR
  ps           : TParamScreen;
  pb           : TParamBoard;




FUNCTION ChangeCase (i_obj : number; var io_val : varchar2; i_lin : number = -1 ) : boolean;
var sn,slin : string;
BEGIN
  result := false;
  if ps.ParamByName('UPLOW').value ='Upper'
    then sn := upper(io_val)
    else sn := lower(io_val);
    
  if sn<>io_val then 
  begin  

    if i_lin>=0 
      then slin := '(line:'|| to_char(i_lin) ||')'
      else slin := '';
    
    LogAdd(' => '+api_getobjectpath(i_obj)+slin+' '+io_val+'=>'+sn);
    io_val := sn;
    result := true;
  end;    
END;


FUNCTION PropertyNotSubclassed (i_obj : number; i_prop : number) : boolean;
begin
  result := true;
  if Generic_isSubclassed(i_obj) then 
  begin
    if Generic_isPropInherited(i_obj, i_prop) then 
    begin
      result := false;
    end;
  end;
end;

  

FUNCTION CheckPLSQLParser(pr : TPLSQLParser; i_proc : varchar2; i_param : varchar2; i_parampos : number; i_obj : number; i_condparam : varchar2; i_condparampos : number) : boolean;
var oname,fname: varchar2;
    i,k,j :    number;
    apo :    number;
    tokidx, idxs, idxe : number;
    isChange : boolean;
    
BEGIN
  result := false;
  if pr.FindIdentifiers(i_proc) then
  begin
  
    for i := pr.FindCount-1 downto 0 do
    begin
      tokidx := pr.FindResults[i];
      isChange := false;
     
      //check if we have a conditional parameter that we need to check      
      if i_condparam<>'' then 
      begin
        if uppercase(trim(pr.GetIdentifierParamValue(tokidx, i_condparampos, i_condparam,false))) <> uppercase(i_condparam) then 
        begin
          //abbort here and make the next loop
          continue;
        end;  
      end;
      
      
      //get the parameter (and filter out any comments and unnecessary things)
      pr.GetIdentifierParamValueRange(tokidx, i_parampos, i_param, idxs, idxe);
      oname := '';
      for k := idxs to idxe do 
      begin
        if not(pr.TokenType(k) in [ttComment,ttCommentText,ttEOL,ttWhitespace]) then
        begin
          oname := oname + pr.Token[k];
        end; 
      end;

      
      if oname<>'' then 
      begin
        fname := oname; 
      
        //count apostrophes to check if the filename is a simple textstring!
        apo := 0;
        for j:=1 to length(oname) do
           if oname[j]='''' then inc(apo);
    
        if (upper(substr(fname,1,5))='LOWER') and (ps.ParamByName('UPLOW').value<>'Upper') then
        begin
          {ignore!}
        end else
        if (upper(substr(fname,1,5))='UPPER') and (ps.ParamByName('UPLOW').value ='Upper') then
        begin
          {ignore!}
        end else
        if (apo=2) and (substr(fname,1,1)='''') then
        begin
          //its a simple text string!
          if ChangeCase(i_obj,fname, pr.TokenLine(tokidx)) then
          begin
            isChange := true;
          end;  
        end else
        begin
          //must then be function call or concatenated strings ?!
          if ps.ParamByName('UPLOW').value ='Upper'
             then fname := 'upper('+fname+')'
             else fname := 'lower('+fname+')';
          isChange := true;
          LogAdd(' => '+api_getobjectpath(i_obj)+' (line:'|| to_char(pr.TokenLine(tokidx)) ||')'+oname+'=>'+fname);
        end;

        if isChange then
        begin
          pr.SetIdentifierParamValue(tokidx, i_parampos, i_param, fname);
          result := true;
        end; 
         
      end;
      
    end;
  end;
END;



FUNCTION CheckPLSQL(i_obj : number; var io_val : varchar2) : boolean;
var
  pr           : TPLSQLParser;
BEGIN
  result := false;
  pr := TPLSQLParser.create;
  pr.text := io_val;
  
  //check for calls to run_product/call_form/open_form/etc
  result := CheckPLSQLParser(pr,'CALL_FORM','formmodule_name',0,i_obj,'',-1) or result;
  result := CheckPLSQLParser(pr,'NEW_FORM','formmodule_name',0,i_obj,'',-1) or result;
  result := CheckPLSQLParser(pr,'OPEN_FORM','form_name',0,i_obj,'',-1) or result;
  result := CheckPLSQLParser(pr,'RUN_PRODUCT','module',1,i_obj,'',-1) or result;
  result := CheckPLSQLParser(pr,'SET_ITEM_PROPERTY','value',2,i_obj,'ICON_NAME',1) or result;
  result := CheckPLSQLParser(pr,'SET_MENU_ITEM_PROPERTY','value',2,i_obj,'ICON_NAME',1) or result;
  result := CheckPLSQLParser(pr,'SET_WINDOW_PROPERTY','value',2,i_obj,'ICON_NAME',1) or result;
  
  if result then 
  begin
    io_val := pr.text;  
  end;
  
END;
            







{*Main Program Block*}
VAR
  v_filename   : varchar2;
  i,j          : number;
  frm          : number;
  files        : TStringList;
  objs         : TStringList;
  v_oldfile    : varchar2;
  v_newfile    : varchar2;
  v_val, v_val2: varchar2;

BEGIN

    //build together a nice parameter screen ...
    ps := TParamScreen.create;
    ps.caption := 'Windows 2 Unix ...';

    pb := ps.AddBoard('Modules',picModules);
    pb.addparam(parLabel,'MYLABEL','This script will change all referenced <B>file names</B> to uppper/lowercase. '+
                      'Please make sure all referenced objects are in the same source path or the forms will fail to load - this is a limitation '+
                      'of Oracles FormsAPI !','','');
    pb.addparam(parPathname,'SRCPATH','Source Path','','');
    pb.addparam(parPathname,'TRGPATH','Target Path','','');
    pb.addparam(parRadioGroup,'OPERATION','Operation','Report only','Report only'+c_cr+'Save Changes');
    ps.parambyname('OPERATION').isNewGroup := true;
    pb.addparam(parComboListbox,'UPLOW','Filecase','Lower','Lower'+c_cr+'Upper');
    pb.addparam(parLabel,'MYLABEL2','Leave database connection empty if you don''t want to connect to a database !','','');
    pb.addparam(parDatabaseLogon,'MYDATABASE','Connect(opt)','','');

    //show the parameter screen and wait for inputs
    if ps.ShowParamScreen then
    begin

      //because it is nice in the log to see what parameters we have specified
      //we just write them out
      logadd('Parameters:');
      for j := 0 to ps.paramcount-1 do
        logadd(rpad(ps.param[j].name,20)+ps.param[j].value);

      // basic parametercheck ...
      if ps.ParamByName('SRCPATH').value ='' then raiseException('Missing Source Path!');
      if (ps.ParamByName('TRGPATH').value ='')
         and (ps.ParamByName('OPERATION').value ='Change') then raiseException('Missing Target Path!');

      try
        if ps.ParamByName('MYDATABASE').value<>'' then 
          api_Connect(ps.ParamByName('MYDATABASE').value);
      except
        logadd( 'Database connection failed, ignoring it.', LogWarning ); 
      end;

      //get the list of fmb-modules to process (with all subdirectories)
      files := GetFileList(ps.ParamByName('SRCPATH').value,'*.fmb;*.mmb;*.olb;*.pll', true);



      for j := 0 to files.count-1 do
      begin
        v_filename := files.strings[j];
        logadd('Checking ('+to_char(j+1)+'/'+to_char(files.count)+') '+v_filename);

        try
          SetCurrentPath(ExtractFilePath(v_filename));
          frm := API_LoadModule(v_filename);

          objs := API_GetAllObjects(frm);

          for i := 0 to objs.count-1 do
          begin

            //check subclassed elements
            if Generic_HasProp(objs.objects[i],D2FP_PAR_FLNAM) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_PAR_FLNAM);
              if ChangeCase(objs.objects[i],v_val) then
                Generic_SetTextProp(objs.objects[i],D2FP_PAR_FLNAM,v_val);
            end;

            if Generic_HasProp(objs.objects[i], D2FP_PAR_FLPATH ) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_PAR_FLPATH);
              if ChangeCase(objs.objects[i],v_val) then
                Generic_SetTextProp(objs.objects[i],D2FP_PAR_FLPATH,v_val);
            end;


            //check program units
            if Generic_HasProp(objs.objects[i],D2FP_PGU_TXT) and PropertyNotSubclassed(objs.objects[i],D2FP_PGU_TXT) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_PGU_TXT);
              if  CheckPLSQL(objs.objects[i], v_val) then
                Generic_SetTextProp(objs.objects[i],D2FP_PGU_TXT,v_val);
            end;

            //check triggers
            if Generic_HasProp(objs.objects[i],D2FP_TRG_TXT) and PropertyNotSubclassed(objs.objects[i],D2FP_TRG_TXT) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_TRG_TXT);
              if  CheckPLSQL(objs.objects[i], v_val) then
                Generic_SetTextProp(objs.objects[i],D2FP_TRG_TXT,v_val);
            end;

            //check menu startup code
            if Generic_HasProp(objs.objects[i],D2FP_STRTUP_CODE) and PropertyNotSubclassed(objs.objects[i],D2FP_STRTUP_CODE) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_STRTUP_CODE);
              if  CheckPLSQL(objs.objects[i], v_val) then
                Generic_SetTextProp(objs.objects[i],D2FP_STRTUP_CODE,v_val);
            end;

            //check menu items code
            if Generic_HasProp(objs.objects[i],D2FP_MNU_ITM_CODE) and PropertyNotSubclassed(objs.objects[i],D2FP_MNU_ITM_CODE) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_MNU_ITM_CODE);
              if  CheckPLSQL(objs.objects[i], v_val) then
                Generic_SetTextProp(objs.objects[i],D2FP_MNU_ITM_CODE,v_val);
            end;


            //check icon filenames
            if Generic_HasProp(objs.objects[i],D2FP_ICON_FLNAM) and PropertyNotSubclassed(objs.objects[i],D2FP_ICON_FLNAM) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_ICON_FLNAM);
              v_val2 := v_val;
              if upper(ExtractFileExt(v_val)) = '.ICO' then
                v_val := ChangeFileExt(v_val,'');
              if upper(ExtractFileExt(v_val)) = '.GIF' then
                v_val := ChangeFileExt(v_val,'');
              ChangeCase(objs.objects[i],v_val);  
              if  v_val<>v_val2 then
                Generic_SetTextProp(objs.objects[i],D2FP_ICON_FLNAM,v_val);
            end;


            //check library attachments, remove path and extension also
            if Generic_HasProp(objs.objects[i],D2FP_LIB_LOC) and PropertyNotSubclassed(objs.objects[i],D2FP_LIB_LOC) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_LIB_LOC);
              v_val2 := v_val;
              if upper(ExtractFileExt(v_val)) = '.PLL' then
                v_val := ChangeFileExt(v_val,'');
              if upper(ExtractFileExt(v_val)) = '.PLX' then
                v_val := ChangeFileExt(v_val,'');
              ChangeCase(objs.objects[i],v_val);  
              if  v_val<>v_val2 then
                Generic_SetTextProp(objs.objects[i],D2FP_LIB_LOC,v_val);
            end;


            //check report-file objects
            if Generic_HasProp(objs.objects[i],D2FP_FLNAM) and PropertyNotSubclassed(objs.objects[i],D2FP_FLNAM) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_FLNAM);
              if ChangeCase(objs.objects[i],v_val) then   
                Generic_SetTextProp(objs.objects[i],D2FP_FLNAM,v_val);
            end;

            //check forms menu
            if Generic_HasProp(objs.objects[i],D2FP_MNU_MOD) and PropertyNotSubclassed(objs.objects[i],D2FP_MNU_MOD) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_MNU_MOD);
              if (v_val<>'DEFAULT&SMARTBAR') and (v_val<>'DEFAULT') then 
              begin
                v_val2 := v_val;
                if upper(ExtractFileExt(v_val)) = '.MMX' then
                  v_val := ChangeFileExt(v_val,'');
                ChangeCase(objs.objects[i],v_val);  
                if  v_val<>v_val2 then
                  Generic_SetTextProp(objs.objects[i],D2FP_MNU_MOD,v_val);
              end;  
            end;

            //check menu-files
            if Generic_HasProp(objs.objects[i],D2FP_MNU_FLNAM) and PropertyNotSubclassed(objs.objects[i],D2FP_MNU_FLNAM) then
            begin
              v_val := Generic_GetTextProp(objs.objects[i],D2FP_MNU_FLNAM);
              if ChangeCase(objs.objects[i],v_val) then   
                Generic_SetTextProp(objs.objects[i],D2FP_MNU_FLNAM,v_val);
            end;


          end;

          logadd('Finished checking '+v_filename+' - '+to_char(objs.count) +' objects scanned');
          objs.free;


          if ps.ParamByName('OPERATION').value ='Save Changes' then
          begin
            //modify the filename to point to the new location
            v_filename := substr(v_filename,length(ps.ParamByName('SRCPATH').value)+1);
            v_filename := ps.ParamByName('TRGPATH').value + v_filename;
            CreateDirectory(ExtractFilePath(v_filename));

            //save it to the new location
            try
              if ps.ParamByName('UPLOW').value ='Upper'
                then API_SaveModule(frm,upper(v_filename))
                else API_SaveModule(frm,lower(v_filename));
                  
            except
              logadd('Error saving file: - '+GetError, LogError);
            end;

          end;

          //... and finally release the module from memory
          API_DestroyModule(frm);

        except
          // ups! an error happened, so just log it and proceed to the next module
          logadd(' =>'+GetError(errDetailed),LogError);
        end;
      end;

    end else
    begin
      //user must have pressed cancel on parameterscreen
      logadd('Canceled on parameterscreen!');
    end;

    // free the parameter screen
    ps.free;

END.