home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pcre34.zip / PCRE34L.ZIP / rexxpcre.rexx < prev    next >
OS/2 REXX Batch file  |  2000-11-22  |  8KB  |  250 lines
  1. /*---------------------------------------------------------------------
  2. Copyright (c) 2000-2001, Vadim Yegorov
  3. All rights reserved.
  4.  
  5. Redistribution and use in source and binary forms, with or without
  6. modification, are permitted provided that the following conditions are met:
  7.  
  8. Redistributions of source code must retain the above copyright notice,
  9. this list of conditions and the following disclaimer.
  10.  
  11. Redistributions in binary form must reproduce the above copyright notice,
  12. this list of conditions and the following disclaimer in the documentation
  13. and/or other materials provided with the distribution.
  14.  
  15. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  16. CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  17. INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  18. MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  19. DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
  20. LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
  21. OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  22. PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  23. DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  24. ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  25. LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
  26. IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
  27. THE POSSIBILITY OF SUCH DAMAGE.
  28. ---------------------------------------------------------------------*/
  29.  
  30. call  RxFuncAdd  'PCRELoad', 'REXXPCRE', 'PCRELoad'
  31. call  PCRELoad
  32.  
  33. /*-------------------------------------------------------------------------*/
  34. /**
  35.  * è½áßß RxPCRE »αÑñßΓáó½∩ÑΓ «ß¡«ó¡δÑ ¼ÑΓ«ñδ ñ½∩ αáí«Γδ ß αÑúπ½∩α¡δ¼¿
  36.  * óδαáªÑ¡¿∩¼¿ ¿ ∩ó½∩ÑΓß∩ πñ«í¡«⌐ "«í±αΓ¬«⌐" ñ½∩ í¿í½¿«ΓѬ¿ libpcre.
  37.  */
  38. ::class RxPCRE public
  39.     /* ¿¡¿µ¿á½¿º¿απÑΓ «íΩѬΓ. »áαá¼ÑΓαδ: ½«¬á½∞*/
  40.     ::method init
  41.         expose curLocale curMask pcre lasterr pairs
  42.         use arg loc
  43.         if  VAR('LOC') then
  44.             curLocale = PCREInit(loc);
  45.         else
  46.             curLocale = PCREInit("");
  47.         curMask = "";    /* current mask */
  48.         pcre    = "";    /* «íΩѬΓ, σαá¡∩Θ¿⌐ «Γ¬«¼»½¿α«óá¡¡«Ñ óδαáªÑ¡¿Ñ */
  49.         lasterr = 0 ;    /* ¡ÑΓ «Φ¿í«¬ ?! ;)*/
  50.         pairs   = 0 ;
  51.         return self;
  52.     /* ó«ºóαáΘáÑΓ ½«¬á½∞, »α¿¼Ñ¡±¡¡πε ñ½∩ PCRE */
  53.     ::method getLocale
  54.         expose curLocale
  55.         return curLocale;
  56.  
  57.     /* ó«ºóαáΘáÑΓ ¿ß»«½∞ºπѼπε ¼á߬π*/
  58.     ::method getMask
  59.         expose curMask
  60.         return curMask;
  61.  
  62.     /** ¬«¼»¿½¿απÑΓ ¼á߬π.
  63.      *  @syntax rc = setMask(mask)
  64.      *  @param mask αÑúπ½∩α¡«Ñ óδαáªÑ¡¿Ñ ó ¡«Γᵿ¿ PERL'a: /regexp/[options]
  65.      *  @return ¬«ñ «Φ¿í¬¿, 0 -- «Φ¿í«¬ ¡ÑΓ
  66.      */
  67.     ::method setMask
  68.         expose curMask pcre lasterr pairs subs
  69.         use arg mask
  70.         lasterr = PCRECompile('pcre_tmp', mask);
  71.         if lasterr = 0 then do
  72.             curMask = mask;
  73.             pcre = pcre_tmp;
  74.             /*-- mask analyzing --*/
  75.             n = 0; pairs = 1; l = mask~length
  76.             do i = 1 to l
  77.               ch = mask~substr(i,1);
  78.               if ch = '(' then
  79.                   n = n + 1;
  80.               if ch = ')' then do
  81.                   n = n - 1;
  82.                   if n = 0 then
  83.                       pairs = pairs + 1;
  84.               end
  85.             end
  86.             subs = .array~new(pairs);
  87.         end
  88.         return lasterr
  89.  
  90.     /** »«¿ß¬ Σαáú¼Ñ¡Γ«ó
  91.      * @syntax rc = find(ofs_stem., str, [start_pos [,opts]])
  92.      * @param ofs_stem  ßΓѼ ß¼ÑΘÑ¡¿⌐, ofs_stem.0 -- τ¿ß½« φ½Ñ¼Ñ¡Γ«ó
  93.      * @param str       ßΓ᫬á
  94.      * @param start_pos ßΓáαΓ«óá∩ »«º¿µ¿∩, ¡Ñ«í∩ºáΓѽѡ
  95.      * @param opt «»µ¿¿, ¡Ñ«í∩ºáΓѽѡ, αáºαÑΦÑ¡δ Γ«½∞¬«:
  96.      *      A -  Anchored
  97.      *      b -  Not begin of line
  98.      *      e -  Not end of line
  99.      *      g -  Not empty
  100.      *
  101.      * @return ¬«ñ «Φ¿í¬¿
  102.      */
  103.     ::method find
  104.         expose pcre ofs lasterr
  105.         use arg L., str, pos, opts
  106.         if \VAR('POS') then
  107.             pos = 1;
  108.         if \VAR('OPTS') then
  109.             opts = "";
  110.         if \VAR('STR') then
  111.             str = "";
  112.  
  113.         lasterr = PCREExec(L,pcre,str,pos,opts);
  114.         if lasterr = -1 then
  115.             L.0 = 0;
  116.  
  117.         return lasterr;
  118.  
  119.  
  120.     /** »«¿ß¬ Σαáú¼Ñ¡Γ«ó
  121.      * @syntax rc = findSubs(str, [start_pos [,opts]])
  122.      * @param str       ßΓ᫬á
  123.      * @param start_pos ßΓáαΓ«óá∩ »«º¿µ¿∩, ¡Ñ«í∩ºáΓѽѡ
  124.      * @param opt «»µ¿¿, ¡Ñ«í∩ºáΓѽѡ, αáºαÑΦÑ¡δ Γ«½∞¬«:
  125.      *      A -  Anchored
  126.      *      b -  Not begin of line
  127.      *      e -  Not end of line
  128.      *      g -  Not empty
  129.      *
  130.      * @return ¼áßß¿ó ßΓ᫬, ß«ñÑαªáΘ¿σ Σαáú¼Ñ¡Γδ ¿½¿ nil
  131.      *
  132.      */
  133.     ::method findSubs
  134.         expose pcre ofs lasterr subs
  135.         use arg str, pos, opts
  136.         if \VAR('POS') then
  137.             pos = 1;
  138.         if \VAR('OPTS') then
  139.             opts = "";
  140.         lasterr = PCREExec('LO',pcre,str,pos,opts);
  141.  
  142.         if lasterr = 0 then do
  143.             n = 1;
  144.             do j = 1 to lo.0 by 2
  145.                 k = j; kk = k + 1;
  146.                 subs[n] = str~substr(lo.k, lo.kk - lo.k);
  147.                 n = n + 1;
  148.             end
  149.         end; else
  150.             return .nil;
  151.         return subs;
  152.  
  153.     /**
  154.      * ó«ºóαáΘáÑΓ ¬«ñ ºáóÑαΦÑ¡¿∩ »«ß½Ññ¡Ñ⌐ «»Ñαᵿ¿
  155.      *
  156.      * @return RC, 0 -- «Φ¿í«¬ ¡ÑΓ, -1 -- »«¿ß¬ ¡Ñπß»ÑΦÑ¡
  157.      *
  158.      */
  159.     ::method lastError
  160.         expose lasterr
  161.         return lasterr
  162.  
  163.     /**
  164.      * ó«ºóαáΘáÑΓ óÑαß¿ε libpcre
  165.      *
  166.      * @return ßΓ᫬á óÑαß¿¿
  167.      */
  168.     ::method getVersion
  169.         return PCREVersion();
  170.     /**
  171.      * ó«ºóαáΘáÑΓ óÑαß¿ε rxlibpcre
  172.      *
  173.      * @return ßΓ᫬á óÑαß¿¿
  174.      */
  175.     ::method getRxVersion
  176.         return PCRERxVersion();
  177.  
  178.     /**
  179.      * ó«ºóαáΘáÑΓ ßΓ᫬π ß ¿¼Ñ¡Ñ¼ áóΓ«αá í¿í½¿«ΓѬ¿ libpcre
  180.      *
  181.      */
  182.     ::method getAuthor
  183.         return PCREAuthor();
  184.  
  185.     /**
  186.      * ó«ºóαáΘáÑΓ ßΓ᫬π ß ¿¼Ñ¡Ñ¼ áóΓ«αá »«αΓá.
  187.      */
  188.     ::method getPortAuthor
  189.         return PCREPortAuthor();
  190.  
  191. /*-------------------------------------------------------------------------*/
  192. /** è½áßß »αÑñßΓáó½∩ÑΓ ß«í«⌐ ¡Ñ¬¿⌐ á¡á½«ú ¬«ßΓαπ¬µ¿¿ Perl'a:
  193.  *  ($a, $b, $c) = /mask/ or do smt
  194.  *  »α¿¼Ñα¡δ⌐ ¬«ñ ñ½∩ αáí«Γδ Γᬫ⌐:
  195.  *  if re~parse(string_for_parsing) then
  196.  *     call re[1], re[2], re[3];
  197.  * ¬áªñá∩ úαπ»»á '()' ó ¼á߬Ѡñá±Γ «ñ¿¡ φ½Ñ¼Ñ¡Γ
  198.  */
  199. ::class RxStrParser subclass RxPCRE public
  200.     ::method init
  201.         expose  ofs. slots instr
  202.         use arg l
  203.         super~new(l); /* set locale*/
  204.         ofs.0 = 0;
  205.         slots = 0;
  206.         instr = "";
  207.         return self;
  208.     /** αáºí¿αáÑΓ ßΓ᫬π
  209.       * @syntax rc = re~parse(string_for_parsing,[pos,[opts]])
  210.       * @return 1 -- Ñß½¿ ßΓ᫬á íδ½á αẫíαá¡á, ¿¡áτÑ 0 ¿
  211.       *              «τÑ¡∞ αѬ«¼Ñ¡ñπÑΓß∩ »«ß¼«ΓαÑΓ∞ ¡á «Φ¿í¬¿.
  212.      */
  213.     ::method parse
  214.         expose ofs. slots instr
  215.         use arg str , pos, opts
  216.         if \VAR('POS') then
  217.             pos = 1;
  218.         if \VAR('OPTS') then
  219.             opts = "";
  220.  
  221.         if  self~find(ofs.,str,pos,opts) = 0 then do
  222.             /* found */
  223.             slots = ofs.0/2;
  224.             instr = str
  225.             return 1;
  226.         end
  227.         /* not found or error occured, see lastError message */
  228.         ofs.0 = 0;
  229.         return 0;
  230.  
  231.     /**
  232.      * ó«ºóαáΘáÑΓ »«ñßΓ᫬π ñ½∩ ß««Γó. φ½Ñ¼Ñ¡Γá ¼á߬¿.
  233.      * »πßΓá∩ »«ñßΓ᫬á ΓᬠªÑ ¼«ªÑΓ «º¡áτΓ∞ «Φ¿í¬¿ (߬áªÑ¼
  234.      * 'index out of range')
  235.      *
  236.      * @syntax str = re[5];
  237.      * @return »«ñßΓ᫬á
  238.      */
  239.     ::method '[]'
  240.         expose ofs. slots  instr
  241.         use arg idx
  242.         if ofs.0 = 0 | idx >= slots then
  243.             return ""; /* out of range */
  244.         /*calc real offsets*/
  245.         L  = idx * 2 + 1;
  246.         H  = L + 1;
  247.         return instr~substr(ofs.L, ofs.H - ofs.L);
  248. /*-------------------------------------------------------------------------*/
  249.  
  250.