package Zen::Config::Compiler; use strict; use base qw/II720d6e18aa34327713eb014408fc9144/; our $classConfig = "Zen::Config"; our $classConfigHash = "Zen::Config::Hash"; sub new { shift()->SUPER::new(); } sub compile { my ($this, $src_file) = @_; my $code = $this->loadFile($src_file, 'main', 1); return unless $code; return " use strict;
require $classConfig;
require $classConfigHash;
my \$h = $classConfigHash\->createAndLoad(
$code
);
\$h;
";
} sub loadFile { my $class = shift; my ($file, $sec) = @_; return unless -f $file; my $fh; open $fh, $file or die "failed to open file [$file]: $!"; my $code = "$sec => $classConfigHash\->createAndLoad(\n"; my ($key, $val, $str); while (my $line = <$fh>) { $line =~ s/[\r\n]//g; if (($str) = $line =~ /^#include\s+(.*)/i) { die "invalid config directive: $line\n" unless $str =~ /([\w:]+)(?:\s+under\s+(\w+))?/; my $incScope = $1; my $defSec = $2 || 'main'; $code .= "),\n"; if ($defSec) { $code .= "(map { ! ref(\$_) && \$_ eq 'main' ? '$defSec' : \$_ } %{ $classConfig\->get('$incScope') }),\n"; } else { $code .= "%{ $classConfig\->get('$incScope') },\n"; } $code .= "$sec => $classConfigHash\->createAndLoad(\n"; } elsif ($line =~ /^[#;]/) { } elsif ($line =~ /^\[(.+?)\]/) { $sec = $1; $code .= "),\n"; $code .= "$sec => $classConfigHash\->createAndLoad(\n"; } elsif (($key, $val) = $line =~ /^([^=]*?)=(.*)$/) { if ($val =~ /^\s*<<(\w+)/) { my $ender = $1; $val = ''; while (my $subline = <$fh>) { last if $subline =~ /^$ender/; $val .= $subline; } } for ($key, $val) { s/([\\\"\$\@])/\\$1/g; s/\r/\\r/g; s/\n/\\n/g; } $code .= qq("$key" => "$val",\n); } } $code .= "),"; close $fh; $code; } 1; 