initial import

lib/racket-data.php

@@ -0,0 +1,317 @@
+<?php
+
+function rktd_package_name_ok($name)
+{
+    return is_string($name) && preg_match('/^[A-Za-z0-9_.+-]+$/', $name);
+}
+
+function rktd_unescape_string($s)
+{
+    $out = '';
+    $n = strlen($s);
+
+    for ($i = 0; $i < $n; $i++) {
+        $c = $s[$i];
+
+        if ($c !== '\\') {
+            $out .= $c;
+            continue;
+        }
+
+        if ($i + 1 >= $n) {
+            break;
+        }
+
+        $i++;
+        $e = $s[$i];
+
+        if ($e === 'n') {
+            $out .= "\n";
+        } elseif ($e === 'r') {
+            $out .= "\r";
+        } elseif ($e === 't') {
+            $out .= "\t";
+        } else {
+            $out .= $e;
+        }
+    }
+
+    return $out;
+}
+
+function rktd_read_string($s, &$i)
+{
+    $n = strlen($s);
+
+    if ($i >= $n || $s[$i] !== '"') {
+        return null;
+    }
+
+    $i++;
+    $out = '';
+
+    while ($i < $n) {
+        $c = $s[$i];
+        $i++;
+
+        if ($c === '"') {
+            return $out;
+        }
+
+        if ($c === '\\') {
+            if ($i >= $n) {
+                break;
+            }
+
+            $e = $s[$i];
+            $i++;
+
+            if ($e === 'n') {
+                $out .= "\n";
+            } elseif ($e === 'r') {
+                $out .= "\r";
+            } elseif ($e === 't') {
+                $out .= "\t";
+            } else {
+                $out .= $e;
+            }
+        } else {
+            $out .= $c;
+        }
+    }
+
+    return null;
+}
+
+function rktd_skip_space($s, &$i)
+{
+    $n = strlen($s);
+
+    while ($i < $n) {
+        $c = $s[$i];
+
+        if ($c === ';') {
+            while ($i < $n && $s[$i] !== "\n") {
+                $i++;
+            }
+            continue;
+        }
+
+        if ($c === ' ' || $c === "\t" || $c === "\r" || $c === "\n") {
+            $i++;
+            continue;
+        }
+
+        break;
+    }
+}
+
+function rktd_skip_string($s, &$i)
+{
+    $dummy = rktd_read_string($s, $i);
+    return $dummy !== null;
+}
+
+function rktd_skip_atom($s, &$i)
+{
+    $n = strlen($s);
+
+    while ($i < $n) {
+        $c = $s[$i];
+
+        if ($c === ' ' || $c === "\t" || $c === "\r" || $c === "\n" ||
+            $c === '(' || $c === ')' || $c === '"' || $c === ';') {
+            break;
+        }
+
+        $i++;
+    }
+}
+
+function rktd_skip_expr($s, &$i)
+{
+    $n = strlen($s);
+
+    rktd_skip_space($s, $i);
+
+    if ($i >= $n) {
+        return;
+    }
+
+    $c = $s[$i];
+
+    if ($c === '"') {
+        rktd_skip_string($s, $i);
+        return;
+    }
+
+    if ($c === "'") {
+        $i++;
+        rktd_skip_expr($s, $i);
+        return;
+    }
+
+    if ($c === '#') {
+        if (substr($s, $i, 2) === '#(') {
+            $i++;
+            rktd_skip_expr($s, $i);
+            return;
+        }
+
+        if (substr($s, $i, 5) === '#hash' ||
+            substr($s, $i, 7) === '#hasheq' ||
+            substr($s, $i, 8) === '#hasheqv') {
+            while ($i < $n && $s[$i] !== '(') {
+                $i++;
+            }
+            rktd_skip_expr($s, $i);
+            return;
+        }
+    }
+
+    if ($c === '(') {
+        $depth = 0;
+
+        while ($i < $n) {
+            $c = $s[$i];
+
+            if ($c === '"') {
+                rktd_skip_string($s, $i);
+                continue;
+            }
+
+            if ($c === ';') {
+                while ($i < $n && $s[$i] !== "\n") {
+                    $i++;
+                }
+                continue;
+            }
+
+            if ($c === '(') {
+                $depth++;
+                $i++;
+                continue;
+            }
+
+            if ($c === ')') {
+                $depth--;
+                $i++;
+
+                if ($depth <= 0) {
+                    return;
+                }
+
+                continue;
+            }
+
+            $i++;
+        }
+
+        return;
+    }
+
+    rktd_skip_atom($s, $i);
+}
+
+function rktd_extract_top_level_package_names($text)
+{
+    $names = array();
+
+    $i = strpos($text, '#hash');
+
+    if ($i === false) {
+        $i = strpos($text, '#hasheq');
+    }
+
+    if ($i === false) {
+        $i = strpos($text, '#hasheqv');
+    }
+
+    if ($i === false) {
+        return array();
+    }
+
+    $n = strlen($text);
+
+    while ($i < $n && $text[$i] !== '(') {
+        $i++;
+    }
+
+    if ($i >= $n || $text[$i] !== '(') {
+        return array();
+    }
+
+    $i++;
+
+    while ($i < $n) {
+        rktd_skip_space($text, $i);
+
+        if ($i >= $n) {
+            break;
+        }
+
+        if ($text[$i] === ')') {
+            break;
+        }
+
+        if ($text[$i] !== '(') {
+            $i++;
+            continue;
+        }
+
+        $i++;
+        rktd_skip_space($text, $i);
+        $name = rktd_read_string($text, $i);
+
+        if ($name === null) {
+            while ($i < $n && $text[$i] !== ')') {
+                rktd_skip_expr($text, $i);
+                rktd_skip_space($text, $i);
+            }
+
+            if ($i < $n && $text[$i] === ')') {
+                $i++;
+            }
+
+            continue;
+        }
+
+        if (rktd_package_name_ok($name)) {
+            $names[$name] = true;
+        }
+
+        rktd_skip_space($text, $i);
+
+        if ($i < $n && $text[$i] === '.') {
+            $i++;
+        }
+
+        rktd_skip_expr($text, $i);
+        rktd_skip_space($text, $i);
+
+        if ($i < $n && $text[$i] === ')') {
+            $i++;
+        }
+    }
+
+    $out = array_keys($names);
+    sort($out, SORT_NATURAL | SORT_FLAG_CASE);
+
+    return $out;
+}
+
+function rktd_extract_catalog_source($catalogText)
+{
+    $patterns = array(
+        '/\\(\\s*source\\s*\\.\\s*"((?:[^"\\\\]|\\\\.)*)"\\s*\\)/s',
+        '/\\(\\s*"source"\\s*\\.\\s*"((?:[^"\\\\]|\\\\.)*)"\\s*\\)/s',
+    );
+
+    foreach ($patterns as $pat) {
+        if (preg_match($pat, $catalogText, $m)) {
+            return rktd_unescape_string($m[1]);
+        }
+    }
+
+    return null;
+}