[69] | 1 | #!/usr/bin/perl -w |
---|
| 2 | # |
---|
| 3 | # idlwave_catalog |
---|
| 4 | # |
---|
| 5 | # Program to create IDLWAVE library catalogs. |
---|
| 6 | # |
---|
| 7 | # (c) 2002-2004 J.D. Smith <jdsmith@as.arizona.edu> |
---|
| 8 | # |
---|
| 9 | # Scans all IDL ".pro" files at the current level and recursively in |
---|
| 10 | # all directories beneath it, compiling a catalog of information for |
---|
| 11 | # each directory with any routines found, stored in a file named |
---|
| 12 | # ".idlwave_catalog". Any such "library catalogs" on the IDL path |
---|
| 13 | # will be automatically loaded into IDLWAVE. |
---|
| 14 | # |
---|
| 15 | # Usage: idlwave_catalog [-l] [-v] [-d] [-s] [-f] [-x PATTERN] [-h] libname |
---|
| 16 | # libname - Unique name of the catalog (4 or more alphanumeric |
---|
| 17 | # characters -- only 10 will be shown in routine info). |
---|
| 18 | # -l - Scan local directory only, otherwise recursively |
---|
| 19 | # catalog all directories at or beneath this one. |
---|
| 20 | # -v - Print verbose information. |
---|
| 21 | # -d - Instead of scanning, delete all .idlwave_catalog files |
---|
| 22 | # here or below. |
---|
| 23 | # -s - Be silent. |
---|
| 24 | # -f - Force overwriting any catalogs found with a different |
---|
| 25 | # library name. |
---|
| 26 | # -x - Skip directories matching the passed pattern |
---|
| 27 | # -h - Print this usage. |
---|
| 28 | # |
---|
| 29 | # You can arrange to have this script run automatically to update |
---|
| 30 | # libraries which change frequently. The name will be used to refer |
---|
| 31 | # to the routines collectively, so make it unique and descriptive |
---|
| 32 | # (without spaces). E.g. "NasaLib". A file named .idlwave_catalog |
---|
| 33 | # will be created in each directory with ".pro" routine files. |
---|
| 34 | # |
---|
| 35 | # $Id: idlwave_catalog,v 1.5 2004/10/13 20:34:07 jdsmith Exp $ |
---|
| 36 | |
---|
| 37 | use Getopt::Std; |
---|
| 38 | $opt_l=$opt_s=$opt_f=$opt_v=$opt_d=$opt_h=0; |
---|
| 39 | getopt('x'); |
---|
| 40 | $opt_v=0 if $opt_s; |
---|
| 41 | |
---|
| 42 | usage() if $opt_h; |
---|
| 43 | |
---|
| 44 | unless ($opt_d) { |
---|
| 45 | $libname=shift or usage(); |
---|
| 46 | if (length($libname)<=3 or ($libname=~tr/A-Za-z0-9_//c)) { |
---|
| 47 | die |
---|
| 48 | "LibName must be alphanumeric, >3 characters, and contains no spaces.\n" |
---|
| 49 | } |
---|
| 50 | } |
---|
| 51 | |
---|
| 52 | $cat=".idlwave_catalog"; |
---|
| 53 | |
---|
| 54 | unless ($opt_l) { |
---|
| 55 | use File::Find; |
---|
| 56 | find(sub{ |
---|
| 57 | if (/\Q$cat\E$/) { |
---|
| 58 | if ($opt_d) { |
---|
| 59 | if (unlink $_) { |
---|
| 60 | print "Removing catalog $File::Find::name\n" if $opt_v; |
---|
| 61 | } else { |
---|
| 62 | warn "Can't remove catalog $File::Find::name: $!\n" |
---|
| 63 | unless $opt_s; |
---|
| 64 | } |
---|
| 65 | } else { |
---|
| 66 | $dirs{$File::Find::dir}{cat}=libname($_); |
---|
| 67 | } |
---|
| 68 | return; |
---|
| 69 | } |
---|
| 70 | return if $opt_d; |
---|
| 71 | return unless -f and /\.pro$/i; |
---|
| 72 | parsefile($File::Find::dir, $_); |
---|
| 73 | }, '.'); |
---|
| 74 | } else { #Just process the local directory |
---|
| 75 | opendir(DIR,".") || die "Can't open this directory: $!"; |
---|
| 76 | if (-f $cat) { |
---|
| 77 | if ($opt_d) { |
---|
| 78 | if (unlink $cat) { |
---|
| 79 | print "Removing catalog $cat\n" if $opt_v; |
---|
| 80 | } else { |
---|
| 81 | warn "Can't remove catalog $cat: $!\n" unless $opt_s; |
---|
| 82 | } |
---|
| 83 | } else { |
---|
| 84 | $dirs{"."}{cat}=libname($cat); |
---|
| 85 | } |
---|
| 86 | } |
---|
| 87 | unless($opt_d) { |
---|
| 88 | foreach (grep {-f and /\.pro$/i} readdir(DIR)) { |
---|
| 89 | parsefile(".",$_); |
---|
| 90 | } |
---|
| 91 | } |
---|
| 92 | closedir DIR; |
---|
| 93 | } |
---|
| 94 | |
---|
| 95 | exit if $opt_d; #Nothing more to do |
---|
| 96 | |
---|
| 97 | foreach $dir (keys %dirs) { |
---|
| 98 | if ($opt_x and $dir=~/$opt_x/) { |
---|
| 99 | print "Skipping $dir\n" if $opt_v; |
---|
| 100 | next; |
---|
| 101 | } |
---|
| 102 | next if !defined($dirs{$dir}{pro}) || !$dirs{$dir}{pro}; |
---|
| 103 | print "Cataloging $dir\n" if $opt_v; |
---|
| 104 | |
---|
| 105 | if (exists $dirs{$dir}{cat} && $dirs{$dir}{cat} ne $libname) { |
---|
| 106 | if ($opt_f) { |
---|
| 107 | warn "Overwriting existing \"$dirs{$dir}{cat}\" catalog in " . |
---|
| 108 | ($dir eq "."?"this directory":$dir) . ".\n" unless $opt_s; |
---|
| 109 | } else { |
---|
| 110 | warn "Skipping existing \"$dirs{$dir}{cat}\" catalog in " . |
---|
| 111 | ($dir eq "."?"this directory":$dir) . |
---|
| 112 | " (-f overrides).\n" unless $opt_s; |
---|
| 113 | next; |
---|
| 114 | } |
---|
| 115 | } |
---|
| 116 | |
---|
| 117 | unless (open CATALOG, ">$dir/$cat") { |
---|
| 118 | warn "Can't open catalog file $dir/$cat for writing... skipping\n"; |
---|
| 119 | next; |
---|
| 120 | } |
---|
[77] | 121 | # $time=localtime(); |
---|
[69] | 122 | print CATALOG <<EOF; |
---|
| 123 | ;; |
---|
| 124 | ;; IDLWAVE catalog for library $libname |
---|
| 125 | ;; Automatically Generated -- do not edit. |
---|
[76] | 126 | ;; Created by idlwave_catalog |
---|
[69] | 127 | ;; |
---|
| 128 | (setq idlwave-library-catalog-libname "$libname") |
---|
| 129 | (setq idlwave-library-catalog-routines |
---|
| 130 | EOF |
---|
| 131 | print CATALOG " '(".join("\n ",@{$dirs{$dir}{pro}}); |
---|
| 132 | print CATALOG "))\n"; |
---|
| 133 | |
---|
| 134 | } |
---|
| 135 | |
---|
| 136 | if($opt_v && !%dirs) { |
---|
| 137 | print $opt_l?"Current directory contains no .pro files.\n": |
---|
| 138 | "No directories with .pro files found.\n"; |
---|
| 139 | } |
---|
| 140 | |
---|
| 141 | sub parsefile { |
---|
| 142 | my ($dir,$file)=@_; |
---|
| 143 | my ($call,@kwds,@args,@entries); |
---|
| 144 | open FILE, $file; |
---|
| 145 | while (<FILE>) { |
---|
| 146 | next unless |
---|
| 147 | /^[ \t]*(pro|function)[ \t]+(?:([a-zA-Z0-9\$_]+)::)?([a-zA-Z0-9\$_]+)/i; |
---|
| 148 | ($type,$class,$name)=(lc($1) eq "pro"?"pro":"fun",$2,$3); |
---|
| 149 | $call=""; |
---|
| 150 | @kwds=@args=(); |
---|
| 151 | while (/[ \t]*\$\s*(;.*)?[\r\n]+/) { # Continuations |
---|
| 152 | $call.=$`; |
---|
| 153 | $_=<FILE>; |
---|
| 154 | while (/^\s*(;.*)?[\r\n]+/) {$_=<FILE>} #skip blank or comment lines |
---|
| 155 | } |
---|
| 156 | s/\s*(;.*)?[\r\n]+//; |
---|
| 157 | $call.=$_; |
---|
| 158 | while($call=~/,\s*([a-zA-Z][a-zA-Z0-9\$_]*|(?:_ref)?_extra)\s*(=)?/gi) { |
---|
| 159 | if ($2) { |
---|
| 160 | push @kwds, $1; |
---|
| 161 | } else { |
---|
| 162 | push @args, $1; |
---|
| 163 | } |
---|
| 164 | } |
---|
| 165 | $is_func=$type eq "fun"; |
---|
| 166 | @kwds=sort {lc($a) cmp lc($b)} @kwds; |
---|
| 167 | |
---|
| 168 | # Name type class |
---|
| 169 | push @{$dirs{$dir}{pro}}, |
---|
| 170 | qq{("$name" $type } . ($class?qq("$class"):"nil") . |
---|
| 171 | # Source (source-type file dir library-name) |
---|
| 172 | qq< (lib "$file" nil "$libname") > . |
---|
| 173 | #Calling sequence |
---|
| 174 | '"' . ($is_func?"Result = ":"") . ($class?'Obj ->[%s::]':"") . '%s' . |
---|
| 175 | # Argument list |
---|
| 176 | (@args?($is_func?"(":", ") . |
---|
| 177 | join(", ",@args) . |
---|
| 178 | ($is_func?')':""):"") . '"' . |
---|
| 179 | # Keywords |
---|
| 180 | ' (nil' . (@kwds?' ("'.join('") ("', @kwds).'")':"") . "))"; |
---|
| 181 | } |
---|
| 182 | close FILE; |
---|
| 183 | return |
---|
| 184 | |
---|
| 185 | } |
---|
| 186 | |
---|
| 187 | sub libname { |
---|
| 188 | my $file=shift; |
---|
| 189 | open FILE, $file; |
---|
| 190 | while (<FILE>) { |
---|
| 191 | return $1 if /\(setq idlwave-library-catalog-libname "([^"]+)"\)/; |
---|
| 192 | } |
---|
| 193 | ""; |
---|
| 194 | } |
---|
| 195 | |
---|
| 196 | sub usage { |
---|
| 197 | print <<EOF; |
---|
| 198 | Usage: idlwave_catalog [-l] [-v] [-d] [-s] [-f] [-h] [-x PATTERN] libname |
---|
| 199 | libname - Unique name of the catalog (4 or more alphanumeric |
---|
| 200 | characters -- only 10 will be shown in routine info). |
---|
| 201 | -l - Scan local directory only, otherwise recursively |
---|
| 202 | catalog all directories at or beneath this one. |
---|
| 203 | -v - Print verbose information. |
---|
| 204 | -d - Instead of scanning, delete all .idlwave_catalog files |
---|
| 205 | here or below. |
---|
| 206 | -s - Be silent. |
---|
| 207 | -f - Force overwriting any catalogs found with a different |
---|
| 208 | library name. |
---|
| 209 | -x - Skip directories matching the passed pattern. |
---|
| 210 | -h - Print this usage. |
---|
| 211 | EOF |
---|
| 212 | exit; |
---|
| 213 | } |
---|
| 214 | |
---|