CVS update: lxr/http/lib/LXR
| From: | jim | Date: | Tue, 29 Jun 1999 02:05:36 +0000 |
| Subject: | CVS update: lxr/http/lib/LXR | ||
| Groups: | php.dev | ||
| Request: | Send a blank email to php-dev+get-7787@lists.php.net to get a copy of this message | ||
Date: Monday June 28, 1999 @ 22:05
Author: jim
Update of /repository/lxr/http/lib/LXR
In directory php:/tmp/cvs-serv14055/lib/LXR
Modified Files:
Common.pm Config.pm
Added Files:
Template.pm
Log Message:
Clean up LXR stuff. This was largely an exercise in playing with perl again and making the LXR code
"neater".
Index: lxr/http/lib/LXR/Common.pm
diff -u lxr/http/lib/LXR/Common.pm:1.1 lxr/http/lib/LXR/Common.pm:1.2
--- lxr/http/lib/LXR/Common.pm:1.1 Sun Jun 13 01:54:09 1999
+++ lxr/http/lib/LXR/Common.pm Mon Jun 28 22:05:36 1999
@@ -1,4 +1,4 @@
-# $Id: Common.pm,v 1.1 1999/06/13 05:54:09 jim Exp $
+# $Id: Common.pm,v 1.2 1999/06/29 02:05:36 jim Exp $
package LXR::Common;
@@ -8,9 +8,8 @@
@ISA = qw(Exporter);
@EXPORT = qw(&warning &fatal &abortall &fflush &urlargs
&fileref &idref &htmlquote &freetextmarkup &markupfile
- &init &makeheader &makefooter &expandtemplate);
+ &makeheader &makefooter &expandtemplate);
-
$wwwdebug = 1;
$SIG{__WARN__} = 'warning';
@@ -72,12 +71,6 @@
}
@args = ();
- foreach ($Conf->allvariables) {
- $val = $args{$_} || $Conf->variable($_);
- push(@args, "$_=$val") unless ($val eq $Conf->vardefault($_));
- delete($args{$_});
- }
-
foreach (keys(%args)) {
push(@args, "$_=$args{$_}");
}
@@ -88,9 +81,9 @@
sub fileref {
my ($desc, $path, $line, @args) = @_;
- return("<a href=\"source$path".
+ return("<a href=\"/source$path".
&urlargs(@args).
- ($line > 0 ? "#L$line" : "").
+ ($line > 0 ? "#L_$line" : "").
"\"\>$desc</a>");
}
@@ -147,40 +140,36 @@
sub freetextmarkup {
$_[0] =~ s#(<)?((ftp|http)://\S*[^\s.](?=>))(>)?#<a
href=\"$2\">$1$2$4</a>#g;
- $_[0] =~ s/(<(.*@.*)>)/<a href=\"mailto:$2\">$1<\/a>/g;
+ $_[0] =~ s/(<(.*?@.*?)>)/<a href=\"mailto:$2\">$1<\/a>/g;
}
sub linetag {
-#$frag =~ s/\n/"\n".&linetag($virtp.$fname, $line)/ge;
-# my $tag = '<a href="'.$_[0].'#L'.$_[1].
-# '" name="L'.$_[1].'">'.$_[1].' </a>';
my $tag;
$tag .= ' ' if $_[1] < 10;
$tag .= ' ' if $_[1] < 100;
$tag .= &fileref($_[1], $_[0], $_[1]).' ';
$tag =~ s/<a/<a name=L$_[1]/;
-# $_[1]++;
return($tag);
}
sub markupfile {
- my ($INFILE, $virtp, $fname, $outfun) = @_;
+ my ($INFILE, $file, $outfun) = @_;
$line = 1;
# A C/C++ file
- if ($fname =~ /\.([ch]|cpp?|cc|lex|y)$/i) { # Duplicated in genxref.
+ if ($file =~ /\.([ch]|cpp?|cc|lex|y)$/i) { # Duplicated in genxref.
- &SimpleParse::init($INFILE, ($fname =~ /\.lex$/) ? @lexterm : @cterm);
+ &SimpleParse::init($INFILE, ($file =~ /\.lex$/) ? @lexterm : @cterm);
- tie (%xref, "DB_File", $Conf->dbdir."/xref", O_RDONLY, 0664, $DB_HASH)
+ tie (%xref, "DB_File", $LXR->config->dbdir."/xref", O_RDONLY, 0664,
$DB_HASH)
|| &warning("Cannot open xref database.");
&$outfun(# "<pre>\n".
#"<a name=\"L".$line++.'"></a>');
- &linetag($virtp.$fname, $line++));
+ &linetag($file, $line++));
($btype, $frag) = &SimpleParse::nextfrag;
@@ -204,7 +193,7 @@
$frag =~ s#<(.*)>#
"<".&fileref
($1,
- $Conf->mappath($Conf->incprefix."/$1")).
+ $LXR->config->mappath($LXR->config->incprefix."/$1")).
">"#e;
} else {
# Code
@@ -215,7 +204,7 @@
}
&htmlquote($frag);
- $frag =~ s/\n/"\n".&linetag($virtp.$fname, $line++)/ge;
+ $frag =~ s/\n/"\n".&linetag($file, $line++)/ge;
&$outfun($frag);
($btype, $frag) = &SimpleParse::nextfrag;
@@ -224,11 +213,11 @@
# &$outfun("</pre>\n");
untie(%xref);
- } elsif ($fname =~ /\.(gif|jpg)$/) {
- &$outfun("<img src=\"http:source".$virtp.$fname.
&urlargs("raw=1").
- "\" border=0 alt=\"$fname\" align=middle>\n");
+ } elsif ($file =~ /\.(gif|jpg)$/) {
+ &$outfun("<img src=\"http:source".$file. &urlargs("raw=1").
+ "\" border=0 alt=\"$file\" align=middle>\n");
- } elsif ($fname eq 'CREDITS') {
+ } elsif ($file eq 'CREDITS') {
while (<$INFILE>) {
&SimpleParse::untabify($_);
&markspecials($_);
@@ -237,7 +226,7 @@
s/^(E:\s+)(\S+@\S+)/$1<a href=\"mailto:$2\">$2<\/a>/gm;
s/^(W:\s+)(.*)/$1<a href=\"$2\">$2<\/a>/gm;
# &$outfun("<a name=\"L$.\"><\/a>".$_);
- &$outfun(&linetag($virtp.$fname, $.).$_);
+ &$outfun(&linetag($file, $.).$_);
}
} else {
while (<$INFILE>) {
@@ -246,15 +235,16 @@
&htmlquote($_);
&freetextmarkup($_);
# &$outfun("<a name=\"L$.\"><\/a>".$_);
- &$outfun(&linetag($virtp.$fname, $.).$_);
+ &$outfun(&linetag($file, $.).$_);
}
}
}
sub fixpaths {
- $Path->{'virtf'} = '/'.shift;
- $Path->{'root'} = $Conf->sourceroot;
+ $Path->{'virtf'} = shift;
+ $Path->{'virtf'} =~ s!^/!!;
+ $Path->{'root'} = $LXR->config->sourceroot;
while ($Path->{'virtf'} =~ s#/[^/]+/\.\./#/#g) {
}
@@ -276,7 +266,7 @@
push(@addrelem, $fpath);
}
- unshift(@pathelem, $Conf->sourcerootname.'/');
+ unshift(@pathelem, $LXR->config->srcrootname.'/');
unshift(@addrelem, "");
foreach (0..$#pathelem) {
@@ -306,8 +296,6 @@
}
$HTTP->{'param'} = {@a};
- $HTTP->{'param'}->{'v'} ||=
$HTTP->{'param'}->{'version'};
- $HTTP->{'param'}->{'a'} ||=
$HTTP->{'param'}->{'arch'};
$HTTP->{'param'}->{'i'} ||=
$HTTP->{'param'}->{'identifier'};
@@ -322,10 +310,7 @@
$Conf = new LXR::Config;
- foreach ($Conf->allvariables) {
- $Conf->variable($_, $HTTP->{'param'}->{$_}) if
$HTTP->{'param'}->{$_};
- }
-
+ # XXX set up the $url and $file
&fixpaths($HTTP->{'path_info'} ||
$HTTP->{'param'}->{'file'});
if (defined($readraw)) {
@@ -388,7 +373,7 @@
} elsif ($who eq 'ident') {
my $i = $HTTP->{'param'}->{'i'};
- return($Conf->sourcerootname.' identfier search'.
+ return($Conf->sourcerootname.' identifier search'.
($i ? " \"$i\"" : ''));
} elsif ($who eq 'search') {
@@ -466,118 +451,23 @@
return($modex);
}
-# This is where it gets a bit tricky. varexpand expands the
-# "variables" template using varname and varlinks, the latter in turn
-# expands the nested "varlinks" template using varval.
-sub varlinks {
- my $templ = shift;
- my $vlex = '';
- my ($val, $oldval);
- local $vallink;
-
- $oldval = $Conf->variable($var);
- foreach $val ($Conf->varrange($var)) {
- if ($val eq $oldval) {
- $vallink = "<b><i>$val</i></b>";
- } else {
- if ($who eq 'source') {
- $vallink = &fileref($val,
- $Conf->mappath($Path->{'virtf'},
- "$var=$val"),
- 0,
- "$var=$val");
-
- } elsif ($who eq 'diff') {
- $vallink = &diffref($val, $Path->{'virtf'}, "$var=$val");
-
- } elsif ($who eq 'ident') {
- $vallink = &idref($val, $identifier, "$var=$val");
-
- } elsif ($who eq 'search') {
- $vallink = "<a href=\"search".
- &urlargs("$var=$val",
- "string=".$HTTP->{'param'}->{'string'}).
- "\">$val</a>";
-
- } elsif ($who eq 'find') {
- $vallink = "<a href=\"find".
- &urlargs("$var=$val",
- "string=".$HTTP->{'param'}->{'string'}).
- "\">$val</a>";
- }
- }
- $vlex .= &expandtemplate($templ,
- ('varvalue', sub { return($vallink) }));
-
- }
- return($vlex);
-}
-
-
-sub varexpand {
- my $templ = shift;
- my $varex = '';
- local $var;
-
- foreach $var ($Conf->allvariables) {
- $varex .= &expandtemplate($templ,
- ('varname', sub {
- return($Conf->vardescription($var))}),
- ('varlinks', \&varlinks));
- }
- return($varex);
-}
-
-
-sub makeheader {
- local $who = shift;
-
- if ($Conf->htmlhead && !open(TEMPL, $Conf->htmlhead)) {
- &warning("Template ".$Conf->htmlhead." does not exist.");
- $template ||= "<html><body>\n<hr>\n";
- } else {
- $save = $/; undef($/);
- $template = <TEMPL>;
- $/ = $save;
- close(TEMPL);
- }
-
- print(
-#"<!doctype html public \"-//W3C//DTD HTML 3.2//EN\">\n",
-# "<html>\n",
-# "<head>\n",
-# "<title>",$Conf->sourcerootname," Cross
Reference</title>\n",
-# "<base href=\"",$Conf->baseurl,"\">\n",
-# "</head>\n",
-
- &expandtemplate($template,
- ('title', \&titleexpand),
- ('banner', \&bannerexpand),
- ('baseurl', \&baseurl),
- ('thisurl', \&thisurl),
- ('modes', \&modeexpand),
- ('variables', \&varexpand)));
-}
-
-
sub makefooter {
local $who = shift;
- if ($Conf->htmltail && !open(TEMPL, $Conf->htmltail)) {
- &warning("Template ".$Conf->htmltail." does not exist.");
- $template = "<hr>\n</body>\n";
- } else {
+# if ($LXR->config->htmltail && !open(TEMPL, $LXR->config->htmltail)) {
+# &warning("Template ".$LXR->config->htmltail." does not exist.");
+# $template = "<hr>\n</body>\n";
+# } else {
$save = $/; undef($/);
$template = <TEMPL>;
$/ = $save;
close(TEMPL);
- }
+# }
print(&expandtemplate($template,
('banner', \&bannerexpand),
('thisurl', \&thisurl),
- ('modes', \&modeexpand),
- ('variables', \&varexpand)),
+ ('modes', \&modeexpand)),
"</html>\n");
}
Index: lxr/http/lib/LXR/Config.pm
diff -u lxr/http/lib/LXR/Config.pm:1.1 lxr/http/lib/LXR/Config.pm:1.2
--- lxr/http/lib/LXR/Config.pm:1.1 Sun Jun 13 01:54:09 1999
+++ lxr/http/lib/LXR/Config.pm Mon Jun 28 22:05:36 1999
@@ -1,256 +1,50 @@
-# $Id: Config.pm,v 1.1 1999/06/13 05:54:09 jim Exp $
+# $Id: Config.pm,v 1.2 1999/06/29 02:05:36 jim Exp $
package LXR::Config;
-use LXR::Common;
-
-require Exporter;
-@ISA = qw(Exporter);
-# @EXPORT = '';
-
-$confname = 'lxr.conf';
-
-
sub new {
- my ($class, @parms) = @_;
- my $self = {};
- bless($self);
- $self->_initialize(@parms);
- return($self);
-}
+ my $class = shift;
+ my $conf = shift;
+ my $self = {};
-sub makevalueset {
- my $val = shift;
- my @valset;
-
- if ($val =~ /^\s*\(([^\)]*)\)/) {
- @valset = split(/\s*,\s*/,$1);
- } elsif ($val =~ /^\s*\[\s*(\S*)\s*\]/) {
- if (open(VALUESET, "$1")) {
- $val = join('',<VALUESET>);
- close(VALUESET);
- @valset = split("\n",$val);
- } else {
- @valset = ();
- }
- } else {
- @valset = ();
- }
- return(@valset);
-}
+ bless $self, $class;
+ $self->initialize($conf);
-sub parseconf {
- my $line = shift;
- my @items = ();
- my $item;
-
- foreach $item ($line =~ /\s*(\[.*?\]|\(.*?\)|\".*?\"|\S+)\s*(?:$|,)/g) {
- if ($item =~ /^\[\s*(.*?)\s*\]/) {
- if (open(LISTF, "$1")) {
- $item = '('.join(',',<LISTF>).')';
- close(LISTF);
- } else {
- $item = '';
- }
- }
- if ($item =~ s/^\((.*)\)/$1/s) {
- $item = join("\0",($item =~ /\s*(\S+)\s*(?:$|,)/gs));
- }
- $item =~ s/^\"(.*)\"/$1/;
-
- push(@items, $item);
- }
- return(@items);
+ return $self;
}
-
-sub _initialize {
- my ($self, $conf) = @_;
- my ($dir, $arg);
-
- unless ($conf) {
- ($conf = $0) =~ s#/[^/]+$#/#;
- $conf .= $confname;
- }
-
- unless (open(CONFIG, $conf)) {
- &fatal("Couldn't open configuration file \"$conf\".");
- }
- while (<CONFIG>) {
- s/\#.*//;
- next if /^\s*$/;
-
- if (($dir, $arg) = /^\s*(\S+):\s*(.*)/) {
- if ($dir eq 'variable') {
- @args = &parseconf($arg);
- if (@args[0]) {
- $self->{vardescr}->{$args[0]} = $args[1];
- push(@{$self->{variables}},$args[0]);
- $self->{varrange}->{$args[0]} = [split(/\0/,$args[2])];
- $self->{vdefault}->{$args[0]} = $args[3];
- $self->{vdefault}->{$args[0]} ||=
- $self->{varrange}->{$args[0]}->[0];
- $self->{variable}->{$args[0]} =
- $self->{vdefault}->{$args[0]};
- }
- } elsif ($dir eq 'sourceroot' ||
- $dir eq 'srcrootname' ||
- $dir eq 'baseurl' ||
- $dir eq 'incprefix' ||
- $dir eq 'dbdir' ||
- $dir eq 'glimpsebin' ||
- $dir eq 'htdigbin' ||
- $dir eq 'htdigconf' ||
- $dir eq 'htmlhead' ||
- $dir eq 'htmltail' ||
- $dir eq 'htmldir') {
- if ($arg =~ /(\S+)/) {
- $self->{$dir} = $1;
- }
- } elsif ($dir eq 'map') {
- if ($arg =~ /(\S+)\s+(\S+)/) {
- push(@{$self->{maplist}}, [$1,$2]);
- }
- } else {
- &warning("Unknown config directive (\"$dir\")");
- }
- next;
- }
- &warning("Noise in config file (\"$_\")");
- }
-}
-
-
-sub allvariables {
- my $self = shift;
- return(@{$self->{variables}});
-}
+sub initialize {
+ $self = shift;
+ $conf = shift;
+ open CONF, $conf
+ or die "unable to open config file '$conf': $!\n";
-sub variable {
- my ($self, $var, $val) = @_;
- $self->{variable}->{$var} = $val if defined($val);
- return($self->{variable}->{$var});
-}
-
-
-sub vardefault {
- my ($self, $var) = @_;
- return($self->{vdefault}->{$var});
-}
-
-
-sub vardescription {
- my ($self, $var, $val) = @_;
- $self->{vardescr}->{$var} = $val if defined($val);
- return($self->{vardescr}->{$var});
-}
-
-
-sub varrange {
- my ($self, $var) = @_;
- return(@{$self->{varrange}->{$var}});
-}
-
-
-sub varexpand {
- my ($self, $exp) = @_;
- $exp =~ s/\$\{?(\w+)\}?/$self->{variable}->{$1}/g;
- return($exp);
-}
-
-
-sub baseurl {
- my $self = shift;
- return($self->varexpand($self->{'baseurl'}));
-}
+ while (<CONF>) {
+ next if /^#/ or /^$/;
-
-sub sourceroot {
- my $self = shift;
- return($self->varexpand($self->{'sourceroot'}));
-}
-
-
-sub sourcerootname {
- my $self = shift;
- return($self->varexpand($self->{'srcrootname'}));
-}
-
-
-sub incprefix {
- my $self = shift;
- return($self->varexpand($self->{'incprefix'}));
-}
-
-
-sub dbdir {
- my $self = shift;
- return($self->varexpand($self->{'dbdir'}));
-}
-
-
-sub glimpsebin {
- my $self = shift;
- return($self->varexpand($self->{'glimpsebin'}));
-}
-
-sub htdigbin {
- my $self = shift;
- return ($self->varexpand($self->{'htdigbin'}));
-}
-
-sub htdigconf {
- my $self = shift;
- return($self->varexpand($self->{'htdigconf'}));
-}
-
-
-sub htmlhead {
- my $self = shift;
- return($self->varexpand($self->{'htmlhead'}));
-}
-
-
-sub htmltail {
- my $self = shift;
- return($self->varexpand($self->{'htmltail'}));
-}
-
-
-sub htmldir {
- my $self = shift;
- return($self->varexpand($self->{'htmldir'}));
-}
-
-
-sub mappath {
- my ($self, $path, @args) = @_;
- my (%oldvars) = %{$self->{variable}};
- my ($m);
-
- foreach $m (@args) {
- $self->{variable}->{$1} = $2 if $m =~ /(.*?)=(.*)/;
- }
-
- foreach $m (@{$self->{maplist}}) {
- $path =~ s/$m->[0]/$self->varexpand($m->[1])/e;
+ if (/\s*(\w+)\s*:\s*(.+)$/) {
+ $self->{$1} = $2;
}
+ }
- $self->{variable} = {%oldvars};
- return($path);
+ close CONF;
}
-#sub mappath {
-# my ($self, $path) = @_;
-# my ($m);
-#
-# foreach $m (@{$self->{maplist}}) {
-# $path =~ s/$m->[0]/$self->varexpand($m->[1])/e;
-# }
-# return($path);
-#}
+sub AUTOLOAD {
+ my $self = shift;
+ my $type = ref($self)
+ or die "$self is not an object\n";
+ my $name = $AUTOLOAD;
+ $name =~ s/.*://; # strip fully-qualified version
+ if (@_) {
+ return $self->{$name} = shift;
+ }
+ else {
+ return $self->{$name};
+ }
+}
1;