Skip to main content

libperl_macrogen/
perl_config.rs

1//! Perl Config.pm から設定を取得するモジュール
2
3use std::path::PathBuf;
4use std::process::Command;
5
6use crate::preprocessor::PPConfig;
7
8/// Perl Config から取得した設定
9#[derive(Debug)]
10pub struct PerlConfig {
11    /// インクルードパス (incpth + archlib/CORE)
12    pub include_paths: Vec<PathBuf>,
13    /// プリプロセッサマクロ定義 (cppsymbols)
14    pub defines: Vec<(String, Option<String>)>,
15    /// 対象 perl の build mode (threaded / non-threaded)
16    pub build_mode: PerlBuildMode,
17}
18
19/// 対象 perl の build mode
20///
21/// `Threaded` は `-Dusethreads` でビルドされた perl
22/// (`PERL_IMPLICIT_CONTEXT` / `MULTIPLICITY` が定義されている)。
23/// 関数は `my_perl: *mut PerlInterpreter` を第一引数に取り、
24/// マクロは `aTHX_` で `my_perl` を伝播する。
25///
26/// `NonThreaded` は `-Uusethreads` の perl。`pTHX_` / `aTHX_` は
27/// 空展開され、関数は `my_perl` を取らない。`PL_curcop` 等のグローバル
28/// は実 extern 変数として bindings に出る。
29#[derive(Debug, Clone, Copy, PartialEq, Eq)]
30pub enum PerlBuildMode {
31    Threaded,
32    NonThreaded,
33}
34
35impl PerlBuildMode {
36    /// `Config{usethreads}` を読んで自動検出する
37    ///
38    /// 判定順:
39    /// 1. `Config{usethreads}` == `"define"` → `Threaded`
40    /// 2. それ以外(`"undef"` / 空文字列)→ `NonThreaded`
41    pub fn detect_from_perl_config() -> Result<Self, PerlConfigError> {
42        let usethreads = get_config_value("usethreads")?;
43        if usethreads == "define" {
44            Ok(PerlBuildMode::Threaded)
45        } else {
46            Ok(PerlBuildMode::NonThreaded)
47        }
48    }
49
50    pub fn is_threaded(self) -> bool {
51        matches!(self, Self::Threaded)
52    }
53}
54
55/// Perl Config 取得エラー
56#[derive(Debug)]
57pub enum PerlConfigError {
58    /// perl コマンド実行失敗
59    CommandFailed(String),
60    /// Config 値の取得失敗
61    ConfigNotFound(String),
62    /// パースエラー
63    ParseError(String),
64}
65
66impl std::fmt::Display for PerlConfigError {
67    fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
68        match self {
69            PerlConfigError::CommandFailed(msg) => write!(f, "perl command failed: {}", msg),
70            PerlConfigError::ConfigNotFound(key) => write!(f, "Config key not found: {}", key),
71            PerlConfigError::ParseError(msg) => write!(f, "parse error: {}", msg),
72        }
73    }
74}
75
76impl std::error::Error for PerlConfigError {}
77
78/// Perl Config.pm から指定されたキーの値を取得
79fn get_config_value(key: &str) -> Result<String, PerlConfigError> {
80    let output = Command::new("perl")
81        .args(["-MConfig", "-le", &format!("print $Config{{{}}}", key)])
82        .output()
83        .map_err(|e| PerlConfigError::CommandFailed(e.to_string()))?;
84
85    if !output.status.success() {
86        return Err(PerlConfigError::CommandFailed(
87            String::from_utf8_lossy(&output.stderr).to_string(),
88        ));
89    }
90
91    let value = String::from_utf8_lossy(&output.stdout).trim().to_string();
92    Ok(value)
93}
94
95/// cppsymbols 文字列をパースして (名前, 値) のペアに変換
96///
97/// 形式: `NAME=VALUE NAME2=VALUE2 NAME3` (スペース区切り)
98/// 値には `\ ` (エスケープされたスペース) を含む場合がある
99fn parse_cppsymbols(symbols: &str) -> Vec<(String, Option<String>)> {
100    let mut result = Vec::new();
101    let mut current = String::new();
102    let mut chars = symbols.chars().peekable();
103
104    while let Some(c) = chars.next() {
105        if c == '\\' {
106            // エスケープシーケンス
107            if let Some(&next) = chars.peek() {
108                current.push(c);
109                current.push(next);
110                chars.next();
111            }
112        } else if c == ' ' || c == '\t' {
113            // 区切り文字
114            if !current.is_empty() {
115                result.push(parse_single_define(&current));
116                current.clear();
117            }
118        } else {
119            current.push(c);
120        }
121    }
122
123    // 最後の要素
124    if !current.is_empty() {
125        result.push(parse_single_define(&current));
126    }
127
128    result
129}
130
131/// 単一の定義文字列をパース (NAME または NAME=VALUE)
132/// バックスラッシュエスケープ (\ ) をスペースに変換
133fn parse_single_define(s: &str) -> (String, Option<String>) {
134    if let Some(pos) = s.find('=') {
135        let (name, value) = s.split_at(pos);
136        // バックスラッシュエスケープを解除 (\ -> スペース)
137        let unescaped_value = value[1..].replace("\\ ", " ");
138        (name.to_string(), Some(unescaped_value))
139    } else {
140        (s.to_string(), None)
141    }
142}
143
144/// incpth 文字列をパースしてパスのベクターに変換
145fn parse_incpth(incpth: &str) -> Vec<PathBuf> {
146    incpth
147        .split_whitespace()
148        .filter(|s| !s.is_empty())
149        .map(PathBuf::from)
150        .collect()
151}
152
153/// ExtUtils::Embed の ccopts から -D オプションを抽出
154fn get_ccopts_defines() -> Result<Vec<(String, Option<String>)>, PerlConfigError> {
155    let output = Command::new("perl")
156        .args(["-MExtUtils::Embed", "-e", "print ccopts"])
157        .output()
158        .map_err(|e| PerlConfigError::CommandFailed(e.to_string()))?;
159
160    if !output.status.success() {
161        return Err(PerlConfigError::CommandFailed(
162            String::from_utf8_lossy(&output.stderr).to_string(),
163        ));
164    }
165
166    let ccopts = String::from_utf8_lossy(&output.stdout);
167    let mut defines = Vec::new();
168
169    for part in ccopts.split_whitespace() {
170        if let Some(def) = part.strip_prefix("-D") {
171            defines.push(parse_single_define(def));
172        }
173    }
174
175    Ok(defines)
176}
177
178/// Perl のデフォルトターゲットディレクトリを取得
179/// archlib/CORE (例: /usr/lib64/perl5/CORE)
180pub fn get_default_target_dir() -> Result<PathBuf, PerlConfigError> {
181    let archlib = get_config_value("archlib")?;
182    if archlib.is_empty() {
183        return Err(PerlConfigError::ConfigNotFound("archlib".to_string()));
184    }
185    Ok(PathBuf::from(&archlib).join("CORE"))
186}
187
188/// Perl のメジャー・マイナーバージョンを取得
189///
190/// $Config{version} は "5.40.0" のような形式
191/// 戻り値: (major, minor) タプル (例: (5, 40))
192pub fn get_perl_version() -> Result<(u32, u32), PerlConfigError> {
193    let version = get_config_value("version")?;
194    if version.is_empty() {
195        return Err(PerlConfigError::ConfigNotFound("version".to_string()));
196    }
197
198    // "5.40.0" -> ["5", "40", "0"]
199    let parts: Vec<&str> = version.split('.').collect();
200    if parts.len() < 2 {
201        return Err(PerlConfigError::ParseError(format!(
202            "invalid version format: {}",
203            version
204        )));
205    }
206
207    let major = parts[0].parse::<u32>().map_err(|_| {
208        PerlConfigError::ParseError(format!("invalid major version: {}", parts[0]))
209    })?;
210
211    let minor = parts[1].parse::<u32>().map_err(|_| {
212        PerlConfigError::ParseError(format!("invalid minor version: {}", parts[1]))
213    })?;
214
215    Ok((major, minor))
216}
217
218/// Perl Config.pm から設定を取得
219pub fn get_perl_config() -> Result<PerlConfig, PerlConfigError> {
220    // インクルードパスを取得
221    let incpth = get_config_value("incpth")?;
222    let mut include_paths = parse_incpth(&incpth);
223
224    // archlib/CORE を追加 (Perl ヘッダー)
225    let archlib = get_config_value("archlib")?;
226    if !archlib.is_empty() {
227        let core_path = PathBuf::from(&archlib).join("CORE");
228        if core_path.exists() {
229            include_paths.push(core_path);
230        }
231    }
232
233    // cppsymbols を取得
234    let cppsymbols = get_config_value("cppsymbols")?;
235    let mut defines = parse_cppsymbols(&cppsymbols);
236
237    // ccopts から -D オプションを抽出して追加(重複は後で上書きされる)
238    if let Ok(ccopts_defines) = get_ccopts_defines() {
239        for (name, value) in ccopts_defines {
240            // 既存の定義を上書き(ccoptの方が優先)
241            if let Some(pos) = defines.iter().position(|(n, _)| n == &name) {
242                defines[pos] = (name, value);
243            } else {
244                defines.push((name, value));
245            }
246        }
247    }
248
249    // PERL_CORE を追加 (perl.h内のDFA表などを正しく展開するために必要)
250    defines.push(("PERL_CORE".to_string(), None));
251
252    // デバッグ: __x86_64__ が含まれているか確認
253    if std::env::var("DEBUG_PERL_CONFIG").is_ok() {
254        eprintln!("[perl_config] include_paths: {:?}", include_paths);
255        eprintln!("[perl_config] defines count: {}", defines.len());
256        for (name, value) in &defines {
257            if name.contains("x86") || name.contains("LP64") {
258                eprintln!("[perl_config] {} = {:?}", name, value);
259            }
260        }
261    }
262
263    let build_mode = PerlBuildMode::detect_from_perl_config()?;
264
265    Ok(PerlConfig {
266        include_paths,
267        defines,
268        build_mode,
269    })
270}
271
272/// Perl 環境用の PPConfig を構築
273///
274/// get_perl_config() と get_default_target_dir() を組み合わせて
275/// プリプロセッサ設定を構築する。build.rs から呼び出すことを想定。
276pub fn build_pp_config_for_perl() -> Result<PPConfig, PerlConfigError> {
277    let perl_cfg = get_perl_config()?;
278    let target_dir = get_default_target_dir().ok();
279    Ok(PPConfig {
280        include_paths: perl_cfg.include_paths,
281        predefined: perl_cfg.defines,
282        debug_pp: false,
283        target_dir,
284        emit_markers: false,
285    })
286}
287
288#[cfg(test)]
289mod tests {
290    use super::*;
291
292    #[test]
293    fn test_parse_single_define() {
294        assert_eq!(
295            parse_single_define("FOO"),
296            ("FOO".to_string(), None)
297        );
298        assert_eq!(
299            parse_single_define("FOO=1"),
300            ("FOO".to_string(), Some("1".to_string()))
301        );
302        assert_eq!(
303            parse_single_define("__GNUC__=15"),
304            ("__GNUC__".to_string(), Some("15".to_string()))
305        );
306    }
307
308    #[test]
309    fn test_parse_cppsymbols_simple() {
310        let symbols = "FOO=1 BAR=2 BAZ";
311        let result = parse_cppsymbols(symbols);
312        assert_eq!(result.len(), 3);
313        assert_eq!(result[0], ("FOO".to_string(), Some("1".to_string())));
314        assert_eq!(result[1], ("BAR".to_string(), Some("2".to_string())));
315        assert_eq!(result[2], ("BAZ".to_string(), None));
316    }
317
318    #[test]
319    fn test_parse_cppsymbols_with_escape() {
320        // エスケープされたスペースを含む値 (\ はスペースに変換される)
321        let symbols = r#"__VERSION__="15.1.1\ 20250521" FOO=1"#;
322        let result = parse_cppsymbols(symbols);
323        assert_eq!(result.len(), 2);
324        assert_eq!(
325            result[0],
326            ("__VERSION__".to_string(), Some(r#""15.1.1 20250521""#.to_string()))
327        );
328        assert_eq!(result[1], ("FOO".to_string(), Some("1".to_string())));
329    }
330
331    #[test]
332    fn test_parse_incpth() {
333        let incpth = "/usr/lib/gcc/x86_64-redhat-linux/15/include /usr/local/include /usr/include";
334        let result = parse_incpth(incpth);
335        assert_eq!(result.len(), 3);
336        assert_eq!(result[0], PathBuf::from("/usr/lib/gcc/x86_64-redhat-linux/15/include"));
337        assert_eq!(result[1], PathBuf::from("/usr/local/include"));
338        assert_eq!(result[2], PathBuf::from("/usr/include"));
339    }
340
341    #[test]
342    fn test_parse_version() {
343        // バージョン文字列のパースをテスト(内部ヘルパー関数で)
344        fn parse_version(version: &str) -> Option<(u32, u32)> {
345            let parts: Vec<&str> = version.split('.').collect();
346            if parts.len() < 2 {
347                return None;
348            }
349            let major = parts[0].parse::<u32>().ok()?;
350            let minor = parts[1].parse::<u32>().ok()?;
351            Some((major, minor))
352        }
353
354        assert_eq!(parse_version("5.40.0"), Some((5, 40)));
355        assert_eq!(parse_version("5.38.2"), Some((5, 38)));
356        assert_eq!(parse_version("5.10.1"), Some((5, 10)));
357        assert_eq!(parse_version("5.8"), Some((5, 8)));
358        assert_eq!(parse_version("invalid"), None);
359    }
360}