Changeset 91


Ignore:
Timestamp:
Nov 8, 2010, 10:45:55 AM (11 years ago)
Author:
Yuri Dario
Message:

rpm: new macros for WPS object handling, courtesy of Dmitry A. Kuminov.

Location:
rpm/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • rpm/trunk/macros.in

    r70 r91  
    12041204
    12051205#------------------------------------------------------------------------
    1206 # Macros to handle creation/deletion of WPS objects
    1207 %wps_object_create /@unixroot/usr/lib/rpm/wps-object.exe %{name} /create $
    1208 
    1209 %wps_object_delete /@unixroot/usr/lib/rpm/wps-object.exe %{name} /delete $
    1210 
    1211 %wps_object_delete_all /@unixroot/usr/lib/rpm/wps-object.exe %{name} /deleteall
     1206# Macros to handle creation/deletion of WPS objects from %post* sections.
     1207# There are four single macros:
     1208#
     1209# %wps_object_create OBJECTID:SPECIFICATION
     1210# %wps_object_create_batch < FILE
     1211# %wps_object_delete OBJECTID
     1212# %wps_object_delete_all
     1213#
     1214# And one double begin-end macro:
     1215#
     1216# %wps_object_create_begin
     1217# OBJECTID:SPECIFICATION
     1218# OBJECTID:SPECIFICATION
     1219# ...
     1220# %wps_object_create_end
     1221#
     1222# All macros (except %wps_object_create_end) accept the -n option that
     1223# specifies the full package name (defaults to %{name}). The -n option
     1224# must be always used for subpackages as there is no way to detect the
     1225# subpackage name automatically.
     1226#
     1227# OBJECTID is an object identifier (w/o angle brackets). SPECIFICATION is
     1228# a string that describes the properties of the object to create and has
     1229# the following format:
     1230#
     1231#   CLASSNAME|TITLE|LOCATION[|SETUP[|OPTION]]
     1232#
     1233# Each component of this format string directly corresponds to the
     1234# respective argument of the SysCreateObject REXX function. Refer to
     1235# to the REXX reference manual for details.. Note that when OPTION is not
     1236# specified, U (update) mode is used by default.
     1237#
     1238# FILE is a text file used to create multiple objects at once: each line
     1239# in this file is an object ID followed by the specification (as described
     1240# above except that no quotes needed), like this:
     1241#
     1242#   OBJECTID:SPECIFICATION
     1243#
     1244# The double begin-end macro serves for the same purpose but doesn't requre
     1245# an external file (see below for an example).
     1246#
     1247# This indirect FILE or begin-end form is preferred and even required if one
     1248# of the object parameters contains a double forward slash (e.g. 'http://foo')
     1249# because otherwise the Classic REXX interpreter will treat it as a start of
     1250# the comment block and fail.
     1251#
     1252# Note that RPM tracks reference counting for each created object so you
     1253# may e.g. share a single WPS folder among several packages -- by creating a
     1254# folder with the same object ID in each package's %post section and
     1255# deleting it in its %postun section -- the folder will be actually removed
     1256# from the desktop only when the last package that creates it gets
     1257# uninstalled.
     1258#
     1259# Note also that each object is automatically associated with the package
     1260# it is created for so that %wps_object_delete_all knows what objects
     1261# to delete when you call it from %postun.
     1262#
     1263# Some object parameters (the LOCATION string or parts of the SETUP string such
     1264# as EXENAME) require valid OS/2 path strings as values, with back slashes
     1265# instead of forward slashes and @unixroot expanded to a full path. You may
     1266# cause this expansion by enclosing the respective part of the string in double
     1267# parenthesis. Note that double parenthesis may not be nested.
     1268#
     1269# Examples:
     1270#
     1271# %post
     1272# ...
     1273# # create objects one by one...
     1274# %wps_object_create MYAPP_FOLDER:WPFolder|My App %{version}|<WP_DESKTOP>
     1275# %wps_object_create MYAPP_EXE:WPProgram|My App|<MYAPP_FOLDER>|EXENAME=((${_bindir}/myapp.exe))
     1276#
     1277# # ...or all at once
     1278# %wps_object_create_begin
     1279# MYAPP_README:WPProgram|Read Me|<MYAPP_FOLDER>|EXENAME=e.exe;PROGTYPE=PROG_PM;PARAMETERS=(({_%docdir}/%{name}/README));OPEN=RUNNING
     1280# MYAPP_URL:WPUrl|myapp.example.com|<MYAPP_FOLDER>|URL=http://myapp.example.com
     1281# %wps_object_create_end
     1282#
     1283# %postun
     1284# ...
     1285# # delete all objects created for this package with wps_object_create*
     1286# %wps_object_delete_all
     1287#
     1288# # create objects for the subpackage 'sub'
     1289# %post sub
     1290# %wps_object_create -n %{name}-sub MYAPP_EXE:WPProgram|My Sub App|<MYAPP_FOLDER>|EXENAME=((${_bindir}/mysubapp.exe))
     1291#
     1292# # delete objects for the subpackage 'sub'
     1293# %postun sub
     1294# %wps_object_delete_all -n %{name}-sub
     1295#
     1296
     1297%wps_object_create(n:) /@unixroot/usr/lib/rpm/wps-object.exe /create %{!-n:%{name}}%{-n:%{-n*}} "%{*}"\
     1298%{nil}
     1299
     1300%wps_object_create_batch(n:) /@unixroot/usr/lib/rpm/wps-object.exe /create %{!-n:%{name}}%{-n:%{-n*}} %{*}\
     1301%{nil}
     1302
     1303%wps_object_delete(n:) /@unixroot/usr/lib/rpm/wps-object.exe /create %{!-n:%{name}}%{-n:%{-n*}} "%{*}"\
     1304%{nil}
     1305
     1306%wps_object_delete_all(n:) /@unixroot/usr/lib/rpm/wps-object.exe /deleteall %{!-n:%{name}}%{-n:%{-n*}}\
     1307%{nil}
     1308
     1309%wps_object_create_begin(n:) /@unixroot/usr/lib/rpm/wps-object.exe /create %{!-n:%{name}}%{-n:%{-n*}} <<'EOF'\
     1310%{nil}
     1311
     1312%wps_object_create_end EOF\
     1313###
    12121314
    12131315#------------------------------------------------------------------------
    12141316# OS/2 macros to handle config.sys changes (using cube script)
     1317#
    12151318%os2_boot_drive                 %{_os2_boot_drive}
    12161319%os2_unixroot_drive             %{_os2_unixroot_drive}
  • rpm/trunk/scripts/wps-object.cmd

    r51 r91  
    1 /*
    2  * wps-object 0.1 (c) 2010 Yuri Dario
    3  *
    4  * Create and delete WPS objects.
    5  * Register and deregister WPS classes.
    6  *
    7  * Keeps track of installed/removed objects into %UNIXROOT%\cache\rpm_wps\{name}
    8  *
    9  */
    10 
    11 call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
    12 call SysLoadFuncs
    13 
    14 parse arg name " " action "$" classname "$" title "$" location "$" setup "$" option
     1/* REXX */
    152
    163/*
    17 say "name:"name
    18 say "action:"action
    19 say "classname:"classname
    20 say "title:"title
    21 say "location:"location
    22 say "setup:"setup
    23 say "option:"option
    24 */
    25 
    26 /* create cache dir */
    27 UNIXROOT = VALUE('UNIXROOT',,'OS2ENVIRONMENT')
    28 cache_dir = UNIXROOT || "\var\cache\rpm_wps"
    29 rc = sysMkDir( cache_dir)
    30 cache_file = cache_dir || "\" || name
    31 
    32 /* cleanup and unescape parameters */
    33 action = convert( action)
    34 classname = convert( classname)
    35 title = convert( title)
    36 location = convert( location)
    37 setup = convert( setup)
    38 option = convert( option)
    39 
    40 select
    41 when action = "/create" then rc = create( cache_file, classname, title, location, setup, option)
    42 when action = "/delete" then rc = delete( cache_file, classname)
    43 when action = "/deleteall" then rc = deleteall( cache_file)
    44 when action = "/register" then
    45   rc = SysRegisterObjectClass( classname, title)
    46 when action = "/deregister" then
    47   rc = SysDeregisterObjectClass( classname)
    48 otherwise
    49   say "unknown opt:" action
     4 * Creates or deletes a WPS object on behalf of an RPM package.
     5 *
     6 * Usage: wps-object /create PACKAGE OBJECTID SPECIFICATION
     7 *        wps-object /create PACKAGE OBJECTID:SPECIFICATION
     8 *        wps-object /create PACKAGE < FILE
     9 *        wps-object /delete PACKAGE OBJECTID
     10 *        wps-object /recreateall PACKAGE
     11 *        wps-object /deleteall PACKAGE
     12 *
     13 * PACKAGE is a name of the RPM package. OBJECTID is an object identifier
     14 * (w/o angle brackets). SPECIFICATION is a string that describes the
     15 * properties of the object to create and has the following format (note
     16 * that the whole specification string must be taken in double quotes on
     17 * the CMD.EXE's command line if it contains spaces or special characters such
     18 * as angle bracets):
     19 *
     20 *   CLASSNAME|TITLE|LOCATION[|SETUP[|OPTION]]
     21 *
     22 * Each component of this format string directly corresponds to the
     23 * respective argument of the SysCreateObject REXX function. Refer to
     24 * to the REXX reference manual for details. Note that when OPTION is not
     25 * specified, U (update) mode is used by default.
     26 *
     27 * FILE is a text file used to create multiple objects at once: each line
     28 * in this file is an object ID followed by the specification (as described
     29 * above), like this:
     30 *
     31 *   OBJECTID:SPECIFICATION
     32 *
     33 * This indirect FILE form is preferred and even required if one of the
     34 * object parameters contains a double forward slash (e.g. 'http://foo')
     35 * because otherwise the Classic REXX interpreter will treat it as a start of
     36 * the comment block and fail.
     37 *
     38 * Note that /create and /delete commands maintain a global reference
     39 * counter for each object (shared by all packages): /create increases
     40 * this counter by 1, /delete decreases it by 1. The object is actually
     41 * deleted only when its counter becomes zero.
     42 *
     43 * /deleteall deletes all objects created for a given package at once (in
     44 * the order opposite to creation). /recreateall recreataes all object
     45 * created for a given package which is useful if the package objects were
     46 * accidentially deleted (w/o removing the package itself).
     47 *
     48 * Some object parameters (the LOCATION string or parts of the SETUP string such
     49 * as EXENAME) require valid OS/2 path strings as values, with back slashes
     50 * instead of forward slashes and @unixroot expanded to a full path. You may
     51 * cause this expansion by enclosing the respective part of the string in double
     52 * parenthesis. Note that double parenthesis may not be nested.
     53 *
     54 * Author: Dmitry A. Kuminov
     55 * Version: 1.0 - 2010-11-08
     56 */
     57
     58trace off
     59numeric digits 12
     60'@echo off'
     61
     62/*------------------------------------------------------------------------------
     63 globals
     64------------------------------------------------------------------------------*/
     65
     66/* all globals to be exposed in procedures */
     67Globals = 'G. Opt. Static.'
     68
     69G.ObjectRefs = ''
     70G.ObjectRefs.!modified = 0
     71
     72G.PackageObjects.0 = 0
     73G.PackageObjects.!modified = 0
     74G.PackageObjects.!removed = 0
     75
     76G.UndoCreateID = ''
     77
     78G.InvalidObjectIDChars = '<>,;:|'
     79
     80/*------------------------------------------------------------------------------
     81 startup + main + termination
     82------------------------------------------------------------------------------*/
     83
     84/* init system REXX library */
     85if (RxFuncQuery('SysLoadFuncs')) then do
     86    call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
     87    call SysLoadFuncs
    5088end
    5189
    52 if rc = 0 then say 'Operation failed!'
    53 
    54 exit 0
    55 
    56 
    57 create: procedure
    58   parse arg cache, classname, title, location, setup, option
    59 
    60   if left(location,1) \= '<' then
    61     location = '<' || location || '>'
    62 
    63   if option = '' then option = 'update'
    64 
    65   rc = SysCreateObject( classname, title, location, setup, option)
    66 
    67   call lineout cache, classname || x2c(7) || title || x2c(7) || location || x2c(7) || setup || x2c(7) || option
    68   call lineout cache
    69   return rc
    70 
    71 
    72 delete: procedure
    73   parse arg cache, objid
    74 
    75   if left(objid,1) \= '<' then
    76     objid = '<' || objid || '>'
    77   rc = SysDestroyObject( objid)
    78 
    79   /* remove id from cache file if specified */
    80   if cache = '' then
     90parse arg aArgs
     91call TokenizeString aArgs, 'G.Args'
     92
     93return Main()
     94
     95/*------------------------------------------------------------------------------
     96 functions
     97------------------------------------------------------------------------------*/
     98
     99/**
     100 * Just do the job.
     101 *
     102 * @param aArgs Comand line arguments.
     103 * @return      0 on success, error code on failure.
     104 */
     105Main: procedure expose (Globals)
     106
     107    if (G.Args.0 == 0) then call Usage
     108
     109    cmd = translate(G.Args.1)
     110    select
     111        when (cmd == '/CREATE') then cmd = 'C'
     112        when (cmd == '/DELETE') then cmd = 'D'
     113        when (cmd == '/RECREATEALL') then cmd = 'RA'
     114        when (cmd == '/DELETEALL') then cmd = 'DA'
     115        otherwise do
     116            say 'ERROR: Invalid command "'G.Args.1'".'
     117            return 1
     118        end
     119    end
     120
     121    if (G.Args.0 < 2) then do
     122        say 'ERROR: Missing package name.'
     123        return 1
     124    end
     125    pkg = G.Args.2
     126
     127    readStdIn = 0
     128
     129    if (cmd == 'C' & G.Args.0 < 3) then do
     130        readStdIn = 1
     131    end
     132    else if (cmd == 'C' | cmd == 'D') then do
     133        if (G.Args.0 < 3) then do
     134            say 'ERROR: Missing object ID.'
     135            return 1
     136        end
     137        id = G.Args.3
     138
     139        if (cmd == 'C') then do
     140            spec = ''
     141            /* if this is a combined form, split it */
     142            if (pos(':', id) > 0) then parse var id id':'spec
     143            else if (G.Args.0 >= 4) then spec = G.Args.4
     144            if (spec == '') then do
     145                say 'ERROR: Missing object specification.'
     146                return 1
     147            end
     148        end
     149
     150        if (verify(id, G.InvalidObjectIDChars, 'M') > 0) then do
     151            say 'ERROR: Object ID "'id'" contains invalid characters.'
     152            return 1
     153        end
     154    end
     155
     156    ux = value('UNIXROOT',,'OS2ENVIRONMENT')
     157    if (ux == '') then do
     158        say 'ERROR: UNIXROOT environment variable is not set.'
     159        return 1
     160    end
     161
     162    G.ObjectRefsFile = FixDir(ux'/var/cache/rpm/wps/objects')
     163    G.PackageDir = FixDir(ux'/var/cache/rpm/wps/packages')
     164
     165    /* Read object refs */
     166    if (FileExists(G.ObjectRefsFile)) then do
     167        G.ObjectRefs = charin(G.ObjectRefsFile, 1, chars(G.ObjectRefsFile))
     168        if (\FileOk(G.ObjectRefsFile)) then do
     169            rc = FileErrorCode(G.ObjectRefsFile)
     170            say 'ERROR: Could not read "'G.ObjectRefsFile'" (rc='rc').'
     171            return rc
     172        end
     173        call charout G.ObjectRefsFile
     174    end
     175
     176    /* Read package object list */
     177    pkgFile = G.PackageDir'\'pkg
     178    if (FileExists(pkgFile)) then do
     179        i = 0
     180        do while lines(pkgFile)
     181            i = i + 1
     182            str = linein(pkgFile)
     183            if (\FileOk(pkgFile)) then do
     184                rc = FileErrorCode(pkgFile)
     185                say 'ERROR: Could not read "'pkgFile'" (rc='rc').'
     186                return rc
     187            end
     188            parse var str s1':'s2 /* id:spec */
     189            if (s1 == '' | verify(s1, G.InvalidObjectIDChars, 'M') > 0 |,
     190                s2 == '') then do
     191                rc = -1
     192                say 'ERROR: Line #'i 'in file "'pkgFile'" is invalid.'
     193                return rc
     194            end
     195            G.PackageObjects.i = str
     196            G.PackageObjects.i.!id = s1
     197            G.PackageObjects.!map.s1 = i
     198        end
     199        G.PackageObjects.0 = i
     200        call lineout pkgFile
     201    end
     202
     203    if (cmd == 'C') then do
     204        if (readStdIn) then do
     205            rc = 0
     206            do while lines()
     207                str = linein()
     208                if (strip(str) == '') then iterate
     209                parse var str id':'spec
     210                rc = CreateObject(id, spec)
     211                if (rc \= 0) then leave
     212            end
     213        end
     214        else do
     215            rc = CreateObject(id, spec)
     216        end
     217    end
     218    else if (cmd == 'D') then do
     219        rc = DeleteObject(id)
     220    end
     221    else if (cmd == 'RA') then do
     222        rc = 0
     223        do i = 1 to G.PackageObjects.0
     224            parse var G.PackageObjects.i id':'spec
     225            rc = CreateObject(id, spec)
     226            if (rc \= 0) then leave
     227        end
     228    end
     229    else if (cmd == 'DA') then do
     230        rc = 0
     231        do i = G.PackageObjects.0 to 1 by -1
     232            rc = DeleteObject(G.PackageObjects.i.!id)
     233            if (rc \= 0) then leave
     234        end
     235    end
     236
     237    /* save object refs */
     238    if (G.ObjectRefs.!modified) then do
     239        rc = EnsureFileDir(G.ObjectRefsFile)
     240        if (rc = 0) then do
     241            refsFileTmp = SysTempFileName(G.ObjectRefsFile'.?????.tmp')
     242            rc = charout(refsFileTmp, G.ObjectRefs)
     243            if (rc \= 0 | \FileOk(refsFileTmp)) then do
     244                rc = FileErrorCode(refsFileTmp)
     245                say 'ERROR: Could not write to "'refsFileTmp'" (rc='rc').'
     246            end
     247            else do
     248                call lineout refsFileTmp
     249                rc = SafeRename(refsFileTmp, G.ObjectRefsFile)
     250            end
     251        end
     252        if (rc \= 0) then do
     253            G.PackageObjects.!modified = 0
     254        end
     255    end
     256
     257    /* save package object list */
     258    if (G.PackageObjects.!modified) then do
     259        if (G.PackageObjects.0 = G.PackageObjects.!removed) then do
     260            rc = SysFileDelete(pkgFile)
     261            if (rc \= 0) then do
     262                say 'ERROR: Could not delete "'pkgFile'".'
     263            end
     264        end
     265        else do
     266            rc = EnsureFileDir(pkgFile)
     267            if (rc = 0) then do
     268                pkgFileTmp = SysTempFileName(pkgFile'.?????.tmp')
     269                do i = 1 to G.PackageObjects.0
     270                    if (G.PackageObjects.i == '') then iterate /* skip removed */
     271                    rc = lineout(pkgFileTmp, G.PackageObjects.i)
     272                    if (rc \= 0 | \FileOk(pkgFileTmp)) then do
     273                        rc = FileErrorCode(pkgFileTmp)
     274                        say 'ERROR: Could not write to "'pkgFileTmp'" (rc='rc').'
     275                        leave
     276                    end
     277                end
     278                if (rc = 0) then do
     279                    call lineout pkgFileTmp
     280                    rc = SafeRename(pkgFileTmp, pkgFile)
     281                end
     282            end
     283        end
     284    end
     285
     286    if (rc \= 0 & G.UndoCreateID \== '') then do
     287        call SysDestroyObject '<'G.UndoCreateID'>'
     288    end
     289
    81290    return rc
    82291
    83   /* move to temp file */
    84   cache_bak = cache || ".bak"
    85   rc2 = SysFileDelete( cache_bak)
    86   '@move 'cache ' ' cache_bak ' > \dev\nul 2> \dev\nul'
    87   /* scan list */
    88   do while( lines( cache_bak))
    89     setup = linein( cache_bak)
    90     if pos( objid, setup) = 0 then
    91       call lineout cache, setup
    92   end
    93   /* close file */
    94   call lineout cache
    95 
    96   /* delete temp file */
    97   rc2 = SysFileDelete( cache_bak)
    98 
    99   return rc
    100 
    101 
    102 deleteall: procedure
    103   parse arg cache
    104 
    105   i = 0
    106 
    107   /* scan list */
    108   do while( lines( cache))
    109     setup = linein( cache) || ';'
    110     o = pos( 'OBJECTID=', setup)
    111     if o > 0 then do
    112       t = pos( ';', setup, o)
    113       objid = substr( setup, o+9, t - o - 9)
    114       list.i = objid
    115       i = i + 1
    116     end
    117   end
    118   /* close file */
    119   call lineout cache
    120 
    121   /* delete in reverse order */
    122   do j = 1 to i
    123     o = i - j
    124     rc = delete( '', list.o)
    125   end
    126 
    127   /* delete temp file */
    128   rc2 = SysFileDelete( cache)
    129 
    130   return 1
    131 
    132 convert: procedure
    133   parse arg _str
    134 
    135   _str = strip( _str)
    136   if left(_str,1) = '"' & right(_str,1) = '"' then
    137      _str = substr(_str,2,length(_str)-2)
    138 
    139   c = pos('#lt#',_str)
    140   if c>0 then _str = left(_str,c-1) || '<' || substr(_str,c+4)
    141 
    142   c = pos('#gt#',_str)
    143   if c>0 then _str = left(_str,c-1) || '>' || substr(_str,c+4)
    144 
    145   c = pos('#35#',_str)
    146   if c>0 then _str = left(_str,c-1) || '#' || substr(_str,c+4)
    147 
    148   c = pos('#36#',_str)
    149   if c>0 then _str = left(_str,c-1) || '$' || substr(_str,c+4)
    150 
    151   return _str
     292/**
     293 * Creates a WPS object.
     294 *
     295 * @param aID   Object ID.
     296 * @param aSpec Object specification string.
     297 * @return      0 on success, error code on failure.
     298 */
     299CreateObject: procedure expose (Globals)
     300
     301    parse arg aID, aSpec
     302
     303    aSpec = ExpandUnixRoot(aSpec)
     304
     305    parse var aSpec class'|'title'|'location'|'setup'|'option
     306    if (class == '' | title == '' | location == '') then do
     307        say 'ERROR: Specification "'aSpec'" is invalid.'
     308        return 1
     309    end
     310    if (pos('OBJECTID=', setup) > 0) then do
     311        say 'ERROR: Specification string must not contain OBJECTID.'
     312        return 1
     313    end
     314
     315    if (setup \== '') then setup = setup';'
     316    setup = setup'OBJECTID=<'aID'>'
     317
     318    if (option == '') then option = 'U' /* Update by default */
     319
     320    rc = SysCreateObject(class, title, location, setup, option)
     321    if (rc \== 1) then do
     322        say 'ERROR: Could not create an object with ID <'aID'> and',
     323            'specification "'aSpec'".'
     324        return 1
     325    end
     326
     327    ok = 1
     328
     329    /* check if there is an object with this id for this package */
     330    if (symbol('G.PackageObjects.!map.'aID) == 'VAR') then do
     331        /* update it */
     332        i = G.PackageObjects.!map.aID
     333        G.PackageObjects.i = aID':'aSpec
     334        G.PackageObjects.!modified = 1
     335    end
     336    else do
     337        /* add a new */
     338        i = G.PackageObjects.0 + 1
     339        G.PackageObjects.i = aID':'aSpec
     340        G.PackageObjects.i.!id = aID
     341        G.PackageObjects.!map.aID = i
     342        G.PackageObjects.0 = i
     343        G.PackageObjects.!modified = 1
     344
     345        /* increase the refcount */
     346        i = pos('<'aID'>', G.ObjectRefs)
     347        if (i == 0) then do
     348            G.ObjectRefs = G.ObjectRefs'<'aID'>1'
     349            G.ObjectRefs.!modified = 1
     350            /* mark as a candidate for undoing creation on failure */
     351            G.UndoCreateID = aID
     352        end
     353        else do
     354            ok = 0
     355            j = i + length(aId) + 2
     356            if (j <= length(G.ObjectRefs)) then do
     357                k = pos('<', G.ObjectRefs, j)
     358                if (k = 0) then k = length(G.ObjectRefs) + 1
     359                refcnt = substr(G.ObjectRefs, j, k - j)
     360                if (datatype(refcnt, 'W') & refcnt >= 0) then do
     361                    refcnt = refcnt + 1
     362                    G.ObjectRefs = delstr(G.ObjectRefs, i, k - i)
     363                    G.ObjectRefs = insert('<'aID'>'refcnt, G.ObjectRefs, i - 1)
     364                    G.ObjectRefs.!modified = 1
     365                    ok = 1
     366                end
     367            end
     368        end
     369        if (\ok) then do
     370            say 'ERROR: Object reference file "'G.ObjectRefsFile'" is invalid',
     371                'near object ID <'aID'>.'
     372            G.PackageObjects.!modified = 0
     373        end
     374    end
     375
     376    return (ok == 0)
     377
     378/**
     379 * Deletes a WPS object.
     380 *
     381 * @param aID   Object ID.
     382 * @return      0 on success, error code on failure.
     383 */
     384DeleteObject: procedure expose (Globals)
     385
     386    parse arg aID
     387
     388    /* check if there is an object with this id for this package */
     389    if (symbol('G.PackageObjects.!map.'aID) \== 'VAR') then do
     390        /* nothing to do */
     391        return 0
     392    end
     393
     394    /* mark as removed */
     395    i = G.PackageObjects.!map.aID
     396    G.PackageObjects.i = ''
     397    G.PackageObjects.!removed = G.PackageObjects.!removed + 1
     398    G.PackageObjects.!modified = 1
     399
     400    ok = 1
     401
     402    /* decrease the refcount */
     403    i = pos('<'aID'>', G.ObjectRefs)
     404    if (i == 0) then do
     405        /* there must be an object with this ID... */
     406        ok = 0
     407    end
     408    else do
     409        ok = 0
     410        j = i + length(aId) + 2
     411        if (j <= length(G.ObjectRefs)) then do
     412            k = pos('<', G.ObjectRefs, j)
     413            if (k = 0) then k = length(G.ObjectRefs) + 1
     414            refcnt = substr(G.ObjectRefs, j, k - j)
     415            if (datatype(refcnt, 'W') & refcnt > 0) then do
     416                refcnt = refcnt - 1
     417                G.ObjectRefs = delstr(G.ObjectRefs, i, k - i)
     418                if (refcnt > 0) then do
     419                    G.ObjectRefs = insert('<'aID'>'refcnt, G.ObjectRefs, i - 1)
     420                end
     421                else do
     422                    call SysDestroyObject '<'aID'>'
     423                end
     424                G.ObjectRefs.!modified = 1
     425                ok = 1
     426            end
     427        end
     428    end
     429    if (\ok) then do
     430        say 'ERROR: Object reference file "'G.ObjectRefsFile'" is invalid',
     431            'near object ID <'aID'>.'
     432        G.PackageObjects.!modified = 0
     433    end
     434
     435    return (ok == 0)
     436
     437/**
     438 * Print usage information.
     439 */
     440Usage: procedure expose (Globals)
     441
     442    say 'This script is intended to be run by RPM only.'
     443    exit 0
     444
     445/**
     446 * Expands "/@unixroot" to the value of the UNIXROOT environment variable and
     447 * replaces all forward slashes with back slashes in parts of the given string
     448 * enclosed with double parenthesis. Parenthesis are removed after expansion.
     449 *
     450 * @param aString   String to expand double-parenthesed parts in.
     451 * @return          Setring with parts expanded.
     452 */
     453ExpandUnixRoot: procedure expose (Globals)
     454
     455    parse arg aString
     456
     457    i = 1
     458    do forever
     459        i = pos('((', aString, i)
     460        if (i <= 0) then leave
     461        j = pos('))', aString, i + 2)
     462        if (j <= 0) then leave
     463        str = substr(aString, i + 2, j - i - 2)
     464        str = Replace(str, '/@unixroot', value('UNIXROOT',,'OS2ENVIRONMENT'))
     465        str = translate(str, '\', '/')
     466        aString = delstr(aString, i, j - i + 2)
     467        aString = insert(str, aString, i - 1)
     468        i = i + length(str)
     469    end
     470
     471    return aString
     472
     473/**
     474 * Creates a directory for the given file.
     475 *
     476 * @param aFile     File name.
     477 * @return          0 on success or an error code on failure.
     478 */
     479EnsureFileDir: procedure expose (Globals)
     480
     481    parse arg aFile
     482
     483    dir = FixDir(filespec('D', aFile)||filespec('P', aFile))
     484    rc = MakeDir(dir)
     485    if (rc \= 0) then do
     486        say 'ERROR: Could not make directory "'dir'" (rc='rc').'
     487        return rc
     488    end
     489
     490    return 0
     491
     492/**
     493 * Renames one file to another. Both files must reside in the same directory.
     494 * If the target file exists, it will be silently deleted before renaming the
     495 * source file (that must exist) to it.
     496 *
     497 * @param aFileFrom     Current file name.
     498 * @param aFileTo       New file name.
     499 * @return              0 on success or an error code on failure.
     500 */
     501SafeRename: procedure expose (Globals)
     502
     503    parse arg aFileFrom, aFileTo
     504
     505    dirFrom = FixDir(filespec('D', aFileFrom)||filespec('P', aFileFrom))
     506    dirTo = FixDir(filespec('D', aFileTo)||filespec('P', aFileTo))
     507    if (translate(dirFrom) \== translate(dirTo)) then do
     508        say 'ERROR: "'aFileFrom'" and "'aFileTo'" must reside in the same',
     509            'directory.'
     510        return -1
     511    end
     512
     513    if (FileExists(aFileTo)) then do
     514        rc = SysFileDelete(aFileTo)
     515        if (rc \= 0) then do
     516            say 'ERROR: Could not delete "'aFileTo'" (rc='rc').'
     517            return rc
     518        end
     519    end
     520
     521    address 'cmd' 'rename 'aFileFrom filespec('N', aFileTo)
     522    if (rc \= 0) then do
     523        say 'ERROR: Could not rename "'aFileFrom'" to "'aFileTo'" (rc='rc').'
     524        return rc
     525    end
     526
     527    return 0
     528
     529MakeDir: procedure expose (Globals)
     530    parse arg aDir
     531    aDir = translate(aDir, '\', '/')
     532    curdir = directory()
     533    base = aDir
     534    todo.0 = 0
     535    do while 1
     536        d = directory(base)
     537        if (d \== '') then
     538            leave
     539        i = todo.0 + 1
     540        todo.i = filespec('N', base)
     541        todo.0 = i
     542        drv = filespec('D', base)
     543        path = filespec('P', base)
     544        if (path == '\' | path == '') then do
     545            base = drv||path
     546            leave
     547        end
     548        base = drv||strip(path, 'T', '\')
     549    end
     550    call directory curdir
     551    do i = todo.0 to 1 by -1
     552        if (i < todo.0 | (base \== '' & right(base,1) \== '\' &,
     553                                        right(base,1) \== ':')) then
     554            base = base'\'
     555        base = base||todo.i
     556        rc = SysMkDir(base)
     557        if (rc \= 0) then return rc
     558    end
     559    return 0
     560
     561/**
     562 *  Fixes the directory path by a) converting all slashes to back
     563 *  slashes and b) ensuring that the trailing slash is present if
     564 *  the directory is the root directory, and absent otherwise.
     565 *
     566 *  @param dir      the directory path
     567 *  @param noslash
     568 *      optional argument. If 1, the path returned will not have a
     569 *      trailing slash anyway. Useful for concatenating it with a
     570 *      file name.
     571 */
     572FixDir: procedure expose (Globals)
     573    parse arg dir, noslash
     574    noslash = (noslash = 1)
     575    dir = translate(dir, '\', '/')
     576    if (right(dir, 1) == '\' &,
     577        (noslash | \(length(dir) == 3 & (substr(dir, 2, 1) == ':')))) then
     578        dir = substr(dir, 1, length(dir) - 1)
     579    return dir
     580
     581/**
     582 *  Returns 1 if the specified file exists and 0 otherwise.
     583 */
     584FileExists: procedure expose (Globals)
     585    parse arg file
     586    return (GetAbsFilePath(file) \= '')
     587
     588/**
     589 *  Returns 1 if the specified file status is other than READY or NOTREADY.
     590 */
     591FileOk: procedure expose (Globals)
     592    parse arg aFile
     593    status = stream(file, 'S')
     594    return (status \= 'READY' & status \= 'NOTREADY')
     595
     596/**
     597 * Returns the error code of the specified file or -1 if the error code is
     598 * not available. Should only be called if FileOk() returns false.
     599 */
     600FileErrorCode: procedure expose (Globals)
     601    parse arg file
     602    parse value stream(file, 'D') with .':'rc
     603    if (datatype(rc) \= 'W') then rc = -1
     604    return rc
     605
     606/**
     607 *  Returns the absolute path to the given file (including the filename)
     608 *  or an empty string if no file exists.
     609 */
     610GetAbsFilePath: procedure expose (Globals)
     611    parse arg file
     612    if (file \= '') then do
     613        file = stream(FixDir(file), 'C', 'QUERY EXISTS')
     614    end
     615    return file
     616
     617/**
     618 *  Replaces all occurences of a given substring in a string with another
     619 *  substring.
     620 *
     621 *  @param  str the string where to replace
     622 *  @param  s1  the substring which to replace
     623 *  @param  s2  the substring to replace with
     624 *  @return     the processed string
     625 *
     626 *  @version 1.1
     627 */
     628Replace: procedure expose (Globals)
     629    parse arg str, s1, s2
     630    l1  = length(s1)
     631    l2  = length(s2)
     632    i   = 1
     633    do while (i > 0)
     634        i = pos(s1, str, i)
     635        if (i > 0) then do
     636            str = delstr(str, i, l1)
     637            str = insert(s2, str, i-1)
     638            i = i + l2
     639        end
     640    end
     641    return str
     642
     643/**
     644 *  Returns a list of all words from the string as a stem.
     645 *  Delimiters are spaces, tabs and new line characters.
     646 *  Words containg spaces must be enclosed with double
     647 *  quotes. Double quote symbols that need to be a part
     648 *  of the word, must be doubled.
     649 *
     650 *  @param string   the string to tokenize
     651 *  @param stem
     652 *      the name of the stem. The stem must be global
     653 *      (i.e. its name must start with 'G.!'), for example,
     654 *      'G.!wordlist'.
     655 *  @param leave_ws
     656 *      1 means whitespace chars are considered as a part of words they follow.
     657 *      Leading whitespace (if any) is always a part of the first word (if any).
     658 *
     659 *  @version 1.1
     660 */
     661TokenizeString: procedure expose (Globals)
     662
     663    parse arg string, stem, leave_ws
     664    leave_ws = (leave_ws == 1)
     665
     666    delims  = '20090D0A'x
     667    quote   = '22'x /* " */
     668
     669    num = 0
     670    token = ''
     671
     672    len = length(string)
     673    last_state = '' /* D - in delim, Q - in quotes, W - in word */
     674    seen_QW = 0
     675
     676    do i = 1 to len
     677        c = substr(string, i, 1)
     678        /* determine a new state */
     679        if (c == quote) then do
     680            if (last_state == 'Q') then do
     681                /* detect two double quotes in a row */
     682                if (substr(string, i + 1, 1) == quote) then i = i + 1
     683                else state = 'W'
     684            end
     685            else state = 'Q'
     686        end
     687        else if (verify(c, delims) == 0 & last_state \== 'Q') then do
     688            state = 'D'
     689        end
     690        else do
     691            if (last_state == 'Q') then state = 'Q'
     692            else state = 'W'
     693        end
     694        /* process state transitions */
     695        if ((last_state == 'Q' | state == 'Q') & state \== last_state) then c = ''
     696        else if (state == 'D' & \leave_ws) then c = ''
     697        if (last_state == 'D' & state \== 'D' & seen_QW) then do
     698            /* flush the token */
     699            num = num + 1
     700            call value stem'.'num, token
     701            token = ''
     702        end
     703        token = token||c
     704        last_state = state
     705        seen_QW = (seen_QW | state \== 'D')
     706    end
     707
     708    /* flush the last token if any */
     709    if (token \== '' | seen_QW) then do
     710        num = num + 1
     711        call value stem'.'num, token
     712    end
     713
     714    call value stem'.0', num
     715
     716    return
     717
Note: See TracChangeset for help on using the changeset viewer.