summaryrefslogtreecommitdiff
path: root/biblio/bibtex/utils/bibview
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /biblio/bibtex/utils/bibview
Initial commit
Diffstat (limited to 'biblio/bibtex/utils/bibview')
-rw-r--r--biblio/bibtex/utils/bibview/bibview.pl-0.2.2538
1 files changed, 538 insertions, 0 deletions
diff --git a/biblio/bibtex/utils/bibview/bibview.pl-0.2.2 b/biblio/bibtex/utils/bibview/bibview.pl-0.2.2
new file mode 100644
index 0000000000..a0201ffbae
--- /dev/null
+++ b/biblio/bibtex/utils/bibview/bibview.pl-0.2.2
@@ -0,0 +1,538 @@
+#!/usr/local/bin/perl
+#
+# bibview : view a BibTeX database and interactively search through it
+# Copyright 1992, Dana Jacobsen (jacobsd@cs.orst.edu)
+#
+#version = "0.1.0"; # 25 Aug 92 jacobsd Wrote original version
+#version = "0.2.0"; # 25 Aug 92 jacobsd added options
+#version = "0.2.1"; # 26 Aug 92 jacobsd added options
+$version = "0.2.2"; # 26 Aug 92 jacobsd fast status, command changes
+#
+# todo:
+# things in help that are not yet implemented
+# understand multiple bibliographies
+# allow "show 1-10 15"
+# support for AND and OR
+#
+# All bug-fixes, suggestions, flames, and compliments gladly accepted.
+#
+
+$ignorewords = "of and the in a on to for from an with by at as its";
+$displaymode = 'brief';
+$autoshow = 0;
+$sortoutput = 0;
+
+while (@ARGV) {
+ $_ = shift @ARGV;
+ /^--$/ && do { push(@files, @ARGV); undef @ARGV; next; };
+ /^-deb/ && do { $debugging = 1; next; };
+ /^-wor/ && do { $worddebug = 1; next; };
+ push (@files, $_);
+}
+
+# globals:
+#
+# $records{$citekey} : the full entry, verbatim
+# $authors{$citekey} : the author field
+# $titles{$citekey} : the title field
+# $inauthors{$name} : a $; seperated list of citekeys
+# $intitles{$word} : a $; seperated list of citekeys
+#
+# @result : a numbered array with citekeys of last result
+
+print "bibview $version by Dana Jacobsen, 1992\n";
+
+foreach $infile (@files) {
+ &readbibfile($infile);
+}
+
+$timetoquit = 0;
+
+until ($timetoquit) {
+ print "> ";
+ chop($command = <STDIN>);
+ $_ = $command;
+
+ if (/^load /i) {
+ ($dummy, $infile) = split;
+ &readbibfile($infile);
+ } elsif (/^write /i) {
+
+ } elsif (/^\w+\s*=/i) {
+ &handlesearch($command);
+ print " -- ", ($#result == 0) ? "1 entry" :
+ ($#result == -1 ? "no" : $#result+1, " entries"), " found.\n";
+ $autoshow && &printrecs(0, @result);
+ } elsif (s/^and\s+(\w+\s*=)/$1/i) {
+ local(%dummyaar);
+ local(@dresult) = @result;
+ &handlesearch($_);
+ grep($dummyaar{$_}++, @dresult);
+ @result = grep($dummyaar{$_}, @result);
+ print " -- ", ($#result == 0) ? "1 entry" :
+ ($#result == -1 ? "no" : $#result+1, " entries"), " found.\n";
+ $autoshow && &printrecs(0, @result);
+ } elsif (s/^or\s+(\w+\s*=)/$1/i) {
+ local(@iresult, %dummyaar);
+ local(@dresult) = @result;
+ &handlesearch($_);
+ grep($dummyaar{$_}++, @dresult);
+ @iresult = grep(!$dummyaar{$_}, @result);
+ @result = (@dresult, @iresult);
+ print " -- ", ($#result == 0) ? "1 entry" :
+ ($#result == -1 ? "no" : $#result+1, " entries"), " found.\n";
+ $autoshow && &printrecs(0, @result);
+ } elsif (/^set\s+display\s+brief/i) {
+ $displaymode = 'brief';
+ print "display mode set to $displaymode.\n";
+ } elsif (/^set\s+display\s+(full|bibtex)/i) {
+ $displaymode = 'full';
+ print "display mode set to $displaymode.\n";
+ } elsif (/^set\s+autoshow\s+true/i) {
+ $autoshow = 1;
+ print "autoshow set to true.\n";
+ } elsif (/^set\s+autoshow\s+false/i) {
+ $autoshow = 0;
+ print "autoshow set to false.\n";
+ } elsif (/^set\s+sort\s+true/i) {
+ $sortoutput = 1;
+ print "output sorting set to true.\n";
+ } elsif (/^set\s+sort\s+false/i) {
+ $sortoutput = 0;
+ print "output sorting set to false.\n";
+ } elsif (/^sort/i) {
+ @result = &titlesort(@result);
+ } elsif (/^status/i) {
+ print $#result+1, " records in last search result.\n";
+ if ($] > 4.019) {
+ print scalar(keys(%records)), " records loaded.\n";
+ print scalar(keys(%inauthors)), " unique author last names.\n";
+ print scalar(keys(%intitles)), " unique words in titles.\n";
+ } else {
+ $count = 0; $count++ while each %records;
+ print $count, " records loaded.\n";
+ $count = 0; $count++ while each %inauthors;
+ print $count, " unique author last names.\n";
+ $count = 0; $count++ while each %intitles;
+ print $count, " unique words in titles.\n";
+ }
+ print "display mode is $displaymode.\n";
+ print "autoshow is ", $autoshow ? "true" : "false", ".\n";
+ print "automatic output sorting is ", $sortoutput ? "true" : "false", ".\n";
+ } elsif (/^select\s+all/i) {
+ @result = sort keys(%records);
+ } elsif (/^display\s+authors/i) {
+ local(@dresult) = sort keys(%inauthors);
+ print join("\n", @dresult), "\n";
+ } elsif (/^display\s+titles/i) {
+ local(@dresult) = sort keys(%intitles);
+ print join("\n", @dresult), "\n";
+ } elsif (/^find\s+duplicates/i) {
+ &finddups();
+ } elsif (/^debug\s+on/i) {
+ $debugging = 1;
+ } elsif (/^debug\s+off/i) {
+ $debugging = 0;
+ } elsif (/^(detail|brief|show)/i) {
+ $oldmode = $displaymode;
+ if (s/^detail\s*//) {
+ $displaymode = 'full';
+ } elsif (s/^brief\s*//) {
+ $displaymode = 'brief';
+ } elsif (s/^show\s*//) {
+ # nothing
+ }
+ /^$/ && ($_ = "all");
+ foreach $num (split) {
+ $debugging && print "$num\n";
+ if ($num eq all) {
+ &printrecs(0, @result);
+ } else {
+ &printrecs($num-1, $result[$num-1]);
+ }
+ }
+ $displaymode = $oldmode;
+ } elsif (/^quit/i) {
+ $timetoquit = 1;
+ } elsif (/^(\?|help)/i) {
+ print "load <file> -- load <file>\n";
+ print "a=<name> -- find author exactly matching <name>\n";
+ print "a=/<name> -- find author matching the regex <name>\n";
+ print "t=<word> -- find title containing the word <word>\n";
+ print "t=/<word> -- find title containing the regex <word>\n";
+ print "<field> = /<text> -- find field containing the regex <text>\n";
+ print "and <search> -- logical and the results with <search>\n";
+ print "or <search> -- logical or the results with <search>\n";
+ print "set display brief -- use one line per record when displaying\n";
+ print "set display full -- use BibTeX record when displaying\n";
+ print "set autoshow true -- display results after search\n";
+ print "set autoshow false -- don't display results after search\n";
+ print "select all -- select all records loaded\n";
+ print "show [all | <n>..] -- show <n>th result(s) or all\n";
+ print "brief [all | <n>..] -- display result(s) <n> in brief format\n";
+ print "detail [all | <n>..] -- display result <n> in BibTeX format\n";
+ print "status -- show status of bibview\n";
+ print "quit -- quit bibview\n";
+ print "!<command> -- execute <command> via the shell\n";
+ print "-----------------------\n";
+ print "not implemented yet:\n";
+ print "write <file> -- write search results to <file>\n";
+ print "load all in <subj> -- load all files in <subj> biblio directory\n";
+ print "unload <file> -- remove entries from <file>\n";
+ print "unload all in <subj> -- remove entries from biblios in <subj>\n";
+ print "display mode lib -- display records in tagged field format\n";
+ print "delete [all | <n>..] -- delete results from memory\n";
+ print "find duplicates -- selects duplicate entries\n";
+ } elsif (/^\s*$/) {
+ # nothing
+ } elsif (s/^!//) {
+ system($_);
+ } else {
+ print "Unrecognized command. Use ? for help.\n";
+ }
+}
+
+
+########################################
+########################################
+########################################
+
+sub readbibfile {
+ local ($file) = @_;
+ local ($num) = 0;
+ local ($dups) = 0;
+ local ($oldpipe) = $|;
+
+ # this little gem is from Larry Wall -- expand ~user.
+ $file =~ s#^(~([a-z0-9]+))(/.*)?$#((getpwnam($2))[7]||$1).$3#e;
+ # this is mine -- handle ~/file
+ $file =~ s#^(~)(/.*)?$#((getpwnam(getlogin))[7]||$1).$2#e;
+
+ open (IN, $file) || open (IN, "$file.bib") ||
+ ((warn "Can't open $file: $!\n"), return 0);
+ $| = 1;
+ print "loading $file..";
+
+ while (! eof(IN)) {
+ $key = &bibtexread(*IN);
+
+ if ((!$records{$key}) && $key) {
+ $num++;
+ ($num % 50) || print ".";
+ $records{$key} = $entry{FULL};
+
+ $authors{$key} = $entry{author};
+
+ if ($entry{booktitle}) {
+ if ($entry{title}) {
+ $titles{$key} = $entry{title} . ' in ' . $entry{booktitle};
+ } else {
+ $titles{$key} = $entry{booktitle};
+ }
+ } else {
+ $titles{$key} = $entry{title};
+ }
+
+ foreach $auth (split(/ and /, $entry{author})) {
+ $name = &parsename($auth);
+ $name =~ tr/A-Za-z0-9\-//cd; # delete non-alphanumerics
+ $name =~ tr/A-Z/a-z/; # everything lowercase
+ $inauthors{$name} .= $; . $key;
+ }
+
+ foreach $word (split(/\s+/, $titles{$key})) {
+ $word =~ tr/A-Za-z0-9\-//cd;
+ $word =~ tr/A-Z/a-z/;
+ if ($word && (index($ignorewords, $word) == -1)) {
+ if ($worddebug) { print "$word\n"; }
+ $intitles{$word} .= $; . $key;
+ }
+ }
+ } else {
+ $key && $debugging && print "Duplicate cite key: not adding $key\n";
+ $key && $dups++;
+ }
+ }
+ $| = $oldpipe;
+ print "$num entries.";
+ print $dups ? " $dups duplicate cite keys.\n" : "\n";
+}
+
+########################################
+sub handlesearch {
+ local($_) = @_;
+ local($afield, $lfield, $lvalue, $lval, $cite, $val);
+ local(%resaar);
+ local(%atolar) = ('a', 'author',
+ 't', 'title',
+ );
+ @result = ();
+
+ if ( ($afield, $lvalue) = /^(\w)\s*=\s*(.*)$/ ) {
+ $lfield = $atolar{$afield};
+ if (!$lfield) {
+ print "No abbreviation for $afield. Spell out the field name.\n";
+ return;
+ }
+ } else {
+ ($lfield, $lvalue) = /^(\w+)\s*=\s*(.*)$/;
+ $lfield =~ tr/A-Z/a-z/;
+ }
+ $debugging && print "lfield: $lfield, lvalue: $lvalue\n";
+ if (substr($lvalue, 0, 1) eq '/') { # regex search
+ substr($lvalue, 0, 1) = '';
+ print "$lfield is /$lvalue/";
+ if ($lfield eq author) {
+ while (($cite, $val) = each %authors) {
+ ($val =~ /$lvalue/i) && (push(@result, $cite));
+ }
+ } elsif ($lfield eq title) {
+ while (($cite, $val) = each %titles) {
+ ($val =~ /$lvalue/i) && (push(@result, $cite));
+ }
+ } else { # long search.
+ # (this implementation could result in false matches)
+ while (($cite, $val) = each %records) {
+ ($val =~ /$lfield\s*=.*$lvalue/i) && (push(@result, $cite));
+ }
+ }
+ } else { # exact search
+ print "$lfield is $lvalue";
+ $lvalue =~ tr/A-Za-z0-9\-//cd;
+ $lvalue =~ tr/A-Z/a-z/;
+ if ($lfield =~ /^author$/) {
+ @result = split(/$;/, $inauthors{$lvalue});
+ } elsif ($lfield =~ /^title$/) {
+ @result = split(/$;/, $intitles{$lvalue});
+ } else {
+ print " -- Exact matching on $lfield not available.\n";
+ return;
+ }
+ shift @result;
+ }
+ # weed out any duplicates that might have cropped up
+ grep($resaar{$_}++, @result);
+ @result = grep($resaar{$_}-- == 1, @result);
+
+ $sortoutput && (@result = &titlesort(@result));
+}
+
+########################################
+sub titlesort {
+ return(sort { $titles{$a} cmp $titles{$b}; } @_);
+}
+
+########################################
+sub printrecs {
+ local($cite, $auth, $names);
+ local($num) = shift(@_);
+
+ foreach $cite (@_) {
+ next if (!$cite);
+ $num++;
+ $debugging && print "cite: $cite\n";
+
+ if ($displaymode eq full) {
+ print $records{$cite}, "\n";
+ } else {
+ $names = '';
+ foreach $auth (split(/ and /, $authors{$cite})) {
+ $names .= ', ' . &parsename($auth);
+ }
+ $names =~ s/^, //;
+ $debugging && print ":$num:$names:$titles{$cite}:\n";
+ printf "%3d %-20s %-50s\n",
+ $num,
+ substr($names, 0, 20),
+ substr($titles{$cite}, 0, 50);
+ }
+ }
+}
+
+
+########################################
+# sets @result to a list of citekeys of duplicates
+sub finddups {
+ local($curtitle);
+ local($cite, $ocite, $name);
+ local($type, $otype);
+ local(@auths, @restauths);
+ local(%resaar);
+
+ @result = ();
+ foreach $name (keys %inauthors) {
+ $debugging && print "$name:";
+ @auths = split(/$;/, $inauthors{$name});
+ shift @auths;
+ @restauths = @auths;
+ foreach $cite (@auths) {
+ $curtitle = $titles{$cite};
+ ($type) = ($records{$cite} =~ /^\s*@\s*(\w+)/);
+ shift(@restauths);
+ foreach $ocite (@restauths) {
+ next if $cite eq $ocite;
+ ($otype) = ($records{$ocite} =~ /^\s*@\s*(\w+)/);
+ next if $type ne $otype;
+ next if $curtitle ne $titles{$ocite};
+ # author in common, same type, and same title
+ push(@result, $cite, $ocite);
+ }
+ }
+ }
+ $debugging && print "\n";
+
+ grep($resaar{$_}++, @result);
+ @result = grep($resaar{$_}-- == 1, @result);
+
+ print "", ($#result == 0) ? "1 duplicate" :
+ ($#result == -1 ? "no" : $#result+1, " duplicates"), " found.\n";
+}
+
+########################################
+#
+# parsename takes a name in BibTeX format, and parses it into
+# parts. It returns the last name. The following globals are
+# set:
+# $First, $von, $Last, $Jr
+
+sub parsename {
+ local($name) = @_;
+ local($doinglast) = 0;
+ local($part) = 0;
+ local($p1, $p2, $p3);
+ local($sing, $dummy);
+
+ ($dummy, $sing, $dummy) = $name =~ /(^|\s){(.*)}(\s|$)/;
+ $name =~ s/(^|\s){(.*)}(\s|$)/$1ASingleNameString$3/;
+ $First = $von = $Last = $Jr = '';
+
+ ($p1, $p2, $p3) = split(/,/, $name, 3);
+ if ($p3) {
+ $First = $p3;
+ $Jr = $p2;
+ if ($p1 =~ s/^\s*{(.*)}\s*$/$1/) {
+ $Last = $p1;
+ } else {
+ while ($p1 =~ /^[a-z]/) {
+ ($part) = $p1 =~ /^(\S+)/;
+ $p1 =~ s/^(\S+)\s*//;
+ $von .= ' ' . $part;
+ }
+ $Last = $p1;
+ }
+ } elsif ($p2) {
+ $First = $p2;
+ if ($p1 =~ s/^\s*{(.*)}\s*$/$1/) {
+ $Last = $p1;
+ } else {
+ while ($p1 =~ /^[a-z]/) {
+ ($part) = $p1 =~ /^(\S+)/;
+ $p1 =~ s/^(\S+)\s*//;
+ $von .= ' ' . $part;
+ }
+ $Last = $p1;
+ }
+ } else {
+ if ($p1 =~ s/^\s*{(.*)}\s*$/$1/) {
+ $Last = $p1;
+ } else {
+ while ($p1 =~ /^[A-Z]/) {
+ ($part) = $p1 =~ /^(\S+)/;
+ $p1 =~ s/^(\S+)\s*//;
+ $First .= ' ' . $part;
+ }
+ while ($p1 =~ /^[a-z]/) {
+ ($part) = $p1 =~ /^(\S+)/;
+ $p1 =~ s/^(\S+)\s*//;
+ $von .= ' ' . $part;
+ }
+ if ($p1) {
+ $Last = $p1;
+ } else {
+ ($Last) = $First =~ /\s+(\S+)\s*$/;
+ $First =~ s/\s+\S+\s*$//;
+ }
+ }
+ }
+ $Last =~ s/ASingleNameString/$sing/;
+ $Last =~ s/^\s+//;
+ $von =~ s/^\s+//;
+ $First =~ s/^\s+//;
+ $Jr =~ s/^\s+//;
+ # handle "et al" or "others"
+ if ( (!$Last) && ($von =~ /^(others|et\.?\s*al)\.?$/i) ) {
+ $Last = "others";
+ $von = '';
+ }
+ if ($debugging) {
+ $name =~ s/ASingleNameString/$sing/;
+ $name =~ s/^\s+//;
+ printf "%20s: %-15s %-10s %-20s %-10s\n", $name, $First, $von, $Last, $Jr;
+ }
+ return ($Last);
+}
+
+
+########################################
+#
+# split out the field parsing into a seperate routine.
+# so we read in verbatim, then call &bibtexexplode to seperate
+# into %entry.
+#
+sub bibtexread {
+ local(*FILE) = @_;
+ local($braces) = 1;
+ local($ent, $delim);
+ local($field, $value, @values);
+
+ %entry = ();
+
+ while (<FILE>) {
+ last if /^\s*@/;
+ }
+ if (!/,/) { # preamble is split on multiple lines
+ $ent = $_;
+ while (<FILE>) {
+ $ent .= $_;
+ last if /,/;
+ }
+ $_ = $ent;
+ }
+ return 0 if eof(FILE);
+ return 0 if /^\s*@\s*string/i;
+ return 0 if /^\s*@\s*preamble/i;
+ $ent = $_;
+ ( ($entry{type}, $delim, $entry{citekey})
+ = /^\s*@\s*(\w+)\s*([{(])\s*(\S+)\s*,\s*$/)
+ || do { print "Error getting line: $_\n"; return 0; };
+ $debugging && print $entry{type}, $delim, $entry{citekey}, "\n";
+ if ($delim eq '{') {
+ while (<FILE>) {
+ $ent .= $_;
+ $braces += s/{/{/g;
+ $braces -= s/}/}/g;
+ last if ($braces <= 0);
+ }
+ $entry{FULL} = $ent;
+ $ent =~ s/}\s*$//;
+ } else {
+ while (<FILE>) {
+ $ent .= $_;
+ last if $ent =~ s/[)]\s*$//;
+ }
+ $entry{FULL} = $ent . ')';
+ }
+ $ent =~ s/\s+/ /g;
+ @values = split(/,\s*(\w+)\s*=\s*/, $ent);
+ $debugging && print join("//", @values), "\n";
+ shift(@values); # zap the beginning info
+ while (@values) {
+ $field = shift(@values);
+ $field =~ tr/A-Z/a-z/;
+ $value = shift(@values);
+ $value =~ s/^\s*{(.*)}\s*$/$1/;
+ $value =~ s/^\s*"(.*)"\s*$/$1/;
+ $entry{$field} = $value;
+ }
+ return($entry{citekey});
+}