view release on metacpan or  search on metacpan

HTPL-modules/lib/HTML/HTPL/Sys.pm  view on Meta::CPAN

sub isheb {
    shift =~ /[\xE0-\xFA]/;
}

sub readini {
    return unless (-f 'website.ini');

    eval "require IniConf;";
    return unless ($IniConf::VERSION);
    my $cfg = new IniConf( -file => 'website.ini', -nocase => 1);
    my (%hash, $s, $p, $v);
    foreach $s ($cfg->Sections) {
        foreach $p ($cfg->Parameters($s)) {
            $hash{$s, $p} = $cfg->val($s, $p);
        }
    }    
    sethash('config', %hash);
}

sub pushvars {
    my @vars = @_;
    @vars = @{$vars[0]} if (!$#vars && UNIVERSAL::isa($vars[0], 'ARRAY'));
    my $hash = {};
    foreach (@vars) {
        $hash->{$_} = &getvar($_);
    }
    push(@__htpl_stack, $hash);
}

sub popvars {
    my $hash = pop @__htpl_stack;
    &publish(%$hash);
}

sub pkghash {
    %{(eval "*$_[0]\::")};
}

sub pkganalyze {
    my ($pkg, $full) = @_;
    my %hash = pkghash($pkg);
    my @result;
    my $pre = $full ? "$pkg\::" : "";
    foreach (keys %hash) {
        my $t = "*${pkg}::$_";
        push(@result, '$' . $pre . $_) if (eval("$t\{SCALAR}"));
        push(@result, '@' . $pre . $_) if (eval("$t\{ARRAY}"));
        push(@result, '%' . $pre . $_) if (eval("$t\{HASH}"));
        push(@result, '&' . $pre . $_) if (eval("$t\{CODE}"));
    }
    @result;
}

sub pkglist {
    my ($pkg, $char, $full) = @_;
    $char =~ s/^(.)$/^\\$1/;
    grep /$char/, &pkganalyze($pkg, $full);
}

sub getpkg {
    my $caller = (caller)[0];
    my $loop;
    do {
        $loop++;
        my $this = (caller($loop))[0];
        return $this if ($this ne $caller);
    }
}

sub mytime {
    $have_time_hires ? Time::HiRes::gettimeofday() : time;
}

sub mytimesince {
    my $from = shift;
    my $t = &mytime;
    $have_time_hires ? tv_interval($t, $from) : abs($t - $from);
}

sub compileutil {
    my $exp = shift;
    my @tokens = split(/\s+/, $exp);
    my @trans = map {
        s/^AND$/&&/i;
        s/^OR$/||/i;
        s/^NOT$/!/i;
        /^[a-z]/i && tr/A-Z/a-z/ && 
            ((":lt:gt:eq:ge:le:ne:" =~ /$_/i)
              || ($_ = "\$hash->{'$_'}"));
        $_;
    } @tokens;
    my $code = qq!sub {
        my \$hash = shift;
        ! . join(" ", @trans) . qq!;
    }!;
    my $ref = eval($code);
    &HTML::HTPL::Lib::htdie($@) unless (UNIVERSAL::isa($ref, 'CODE'));
    $ref;
}

sub DEBUG (&) {
    return unless ($debug_file);
    my $code = shift;
    &HTML::HTPL::Lib::begintransaction;
    eval '&$code';
    my $txt = &HTML::HTPL::Lib::endtransaction;
    open(O, ">>$debug_file");
    print O $txt;
    print O "$@\n" if ($@);
    close(O);
}

sub scriptdir {
    my $slash = &HTML::HTPL::Lib::slash;
    my @tokens = split($slash, $0);
    pop @tokens;
    pop @tokens if ($tokens[-1] eq 'htpl-cache');
    join($slash, @tokens);
}

1;