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 | } |
---|
121 | # $time=localtime(); |
---|
122 | print CATALOG <<EOF; |
---|
123 | ;; |
---|
124 | ;; IDLWAVE catalog for library $libname |
---|
125 | ;; Automatically Generated -- do not edit. |
---|
126 | ;; Created by idlwave_catalog |
---|
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 | |
---|