Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- /*
- *
- * Gets setup strings from .rc files and
- * creates or destroys WPS objects by them.
- * Registers and replaces classes,
- * creates keys in selected .ini files.
- * .rc file (like ini.rc in \os2)
- * is the template in text format
- * for creating .ini binary files.
- * Syntax: crobj [global opts] [[local opts1] <file1.rc>] ... [[local optsN] <fileN.rc>]
- * or: cat <file.rc> | crobj [global opts]
- * where [global opts] can be:
- * '-h' -- Give Help
- * '-I' -- One global ini file for all selected .rc's
- * '-U' -- Global undo: undo all the following .rc's
- *
- * [local opts] can be:
- * '-i' -- local .ini file for one selected .rc
- * '-u' -- local undo: undo one the following .rc
- *
- * (c) valerius, 2006 Jun 2,
- * _valerius (at-sign) mail (dot) ru
- * licensed under BSD license.
- *
- */
- /*
- * ToDo: undo .rc files
- * instead of applying them;
- */
- parse arg args
- call ParseCmdLine args
- call InitRxDlls
- call GetObjIds
- /* defaults: */
- InComment = 0
- countCommented = 0;
- /* commentary symbols */
- BeginComment = '/*'
- EndComment = '*/'
- CommentVars = 'InComment countCommented',
- 'BeginComment EndComment'
- if opt.Help = 1 then do
- call GiveHelp
- exit 0
- end
- BackupFolder = 'Preserved'
- BackupID = '<PRG_BACKUPFLD>'
- /* Apply several .rc files in the order */
- do num = 1 to infile.0
- infile = infile.num
- /* Reading all lines in order: */
- if infile \= '' then
- rc = stream(infile, 'c', 'open read')
- /* Process each .rc file */
- lines = 0
- do while lines(infile) > 0
- line = linein(infile)
- lines = lines + 1
- line = strip(line)
- call processLine line
- end
- if infile \= '' then
- rc = stream(infile, 'c', 'close')
- end
- exit 0
- /* ------==========------- */
- ParseCmdLine: procedure expose infile. opt.
- args = arg(1)
- drop opt.
- /*
- * opt. -- options stem
- * opt.i -- options subtree for i'th .rc file,
- * where 'i' is .rc file number
- */
- opts = args
- count = 0
- inis = 0
- opt.ini = ''
- do while opts \= ''
- count = count + 1
- opt = getarg()
- if pos('-', opt) == 1 then
- select
- when opt = '-U'
- /* Global Undo option: undo all
- the following .rc files */
- then opt.Undo = 1
- when opt = '-u'
- /* Local Undo: undo one
- following .rc file */
- then do
- count = count + 1
- opt = getarg()
- infile.count = opt
- opt.count.Undo = 1
- opt.count.Ini = opt.ini
- end
- when opt = '-i'
- /* Apply the following .rc files to
- this .ini file */
- then do
- inis = inis + 1
- count = count + 1
- opt = getarg()
- opt.ini = opt
- end
- when opt = '-h'
- /* Give Help */
- then opt.Help = 1
- otherwise nop
- end
- else do
- infile.count = opt
- /* .ini file for count'th .rc file to apply */
- opt.count.Ini = opt.ini
- end
- end
- infile.0 = count
- if count = 0 then do
- infile.0 = 1
- infile.1 = ''
- end
- drop opt.ini
- return
- /* ------==========------- */
- getarg: procedure expose opts
- /* Gets one word, or a line, enclosed
- in quotes, from opts */
- opts = strip(opts)
- if pos('"', opts) == 1 then
- parse value opts with '"' opt '"' opts
- else
- parse var opts opt opts
- return opt
- /* ------==========------- */
- InitRxDlls: procedure
- call RxFuncAdd 'SysLoadFuncs', 'rexxutil', 'SysLoadFuncs'
- call SysLoadFuncs
- call RxFuncAdd 'WPToolsLoadFuncs', 'wptools', 'WPToolsLoadFuncs'
- call WPToolsLoadFuncs
- return
- /* ------==========------- */
- processLine: procedure expose (CommentVars),
- lines infile,
- opt. opts. keys.
- line = arg(1)
- p1 = 1; p2 = 1;
- do while p1 + p2 > 0
- /* Comment deleting */
- /* Comments can't be nested */
- p1 = pos(BeginComment, line);
- p2 = pos(EndComment, line);
- /* Deleting the first comment in a line */
- if (0 < p1) & (p1 < p2) then do
- line = delstr(line, p1, p2 - p1 + 2)
- end; else if (0 < p2) & ((p2 < p1) | (p1 == 0)) then do
- line = substr(line, p2 + 2);
- InComment = 0;
- countCommented = 0;
- end; else if p1 > 0 then do
- line = delstr(line, p1);
- InComment = 1
- end
- line = strip(line)
- /* Skipping the lines inside the comment */
- if InComment > 0 then countCommented = countCommented + 1;
- if countCommented > 2 then return;
- /* Processing the line after deleting all the comments */
- if p1 + p2 == 0 then do
- if line = '' then return;
- if pos('"', line) == 0 then do
- /* Upper Case: */
- line = translate(line)
- parse var line keyword opt
- select
- when keyword == 'CODEPAGE' then
- opt.CodePage = opt
- when keyword == 'STRINGTABLE' then
- if opt = 'REPLACEMODE' then
- opt.Replace = 1
- else
- opt.Replace = 0
- when keyword == 'BEGIN' then
- opt.Section = prev
- when keyword == 'END' then
- opt.Section = ''
- otherwise nop
- end
- prev = keyword
- return;
- end
- /*
- parse var line '"' name '"' line
- */
- call splitLine line
- name = opts.app
- select
- when name == '' then return;
- when name == 'PM_InstallObject'
- then call processInstallObj;
- when name == 'PM_InstallClass'
- then call processInstallClass line;
- when name == 'PM_InstallClassReplacement'
- then call processInstallClassRep line;
- when name == 'PM_MigrateFolder'
- then nop
- when name == 'PM_RunInstallProgram'
- then nop
- otherwise
- call processAddKey '"'name'" 'line;
- end;
- return;
- end;
- end;
- return
- /* ------==========------- */
- processInstallObj: procedure expose lines,
- infile keys.,
- opts.
- /* Processing of the "PM_InstallObject" lines */
- line = opts.key
- opts.setup = opts.val
- parse var line opts.name ';' opts.class ';' opts.location ';' opts.opt
- opts.opt = strip(opts.opt, 'T', ';')
- /* Determining the Object Id */
- str = opts.setup
- ObjId = ''
- do while str \= ''
- parse var str parm '=' value ';' str
- parm = translate(parm)
- value = strip(value, 'T', ';')
- if parm == 'OBJECTID' then do
- ObjId = value
- leave
- end
- end
- title = ''
- str = opts.setup
- do while str \= ''
- parse var str parm '=' value ';' str
- parm = translate(parm)
- value = strip(value, 'T', ';')
- if parm == 'TITLE' then do
- title = value
- leave
- end
- end
- if infile = '' then
- file = 'stdin'
- else
- file = infile
- if ObjId = '' then do
- ret = -255
- call lineout 'stderr', 'Error 'ret': empty object id!'
- call lineout 'stderr', 'rc file: 'file','
- call lineout 'stderr', 'line: 'lines
- exit ret
- end
- if oprs.name = '' then opts.name = title
- if opts.name = '' then do
- ret = -254
- call lineout 'stderr', 'Error 'ret': no object name and no title!'
- call lineout 'stderr', 'rc file: 'file','
- call lineout 'stderr', 'line: 'lines
- exit ret
- end
- if opts.class = '' then do
- ret = -253
- call lineout 'stderr', 'Error 'ret': no object class!'
- call lineout 'stderr', 'rc file: 'file','
- call lineout 'stderr', 'line: 'lines
- exit ret
- end
- if opts.location = '' then do
- ret = -252
- call lineout 'stderr', 'Error 'ret': no object location!'
- call lineout 'stderr', 'rc file: 'file','
- call lineout 'stderr', 'line: 'lines
- exit ret
- end
- /*
- call SysSleep 0.1
- */
- select
- when opts.opt == 'FAIL' then do
- /* Do nothing if an object already exists or create
- the new object if it didn't exist */
- opts.opt = 'F';
- call lineout 'stderr', 'Failing if target object exist: 'ObjId'...'
- rc = SysCreateObject(opts.class, opts.name, opts.location, opts.setup, opts.opt);
- end;
- when opts.opt == 'PRESERVEOLD' then do
- /* Preserve old object with renamed Object Id
- and create new object with these settings with
- the object id in these settings -- as the old
- object had */
- opts.opt = 'R';
- call lineout 'stderr', 'Preserving old 'ObjId'...'
- p = pos('>', ObjId)
- if p <= 0 then p = length(ObjId) + 1
- f = 0
- cnt = 0
- do until f
- cnt = cnt + 1
- newid = insert('_'cnt, ObjId, p - 1)
- f = \ObjExists(newid)
- end
- ret = WPToolsQueryObject(ObjId,,
- 'class1',,
- 'title1',,
- 'setup1',,
- 'location1')
- if ret then do
- newname = insert('_'cnt, name, length(name))
- newsetup = setup
- parse var newsetup first 'OBJECTID=' second ';' last
- newsetup = first'OBJECTID='newid';'last
- rc = SysCreateObject(class1, newname, location1, newsetup, 'U')
- if class1 = 'WPFolder' |,
- class1 = 'XWPFolder' |,
- class1 = 'MMFolder' |,
- class1 = 'WPUrlFolder' |,
- class1 = 'WPDesktop'
- then do
- ret = WPToolsFolderContent(newid, 'objs.', F)
- if ret then do
- do i = 1 to objs.0
- obj = obj.i
- ret = WPToolsQueryOnject(obj,,
- 'class2',,
- 'title2',,
- 'setup2',,
- 'location2')
- if ret then do
- parse var setup2 first 'OBJECTID=' second ';' last
- location2 = newid
- ret = SysMoveObject(second, location2)
- ret = SysCreateObject(class2, title2, location2, setup2, 'U')
- end
- else do
- call lineout 'stderr', 'Can''t query object properties: 'second'!'
- exit -1
- end
- end
- end
- else do
- call lineout 'stderr', 'Can''t query folder confent: 'newid'!'
- exit -2
- end
- end
- end
- rc = SysCreateObject(opts.class, opts.name, opts.location, opts.setup, opts.opt);
- end;
- when opts.opt == 'REPLACE' then do
- /* Delete an old object and create new one */
- opts.opt = 'R';
- call lineout 'stderr', 'Replacing 'ObjId'...'
- rc = SysCreateObject(opts.class, opts.name, opts.location, opts.setup, opts.opt);
- end;
- when opts.opt == 'RELOCATE' then do
- /* Find the object 'ObjId', move it to the new folder and apply setup string */
- opts.opt = 'U'
- call lineout 'stderr', 'Relocating 'ObjId' to folder: 'location'...'
- rc = SysMoveObject(ObjId, opts.location)
- rc = SysCreateObject(opts.class, opts.name, opts.location, opts.setup, opts.opt);
- end;
- when opts.opt == 'UPDATE' then do
- /* Update properties, if an object already exists */
- call lineout 'stderr', 'Updating 'ObjId'...'
- opts.opt = 'U';
- rc = SysCreateObject(opts.class, opts.name, opts.location, opts.setup, opts.opt);
- end;
- when opts.opt == 'UPDATEONLY' then do
- /* What's the difference from 'UPDATE'? Please let me know (if you know) */
- /* My hypotesis on this is that only SETUP string is updated, not other */
- call lineout 'stderr', 'Updating only setup string: 'ObjId'...'
- opts.opt = 'U';
- rc = SysSetObjectData(ObjId, opts.setup);
- end;
- when opts.opt == 'DELETE' then
- /* Delete object with given settings */
- call DeleteObj;
- otherwise do
- /* By default, Update the settings of the object */
- opts.opt = 'U';
- rc = SysCreateObject(opts.class, opts.name, opts.location, opts.setup, opts.opt);
- end;
- end;
- return
- /* ------==========------- */
- splitLine: procedure expose opts.
- line = arg(1)
- q = 0
- drop opts.
- line = strip(line)
- opts.app = quotedText()
- opts.key = quotedText()
- opts.val = quotedText()
- opts.comment = commentedText()
- return
- /* ------==========------- */
- quotedText: procedure expose line q
- p = pos('"', line, q + 1)
- if p > 0 then do
- t = p
- do forever
- q = pos('"', line, p + 1)
- if q > 1
- then do
- if substr(line, q - 1, 1) \= '^'
- then
- leave
- else do
- s1 = substr(line, 1, q - 2)
- s2 = substr(line, q)
- line = s1 || s2
- p = q - 1
- end
- end
- end
- s = substr(line, t + 1, q - t - 1)
- end
- else
- parse var line s line
- return s
- /* ------==========------- */
- commentedText: procedure expose line q
- p = pos('/*', line, q + 1)
- if p > 0 then do
- q = pos('*/', line, p + 1)
- s = substr(line, p + 2, q - p - 3)
- end
- else
- parse var line '/*' s '*/' line
- s = strip(s)
- line = strip(line)
- return s
- /* ------==========------- */
- GetObjIds: procedure expose keys.
- call SysIni 'USER', 'PM_Workplace:Location', 'ALL:', 'keys.'
- return
- /* ------==========------- */
- ObjExists: procedure expose keys.
- objid = arg(1)
- /* Check if object with Id = objid exist */
- do i = 1 to keys.0
- key = keys.i
- if objid = key then return 1
- end
- return 0
- /* ------==========------- */
- DeleteObj: procedure expose file lines,
- ObjId opts.
- if \WPToolsQueryObject(opts.location,,
- 'prop.Class1',,
- 'prop.Title1',,
- 'prop.Setup1',,
- 'prop.Location1') then do
- ret = -251
- call lineout 'stderr', 'Error 'ret': location folder doesn''t exist!'
- call lineout 'stderr', 'rc file: 'file','
- call lineout 'stderr', 'line: 'lines
- exit ret
- end
- if WPToolsFolderContent(opts.location, 'objs', 'F') then do
- ObjExists = 0
- do i = 1 to objs.0
- if WPToolsQueryObject(objs.i,,
- 'prop.Class1',,
- 'prop.Title1',,
- 'prop.Setup1',,
- 'prop.Location1')
- then do
- str = prop.Setup1
- prop.ObjId1 = ''
- do while str \= ''
- parse var str parm '=' value ';' str
- parm = translate(parm)
- value = strip(value, 'T', ';')
- if parm == 'OBJECTID' then do
- prop.ObjId1 = value
- leave
- end
- end
- if opts.name = prop.Title1 &,
- opts.class = prop.Class1 &,
- ObjId = prop.ObjId1 then do
- ObjExists = 1
- leave
- end
- end
- else do
- call lineout 'stderr', 'Can''t query object properties: 'objs.i'!'
- exit -250
- end
- end
- end
- else
- call lineout 'stderr', 'Can''t query folder content!: 'location' (WPToolsFolderContent)'
- if ObjExists then do
- call lineout 'stderr', 'Destroying 'ObjId'...'
- rc = SysDestroyObject(ObjId)
- end
- else do
- call lineout 'stderr', 'No such object 'ObjId' with given properties!'
- exit -250
- end
- return
- /* ------==========------- */
- processInstallClass: procedure
- line = arg(1)
- /* Processing of the "PM_InstallClass" lines */
- parse var line '"' class '"' . '"' module '"' .
- ret = SysRegisterObjectClass(class, module)
- if ret \= 'ERROR:' then do
- call lineout , 'Registering object class: 'class' in module: 'module', done...'
- end
- else do
- call lineout , 'Registering object class: 'class' in module: 'module', fail...'
- exit -248
- end
- return
- /* ------==========------- */
- processInstallClassRep: procedure
- line = arg(1)
- /* Processing of the "PM_InstallClassReplacement" lines */
- parse var line '"' class '"' . '"' rep '"' .
- ret = SysIni('USER', 'PM_Workplace:ReplaceList', 'ALL:', 'list.')
- if ret \= 'ERROR:' then do
- found = 0
- do i = 1 to list.0
- oldclass = list.i
- if oldclass == class then found = 1
- replist = SysIni('USER', 'PM_Workplace:ReplaceList', oldclass)
- leave
- end
- ending = '0000'x
- if found then do
- p = length(replist)
- if pos(ending, replist) == p - 1 then do
- replist = delstr(replist, p)
- replist = replist || rep || ending
- ret = SysIni('USER', 'PM_Workplace:ReplaceList', oldclass, replist)
- if ret \= 'ERROR:' then
- call lineout , 'Replacing object class: 'class' by class: 'rep', done...'
- else do
- call lineout , 'Replacing object class: 'class' by class: 'rep', fail...'
- exit -247
- end
- end
- end
- else do
- replist = rep || ending
- ret = SysIni('USER', 'PM_Workplace:ReplaceList', oldclass, replist)
- if ret \= 'ERROR:' then
- call lineout , 'Replacing object class: 'class' by class: 'rep', done...'
- else do
- call lineout , 'Replacing object class: 'class' by class: 'rep', fail...'
- exit -247
- end
- end
- end
- else do
- call lineout 'stderr', 'SysIni: can''t query keys list for ''PM_Workplace:ReplaceList''!'
- exit -247
- end
- return
- /* ------==========------- */
- processAddKey: procedure
- line = arg(1)
- /* Adding the arbitrary keys into the current .INI file */
- /*
- parse var line '"' app '"' . '"' key '"' . '"' val '"' .
- */
- call splitLine line
- ini = 'USER'
- ret = SysIni(ini, opts.app, opts.key, opts.val)
- if ret \= 'ERROR:' then do
- call lineout 'stderr', 'Setting app: '''opts.app''', key: '''opts.key''', value: '''opts.val''' in ini: '''ini''': Done...'
- end
- else do
- call lineout 'stderr', 'Setting app: '''opts.app''', key: '''opts.key''', value: '''opts.val''' in ini: '''ini''': Fail...'
- exit -246
- end
- return
- /* ------==========------- */
- GiveHelp:
- call lineout 'stderr', ''
- call lineout 'stderr', 'Syntax: crobj [global opts] [[local opts1] <file1.rc>] ... [[local optsN] <fileN.rc>]'
- call lineout 'stderr', 'or: cat <file.rc> | crobj [global opts]'
- call lineout 'stderr', 'where [global opts] can be:'
- call lineout 'stderr', '''-h'' -- Give Help'
- call lineout 'stderr', '''-I'' -- One global ini file for all selected .rc''s'
- call lineout 'stderr', '''-U'' -- Global undo: undo all the following .rc''s '
- call lineout 'stderr', ''
- call lineout 'stderr', '[local opts] can be:'
- call lineout 'stderr', '''-i'' -- local .ini file for one selected .rc '
- call lineout 'stderr', '''-u'' -- local undo: undo one the following .rc'
- call lineout 'stderr', ''
- return
- /* ------==========------- */
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement