To check out this repository please hg clone the following URL, or open the URL using EasyMercurial or your preferred Mercurial client.

Statistics Download as Zip
| Branch: | Tag: | Revision:

root / extra / soundsoftware @ 1538:87bea4981d6d

1 7:3c16ed8faa07 Chris
package Apache::Authn::SoundSoftware;
2
3
=head1 Apache::Authn::SoundSoftware
4
5
SoundSoftware - a mod_perl module for Apache authentication against a
6
Redmine database and optional LDAP implementing the access control
7
rules required for the SoundSoftware.ac.uk repository site.
8
9
=head1 SYNOPSIS
10
11
This module is closely based on the Redmine.pm authentication module
12
provided with Redmine.  It is intended to be used for authentication
13
in front of a repository service such as hgwebdir.
14
15
Requirements:
16
17
1. Clone/pull from repo for public project: Any user, no
18
authentication required
19
20
2. Clone/pull from repo for private project: Project members only
21
22
3. Push to repo for public project: "Permitted" users only (this
23 8:0c83d98252d9 Chris
probably means project members who are also identified in the hgrc web
24
section for the repository and so will be approved by hgwebdir?)
25 7:3c16ed8faa07 Chris
26 8:0c83d98252d9 Chris
4. Push to repo for private project: "Permitted" users only (as above)
27 7:3c16ed8faa07 Chris
28 300:034e9b00b341 chris
5. Push to any repo that is tracking an external repo: Refused always
29
30 7:3c16ed8faa07 Chris
=head1 INSTALLATION
31
32
Debian/ubuntu:
33
34
  apt-get install libapache-dbi-perl libapache2-mod-perl2 \
35
    libdbd-mysql-perl libauthen-simple-ldap-perl libio-socket-ssl-perl
36
37
Note that LDAP support is hardcoded "on" in this script (it is
38
optional in the original Redmine.pm).
39
40
=head1 CONFIGURATION
41
42
   ## This module has to be in your perl path
43
   ## eg:  /usr/local/lib/site_perl/Apache/Authn/SoundSoftware.pm
44
   PerlLoadModule Apache::Authn::SoundSoftware
45
46
   # Example when using hgwebdir
47
   ScriptAlias / "/var/hg/hgwebdir.cgi/"
48
49
   <Location />
50
       AuthName "Mercurial"
51
       AuthType Basic
52
       Require valid-user
53
       PerlAccessHandler Apache::Authn::SoundSoftware::access_handler
54
       PerlAuthenHandler Apache::Authn::SoundSoftware::authen_handler
55
       SoundSoftwareDSN "DBI:mysql:database=redmine;host=localhost"
56
       SoundSoftwareDbUser "redmine"
57
       SoundSoftwareDbPass "password"
58
       Options +ExecCGI
59
       AddHandler cgi-script .cgi
60
       ## Optional where clause (fulltext search would be slow and
61
       ## database dependant).
62
       # SoundSoftwareDbWhereClause "and members.role_id IN (1,2)"
63 8:0c83d98252d9 Chris
       ## Optional prefix for local repository URLs
64
       # SoundSoftwareRepoPrefix "/var/hg/"
65 7:3c16ed8faa07 Chris
  </Location>
66
67
See the original Redmine.pm for further configuration notes.
68
69
=cut
70
71
use strict;
72
use warnings FATAL => 'all', NONFATAL => 'redefine';
73
74
use DBI;
75
use Digest::SHA1;
76
use Authen::Simple::LDAP;
77
use Apache2::Module;
78
use Apache2::Access;
79
use Apache2::ServerRec qw();
80
use Apache2::RequestRec qw();
81
use Apache2::RequestUtil qw();
82
use Apache2::Const qw(:common :override :cmd_how);
83
use APR::Pool ();
84
use APR::Table ();
85
86
my @directives = (
87
  {
88
    name => 'SoundSoftwareDSN',
89
    req_override => OR_AUTHCFG,
90
    args_how => TAKE1,
91
    errmsg => 'Dsn in format used by Perl DBI. eg: "DBI:Pg:dbname=databasename;host=my.db.server"',
92
  },
93
  {
94
    name => 'SoundSoftwareDbUser',
95
    req_override => OR_AUTHCFG,
96
    args_how => TAKE1,
97
  },
98
  {
99
    name => 'SoundSoftwareDbPass',
100
    req_override => OR_AUTHCFG,
101
    args_how => TAKE1,
102
  },
103
  {
104
    name => 'SoundSoftwareDbWhereClause',
105
    req_override => OR_AUTHCFG,
106
    args_how => TAKE1,
107
  },
108
  {
109 8:0c83d98252d9 Chris
    name => 'SoundSoftwareRepoPrefix',
110 7:3c16ed8faa07 Chris
    req_override => OR_AUTHCFG,
111
    args_how => TAKE1,
112
  },
113
);
114
115
sub SoundSoftwareDSN {
116 8:0c83d98252d9 Chris
    my ($self, $parms, $arg) = @_;
117
    $self->{SoundSoftwareDSN} = $arg;
118
    my $query = "SELECT
119 7:3c16ed8faa07 Chris
                 hashed_password, auth_source_id, permissions
120
              FROM members, projects, users, roles, member_roles
121
              WHERE
122
                projects.id=members.project_id
123
                AND member_roles.member_id=members.id
124
                AND users.id=members.user_id
125
                AND roles.id=member_roles.role_id
126
                AND users.status=1
127
                AND login=?
128
                AND identifier=? ";
129 8:0c83d98252d9 Chris
    $self->{SoundSoftwareQuery} = trim($query);
130 7:3c16ed8faa07 Chris
}
131
132
sub SoundSoftwareDbUser { set_val('SoundSoftwareDbUser', @_); }
133
sub SoundSoftwareDbPass { set_val('SoundSoftwareDbPass', @_); }
134
sub SoundSoftwareDbWhereClause {
135 8:0c83d98252d9 Chris
    my ($self, $parms, $arg) = @_;
136
    $self->{SoundSoftwareQuery} = trim($self->{SoundSoftwareQuery}.($arg ? $arg : "")." ");
137 7:3c16ed8faa07 Chris
}
138
139 8:0c83d98252d9 Chris
sub SoundSoftwareRepoPrefix {
140
    my ($self, $parms, $arg) = @_;
141
    if ($arg) {
142
	$self->{SoundSoftwareRepoPrefix} = $arg;
143
    }
144 7:3c16ed8faa07 Chris
}
145
146
sub trim {
147 8:0c83d98252d9 Chris
    my $string = shift;
148
    $string =~ s/\s{2,}/ /g;
149
    return $string;
150 7:3c16ed8faa07 Chris
}
151
152
sub set_val {
153 8:0c83d98252d9 Chris
    my ($key, $self, $parms, $arg) = @_;
154
    $self->{$key} = $arg;
155 7:3c16ed8faa07 Chris
}
156
157
Apache2::Module::add(__PACKAGE__, \@directives);
158
159
160
my %read_only_methods = map { $_ => 1 } qw/GET PROPFIND REPORT OPTIONS/;
161
162
sub access_handler {
163 8:0c83d98252d9 Chris
    my $r = shift;
164 7:3c16ed8faa07 Chris
165 152:a389c77da9fd Chris
    print STDERR "SoundSoftware.pm: In access handler at " . scalar localtime() . "\n";
166 7:3c16ed8faa07 Chris
167 8:0c83d98252d9 Chris
    unless ($r->some_auth_required) {
168
	$r->log_reason("No authentication has been configured");
169
	return FORBIDDEN;
170
    }
171 7:3c16ed8faa07 Chris
172 8:0c83d98252d9 Chris
    my $method = $r->method;
173 7:3c16ed8faa07 Chris
174 8:0c83d98252d9 Chris
    print STDERR "SoundSoftware.pm: Method: $method, uri " . $r->uri . ", location " . $r->location . "\n";
175
    print STDERR "SoundSoftware.pm: Accept: " . $r->headers_in->{Accept} . "\n";
176 7:3c16ed8faa07 Chris
177 8:0c83d98252d9 Chris
    my $dbh = connect_database($r);
178 152:a389c77da9fd Chris
    unless ($dbh) {
179
	print STDERR "SoundSoftware.pm: Database connection failed!: " . $DBI::errstr . "\n";
180
	return FORBIDDEN;
181
    }
182
183 300:034e9b00b341 chris
    print STDERR "Connected to db, dbh is " . $dbh . "\n";
184 7:3c16ed8faa07 Chris
185 8:0c83d98252d9 Chris
    my $project_id = get_project_identifier($dbh, $r);
186 300:034e9b00b341 chris
187
    if (!defined $read_only_methods{$method}) {
188
        print STDERR "SoundSoftware.pm: Method is not read-only\n";
189
        if (project_repo_is_readonly($dbh, $project_id, $r)) {
190
            print STDERR "SoundSoftware.pm: Project repo is read-only, refusing access\n";
191
	    return FORBIDDEN;
192
        } else {
193
	    print STDERR "SoundSoftware.pm: Project repo is read-write, authentication handler required\n";
194
            return OK;
195
        }
196
    }
197
198 8:0c83d98252d9 Chris
    my $status = get_project_status($dbh, $project_id, $r);
199 7:3c16ed8faa07 Chris
200 8:0c83d98252d9 Chris
    $dbh->disconnect();
201
    undef $dbh;
202 7:3c16ed8faa07 Chris
203 8:0c83d98252d9 Chris
    if ($status == 0) { # nonexistent
204
	print STDERR "SoundSoftware.pm: Project does not exist, refusing access\n";
205
	return FORBIDDEN;
206
    } elsif ($status == 1) { # public
207
	print STDERR "SoundSoftware.pm: Project is public, no restriction here\n";
208
	$r->set_handlers(PerlAuthenHandler => [\&OK])
209
    } else { # private
210
	print STDERR "SoundSoftware.pm: Project is private, authentication handler required\n";
211
    }
212 7:3c16ed8faa07 Chris
213 8:0c83d98252d9 Chris
    return OK
214 7:3c16ed8faa07 Chris
}
215
216
sub authen_handler {
217 8:0c83d98252d9 Chris
    my $r = shift;
218
219 152:a389c77da9fd Chris
    print STDERR "SoundSoftware.pm: In authentication handler at " . scalar localtime() . "\n";
220 7:3c16ed8faa07 Chris
221 8:0c83d98252d9 Chris
    my $dbh = connect_database($r);
222 152:a389c77da9fd Chris
    unless ($dbh) {
223
        print STDERR "SoundSoftware.pm: Database connection failed!: " . $DBI::errstr . "\n";
224
        return AUTH_REQUIRED;
225
    }
226 8:0c83d98252d9 Chris
227
    my $project_id = get_project_identifier($dbh, $r);
228
    my $realm = get_realm($dbh, $project_id, $r);
229
    $r->auth_name($realm);
230
231
    my ($res, $redmine_pass) =  $r->get_basic_auth_pw();
232
    unless ($res == OK) {
233
	$dbh->disconnect();
234
	undef $dbh;
235
	return $res;
236
    }
237
238
    print STDERR "SoundSoftware.pm: User is " . $r->user . ", got password\n";
239
240
    my $permitted = is_permitted($dbh, $project_id, $r->user, $redmine_pass, $r);
241
242
    $dbh->disconnect();
243
    undef $dbh;
244
245
    if ($permitted) {
246
	return OK;
247
    } else {
248
	print STDERR "SoundSoftware.pm: Not permitted\n";
249
	$r->note_auth_failure();
250
	return AUTH_REQUIRED;
251
    }
252 7:3c16ed8faa07 Chris
}
253
254
sub get_project_status {
255 8:0c83d98252d9 Chris
    my $dbh = shift;
256 7:3c16ed8faa07 Chris
    my $project_id = shift;
257
    my $r = shift;
258 8:0c83d98252d9 Chris
259
    if (!defined $project_id or $project_id eq '') {
260
	return 0; # nonexistent
261
    }
262 7:3c16ed8faa07 Chris
263
    my $sth = $dbh->prepare(
264
        "SELECT is_public FROM projects WHERE projects.identifier = ?;"
265
    );
266
267
    $sth->execute($project_id);
268 8:0c83d98252d9 Chris
    my $ret = 0; # nonexistent
269 7:3c16ed8faa07 Chris
    if (my @row = $sth->fetchrow_array) {
270
    	if ($row[0] eq "1" || $row[0] eq "t") {
271
	    $ret = 1; # public
272
    	} else {
273 8:0c83d98252d9 Chris
	    $ret = 2; # private
274 7:3c16ed8faa07 Chris
	}
275
    }
276
    $sth->finish();
277
    undef $sth;
278
279
    $ret;
280
}
281
282 300:034e9b00b341 chris
sub project_repo_is_readonly {
283
    my $dbh = shift;
284
    my $project_id = shift;
285
    my $r = shift;
286
287
    if (!defined $project_id or $project_id eq '') {
288
        return 0; # nonexistent
289
    }
290
291
    my $sth = $dbh->prepare(
292
        "SELECT repositories.is_external FROM repositories, projects WHERE projects.identifier = ? AND repositories.project_id = projects.id;"
293
    );
294
295
    $sth->execute($project_id);
296
    my $ret = 0; # nonexistent
297
    if (my @row = $sth->fetchrow_array) {
298 301:6d3f8aeb51b7 chris
        if (defined($row[0]) && ($row[0] eq "1" || $row[0] eq "t")) {
299 300:034e9b00b341 chris
            $ret = 1; # read-only (i.e. external)
300
        } else {
301
            $ret = 0; # read-write
302
        }
303
    }
304
    $sth->finish();
305
    undef $sth;
306
307
    $ret;
308
}
309
310 8:0c83d98252d9 Chris
sub is_permitted {
311
    my $dbh = shift;
312
    my $project_id = shift;
313
    my $redmine_user = shift;
314
    my $redmine_pass = shift;
315
    my $r = shift;
316 7:3c16ed8faa07 Chris
317 8:0c83d98252d9 Chris
    my $pass_digest = Digest::SHA1::sha1_hex($redmine_pass);
318 7:3c16ed8faa07 Chris
319 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
320
	(__PACKAGE__, $r->server, $r->per_dir_config);
321 7:3c16ed8faa07 Chris
322 8:0c83d98252d9 Chris
    my $query = $cfg->{SoundSoftwareQuery};
323
    my $sth = $dbh->prepare($query);
324
    $sth->execute($redmine_user, $project_id);
325 7:3c16ed8faa07 Chris
326 8:0c83d98252d9 Chris
    my $ret;
327
    while (my ($hashed_password, $auth_source_id, $permissions) = $sth->fetchrow_array) {
328 7:3c16ed8faa07 Chris
329 8:0c83d98252d9 Chris
	# Test permissions for this user before we verify credentials
330
	# -- if the user is not permitted this action anyway, there's
331
	# not much point in e.g. contacting the LDAP
332 7:3c16ed8faa07 Chris
333 8:0c83d98252d9 Chris
	my $method = $r->method;
334 7:3c16ed8faa07 Chris
335 8:0c83d98252d9 Chris
	if ((defined $read_only_methods{$method} && $permissions =~ /:browse_repository/)
336
	    || $permissions =~ /:commit_access/) {
337
338
	    # User would be permitted this action, if their
339
	    # credentials checked out -- test those now
340
341
	    print STDERR "SoundSoftware.pm: User $redmine_user has required role, checking credentials\n";
342
343
	    unless ($auth_source_id) {
344
		if ($hashed_password eq $pass_digest) {
345
		    print STDERR "SoundSoftware.pm: User $redmine_user authenticated via password\n";
346
		    $ret = 1;
347
		    last;
348
		}
349
	    } else {
350
		my $sthldap = $dbh->prepare(
351
		    "SELECT host,port,tls,account,account_password,base_dn,attr_login FROM auth_sources WHERE id = ?;"
352
		    );
353
		$sthldap->execute($auth_source_id);
354
		while (my @rowldap = $sthldap->fetchrow_array) {
355
		    my $ldap = Authen::Simple::LDAP->new(
356
			host    => ($rowldap[2] eq "1" || $rowldap[2] eq "t") ? "ldaps://$rowldap[0]" : $rowldap[0],
357
			port    => $rowldap[1],
358
			basedn  => $rowldap[5],
359
			binddn  => $rowldap[3] ? $rowldap[3] : "",
360
			bindpw  => $rowldap[4] ? $rowldap[4] : "",
361
			filter  => "(".$rowldap[6]."=%s)"
362
			);
363
		    if ($ldap->authenticate($redmine_user, $redmine_pass)) {
364
			print STDERR "SoundSoftware.pm: User $redmine_user authenticated via LDAP\n";
365
			$ret = 1;
366
		    }
367
		}
368
		$sthldap->finish();
369
		undef $sthldap;
370
	    }
371
	} else {
372
	    print STDERR "SoundSoftware.pm: User $redmine_user lacks required role for this project\n";
373
	}
374 7:3c16ed8faa07 Chris
    }
375
376 8:0c83d98252d9 Chris
    $sth->finish();
377
    undef $sth;
378
379
    $ret;
380 7:3c16ed8faa07 Chris
}
381
382
sub get_project_identifier {
383 8:0c83d98252d9 Chris
    my $dbh = shift;
384 7:3c16ed8faa07 Chris
    my $r = shift;
385
386
    my $location = $r->location;
387
    my ($repo) = $r->uri =~ m{$location/*([^/]+)};
388 10:2c10dc5f122d Chris
389
    return $repo if (!$repo);
390
391 7:3c16ed8faa07 Chris
    $repo =~ s/[^a-zA-Z0-9\._-]//g;
392
393 8:0c83d98252d9 Chris
    # The original Redmine.pm returns the string just calculated as
394
    # the project identifier.  That won't do for us -- we may have
395
    # (and in fact already do have, in our test instance) projects
396
    # whose repository names differ from the project identifiers.
397
398
    # This is a rather fundamental change because it means that almost
399
    # every request needs more than one database query -- which
400
    # prompts us to start passing around $dbh instead of connecting
401
    # locally within each function as is done in Redmine.pm.
402
403 7:3c16ed8faa07 Chris
    my $sth = $dbh->prepare(
404
        "SELECT projects.identifier FROM projects, repositories WHERE repositories.project_id = projects.id AND repositories.url LIKE ?;"
405
    );
406
407 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
408
	(__PACKAGE__, $r->server, $r->per_dir_config);
409
410
    my $prefix = $cfg->{SoundSoftwareRepoPrefix};
411
    if (!defined $prefix) { $prefix = '%/'; }
412
413 7:3c16ed8faa07 Chris
    my $identifier = '';
414
415 8:0c83d98252d9 Chris
    $sth->execute($prefix . $repo);
416 7:3c16ed8faa07 Chris
    my $ret = 0;
417
    if (my @row = $sth->fetchrow_array) {
418
	$identifier = $row[0];
419
    }
420
    $sth->finish();
421
    undef $sth;
422
423 8:0c83d98252d9 Chris
    print STDERR "SoundSoftware.pm: Repository '$repo' belongs to project '$identifier'\n";
424 7:3c16ed8faa07 Chris
425
    $identifier;
426
}
427
428 8:0c83d98252d9 Chris
sub get_realm {
429
    my $dbh = shift;
430
    my $project_id = shift;
431
    my $r = shift;
432
433
    my $sth = $dbh->prepare(
434
        "SELECT projects.name FROM projects WHERE projects.identifier = ?;"
435
    );
436
437
    my $name = $project_id;
438
439
    $sth->execute($project_id);
440
    my $ret = 0;
441
    if (my @row = $sth->fetchrow_array) {
442
	$name = $row[0];
443
    }
444
    $sth->finish();
445
    undef $sth;
446
447
    # be timid about characters not permitted in auth realm and revert
448
    # to project identifier if any are found
449
    if ($name =~ m/[^\w\d\s\._-]/) {
450
	$name = $project_id;
451
    }
452
453
    my $realm = '"Mercurial repository for ' . "'$name'" . '"';
454
455
    $realm;
456
}
457
458 7:3c16ed8faa07 Chris
sub connect_database {
459
    my $r = shift;
460
461 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
462
	(__PACKAGE__, $r->server, $r->per_dir_config);
463
464
    return DBI->connect($cfg->{SoundSoftwareDSN},
465 152:a389c77da9fd Chris
	                $cfg->{SoundSoftwareDbUser},
466
		        $cfg->{SoundSoftwareDbPass});
467 7:3c16ed8faa07 Chris
}
468
469
1;
470
package Apache::Authn::SoundSoftware;
471
472
=head1 Apache::Authn::SoundSoftware
473
474
SoundSoftware - a mod_perl module for Apache authentication against a
475
Redmine database and optional LDAP implementing the access control
476
rules required for the SoundSoftware.ac.uk repository site.
477
478
=head1 SYNOPSIS
479
480
This module is closely based on the Redmine.pm authentication module
481
provided with Redmine.  It is intended to be used for authentication
482
in front of a repository service such as hgwebdir.
483
484
Requirements:
485
486
1. Clone/pull from repo for public project: Any user, no
487
authentication required
488
489
2. Clone/pull from repo for private project: Project members only
490
491
3. Push to repo for public project: "Permitted" users only (this
492 8:0c83d98252d9 Chris
probably means project members who are also identified in the hgrc web
493
section for the repository and so will be approved by hgwebdir?)
494 7:3c16ed8faa07 Chris
495 8:0c83d98252d9 Chris
4. Push to repo for private project: "Permitted" users only (as above)
496 7:3c16ed8faa07 Chris
497 300:034e9b00b341 chris
5. Push to any repo that is tracking an external repo: Refused always
498
499 7:3c16ed8faa07 Chris
=head1 INSTALLATION
500
501
Debian/ubuntu:
502
503
  apt-get install libapache-dbi-perl libapache2-mod-perl2 \
504
    libdbd-mysql-perl libauthen-simple-ldap-perl libio-socket-ssl-perl
505
506
Note that LDAP support is hardcoded "on" in this script (it is
507
optional in the original Redmine.pm).
508
509
=head1 CONFIGURATION
510
511
   ## This module has to be in your perl path
512
   ## eg:  /usr/local/lib/site_perl/Apache/Authn/SoundSoftware.pm
513
   PerlLoadModule Apache::Authn::SoundSoftware
514
515
   # Example when using hgwebdir
516
   ScriptAlias / "/var/hg/hgwebdir.cgi/"
517
518
   <Location />
519
       AuthName "Mercurial"
520
       AuthType Basic
521
       Require valid-user
522
       PerlAccessHandler Apache::Authn::SoundSoftware::access_handler
523
       PerlAuthenHandler Apache::Authn::SoundSoftware::authen_handler
524
       SoundSoftwareDSN "DBI:mysql:database=redmine;host=localhost"
525
       SoundSoftwareDbUser "redmine"
526
       SoundSoftwareDbPass "password"
527
       Options +ExecCGI
528
       AddHandler cgi-script .cgi
529
       ## Optional where clause (fulltext search would be slow and
530
       ## database dependant).
531
       # SoundSoftwareDbWhereClause "and members.role_id IN (1,2)"
532 8:0c83d98252d9 Chris
       ## Optional prefix for local repository URLs
533
       # SoundSoftwareRepoPrefix "/var/hg/"
534 7:3c16ed8faa07 Chris
  </Location>
535
536
See the original Redmine.pm for further configuration notes.
537
538
=cut
539
540
use strict;
541
use warnings FATAL => 'all', NONFATAL => 'redefine';
542
543
use DBI;
544 1331:1e9b1bdd062e Chris
use Digest::SHA;
545 7:3c16ed8faa07 Chris
use Authen::Simple::LDAP;
546
use Apache2::Module;
547
use Apache2::Access;
548
use Apache2::ServerRec qw();
549
use Apache2::RequestRec qw();
550
use Apache2::RequestUtil qw();
551
use Apache2::Const qw(:common :override :cmd_how);
552
use APR::Pool ();
553
use APR::Table ();
554
555
my @directives = (
556
  {
557
    name => 'SoundSoftwareDSN',
558
    req_override => OR_AUTHCFG,
559
    args_how => TAKE1,
560
    errmsg => 'Dsn in format used by Perl DBI. eg: "DBI:Pg:dbname=databasename;host=my.db.server"',
561
  },
562
  {
563
    name => 'SoundSoftwareDbUser',
564
    req_override => OR_AUTHCFG,
565
    args_how => TAKE1,
566
  },
567
  {
568
    name => 'SoundSoftwareDbPass',
569
    req_override => OR_AUTHCFG,
570
    args_how => TAKE1,
571
  },
572
  {
573
    name => 'SoundSoftwareDbWhereClause',
574
    req_override => OR_AUTHCFG,
575
    args_how => TAKE1,
576
  },
577
  {
578 8:0c83d98252d9 Chris
    name => 'SoundSoftwareRepoPrefix',
579 7:3c16ed8faa07 Chris
    req_override => OR_AUTHCFG,
580
    args_how => TAKE1,
581
  },
582 732:897bc2b63bfe Chris
  {
583
    name => 'SoundSoftwareSslRequired',
584
    req_override => OR_AUTHCFG,
585
    args_how => TAKE1,
586
  },
587 7:3c16ed8faa07 Chris
);
588
589
sub SoundSoftwareDSN {
590 8:0c83d98252d9 Chris
    my ($self, $parms, $arg) = @_;
591
    $self->{SoundSoftwareDSN} = $arg;
592
    my $query = "SELECT
593 301:6d3f8aeb51b7 chris
                 hashed_password, salt, auth_source_id, permissions
594 7:3c16ed8faa07 Chris
              FROM members, projects, users, roles, member_roles
595
              WHERE
596
                projects.id=members.project_id
597
                AND member_roles.member_id=members.id
598
                AND users.id=members.user_id
599
                AND roles.id=member_roles.role_id
600
                AND users.status=1
601
                AND login=?
602
                AND identifier=? ";
603 8:0c83d98252d9 Chris
    $self->{SoundSoftwareQuery} = trim($query);
604 7:3c16ed8faa07 Chris
}
605
606
sub SoundSoftwareDbUser { set_val('SoundSoftwareDbUser', @_); }
607
sub SoundSoftwareDbPass { set_val('SoundSoftwareDbPass', @_); }
608
sub SoundSoftwareDbWhereClause {
609 8:0c83d98252d9 Chris
    my ($self, $parms, $arg) = @_;
610
    $self->{SoundSoftwareQuery} = trim($self->{SoundSoftwareQuery}.($arg ? $arg : "")." ");
611 7:3c16ed8faa07 Chris
}
612
613 8:0c83d98252d9 Chris
sub SoundSoftwareRepoPrefix {
614
    my ($self, $parms, $arg) = @_;
615
    if ($arg) {
616
	$self->{SoundSoftwareRepoPrefix} = $arg;
617
    }
618 7:3c16ed8faa07 Chris
}
619
620 732:897bc2b63bfe Chris
sub SoundSoftwareSslRequired { set_val('SoundSoftwareSslRequired', @_); }
621
622 7:3c16ed8faa07 Chris
sub trim {
623 8:0c83d98252d9 Chris
    my $string = shift;
624
    $string =~ s/\s{2,}/ /g;
625
    return $string;
626 7:3c16ed8faa07 Chris
}
627
628
sub set_val {
629 8:0c83d98252d9 Chris
    my ($key, $self, $parms, $arg) = @_;
630
    $self->{$key} = $arg;
631 7:3c16ed8faa07 Chris
}
632
633
Apache2::Module::add(__PACKAGE__, \@directives);
634
635
636
my %read_only_methods = map { $_ => 1 } qw/GET PROPFIND REPORT OPTIONS/;
637
638
sub access_handler {
639 8:0c83d98252d9 Chris
    my $r = shift;
640 7:3c16ed8faa07 Chris
641 517:bd1d512f9e1b Chris
    print STDERR "SoundSoftware.pm:$$: In access handler at " . scalar localtime() . "\n";
642 7:3c16ed8faa07 Chris
643 8:0c83d98252d9 Chris
    unless ($r->some_auth_required) {
644
	$r->log_reason("No authentication has been configured");
645
	return FORBIDDEN;
646
    }
647 7:3c16ed8faa07 Chris
648 8:0c83d98252d9 Chris
    my $method = $r->method;
649 7:3c16ed8faa07 Chris
650 517:bd1d512f9e1b Chris
    print STDERR "SoundSoftware.pm:$$: Method: $method, uri " . $r->uri . ", location " . $r->location . "\n";
651
    print STDERR "SoundSoftware.pm:$$: Accept: " . $r->headers_in->{Accept} . "\n";
652 7:3c16ed8faa07 Chris
653 8:0c83d98252d9 Chris
    my $dbh = connect_database($r);
654 152:a389c77da9fd Chris
    unless ($dbh) {
655 517:bd1d512f9e1b Chris
	print STDERR "SoundSoftware.pm:$$: Database connection failed!: " . $DBI::errstr . "\n";
656 152:a389c77da9fd Chris
	return FORBIDDEN;
657
    }
658
659 300:034e9b00b341 chris
    print STDERR "Connected to db, dbh is " . $dbh . "\n";
660 7:3c16ed8faa07 Chris
661 8:0c83d98252d9 Chris
    my $project_id = get_project_identifier($dbh, $r);
662 300:034e9b00b341 chris
663 732:897bc2b63bfe Chris
    # We want to delegate most of the work to the authentication
664
    # handler (to ensure that user is asked to login even for
665
    # nonexistent projects -- so they can't tell whether a private
666
    # project exists or not without authenticating). So
667
    #
668
    # * if the project is public
669
    #   - if the method is read-only
670
    #     + set handler to OK, no auth needed
671
    #   - if the method is not read-only
672
    #     + if the repo is read-only, return forbidden
673
    #     + else require auth
674
    # * if the project is not public or does not exist
675
    #     + require auth
676
    #
677
    # If we are requiring auth and are not currently https, and
678
    # https is required, then we must return a redirect to https
679
    # instead of an OK.
680 300:034e9b00b341 chris
681 8:0c83d98252d9 Chris
    my $status = get_project_status($dbh, $project_id, $r);
682 732:897bc2b63bfe Chris
    my $readonly = project_repo_is_readonly($dbh, $project_id, $r);
683 7:3c16ed8faa07 Chris
684 8:0c83d98252d9 Chris
    $dbh->disconnect();
685
    undef $dbh;
686 7:3c16ed8faa07 Chris
687 734:1d1b8170c2f7 Chris
    my $auth_ssl_reqd = will_require_ssl_auth($r);
688
689 732:897bc2b63bfe Chris
    if ($status == 1) { # public
690
691
	print STDERR "SoundSoftware.pm:$$: Project is public\n";
692
693
	if (!defined $read_only_methods{$method}) {
694
695
	    print STDERR "SoundSoftware.pm:$$: Method is not read-only\n";
696
697
	    if ($readonly) {
698
		print STDERR "SoundSoftware.pm:$$: Project repo is read-only, refusing access\n";
699
		return FORBIDDEN;
700
	    } else {
701
		print STDERR "SoundSoftware.pm:$$: Project repo is read-write, auth required\n";
702
		# fall through, this is the normal case
703
	    }
704
705 734:1d1b8170c2f7 Chris
        } elsif ($auth_ssl_reqd and $r->unparsed_uri =~ m/cmd=branchmap/) {
706
707
            # A hac^H^H^Hspecial case. We want to ensure we switch to
708
            # https (if it will be necessarily for authentication)
709
            # before the first POST request, and this is what I think
710
            # will give us suitable warning for Mercurial.
711
712
            print STDERR "SoundSoftware.pm:$$: Switching to HTTPS in preparation\n";
713
            # fall through, this is the normal case
714
715 732:897bc2b63bfe Chris
	} else {
716
	    # Public project, read-only method -- this is the only
717
	    # case we can decide for certain to accept in this function
718
	    print STDERR "SoundSoftware.pm:$$: Method is read-only, no restriction here\n";
719
	    $r->set_handlers(PerlAuthenHandler => [\&OK]);
720
	    return OK;
721
	}
722
723
    } else { # status != 1, i.e. nonexistent or private -- equivalent here
724
725
	print STDERR "SoundSoftware.pm:$$: Project is private or nonexistent, auth required\n";
726
	# fall through
727 8:0c83d98252d9 Chris
    }
728 7:3c16ed8faa07 Chris
729 734:1d1b8170c2f7 Chris
    if ($auth_ssl_reqd) {
730
        my $redir_to = "https://" . $r->hostname() . $r->unparsed_uri();
731
        print STDERR "SoundSoftware.pm:$$: Need to switch to HTTPS, redirecting to $redir_to\n";
732
        $r->headers_out->add('Location' => $redir_to);
733
        return REDIRECT;
734 732:897bc2b63bfe Chris
    } else {
735 734:1d1b8170c2f7 Chris
        return OK;
736 732:897bc2b63bfe Chris
    }
737 7:3c16ed8faa07 Chris
}
738
739
sub authen_handler {
740 8:0c83d98252d9 Chris
    my $r = shift;
741
742 517:bd1d512f9e1b Chris
    print STDERR "SoundSoftware.pm:$$: In authentication handler at " . scalar localtime() . "\n";
743 7:3c16ed8faa07 Chris
744 8:0c83d98252d9 Chris
    my $dbh = connect_database($r);
745 152:a389c77da9fd Chris
    unless ($dbh) {
746 517:bd1d512f9e1b Chris
        print STDERR "SoundSoftware.pm:$$: Database connection failed!: " . $DBI::errstr . "\n";
747 152:a389c77da9fd Chris
        return AUTH_REQUIRED;
748
    }
749 8:0c83d98252d9 Chris
750
    my $project_id = get_project_identifier($dbh, $r);
751
    my $realm = get_realm($dbh, $project_id, $r);
752
    $r->auth_name($realm);
753
754
    my ($res, $redmine_pass) =  $r->get_basic_auth_pw();
755
    unless ($res == OK) {
756
	$dbh->disconnect();
757
	undef $dbh;
758
	return $res;
759
    }
760
761 517:bd1d512f9e1b Chris
    print STDERR "SoundSoftware.pm:$$: User is " . $r->user . ", got password\n";
762 8:0c83d98252d9 Chris
763 732:897bc2b63bfe Chris
    my $status = get_project_status($dbh, $project_id, $r);
764
    if ($status == 0) {
765
	# nonexistent, behave like private project you aren't a member of
766
	print STDERR "SoundSoftware.pm:$$: Project doesn't exist, not permitted\n";
767
	$dbh->disconnect();
768
	undef $dbh;
769
	$r->note_auth_failure();
770
	return AUTH_REQUIRED;
771
    }
772
773 8:0c83d98252d9 Chris
    my $permitted = is_permitted($dbh, $project_id, $r->user, $redmine_pass, $r);
774
775
    $dbh->disconnect();
776
    undef $dbh;
777
778
    if ($permitted) {
779
	return OK;
780
    } else {
781 517:bd1d512f9e1b Chris
	print STDERR "SoundSoftware.pm:$$: Not permitted\n";
782 8:0c83d98252d9 Chris
	$r->note_auth_failure();
783
	return AUTH_REQUIRED;
784
    }
785 7:3c16ed8faa07 Chris
}
786
787
sub get_project_status {
788 8:0c83d98252d9 Chris
    my $dbh = shift;
789 7:3c16ed8faa07 Chris
    my $project_id = shift;
790
    my $r = shift;
791 8:0c83d98252d9 Chris
792
    if (!defined $project_id or $project_id eq '') {
793
	return 0; # nonexistent
794
    }
795 7:3c16ed8faa07 Chris
796
    my $sth = $dbh->prepare(
797
        "SELECT is_public FROM projects WHERE projects.identifier = ?;"
798
    );
799
800
    $sth->execute($project_id);
801 8:0c83d98252d9 Chris
    my $ret = 0; # nonexistent
802 7:3c16ed8faa07 Chris
    if (my @row = $sth->fetchrow_array) {
803
    	if ($row[0] eq "1" || $row[0] eq "t") {
804
	    $ret = 1; # public
805
    	} else {
806 8:0c83d98252d9 Chris
	    $ret = 2; # private
807 7:3c16ed8faa07 Chris
	}
808
    }
809
    $sth->finish();
810
    undef $sth;
811
812
    $ret;
813
}
814
815 734:1d1b8170c2f7 Chris
sub will_require_ssl_auth {
816
    my $r = shift;
817
818
    my $cfg = Apache2::Module::get_config
819
        (__PACKAGE__, $r->server, $r->per_dir_config);
820
821
    if ($cfg->{SoundSoftwareSslRequired} eq "on") {
822
        if ($r->dir_config('HTTPS') eq "on") {
823
            # already have ssl
824
            return 0;
825
        } else {
826
            # require ssl for auth, don't have it yet
827
            return 1;
828
        }
829
    } elsif ($cfg->{SoundSoftwareSslRequired} eq "off") {
830
        # don't require ssl for auth
831
        return 0;
832
    } else {
833
        print STDERR "WARNING: SoundSoftware.pm:$$: SoundSoftwareSslRequired should be either 'on' or 'off'\n";
834
        # this is safer
835
        return 1;
836
    }
837
}
838
839 300:034e9b00b341 chris
sub project_repo_is_readonly {
840
    my $dbh = shift;
841
    my $project_id = shift;
842
    my $r = shift;
843
844
    if (!defined $project_id or $project_id eq '') {
845
        return 0; # nonexistent
846
    }
847
848
    my $sth = $dbh->prepare(
849
        "SELECT repositories.is_external FROM repositories, projects WHERE projects.identifier = ? AND repositories.project_id = projects.id;"
850
    );
851
852
    $sth->execute($project_id);
853
    my $ret = 0; # nonexistent
854
    if (my @row = $sth->fetchrow_array) {
855 301:6d3f8aeb51b7 chris
        if (defined($row[0]) && ($row[0] eq "1" || $row[0] eq "t")) {
856 300:034e9b00b341 chris
            $ret = 1; # read-only (i.e. external)
857
        } else {
858
            $ret = 0; # read-write
859
        }
860
    }
861
    $sth->finish();
862
    undef $sth;
863
864
    $ret;
865
}
866
867 8:0c83d98252d9 Chris
sub is_permitted {
868
    my $dbh = shift;
869
    my $project_id = shift;
870
    my $redmine_user = shift;
871
    my $redmine_pass = shift;
872
    my $r = shift;
873 7:3c16ed8faa07 Chris
874 1331:1e9b1bdd062e Chris
    my $pass_digest = Digest::SHA::sha1_hex($redmine_pass);
875 7:3c16ed8faa07 Chris
876 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
877
	(__PACKAGE__, $r->server, $r->per_dir_config);
878 7:3c16ed8faa07 Chris
879 8:0c83d98252d9 Chris
    my $query = $cfg->{SoundSoftwareQuery};
880
    my $sth = $dbh->prepare($query);
881
    $sth->execute($redmine_user, $project_id);
882 7:3c16ed8faa07 Chris
883 8:0c83d98252d9 Chris
    my $ret;
884 301:6d3f8aeb51b7 chris
    while (my ($hashed_password, $salt, $auth_source_id, $permissions) = $sth->fetchrow_array) {
885 7:3c16ed8faa07 Chris
886 8:0c83d98252d9 Chris
	# Test permissions for this user before we verify credentials
887
	# -- if the user is not permitted this action anyway, there's
888
	# not much point in e.g. contacting the LDAP
889 7:3c16ed8faa07 Chris
890 8:0c83d98252d9 Chris
	my $method = $r->method;
891 7:3c16ed8faa07 Chris
892 8:0c83d98252d9 Chris
	if ((defined $read_only_methods{$method} && $permissions =~ /:browse_repository/)
893
	    || $permissions =~ /:commit_access/) {
894
895
	    # User would be permitted this action, if their
896
	    # credentials checked out -- test those now
897
898
	    print STDERR "SoundSoftware.pm: User $redmine_user has required role, checking credentials\n";
899
900
	    unless ($auth_source_id) {
901 1331:1e9b1bdd062e Chris
                my $salted_password = Digest::SHA::sha1_hex($salt.$pass_digest);
902 301:6d3f8aeb51b7 chris
		if ($hashed_password eq $salted_password) {
903 8:0c83d98252d9 Chris
		    print STDERR "SoundSoftware.pm: User $redmine_user authenticated via password\n";
904
		    $ret = 1;
905
		    last;
906
		}
907
	    } else {
908
		my $sthldap = $dbh->prepare(
909
		    "SELECT host,port,tls,account,account_password,base_dn,attr_login FROM auth_sources WHERE id = ?;"
910
		    );
911
		$sthldap->execute($auth_source_id);
912
		while (my @rowldap = $sthldap->fetchrow_array) {
913
		    my $ldap = Authen::Simple::LDAP->new(
914
			host    => ($rowldap[2] eq "1" || $rowldap[2] eq "t") ? "ldaps://$rowldap[0]" : $rowldap[0],
915
			port    => $rowldap[1],
916
			basedn  => $rowldap[5],
917
			binddn  => $rowldap[3] ? $rowldap[3] : "",
918
			bindpw  => $rowldap[4] ? $rowldap[4] : "",
919
			filter  => "(".$rowldap[6]."=%s)"
920
			);
921
		    if ($ldap->authenticate($redmine_user, $redmine_pass)) {
922 517:bd1d512f9e1b Chris
			print STDERR "SoundSoftware.pm:$$: User $redmine_user authenticated via LDAP\n";
923 8:0c83d98252d9 Chris
			$ret = 1;
924
		    }
925
		}
926
		$sthldap->finish();
927
		undef $sthldap;
928 735:8653bddf26a6 Chris
                last if ($ret);
929 8:0c83d98252d9 Chris
	    }
930
	} else {
931 517:bd1d512f9e1b Chris
	    print STDERR "SoundSoftware.pm:$$: User $redmine_user lacks required role for this project\n";
932 8:0c83d98252d9 Chris
	}
933 7:3c16ed8faa07 Chris
    }
934
935 8:0c83d98252d9 Chris
    $sth->finish();
936
    undef $sth;
937
938
    $ret;
939 7:3c16ed8faa07 Chris
}
940
941
sub get_project_identifier {
942 8:0c83d98252d9 Chris
    my $dbh = shift;
943 7:3c16ed8faa07 Chris
    my $r = shift;
944
    my $location = $r->location;
945 737:1ce6efe3db0e Chris
    my ($repo) = $r->uri =~ m{$location/*([^/]*)};
946 10:2c10dc5f122d Chris
947
    return $repo if (!$repo);
948
949 7:3c16ed8faa07 Chris
    $repo =~ s/[^a-zA-Z0-9\._-]//g;
950 736:51c97efbe241 Chris
951 8:0c83d98252d9 Chris
    # The original Redmine.pm returns the string just calculated as
952
    # the project identifier.  That won't do for us -- we may have
953
    # (and in fact already do have, in our test instance) projects
954
    # whose repository names differ from the project identifiers.
955
956
    # This is a rather fundamental change because it means that almost
957
    # every request needs more than one database query -- which
958
    # prompts us to start passing around $dbh instead of connecting
959
    # locally within each function as is done in Redmine.pm.
960
961 7:3c16ed8faa07 Chris
    my $sth = $dbh->prepare(
962
        "SELECT projects.identifier FROM projects, repositories WHERE repositories.project_id = projects.id AND repositories.url LIKE ?;"
963
    );
964
965 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
966
	(__PACKAGE__, $r->server, $r->per_dir_config);
967
968
    my $prefix = $cfg->{SoundSoftwareRepoPrefix};
969
    if (!defined $prefix) { $prefix = '%/'; }
970 7:3c16ed8faa07 Chris
    my $identifier = '';
971
972 8:0c83d98252d9 Chris
    $sth->execute($prefix . $repo);
973 7:3c16ed8faa07 Chris
    my $ret = 0;
974
    if (my @row = $sth->fetchrow_array) {
975
	$identifier = $row[0];
976
    }
977
    $sth->finish();
978
    undef $sth;
979
980 517:bd1d512f9e1b Chris
    print STDERR "SoundSoftware.pm:$$: Repository '$repo' belongs to project '$identifier'\n";
981 7:3c16ed8faa07 Chris
982
    $identifier;
983
}
984
985 8:0c83d98252d9 Chris
sub get_realm {
986
    my $dbh = shift;
987
    my $project_id = shift;
988
    my $r = shift;
989
990
    my $sth = $dbh->prepare(
991
        "SELECT projects.name FROM projects WHERE projects.identifier = ?;"
992
    );
993
994
    my $name = $project_id;
995
996
    $sth->execute($project_id);
997
    my $ret = 0;
998
    if (my @row = $sth->fetchrow_array) {
999
	$name = $row[0];
1000
    }
1001
    $sth->finish();
1002
    undef $sth;
1003
1004
    # be timid about characters not permitted in auth realm and revert
1005
    # to project identifier if any are found
1006
    if ($name =~ m/[^\w\d\s\._-]/) {
1007
	$name = $project_id;
1008 733:c7a731db96e5 Chris
    } elsif ($name =~ m/^\s*$/) {
1009
	# empty or whitespace
1010
	$name = $project_id;
1011
    }
1012
1013
    if ($name =~ m/^\s*$/) {
1014
        # nothing even in $project_id -- probably a nonexistent project.
1015
        # use repo name instead (don't want to admit to user that project
1016
        # doesn't exist)
1017
        my $location = $r->location;
1018 737:1ce6efe3db0e Chris
        my ($repo) = $r->uri =~ m{$location/*([^/]*)};
1019 733:c7a731db96e5 Chris
        $name = $repo;
1020 8:0c83d98252d9 Chris
    }
1021
1022 1271:cf4cc816278a Chris
#    my $realm = '"Mercurial repository for ' . "'$name'" . '"';
1023
# see #577:
1024
    my $realm = '"Mercurial repository for ' . "$name" . '"';
1025 8:0c83d98252d9 Chris
1026
    $realm;
1027
}
1028
1029 7:3c16ed8faa07 Chris
sub connect_database {
1030
    my $r = shift;
1031
1032 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
1033
	(__PACKAGE__, $r->server, $r->per_dir_config);
1034
1035
    return DBI->connect($cfg->{SoundSoftwareDSN},
1036 152:a389c77da9fd Chris
	                $cfg->{SoundSoftwareDbUser},
1037
		        $cfg->{SoundSoftwareDbPass});
1038 7:3c16ed8faa07 Chris
}
1039
1040
1;
1041 217:ed8222a04634 chris
#!/usr/bin/env ruby
1042
1043
# == Synopsis
1044
#
1045 241:7658d21a1493 chris
# convert-external-repos: Update local Mercurial mirrors of external repos,
1046
# by running an external command for each project requiring an update.
1047 217:ed8222a04634 chris
#
1048
# == Usage
1049
#
1050
#    convert-external-repos [OPTIONS...] -s [DIR] -r [HOST]
1051
#
1052
# == Arguments (mandatory)
1053
#
1054 241:7658d21a1493 chris
#   -s, --scm-dir=DIR         use DIR as base directory for repositories
1055 217:ed8222a04634 chris
#   -r, --redmine-host=HOST   assume Redmine is hosted on HOST. Examples:
1056
#                             -r redmine.example.net
1057
#                             -r http://redmine.example.net
1058
#                             -r https://example.net/redmine
1059
#   -k, --key=KEY             use KEY as the Redmine API key
1060 241:7658d21a1493 chris
#   -c, --command=COMMAND     use this command to update each external
1061
#                             repository: command is called with the name
1062
#                             of the project, the path to its repo, and
1063
#                             its external repo url as its three args
1064 217:ed8222a04634 chris
#
1065
# == Options
1066
#
1067
#   --http-user=USER          User for HTTP Basic authentication with Redmine WS
1068
#   --http-pass=PASSWORD      Password for Basic authentication with Redmine WS
1069
#   -t, --test                only show what should be done
1070
#   -h, --help                show help and exit
1071
#   -v, --verbose             verbose
1072
#   -V, --version             print version and exit
1073
#   -q, --quiet               no log
1074
1075
1076
require 'getoptlong'
1077
require 'find'
1078
require 'etc'
1079
1080
Version = "1.0"
1081
1082
opts = GetoptLong.new(
1083 241:7658d21a1493 chris
                      ['--scm-dir',      '-s', GetoptLong::REQUIRED_ARGUMENT],
1084 217:ed8222a04634 chris
                      ['--redmine-host', '-r', GetoptLong::REQUIRED_ARGUMENT],
1085
                      ['--key',          '-k', GetoptLong::REQUIRED_ARGUMENT],
1086
                      ['--http-user',          GetoptLong::REQUIRED_ARGUMENT],
1087
                      ['--http-pass',          GetoptLong::REQUIRED_ARGUMENT],
1088 241:7658d21a1493 chris
                      ['--command' ,     '-c', GetoptLong::REQUIRED_ARGUMENT],
1089 217:ed8222a04634 chris
                      ['--test',         '-t', GetoptLong::NO_ARGUMENT],
1090
                      ['--verbose',      '-v', GetoptLong::NO_ARGUMENT],
1091
                      ['--version',      '-V', GetoptLong::NO_ARGUMENT],
1092
                      ['--help'   ,      '-h', GetoptLong::NO_ARGUMENT],
1093
                      ['--quiet'  ,      '-q', GetoptLong::NO_ARGUMENT]
1094
                      )
1095
1096
$verbose      = 0
1097
$quiet        = false
1098
$redmine_host = ''
1099
$repos_base   = ''
1100
$http_user    = ''
1101
$http_pass    = ''
1102
$test         = false
1103
1104 437:102056ec2de9 chris
$mirrordir    = '/var/mirror'
1105
1106 217:ed8222a04634 chris
def log(text, options={})
1107
  level = options[:level] || 0
1108
  puts text unless $quiet or level > $verbose
1109
  exit 1 if options[:exit]
1110
end
1111
1112
def system_or_raise(command)
1113
  raise "\"#{command}\" failed" unless system command
1114
end
1115
1116
begin
1117
  opts.each do |opt, arg|
1118
    case opt
1119 241:7658d21a1493 chris
    when '--scm-dir';        $repos_base   = arg.dup
1120 217:ed8222a04634 chris
    when '--redmine-host';   $redmine_host = arg.dup
1121
    when '--key';            $api_key      = arg.dup
1122
    when '--http-user';      $http_user    = arg.dup
1123
    when '--http-pass';      $http_pass    = arg.dup
1124 241:7658d21a1493 chris
    when '--command';        $command      = arg.dup
1125 217:ed8222a04634 chris
    when '--verbose';        $verbose += 1
1126
    when '--test';           $test = true
1127
    when '--version';        puts Version; exit
1128 1336:b61a51fb42b9 Chris
    when '--help';           puts "Read source for documentation"; exit
1129 217:ed8222a04634 chris
    when '--quiet';          $quiet = true
1130
    end
1131
  end
1132
rescue
1133
  exit 1
1134
end
1135
1136
if $test
1137
  log("running in test mode")
1138
end
1139
1140 241:7658d21a1493 chris
if ($redmine_host.empty? or $repos_base.empty? or $command.empty?)
1141 1336:b61a51fb42b9 Chris
  puts "Read source for documentation"; exit
1142 217:ed8222a04634 chris
end
1143
1144
unless File.directory?($repos_base)
1145
  log("directory '#{$repos_base}' doesn't exist", :exit => true)
1146
end
1147
1148
begin
1149
  require 'active_resource'
1150
rescue LoadError
1151
  log("This script requires activeresource.\nRun 'gem install activeresource' to install it.", :exit => true)
1152
end
1153
1154
class Project < ActiveResource::Base
1155
  self.headers["User-agent"] = "SoundSoftware external repository converter/#{Version}"
1156 1336:b61a51fb42b9 Chris
  self.format = :xml
1157 217:ed8222a04634 chris
end
1158
1159
log("querying Redmine for projects...", :level => 1);
1160
1161
$redmine_host.gsub!(/^/, "http://") unless $redmine_host.match("^https?://")
1162
$redmine_host.gsub!(/\/$/, '')
1163
1164
Project.site = "#{$redmine_host}/sys";
1165
Project.user = $http_user;
1166
Project.password = $http_pass;
1167
1168
begin
1169
  # Get all active projects that have the Repository module enabled
1170
  projects = Project.find(:all, :params => {:key => $api_key})
1171 1336:b61a51fb42b9 Chris
rescue ActiveResource::ForbiddenAccess
1172
  log("Request was denied by your Redmine server. Make sure that 'WS for repository management' is enabled in application settings and that you provided the correct API key.")
1173 217:ed8222a04634 chris
rescue => e
1174
  log("Unable to connect to #{Project.site}: #{e}", :exit => true)
1175
end
1176
1177
if projects.nil?
1178
  log('no project found, perhaps you forgot to "Enable WS for repository management"', :exit => true)
1179
end
1180
1181
log("retrieved #{projects.size} projects", :level => 1)
1182
1183
projects.each do |project|
1184
  log("treating project #{project.name}", :level => 1)
1185
1186
  if project.identifier.empty?
1187
    log("\tno identifier for project #{project.name}")
1188
    next
1189 1445:0c7b3bb73517 Chris
  elsif not project.identifier.match(/^[a-z0-9_\-]+$/)
1190 217:ed8222a04634 chris
    log("\tinvalid identifier for project #{project.name} : #{project.identifier}");
1191
    next
1192
  end
1193
1194
  if !project.respond_to?(:repository) or !project.repository.is_external?
1195
    log("\tproject #{project.identifier} does not use an external repository");
1196
    next
1197
  end
1198
1199
  external_url = project.repository.external_url;
1200
  log("\tproject #{project.identifier} has external repository url #{external_url}");
1201
1202
  if !external_url.match(/^[a-z][a-z+]{0,8}[a-z]:\/\//)
1203
    log("\tthis doesn't look like a plausible url to me, skipping")
1204
    next
1205
  end
1206
1207
  repos_path = File.join($repos_base, project.identifier).gsub(File::SEPARATOR, File::ALT_SEPARATOR || File::SEPARATOR)
1208
1209 241:7658d21a1493 chris
  unless File.directory?(repos_path)
1210
    log("\tproject repo directory '#{repos_path}' doesn't exist")
1211 217:ed8222a04634 chris
    next
1212
  end
1213
1214 241:7658d21a1493 chris
  system($command, project.identifier, repos_path, external_url)
1215 437:102056ec2de9 chris
1216
  $cache_clearance_file = File.join($mirrordir, project.identifier, 'url_changed')
1217
  if File.file?($cache_clearance_file)
1218
    log("\tproject repo url has changed, requesting cache clearance")
1219
    if project.post(:repository_cache, :key => $api_key)
1220
      File.delete($cache_clearance_file)
1221
    end
1222
  end
1223 217:ed8222a04634 chris
1224
end
1225
1226 1538:87bea4981d6d Chris
#!/usr/bin/env ruby
1227
1228
# Create authormap files for hg repos based on the changeset & project
1229
# member info available to Redmine.
1230
#
1231
# We have a set of hg repos in a given directory:
1232
#
1233
# /var/hg/repo_1
1234
# /var/hg/repo_2
1235
# /var/hg/repo_3
1236
#
1237
# and we want to produce authormap files in another directory:
1238
#
1239
# /var/repo-export/authormap/authormap_repo_1
1240
# /var/repo-export/authormap/authormap_repo_2
1241
# /var/repo-export/authormap/authormap_repo_3
1242
#
1243
# This script does that, if given the two directory names as arguments
1244
# to the -s and -o options. In the above example:
1245
#
1246
# create-repo-authormaps.rb -s /var/hg -o /var/repo-export/authormap
1247
#
1248
# Note that this script will overwrite any existing authormap
1249
# files. (That's why the output files are given an authormap_ prefix,
1250
# so we're less likely to clobber something else if the user gets the
1251
# arguments wrong.)
1252
1253
require 'getoptlong'
1254
1255
opts = GetoptLong.new(
1256
                      ['--scm-dir',      '-s', GetoptLong::REQUIRED_ARGUMENT],
1257
                      ['--out-dir',      '-o', GetoptLong::REQUIRED_ARGUMENT]
1258
)
1259
1260
$repos_base   = ''
1261
$out_base     = ''
1262
1263
def usage
1264
  puts "See source code for supported options"
1265
  exit
1266
end
1267
1268
begin
1269
  opts.each do |opt, arg|
1270
    case opt
1271
    when '--scm-dir';   $repos_base   = arg.dup
1272
    when '--out-dir';   $out_base     = arg.dup
1273
    end
1274
  end
1275
rescue
1276
  exit 1
1277
end
1278
1279
if ($repos_base.empty? or $out_base.empty?)
1280
  usage
1281
end
1282
1283
unless File.directory?($repos_base)
1284
  log("input directory '#{$repos_base}' doesn't exist", :exit => true)
1285
end
1286
1287
unless File.directory?($out_base)
1288
  log("output directory '#{$out_base}' doesn't exist", :exit => true)
1289
end
1290
1291
projects = Project.find(:all)
1292
1293
if projects.nil?
1294
  log('No projects found', :exit => true)
1295
end
1296
1297
projects.each do |proj|
1298
  next unless proj.respond_to?(:repository)
1299
1300
  repo = proj.repository
1301
1302
  repo_url = repo.url
1303
  repo_url = repo_url.gsub(/^file:\/*/, "/");
1304
  if repo_url != File.join($repos_base, proj.identifier)
1305
    log('Project #{proj.identifier} has repo in unsupported location #{repo_url}, skipping')
1306
    next
1307
  end
1308
1309
  csets = repo.changesets
1310
  committers = csets.map do |c| c.committer end.sort.uniq
1311
1312
  authormap = ""
1313
  committers.each do |c|
1314
    if not c =~ /[^<]+<.*@.*>/ then
1315
      user = repo.find_committer_user c
1316
      authormap << "#{c}=#{u.name} <#{u.mail}>\n" unless u.nil?
1317
    end
1318
  end
1319
1320
  File.open (File.join($out_base, "authormap_#{proj.identifier}"), "w") do |f|
1321
    f.puts(authormap)
1322
  end
1323
1324
end
1325
1326 226:5b028aef59a7 chris
#!/usr/bin/perl -w
1327
1328
# Read a Doxyfile and print it out again to stdout, with only
1329
# whitelisted keys in it and with some keys set to pre-fixed values.
1330
#
1331
# Note that OUTPUT_DIRECTORY is not included; it should be added by
1332
# the caller
1333
1334
use strict;
1335
1336
my $txt = join "", <>;
1337
$txt =~ s/^\s*#.*$//gm;
1338
$txt =~ s/\\\n//gs;
1339
$txt =~ s/\r//g;
1340
$txt =~ s/\n\s*\n/\n/gs;
1341
1342
my %fixed = (
1343
    FULL_PATH_NAMES => "NO",
1344
    SYMBOL_CACHE_SIZE => 2,
1345
    EXCLUDE_SYMLINKS => "YES",
1346
    GENERATE_HTML => "YES",
1347
    PERL_PATH => "/usr/bin/perl",
1348
    HAVE_DOT => "YES",
1349
    HTML_OUTPUT => ".",
1350 228:3c084a25d8ab chris
    HTML_DYNAMIC_SECTIONS => "NO",
1351 226:5b028aef59a7 chris
    SEARCHENGINE => "NO",
1352
    DOT_FONTNAME => "FreeMono",
1353
    DOT_FONTSIZE => 10,
1354
    DOT_FONTPATH => "/usr/share/fonts/truetype/freefont",
1355
    DOT_IMAGE_FORMAT => "png",
1356
    DOT_PATH => "/usr/bin/dot",
1357
    DOT_TRANSPARENT => "YES",
1358
);
1359
1360 233:df89e7aa3ce8 Chris
# These are the keys that are safe to take from the output and include
1361
# in the output; they may still need to be checked for safe values (if
1362
# file paths).
1363 226:5b028aef59a7 chris
my @safe = qw(
1364 233:df89e7aa3ce8 Chris
INPUT
1365
FILE_PATTERNS
1366
EXAMPLE_PATH
1367
EXAMPLE_PATTERNS
1368
IMAGE_PATH
1369
INCLUDE_PATH
1370
INCLUDE_FILE_PATTERNS
1371 226:5b028aef59a7 chris
DOXYFILE_ENCODING
1372
PROJECT_NAME
1373
PROJECT_NUMBER
1374
CREATE_SUBDIRS
1375
OUTPUT_LANGUAGE
1376
BRIEF_MEMBER_DESC
1377
REPEAT_BRIEF
1378
ABBREVIATE_BRIEF
1379
ALWAYS_DETAILED_SEC
1380
INLINE_INHERITED_MEMB
1381
STRIP_FROM_PATH
1382
STRIP_FROM_INC_PATH
1383
JAVADOC_AUTOBRIEF
1384
QT_AUTOBRIEF
1385
MULTILINE_CPP_IS_BRIEF
1386
INHERIT_DOCS
1387
SEPARATE_MEMBER_PAGES
1388
TAB_SIZE
1389
ALIASES
1390
OPTIMIZE_OUTPUT_FOR_C
1391
OPTIMIZE_OUTPUT_JAVA
1392
OPTIMIZE_FOR_FORTRAN
1393
OPTIMIZE_OUTPUT_VHDL
1394
EXTENSION_MAPPING
1395
BUILTIN_STL_SUPPORT
1396
CPP_CLI_SUPPORT
1397
SIP_SUPPORT
1398
IDL_PROPERTY_SUPPORT
1399
DISTRIBUTE_GROUP_DOC
1400
SUBGROUPING
1401
TYPEDEF_HIDES_STRUCT
1402
EXTRACT_ALL
1403
EXTRACT_PRIVATE
1404
EXTRACT_STATIC
1405
EXTRACT_LOCAL_CLASSES
1406
EXTRACT_LOCAL_METHODS
1407
EXTRACT_ANON_NSPACES
1408
HIDE_UNDOC_MEMBERS
1409
HIDE_UNDOC_CLASSES
1410
HIDE_FRIEND_COMPOUNDS
1411
HIDE_IN_BODY_DOCS
1412
INTERNAL_DOCS
1413
HIDE_SCOPE_NAMES
1414
SHOW_INCLUDE_FILES
1415
FORCE_LOCAL_INCLUDES
1416
INLINE_INFO
1417
SORT_MEMBER_DOCS
1418
SORT_BRIEF_DOCS
1419
SORT_MEMBERS_CTORS_1ST
1420
SORT_GROUP_NAMES
1421
SORT_BY_SCOPE_NAME
1422
GENERATE_TODOLIST
1423
GENERATE_TESTLIST
1424
GENERATE_BUGLIST
1425
GENERATE_DEPRECATEDLIST
1426
ENABLED_SECTIONS
1427
MAX_INITIALIZER_LINES
1428
SHOW_USED_FILES
1429
SHOW_DIRECTORIES
1430
SHOW_FILES
1431
SHOW_NAMESPACES
1432
QUIET
1433
WARNINGS
1434
WARN_IF_UNDOCUMENTED
1435
WARN_IF_DOC_ERROR
1436
WARN_NO_PARAMDOC
1437
INPUT_ENCODING
1438
RECURSIVE
1439
EXCLUDE
1440
EXCLUDE_SYMLINKS
1441
EXCLUDE_PATTERNS
1442
EXCLUDE_SYMBOLS
1443
EXAMPLE_RECURSIVE
1444
SOURCE_BROWSER
1445
INLINE_SOURCES
1446
STRIP_CODE_COMMENTS
1447
REFERENCED_BY_RELATION
1448
REFERENCES_RELATION
1449
REFERENCES_LINK_SOURCE
1450
VERBATIM_HEADERS
1451
ALPHABETICAL_INDEX
1452
COLS_IN_ALPHA_INDEX
1453
IGNORE_PREFIX
1454
HTML_TIMESTAMP
1455
HTML_ALIGN_MEMBERS
1456
ENABLE_PREPROCESSING
1457
MACRO_EXPANSION
1458
EXPAND_ONLY_PREDEF
1459
SEARCH_INCLUDES
1460
PREDEFINED
1461
EXPAND_AS_DEFINED
1462
SKIP_FUNCTION_MACROS
1463
ALLEXTERNALS
1464
EXTERNAL_GROUPS
1465
CLASS_DIAGRAMS
1466
HIDE_UNDOC_RELATIONS
1467
CLASS_GRAPH
1468
COLLABORATION_GRAPH
1469
GROUP_GRAPHS
1470
UML_LOOK
1471
TEMPLATE_RELATIONS
1472
INCLUDE_GRAPH
1473
INCLUDED_BY_GRAPH
1474
CALL_GRAPH
1475
CALLER_GRAPH
1476
GRAPHICAL_HIERARCHY
1477
DIRECTORY_GRAPH
1478
DOT_GRAPH_MAX_NODES
1479
MAX_DOT_GRAPH_DEPTH
1480
DOT_MULTI_TARGETS
1481
DOT_CLEANUP
1482
);
1483
1484
my %safehash;
1485
for my $sk (@safe) { $safehash{$sk} = 1; }
1486
1487
my @lines = split "\n", $txt;
1488
1489
my %settings;
1490
1491
sub is_safe {
1492
    my $key = shift;
1493
    defined $safehash{$key} and $safehash{$key} == 1;
1494
}
1495
1496
sub has_file_path {
1497
    # Returns true if the given key expects a file path as a value.
1498
    # We only need to test keys that are safe; unsafe keys have been
1499
    # rejected already.
1500
    my $key = shift;
1501
    $key eq "INPUT" or
1502
	$key =~ /^OUTPUT_/ or
1503
	$key =~ /_PATH$/ or
1504
	$key =~ /_PATTERNS$/;
1505
}
1506
1507
sub is_safe_file_path {
1508
    my $value = shift;
1509
    not $value =~ /^\// and not $value =~ /\.\./;
1510
}
1511
1512
foreach my $line (@lines) {
1513
1514
    chomp $line;
1515
    my ($key, $value) = split /\s*=\s*/, $line;
1516
1517
    next if !defined $key;
1518
1519
    if ($key =~ /^GENERATE_/ and not $key =~ /LIST$/) {
1520
	print STDERR "NOTE: Setting $key explicitly to NO\n";
1521
	$settings{$key} = "NO";
1522
	next;
1523
    }
1524
1525
    if (!is_safe($key)) {
1526
	print STDERR "NOTE: Skipping non-whitelisted key $key\n";
1527
	next;
1528
    }
1529
1530
    if (has_file_path($key) and !is_safe_file_path($value)) {
1531
	print STDERR "ERROR: Unsafe file path \"$value\" for key $key\n";
1532
	exit 1;
1533
    }
1534
1535
    $settings{$key} = $value;
1536
}
1537
1538 228:3c084a25d8ab chris
foreach my $key (keys %fixed) {
1539
    my $value = $fixed{$key};
1540
    print STDERR "NOTE: Setting $key to fixed value $value\n";
1541
    $settings{$key} = $value;
1542
}
1543
1544 226:5b028aef59a7 chris
print join "\n", map { "$_ = $settings{$_}" } keys %settings;
1545
print "\n";
1546 203:1e55195bca45 chris
#!/bin/bash
1547
1548
# Run this script from anywhere
1549
1550
# Enumerate Hg repos; make sure they're up to date; extract docs for
1551
# each
1552
1553
hgdir="/var/hg"
1554
docdir="/var/doc"
1555 223:c3544e9fd588 chris
logfile="/var/www/test-cannam/log/extract-docs.log"
1556
1557
redgrp="redmine"
1558 203:1e55195bca45 chris
1559 218:292cde42265a chris
apikey=""
1560 339:5410d82c12df chris
apischeme="https"
1561 218:292cde42265a chris
apihost=""
1562
apiuser=""
1563
apipass=""
1564
1565 203:1e55195bca45 chris
progdir=$(dirname $0)
1566
case "$progdir" in
1567
    /*) ;;
1568
    *) progdir="$(pwd)/$progdir" ;;
1569
esac
1570
1571 411:e7ba81c8dc5a chris
types="doxygen javadoc matlabdocs" # Do Doxygen first (it can be used for Java too)
1572 203:1e55195bca45 chris
1573
for x in $types; do
1574
    if [ ! -x "$progdir/extract-$x.sh" ]; then
1575
	echo "Helper script not available: $progdir/extract-$x.sh"
1576
	exit 1
1577
    fi
1578
done
1579
1580 218:292cde42265a chris
enable_embedded()
1581
{
1582
    p="$1"
1583 228:3c084a25d8ab chris
    if [ -n "$apikey" ]; then
1584
	if [ -n "$apiuser" ]; then
1585 339:5410d82c12df chris
	    sudo -u docgen curl -u "$apiuser":"$apipass" "$apischeme://$apihost/sys/projects/$p/embedded.xml?enable=1&key=$apikey" -d ""
1586 228:3c084a25d8ab chris
	else
1587 339:5410d82c12df chris
	    sudo -u docgen curl "$apischeme://$apihost/sys/projects/$p/embedded.xml?enable=1&key=$apikey" -d ""
1588 228:3c084a25d8ab chris
	fi
1589
    else
1590
	echo "Can't enable Embedded, API not configured" 1>&2
1591 218:292cde42265a chris
    fi
1592
}
1593
1594 223:c3544e9fd588 chris
# We want to ensure the doc extraction is done by the unprivileged
1595
# user docgen, which is not a member of any interesting group
1596
#
1597
# To this end, we create the tmpdir with user docgen and group
1598
# www-data, and use the www-data user to pull out an archive of the Hg
1599
# repo tip into a location beneath that, before using the docgen user
1600
# to extract docs from that location and write them into the tmpdir
1601
1602
# Same tmpdir for each project: we delete and recreate to avoid
1603
# cleanup duty from lots of directories being created
1604
#
1605
tmpdir=$(mktemp -d "$docdir/tmp_XXXXXX")
1606
1607
fail()
1608
{
1609
    message="$1"
1610
    echo "$message" 1>&2
1611
    case "$tmpdir" in
1612
	*/tmp*) rm -rf "$tmpdir";;
1613
	*);;
1614
    esac
1615
    exit 1
1616
}
1617
1618
case "$tmpdir" in
1619
    /*) ;;
1620
    *) fail "Temporary directory creation failed";;
1621
esac
1622
1623
chown docgen.www-data "$tmpdir" || fail "Temporary directory ownership change failed"
1624
chmod g+rwx "$tmpdir" || fail "Temporary directory permissions change failed"
1625
1626 203:1e55195bca45 chris
for projectdir in "$hgdir"/* ; do
1627
1628
    if [ -d "$projectdir" ] && [ -d "$projectdir/.hg" ]; then
1629
1630 223:c3544e9fd588 chris
	if ! sudo -u www-data hg -R "$projectdir" -q update; then
1631
	    echo "Failed to update Hg in $projectdir, skipping" 1>&2
1632
	    continue
1633
	fi
1634
1635 203:1e55195bca45 chris
	project=$(basename "$projectdir")
1636
1637 223:c3544e9fd588 chris
	tmptargetdir="$tmpdir/doc"
1638
	snapshotdir="$tmpdir/hgsnapshot"
1639 203:1e55195bca45 chris
1640 223:c3544e9fd588 chris
	rm -rf "$tmptargetdir" "$snapshotdir"
1641
1642 226:5b028aef59a7 chris
	mkdir -m 770 "$tmptargetdir" || fail "Temporary target directory creation failed"
1643
	chown docgen.www-data "$tmptargetdir" || fail "Temporary target directory ownership change failed"
1644 223:c3544e9fd588 chris
1645
	mkdir -m 770 "$snapshotdir" || fail "Snapshot directory creation failed"
1646
	chown docgen.www-data "$snapshotdir" || fail "Snapshot directory ownership change failed"
1647
1648
	hgparents=$(sudo -u www-data hg -R "$projectdir" parents)
1649
	if [ -z "$hgparents" ]; then
1650
	    echo "Hg repo at $projectdir has no working copy (empty repo?), skipping"
1651
	    continue
1652
	else
1653
	    echo "Found non-empty Hg repo: $projectdir for project $project"
1654
	fi
1655
1656
	if ! sudo -u www-data hg -R "$projectdir" archive -r tip -t files "$snapshotdir"; then
1657
	    echo "Failed to pick archive from $projectdir, skipping" 1>&2
1658
	    continue
1659
	fi
1660 203:1e55195bca45 chris
1661
	targetdir="$docdir/$project"
1662
1663 223:c3544e9fd588 chris
	echo "Temporary dir is $tmpdir, temporary doc dir is $tmptargetdir, snapshot dir is $snapshotdir, eventual target is $targetdir"
1664 203:1e55195bca45 chris
1665
	for x in $types; do
1666 226:5b028aef59a7 chris
	    if sudo -u docgen "$progdir/extract-$x.sh" "$project" "$snapshotdir" "$tmptargetdir" >> "$logfile" 2>&1; then
1667
		break
1668
	    else
1669 203:1e55195bca45 chris
		echo "Failed to extract via type $x"
1670
	    fi
1671
	done
1672
1673 223:c3544e9fd588 chris
        if [ -f "$tmptargetdir/index.html" ]; then
1674 203:1e55195bca45 chris
	    echo "Processing resulted in an index.html being created, looks good!"
1675
	    if [ ! -d "$targetdir" ] || [ ! -f "$targetdir/index.html" ]; then
1676 223:c3544e9fd588 chris
		echo "This project hasn't had doc extracted before: enabling Embedded"
1677 218:292cde42265a chris
		enable_embedded "$project"
1678 203:1e55195bca45 chris
	    fi
1679
1680
	    if [ -d "$targetdir" ]; then
1681
		mv "$targetdir" "$targetdir"_"$$" && \
1682 223:c3544e9fd588 chris
		    mv "$tmptargetdir" "$targetdir" && \
1683 203:1e55195bca45 chris
		    rm -rf "$targetdir"_"$$"
1684 223:c3544e9fd588 chris
		chgrp -R "$redgrp" "$targetdir"
1685 203:1e55195bca45 chris
	    else
1686 223:c3544e9fd588 chris
		mv "$tmptargetdir" "$targetdir"
1687
		chgrp -R "$redgrp" "$targetdir"
1688 203:1e55195bca45 chris
	    fi
1689 228:3c084a25d8ab chris
	else
1690
	    echo "Processing did not result in an index.html being created"
1691 203:1e55195bca45 chris
	fi
1692
    fi
1693
done
1694
1695 223:c3544e9fd588 chris
rm -rf "$tmpdir"
1696 203:1e55195bca45 chris
#!/bin/bash
1697
1698
docdir="/var/doc"
1699
1700 228:3c084a25d8ab chris
progdir=$(dirname $0)
1701
case "$progdir" in
1702
    /*) ;;
1703
    *) progdir="$(pwd)/$progdir" ;;
1704
esac
1705
1706 203:1e55195bca45 chris
project="$1"
1707 223:c3544e9fd588 chris
projectdir="$2"
1708
targetdir="$3"
1709 203:1e55195bca45 chris
1710 223:c3544e9fd588 chris
if [ -z "$project" ] || [ -z "$targetdir" ] || [ -z "$projectdir" ]; then
1711
    echo "Usage: $0 <project> <projectdir> <targetdir>"
1712 203:1e55195bca45 chris
    exit 2
1713
fi
1714
1715 223:c3544e9fd588 chris
if [ ! -d "$projectdir" ]; then
1716
    echo "Project directory $projectdir not found"
1717 203:1e55195bca45 chris
    exit 1
1718
fi
1719
1720
if [ ! -d "$targetdir" ]; then
1721
    echo "Target dir $targetdir not found"
1722
    exit 1
1723
fi
1724
1725
if [ -f "$targetdir/index.html" ]; then
1726
    echo "Target dir $targetdir already contains index.html"
1727
    exit 1
1728
fi
1729
1730
doxyfile=$(find "$projectdir" -type f -name Doxyfile -print | head -1)
1731
1732
if [ -z "$doxyfile" ]; then
1733
    echo "No Doxyfile found for project $project"
1734
    exit 1
1735
fi
1736
1737
echo "Project $project contains a Doxyfile at $doxyfile"
1738
1739
cd "$projectdir" || exit 1
1740
1741 228:3c084a25d8ab chris
"$progdir/doxysafe.pl" "$doxyfile" | \
1742
    sed -e '$a OUTPUT_DIRECTORY='"$targetdir" | \
1743 203:1e55195bca45 chris
    doxygen -
1744
1745
#!/bin/bash
1746 168:c1e9f2dab1d5 chris
1747 203:1e55195bca45 chris
docdir="/var/doc"
1748 168:c1e9f2dab1d5 chris
1749 203:1e55195bca45 chris
project="$1"
1750 223:c3544e9fd588 chris
projectdir="$2"
1751
targetdir="$3"
1752 168:c1e9f2dab1d5 chris
1753 223:c3544e9fd588 chris
if [ -z "$project" ] || [ -z "$targetdir" ] || [ -z "$projectdir" ]; then
1754
    echo "Usage: $0 <project> <projectdir> <targetdir>"
1755 203:1e55195bca45 chris
    exit 2
1756 168:c1e9f2dab1d5 chris
fi
1757
1758 223:c3544e9fd588 chris
if [ ! -d "$projectdir" ]; then
1759
    echo "Project directory $projectdir not found"
1760 203:1e55195bca45 chris
    exit 1
1761
fi
1762 168:c1e9f2dab1d5 chris
1763 203:1e55195bca45 chris
if [ ! -d "$targetdir" ]; then
1764
    echo "Target dir $targetdir not found"
1765
    exit 1
1766
fi
1767 168:c1e9f2dab1d5 chris
1768 203:1e55195bca45 chris
if [ -f "$targetdir/index.html" ]; then
1769
    echo "Target dir $targetdir already contains index.html"
1770
    exit 1
1771 178:2cec5c53cd68 chris
fi
1772 168:c1e9f2dab1d5 chris
1773 191:0d1c6fa50d3a chris
# Identify Java files whose packages match the trailing parts of their
1774
# paths, and list the resulting packages and the path prefixes with
1775
# the packages removed (so as to find code in subdirs,
1776
# e.g. src/com/example/...)
1777
1778
# Regexp match is very rough; check what is actually permitted for
1779
# package declarations
1780
1781 203:1e55195bca45 chris
find "$projectdir" -type f -name \*.java \
1782 989:3549525ba22a Chris
    -exec egrep '^ *package +[a-zA-Z][a-zA-Z0-9\._-]*;.*$' \{\} /dev/null \; |
1783
    sed -e 's/\/[^\/]*: *package */:/' -e 's/;.*$//' |
1784 191:0d1c6fa50d3a chris
    sort | uniq | (
1785
	current_prefix=
1786
	current_packages=
1787
	while IFS=: read filepath package; do
1788
	    echo "Looking at $package in $filepath"
1789
	    packagepath=${package//./\/}
1790
	    prefix=${filepath%$packagepath}
1791 203:1e55195bca45 chris
	    prefix=${prefix:=$projectdir}
1792 191:0d1c6fa50d3a chris
	    if [ "$prefix" = "$filepath" ]; then
1793
		echo "Package $package does not match suffix of path $filepath, skipping"
1794
		continue
1795
	    fi
1796
	    if [ "$prefix" != "$current_prefix" ]; then
1797 450:73401a15037b Chris
		echo "Package $package matches file path and has new prefix $prefix"
1798 191:0d1c6fa50d3a chris
		if [ -n "$current_packages" ]; then
1799
		    echo "Running Javadoc for packages $current_packages from prefix $current_prefix"
1800 450:73401a15037b Chris
		    echo "Command is: javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages"
1801 203:1e55195bca45 chris
		    javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages
1802 191:0d1c6fa50d3a chris
		fi
1803
		current_prefix="$prefix"
1804 450:73401a15037b Chris
		current_packages="$package"
1805 191:0d1c6fa50d3a chris
	    else
1806 450:73401a15037b Chris
		echo "Package $package matches file path with same prefix as previous file"
1807 191:0d1c6fa50d3a chris
		current_packages="$current_packages $package"
1808
	    fi
1809
	done
1810 203:1e55195bca45 chris
	prefix=${prefix:=$projectdir}
1811 191:0d1c6fa50d3a chris
	if [ -n "$current_packages" ]; then
1812
	    echo "Running Javadoc for packages $current_packages in prefix $current_prefix"
1813 450:73401a15037b Chris
  	    echo "Command is: javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages"
1814 203:1e55195bca45 chris
	    javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages
1815 191:0d1c6fa50d3a chris
	fi
1816
    )
1817
1818 450:73401a15037b Chris
if [ -f "$targetdir"/overview-tree.html ]; then
1819
    cp "$targetdir"/overview-tree.html "$targetdir"/index.html
1820
fi
1821
1822 203:1e55195bca45 chris
# for exit code:
1823
[ -f "$targetdir/index.html" ]
1824 168:c1e9f2dab1d5 chris
1825 411:e7ba81c8dc5a chris
#!/bin/bash
1826
1827
docdir="/var/doc"
1828
1829
progdir=$(dirname $0)
1830
case "$progdir" in
1831
    /*) ;;
1832
    *) progdir="$(pwd)/$progdir" ;;
1833
esac
1834
1835
project="$1"
1836
projectdir="$2"
1837
targetdir="$3"
1838
1839
if [ -z "$project" ] || [ -z "$targetdir" ] || [ -z "$projectdir" ]; then
1840
    echo "Usage: $0 <project> <projectdir> <targetdir>"
1841
    exit 2
1842
fi
1843
1844
if [ ! -d "$projectdir" ]; then
1845
    echo "Project directory $projectdir not found"
1846
    exit 1
1847
fi
1848
1849
if [ ! -d "$targetdir" ]; then
1850
    echo "Target dir $targetdir not found"
1851
    exit 1
1852
fi
1853
1854
if [ -f "$targetdir/index.html" ]; then
1855
    echo "Target dir $targetdir already contains index.html"
1856
    exit 1
1857
fi
1858
1859
mfile=$(find "$projectdir" -type f -name \*.m -print0 | xargs -0 grep -l '^% ' | head -1)
1860
1861
if [ -z "$mfile" ]; then
1862
    echo "No MATLAB files with comments found for project $project"
1863
    exit 1
1864
fi
1865
1866
echo "Project $project contains at least one MATLAB file with comments"
1867
1868
cd "$projectdir" || exit 1
1869
1870
perl "$progdir/matlab-docs.pl" -c "$progdir/matlab-docs.conf" -d "$targetdir"
1871
1872 978:bbb88c44f805 Chris
1873 980:9b4919de5317 Chris
# Read an Apache log file in SoundSoftware site format from stdin and
1874
# produce some per-project stats.
1875 978:bbb88c44f805 Chris
#
1876
# Invoke with e.g.
1877
#
1878
# cat /var/log/apache2/code-access.log | \
1879
#   script/runner -e production extra/soundsoftware/get-apache-log-stats.rb
1880
1881 975:198f764e734c Chris
1882
# Use the ApacheLogRegex parser, a neat thing
1883
# See http://www.simonecarletti.com/blog/2009/02/apache-log-regex-a-lightweight-ruby-apache-log-parser/
1884
require 'apachelogregex'
1885
1886
# This is the format defined in our httpd.conf
1887
vhost_combined_format = '%v:%p %h %{X-Forwarded-For}i %l %u %t \"%r\" %>s %O \"%{Referer}i\" \"%{User-Agent}i\"'
1888
1889
parser = ApacheLogRegex.new(vhost_combined_format)
1890
1891
# project name -> count of hg clones
1892
clones = Hash.new(0)
1893
1894
# project name -> count of hg pulls
1895
pulls = Hash.new(0)
1896
1897 978:bbb88c44f805 Chris
# project name -> count of hg pushes
1898
pushes = Hash.new(0)
1899 975:198f764e734c Chris
1900
# project name -> count of hg archive requests (i.e. Download as Zip)
1901
zips = Hash.new(0)
1902
1903
# project name -> count of hits to pages under /projects/projectname
1904
hits = Hash.new(0)
1905
1906 978:bbb88c44f805 Chris
# project name -> Project object
1907
@projects = Hash.new
1908
1909 975:198f764e734c Chris
parseable = 0
1910
unparseable = 0
1911
1912 979:56a38a9f6204 Chris
def is_public_project?(project)
1913 978:bbb88c44f805 Chris
  if !project
1914
    false
1915 983:a97e573d7f87 Chris
  elsif project =~ /^\d+$/
1916
    # ignore numerical project ids, they are only used when editing projects
1917
    false
1918 978:bbb88c44f805 Chris
  elsif @projects.key?(project)
1919 979:56a38a9f6204 Chris
    @projects[project].is_public?
1920 978:bbb88c44f805 Chris
  else
1921
    pobj = Project.find_by_identifier(project)
1922
    if pobj
1923
      @projects[project] = pobj
1924 979:56a38a9f6204 Chris
      pobj.is_public?
1925 978:bbb88c44f805 Chris
    else
1926 979:56a38a9f6204 Chris
      print "Project not found: ", project, "\n"
1927 978:bbb88c44f805 Chris
      false
1928
    end
1929
  end
1930
end
1931
1932 980:9b4919de5317 Chris
def print_stats(h)
1933
  h.keys.sort { |a,b| h[b] <=> h[a] }.each do |p|
1934 982:6edb748be064 Chris
    if h[p] > 0
1935 983:a97e573d7f87 Chris
      print h[p], " ", @projects[p].name, " [", p, "]\n"
1936 982:6edb748be064 Chris
    end
1937 980:9b4919de5317 Chris
  end
1938
end
1939
1940 979:56a38a9f6204 Chris
STDIN.each do |line|
1941 975:198f764e734c Chris
1942
  record = parser.parse(line)
1943
1944
  # most annoyingly, the parser can't handle the comma-separated list
1945
  # in X-Forwarded-For where it has more than one element. If it has
1946 983:a97e573d7f87 Chris
  # failed, remove any IP addresses or the word "unknown" with
1947
  # trailing commas and try again
1948 975:198f764e734c Chris
  if not record
1949 983:a97e573d7f87 Chris
    filtered = line.gsub(/(unknown|([0-9]+\.){3}[0-9]+),\s*/, "")
1950 975:198f764e734c Chris
    record = parser.parse(filtered)
1951
  end
1952
1953
  # discard, but count, unparseable lines
1954
  if not record
1955 979:56a38a9f6204 Chris
    print "Line not parseable: ", line, "\n"
1956 975:198f764e734c Chris
    unparseable += 1
1957
    next
1958
  end
1959
1960
  # discard everything that isn't a 200 OK response
1961
  next if record["%>s"] != "200"
1962
1963
  # discard anything apparently requested by a crawler
1964
  next if record["%{User-Agent}i"] =~ /(bot|slurp|crawler|spider|Redmine)\b/i
1965
1966
  # pull out request e.g. GET / HTTP/1.0
1967
  request = record["%r"]
1968
1969
  # split into method, path, protocol
1970
  if not request =~ /^[^\s]+ ([^\s]+) [^\s]+$/
1971 979:56a38a9f6204 Chris
    print "Line not parseable (bad method, path, protocol): ", line, "\n"
1972 975:198f764e734c Chris
    unparseable += 1
1973
    next
1974
  end
1975
1976
  # get the path e.g. /projects/weevilmatic and split on /
1977
  path = $~[1]
1978
  components = path.split("/")
1979
1980
  # should have at least two elements unless path is "/"; first should
1981
  # be empty (begins with /)
1982
  if path != "/" and (components.size < 2 or components[0] != "")
1983 979:56a38a9f6204 Chris
    print "Line not parseable (degenerate path): ", line, "\n"
1984 975:198f764e734c Chris
    unparseable += 1
1985
    next
1986
  end
1987
1988
  if components[1] == "hg"
1989
1990
    # path is /hg/project?something or /hg/project/something
1991
1992
    project = components[2].split("?")[0]
1993 979:56a38a9f6204 Chris
    if not is_public_project?(project)
1994 978:bbb88c44f805 Chris
      next
1995
    end
1996 975:198f764e734c Chris
1997
    if components[2] =~ /&roots=00*$/
1998
      clones[project] += 1
1999
    elsif components[2] =~ /cmd=capabilities/
2000
      pulls[project] += 1
2001 978:bbb88c44f805 Chris
    elsif components[2] =~ /cmd=unbundle/
2002
      pushes[project] += 1
2003 975:198f764e734c Chris
    elsif components[3] == "archive"
2004
      zips[project] += 1
2005
    end
2006
2007
  elsif components[1] == "projects"
2008
2009
    # path is /projects/project or /projects/project/something
2010
2011
    project = components[2]
2012 979:56a38a9f6204 Chris
    project = project.split("?")[0] if project
2013
    if not is_public_project?(project)
2014 978:bbb88c44f805 Chris
      next
2015 975:198f764e734c Chris
    end
2016
2017 978:bbb88c44f805 Chris
    hits[project] += 1
2018
2019 975:198f764e734c Chris
  end
2020
2021
  parseable += 1
2022
end
2023
2024
# Each clone is also a pull; deduct it from the pulls hash, because we
2025
# want that to contain only non-clone pulls
2026
2027
clones.keys.each do |project|
2028
  pulls[project] -= 1
2029
end
2030
2031 982:6edb748be064 Chris
print parseable, " parseable\n"
2032
print unparseable, " unparseable\n"
2033
2034
2035 980:9b4919de5317 Chris
print "\nMercurial clones:\n"
2036
print_stats clones
2037
2038
print "\nMercurial pulls (excluding clones):\n"
2039
print_stats pulls
2040
2041
print "\nMercurial pushes:\n"
2042
print_stats pushes
2043
2044
print "\nMercurial archive (zip file) downloads:\n"
2045
print_stats zips
2046
2047 982:6edb748be064 Chris
print "\nProject page hits (excluding crawlers):\n"
2048 980:9b4919de5317 Chris
print_stats hits
2049 975:198f764e734c Chris
2050
2051 1536:e2a3230f61fa Chris
2052
# Print out an authormap file for hg-to-git conversion using
2053
# hg-fast-export
2054
#
2055
# Invoke with the project identifier as argument, e.g.
2056
#
2057
# ./script/rails runner -e production extra/soundsoftware/get-repo-authormap.rb soundsoftware-site
2058
2059 1537:e55cbb9ba8bf Chris
proj_ident = ARGV.last
2060 1536:e2a3230f61fa Chris
proj = Project.find_by_identifier(proj_ident)
2061
repo = Repository.where(:project_id => proj.id).first
2062
csets = Changeset.where(:repository_id => repo.id)
2063
committers = csets.map do |c| c.committer end.sort.uniq
2064
committers.each do |c|
2065 1537:e55cbb9ba8bf Chris
  if not c =~ /[^<]+<.*@.*>/ then
2066
    u = repo.find_committer_user c
2067
    print "#{c}=#{u.name} <#{u.mail}>\n" unless u.nil?
2068
  end
2069 1536:e2a3230f61fa Chris
end
2070 970:6bd8364eafae luis
2071 1453:b554eb79ec7b luis
# Log user and project information
2072
#
2073
# Invoke with e.g.
2074
#
2075
# ./script/rails runner -e production extra/soundsoftware/get-statistics.rb
2076 970:6bd8364eafae luis
#
2077
2078 1454:02a05da0bedc luis
projectStats =  {
2079
        :all => Project.active.all.count,
2080
        :private => Project.active.find(:all, :conditions => {:is_public => false}).count,
2081
        :top_level => Project.active.find(:all, :conditions => {:parent_id => nil}).count,
2082
        :top_level_and_private => Project.active.find(:all, :conditions => {:is_public => false, :parent_id => nil}).count
2083
      }
2084 970:6bd8364eafae luis
2085 1453:b554eb79ec7b luis
userStats = {:all => User.active.all.count}
2086 1002:f6ede18f3e6e Chris
2087 1453:b554eb79ec7b luis
stats = {:date => Date.today, :projects => projectStats, :users => userStats}.to_json
2088 1002:f6ede18f3e6e Chris
2089 1453:b554eb79ec7b luis
print "#{stats}\n"
2090 1002:f6ede18f3e6e Chris
2091 383:47ae83ce8db8 Chris
<div style="clear: both; float: right"><small><i>Produced by mtree2html by Hartmut Pohlheim</i></small></div>
2092
# configuration file for generation of html-docu from m-files
2093
#
2094
# Author:   Hartmut Pohlheim
2095
# History:  05.11.2000  file created (parameters for mtree2html2001)
2096
#
2097
# The following options/variables must be changed/adapted:
2098
#   dirmfiles
2099
#   dirhtml
2100
#   csslink
2101
#   texttitleframelayout
2102
#   texttitlefiles
2103
#
2104
# The following options/variables should be adapted:
2105
#   authorfile
2106
#   filenametopframe
2107
#   codeheadmeta
2108
2109
#========================================================================
2110
# Variables (possible keywords: set)
2111
# to use the built-in settings, comment the line using # in first column
2112
#========================================================================
2113
2114
#------------------------------------------------------------------------
2115
# dirmfiles: name of directory containing Matlab m-files
2116
# dirhtml: name of directory to place the html-files into
2117
# exthtml: extension used for the html files (.html or .htm)
2118
#          don't forget the point in front of the extension
2119
#------------------------------------------------------------------------
2120
set dirmfiles = .
2121
set dirhtml = doc-output
2122
set exthtml = .html
2123
2124
#------------------------------------------------------------------------
2125
# authorfile:   name of file containing info about author (in html)
2126
#               if defined, this text is included at the bottom of the
2127
#               html files
2128
#------------------------------------------------------------------------
2129 410:675de8e6becf chris
set authorfile = matlab-docs-credit.html
2130 383:47ae83ce8db8 Chris
2131
#------------------------------------------------------------------------
2132
# csslink:   text for linking to css file (style sheets)
2133
#            the text defined here is directly included into the head
2134
#            of the html file
2135
#------------------------------------------------------------------------
2136 410:675de8e6becf chris
#set csslink = <link rel=stylesheet type="text/css" href="CSSFILENAME.css" />
2137 383:47ae83ce8db8 Chris
2138
#------------------------------------------------------------------------
2139
# links2filescase: this is a bit difficult
2140
#                  Matlab is case sensitive on UNIX, but case insensitive
2141
#                  on Windows. Under UNIX Matlab function calls work
2142
#                  only, when the case of file name and function call are
2143
#                  identical, under Windows you can do what you want.
2144
#                  This scripts help you, to keep an exact case in your
2145
#                  project.
2146
#          exact - internal links are only generated, when case of file
2147
#                  name and in source code are identical
2148
#            all - case doesn't matter
2149
#     exactupper - same as exact, additionally links are also vreated to
2150
#                  all upper case function names in source code (often
2151
#                  used by Mathworks)
2152
#      exactvery - same as exact, additionally info about not matching
2153
#                  case is written to screen (stdout), this can be very
2154
#                  helpful in cleaning up the case in a project
2155
#------------------------------------------------------------------------
2156
set links2filescase = all
2157
2158
#------------------------------------------------------------------------
2159
# texttitleframelayout:    text of title for frame layout file (whole docu)
2160
#------------------------------------------------------------------------
2161 389:0bc92382a86b chris
set texttitleframelayout = MATLAB Function Documentation
2162 383:47ae83ce8db8 Chris
2163
#------------------------------------------------------------------------
2164
# texttitle/headerindexalldirs: text of title and header for directory index
2165
#------------------------------------------------------------------------
2166
set texttitleindexalldirs = Index of Directories
2167
set textheaderindexalldirs = Index of Directories
2168
2169
#------------------------------------------------------------------------
2170
# texttitle/headerindex:    text of title and header for index file
2171
#------------------------------------------------------------------------
2172
set texttitleindex = A-Z Index of Functions
2173
set textheaderindex = A-Z Index of Functions
2174
2175
#------------------------------------------------------------------------
2176
# texttitle/headerfiles:    text of title and header for files
2177
#                           name of file will be added at the end
2178
#------------------------------------------------------------------------
2179 389:0bc92382a86b chris
set texttitlefiles = Function
2180 383:47ae83ce8db8 Chris
set textheaderfiles = Documentation of
2181
2182
#------------------------------------------------------------------------
2183
# frames: whether to use frames in layout (yes or no)
2184
#------------------------------------------------------------------------
2185
set frames = no
2186
2187
#------------------------------------------------------------------------
2188
# filenametopframe: name of file including frame layout (highest level file)
2189
# [default: index]
2190
#------------------------------------------------------------------------
2191
set filenametopframe = index
2192
2193
#------------------------------------------------------------------------
2194
# textjumpindexglobal: text displayed for jump to index of all files
2195
#                      (global)
2196
# textjumpindexlocal:  text displayed for jump to index of files in actual
2197
#                      directory (local)
2198
#------------------------------------------------------------------------
2199 389:0bc92382a86b chris
set textjumpindexglobal = <b>Index of</b> all files:
2200
set textjumpindexlocal = this subdirectory only:
2201 383:47ae83ce8db8 Chris
2202
#------------------------------------------------------------------------
2203
# includesource: include source of m-files in documentation [YES|no]
2204
#------------------------------------------------------------------------
2205
set includesource = yes
2206
2207
#------------------------------------------------------------------------
2208
# usecontentsm: use contents.m files as well for structured
2209
#               (hopefully) index [YES|no]
2210
#------------------------------------------------------------------------
2211
set usecontentsm = no
2212
2213
#------------------------------------------------------------------------
2214
# includesource: write/update contents.m files [yes|NO]
2215
#------------------------------------------------------------------------
2216
set writecontentsm = no
2217
2218
#------------------------------------------------------------------------
2219
# processtree:  parse whole directory tree recursively [YES|no]
2220
#------------------------------------------------------------------------
2221
set processtree = yes
2222
2223
#------------------------------------------------------------------------
2224
# producetree:  produce tree for html-files in same structure than
2225
#		          tree of m-files [yes|NO]
2226
#               if no, all files are saved in the same directory, often
2227
#               easier for outside linking to files
2228
#------------------------------------------------------------------------
2229 401:a0f6e994657f chris
set producetree = yes
2230 383:47ae83ce8db8 Chris
2231
#------------------------------------------------------------------------
2232
# codebodyindex/files: HTML-code for adding to BODY tag
2233
#                      can be used for defining colors and
2234
#                      backgroundimages of the files
2235
#                      No longer recommended, use the css file
2236
#------------------------------------------------------------------------
2237
set codebodyindex =
2238
set codebodyfiles =
2239
2240
#------------------------------------------------------------------------
2241
# codeheadmeta: HTML-code added in HEAD area, use for supplying META info
2242
#------------------------------------------------------------------------
2243
set codeheadmeta =
2244
2245
#------------------------------------------------------------------------
2246
# codehr: HTML-code used to define a <HR>, do what you want
2247
#------------------------------------------------------------------------
2248 411:e7ba81c8dc5a chris
set codehr = <hr>
2249 383:47ae83ce8db8 Chris
2250
#------------------------------------------------------------------------
2251
# codeheader: HTML-code added to <H*> tags, use for centering header text
2252
#             or changing the colour/size/font of the header text
2253
#------------------------------------------------------------------------
2254 389:0bc92382a86b chris
set codeheader =
2255 383:47ae83ce8db8 Chris
2256
2257
# End of parameter file
2258 381:2dc8163e9150 Chris
@rem = '--*-Perl-*--';
2259
@rem = '
2260
@echo off
2261
perl -w -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
2262
goto endofperl
2263
@rem ';
2264
# perl -w -S %0.bat "$@"
2265 382:baff1c482d98 Chris
#!/usr/bin/perl
2266 381:2dc8163e9150 Chris
#
2267
# mtree2html_2000 - produce html files from Matlab m-files.
2268
#                   use configuration file for flexibility
2269
#                   can process tree of directories
2270
#
2271
# Copyright (C) 1996-2000 Hartmut Pohlheim.  All rights reserved.
2272
# includes small parts of m2html from Jeffrey C. Kantor 1995
2273
#
2274
# Author:  Hartmut Pohlheim
2275
# History: 06.03.1996  file created
2276
#          07.03.1996  first working version
2277
#          08.03.1996  modularized, help text only once included
2278
#          11.03.1996  clean up, some functions rwritten
2279
#          18.04.1996  silent output with writing in one line only
2280
#                      version 0.20 fixed
2281
#          14.05.1996  start of adding tree structure, could create tree
2282
#          15.05.1996  creating of index files for every directory
2283
#          17.05.1996  first working version except compact A-Z index
2284
#          20.05.1996  cleanup of actual version, more variables and
2285
#                      configurable settings
2286
#          21.05.1996  reading, update and creation of contents.m added
2287
#          22.05.1996  creation of short index started
2288
#          28.05.1996  jump letters for short index,
2289
#                      3 different directory indexes (short/long/contents)
2290
#          29.05.1996  major cleanup, short and long index created from one function
2291
#                      links for HTML and Indexes from 1 function,
2292
#                      version 0.9
2293
#          30.05.1996  contents.m changed to Contents.m (because unix likes it)
2294
#                      function definition can be in first line of m file before comments
2295
#                      version 0.91 fixed
2296
#          03.06.1996  contents file can be written as wanted, the links will be correct
2297
#                      cross references in help block of m-file will be found and
2298
#                      converted, even if the name of the function is written upper case
2299
#                      version 0.92 fixed
2300
#          05.06.1996  construction of dependency matrix changed, is able now to process
2301
#                      even the whole matlab tree (previous version needed to much memory)
2302
#                      removed warning for contents files in different directories
2303
#                      version 0.94 fixed
2304
#          06.06.1996  new link name matrices for ConstructHTMLFile created,
2305
#                      everything is done in ConstructDependencyMatrix,
2306
#                      both dependencies (calls and called) and matrix
2307
#                      with all mentioned names in this m-file, thus, much
2308
#                      less scanning in html construction
2309
#                      script is now (nearly) linear scalable, thus, matlab-toolbox
2310
#                      tree takes less than 1 hour on a Pentium120, with source
2311
#                      version 0.96 fixed
2312
#          10.06.1996  order of creation changed, first all indexes (includes
2313
#                      update/creation of contents.m) and then ConstructDepency
2314
#                      thus, AutoAdd section will be linked as well
2315
#                      excludenames extended, some more common word function names added
2316
#                      version 0.97 fixed
2317
#          17.02.1998  writecontentsm as command line parameter added
2318
#                      error of file not found will even appear when silent
2319
#                      version 1.02
2320
#          21.05.2000  mark comments in source code specially (no fully correct,
2321
#                      can't handle % in strings)
2322
#                      version 1.11
2323
#          05.11.2000  link also to upper and mixed case m-files
2324
#                      searching for .m files now really works (doesn't find grep.com any longer)
2325
#                      file renamed to mtree2html2001
2326
#                      generated html code now all lower case
2327
#                      inclusion of meta-description and meta-keywords in html files
2328
#                      HTML4 compliance done (should be strict HTML4.0, quite near XHTML)
2329
#                      version 1.23
2330
#
2331 383:47ae83ce8db8 Chris
#	   29.03.2011  (Chris Cannam) add frames option.
2332 381:2dc8163e9150 Chris
2333
$VERSION  = '1.23';
2334
($PROGRAM = $0) =~ s@.*/@@; $PROGRAM = "\U$PROGRAM\E";
2335 411:e7ba81c8dc5a chris
$debug = 1;
2336 381:2dc8163e9150 Chris
2337
#------------------------------------------------------------------------
2338
# Define platform specific things
2339
#------------------------------------------------------------------------
2340
# suffix for files to search is defined twice
2341
# the first ($suffix) is for string creation and contains the . as well
2342
# the second ($suffixforsearch) is for regular expression, handling of . is quite special
2343
$suffix = ".m";
2344
$suffixforsearch = "m";
2345
# the directory separator
2346
$dirsep = "/";
2347
# what is the current directory
2348
$diract = ".";
2349
2350
#------------------------------------------------------------------------
2351 382:baff1c482d98 Chris
#  Define all variables and their standard settings
2352 381:2dc8163e9150 Chris
#  documentation of variables is contained in accompanying rc file
2353
#------------------------------------------------------------------------
2354
%var =
2355
(
2356
   'authorfile',                '',
2357
   'codebodyfiles',             '',
2358
   'codebodyindex',             '',
2359
   'codeheadmeta',              '<meta name="author of conversion perl script" content="Hartmut Pohlheim" />',
2360
   'codehr',                    '<hr size="3" noshade="noshade" />',
2361
   'codeheader',                '',
2362 383:47ae83ce8db8 Chris
   'configfile',                'matlab-docs.conf',
2363 381:2dc8163e9150 Chris
   'csslink',                   '',
2364
   'dirmfiles',                 $diract,
2365
   'dirhtml',                   $diract,
2366
   'exthtml',                   '.html',
2367 382:baff1c482d98 Chris
   'frames',                    'yes',
2368 381:2dc8163e9150 Chris
   'filenametopframe',          'index',
2369
   'filenameindexlongglobal',   'indexlg',
2370
   'filenameindexlonglocal',    'indexll',
2371
   'filenameindexshortglobal',  'indexsg',
2372
   'filenameindexshortlocal',   'indexsl',
2373
   'filenameextensionframe',    'f',
2374
   'filenameextensionindex',    'i',
2375
   'filenameextensionjump',     'j',
2376
   'filenamedirshort',          'dirtops',
2377
   'filenamedirlong',           'dirtopl',
2378
   'filenamedircontents',       'dirtopc',
2379
   'includesource',             'yes',
2380
   'links2filescase',           'all',
2381
   'processtree',               'yes',
2382
   'producetree',               'yes',
2383
   'textjumpindexlocal',        'Local Index',
2384
   'textjumpindexglobal',       'Global Index',
2385
   'texttitleframelayout',      'Documentation of Matlab Files',
2386
   'texttitleindexalldirs',     'Index of Directories',
2387
   'textheaderindexalldirs',    'Index of Directories',
2388
   'texttitleindex',            '',
2389
   'textheaderindex',           '',
2390
   'texttitlefiles',            'Documentation of ',
2391
   'textheaderfiles',           'Documentation of ',
2392
   'usecontentsm',              'yes',
2393
   'writecontentsm',            'no'
2394
);
2395
2396
2397
# define all m-file names, that should be excluded from linking
2398
# however, files will still be converted
2399
@excludenames = ( 'all','ans','any','are',
2400
                  'cs',
2401
                  'demo','dos',
2402
                  'echo','edit','else','elseif','end','exist',
2403
                  'flag','for','function',
2404
                  'global',
2405
                  'help',
2406
                  'i','if','inf','info',
2407
                  'j',
2408
                  'more',
2409
                  'null',
2410
                  'return',
2411
                  'script','strings',
2412
                  'what','which','while','who','whos','why',
2413
                );
2414
2415
# Text for inclusion in created HTML/Frame files: Doctype and Charset
2416
$TextDocTypeHTML  = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">';
2417
$TextDocTypeFrame = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN" "http://www.w3.org/TR/REC-html40/frameset.dtd">';
2418
$TextMetaCharset = '<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />';
2419
2420
#------------------------------------------------------------------------
2421
# Read the command line arguments
2422
#------------------------------------------------------------------------
2423
if (@ARGV == 0) {
2424
   &DisplayHelp()  if &CheckFileName($var{'configfile'}, 'configuration file');
2425
}
2426
2427
# Print provided command line arguments on screen
2428
foreach (@ARGV) { print "   $_\n      "; }
2429
2430
# Get the options
2431
use Getopt::Long;
2432
@options = ('help|h', 'todo|t', 'version|v',
2433
            'authorfile|a=s', 'configfile|c=s', 'dirhtml|html|d=s',
2434
            'dirmfiles|mfiles|m=s', 'includesource|i=s',
2435
            'processtree|r=s', 'producetree|p=s',
2436
            'silent|quiet|q', 'writecontentsm|w=s');
2437
&GetOptions(@options) || die "use -h switch to display help statement\n";
2438
2439
2440
# Display help or todo list, when requested
2441
&DisplayHelp()                         if $opt_help;
2442
&DisplayTodo()                         if $opt_todo;
2443
die "$PROGRAM v$VERSION\n"             if $opt_version;
2444
2445
$exit_status = 0;
2446
2447
#------------------------------------------------------------------------
2448
# Read the config file
2449
#------------------------------------------------------------------------
2450
$var{'configfile'} = $opt_configfile         if $opt_configfile;
2451
&GetConfigFile($var{'configfile'});
2452
2453
2454
#------------------------------------------------------------------------
2455
# Process/Check the command line otions
2456
#------------------------------------------------------------------------
2457
$var{'dirhtml'}   = $opt_dirhtml              if $opt_dirhtml;
2458
if (!(substr($var{'dirhtml'}, -1, 1) eq $dirsep)) { $var{'dirhtml'} = $var{'dirhtml'}.$dirsep; }
2459
$var{'dirmfiles'} = $opt_dirmfiles            if $opt_dirmfiles;
2460
if (!(substr($var{'dirmfiles'}, -1, 1) eq $dirsep)) { $var{'dirmfiles'} = $var{'dirmfiles'}.$dirsep; }
2461
2462
$var{'authorfile'} = $opt_author              if $opt_author;
2463
$var{'includesource'} = $opt_includesource    if $opt_includesource;
2464
if ($var{'includesource'} ne 'no') { $var{'includesource'} = 'yes'; }
2465
$var{'processtree'} = $opt_processtree        if $opt_processtree;
2466
if ($var{'processtree'} ne 'no') { $var{'processtree'} = 'yes'; }
2467
$var{'producetree'} = $opt_producetree        if $opt_producetree;
2468
if ($var{'producetree'} ne 'no') { $var{'producetree'} = 'yes'; }
2469
if ($var{'processtree'} eq 'no') { $var{'producetree'} = 'no'; }
2470 382:baff1c482d98 Chris
if ($var{'frames'} ne 'no') { $var{'frames'} = 'yes'; }
2471 381:2dc8163e9150 Chris
# if (($var{'processtree'} eq 'yes') && ($var{'producetree'} eq 'no')) { $var{'usecontentsm'} = 'no'; }
2472
2473
$var{'writecontentsm'} = $opt_writecontentsm  if $opt_writecontentsm;
2474
2475
#------------------------------------------------------------------------
2476
# Do the real stuff
2477
#------------------------------------------------------------------------
2478
2479
# Print variables on screen, when not silent
2480
&ListVariables                          if !$opt_silent;
2481
2482
# Check the author file
2483
if ($var{'authorfile'} ne '') {
2484 410:675de8e6becf chris
    if (!($var{'authorfile'} =~ m,^/,)) {
2485
	# relative path: treat as relative to config file
2486
	my $cfd = $var{'configfile'};
2487
	$cfd =~ s,/[^/]*$,/,;
2488
	$cfd =~ s,^[^/]*$,.,;
2489
	$var{'authorfile'} = "$cfd/" . $var{'authorfile'};
2490
    }
2491
    if (&CheckFileName($var{'authorfile'}, 'author file')) {
2492
	$var{'authorfile'} = '';
2493
	if (!$opt_silent) { print "   Proceeding without author information!\n"; }
2494
    }
2495 381:2dc8163e9150 Chris
}
2496
2497
# Call the function doing all the real work
2498
&ConstructNameMatrix;
2499
2500
&ConstructDependencyMatrix;
2501
2502
&ConstructAllIndexFiles;
2503
2504
&ConstructHTMLFiles;
2505
2506
exit $exit_status;
2507
2508
#------------------------------------------------------------------------
2509
# Construct list of all mfile names and initialize various data arrays.
2510
#------------------------------------------------------------------------
2511
sub ConstructNameMatrix
2512
{
2513
   local(*MFILE);
2514
   local($file, $dirname);
2515
   local(@newdirectories);
2516
   local(%localnames);
2517
2518
   $RecDeep = 0;
2519
   &ParseTreeReadFiles($var{'dirmfiles'}, $RecDeep);
2520
2521
   foreach $dirname (@directories) {
2522
      if ($dirnumbermfiles{$dirname} > 0) {
2523
         push(@newdirectories, $dirname);
2524
         if (! defined($contentsname{$dirname})) {
2525
            $contentsname{$dirname} = 'Contents';
2526
            if (($var{'writecontentsm'} eq 'no') && ($var{'usecontentsm'} eq 'yes')) {
2527
               print "\r ParseTree - for directory  $dirname  no contents file found!\n";
2528
               print   "             create one or enable writing of contents file (writecontentsm = yes)!\n";
2529
            }
2530
         }
2531
      }
2532
   }
2533
   @alldirectories = @directories;
2534
   @directories = @newdirectories;
2535
2536
   foreach $dirname (@directories) {
2537
      if ($debug > 0) { print "Dir: $dirname \t\t $dirnumbermfiles{$dirname} \t$contentsname{$dirname}\n"; }
2538
   }
2539
2540
   @names = sort(keys %mfile);
2541
2542
   # check, if name of directory is identical to name of file
2543
   @dirsinglenames = values(%dirnamesingle);
2544
   grep($localnames{$_}++, @dirsinglenames);
2545
   @dirandfilename = grep($localnames{$_}, @names);
2546
   if (@dirandfilename) {
2547
      print "\r   Name clash between directory and file name: @dirandfilename\n";
2548
      print   "      These files will be excluded from linking!\n";
2549
      push(@excludenames, @dirandfilename);
2550
   }
2551
2552
   # construct names matrix for help text linking
2553
   #    exclude some common words (and at the same time m-functions) from linking in help text
2554
   grep($localnames{$_}++, @excludenames);
2555
   @linknames = grep(!$localnames{$_}, @names);
2556
2557
   if ($debug > 2) { print "linknames (names of found m-files):\n    @linknames\n"; }
2558
2559
}
2560
2561
#------------------------------------------------------------------------
2562
# Parse tree and collect all Files
2563
#------------------------------------------------------------------------
2564
sub ParseTreeReadFiles
2565
{
2566
   local($dirname, $localRecDeep) = @_;
2567
   local($file, $name, $filewosuffix);
2568
   local($dirhtmlname, $dirmode);
2569
   local($relpath, $relpathtoindex, $replacevardir);
2570
   local(*CHECKDIR, *AKTDIR);
2571
   local(@ALLEFILES);
2572
2573
   opendir(AKTDIR, $dirname) || die "ParseTree - Can't open directory $dirname: $!";
2574
   if ($debug > 1) { print "\nDirectory: $dirname\n"; }
2575
2576
   # create relative path
2577
   $_ = $dirname; $replacevardir = $var{'dirmfiles'};
2578
   s/$replacevardir//; $relpath = $_;
2579
   s/[^\/]+/../g; $relpathtoindex = $_;
2580
2581
   # producetree no
2582
   if ($var{'producetree'} eq 'no') { $relpath = ''; $relpathtoindex = ''; }
2583
2584
   # names of directories (top-level and below top-level m-file-directory)
2585
   push(@directories, $dirname);
2586
   $dirnumbermfiles{$dirname} = 0;    # set number of m-files for this dir to zero
2587
   # relative path from top-level directory, depends on directory name
2588
   $dirnamerelpath{$dirname} = $relpath;
2589
   # relative path from actual directory to top-level directory, depends on directory name
2590
   $dirnamerelpathtoindex{$dirname} = $relpathtoindex;
2591
   # recursion level for directory, depends on directory name
2592
   $dirnamerecdeep{$dirname} = $localRecDeep;
2593
2594
   # only the name of the directory, without path
2595
   $rindexprint = rindex($dirname, $dirsep, length($dirname)-2);
2596
   $rindsub = substr($dirname, $rindexprint+1, length($dirname)-$rindexprint-2);
2597
   $dirnamesingle{$dirname} = $rindsub;
2598
2599
   # create name of html-directories
2600
   $_ = $dirname;
2601
   s/$var{'dirmfiles'}/$var{'dirhtml'}/;
2602
   $dirhtmlname = $_;
2603
   if ($var{'producetree'} eq 'no') { $dirhtmlname = $var{'dirhtml'}; }
2604
   # try to open html directory, if error, then create directory,
2605
   # use same mode as for corresponding m-file directory
2606
   opendir(CHECKDIR,"$dirhtmlname") || do {
2607
      $dirmode = (stat($dirname))[2]; # print "$dirmode\n";
2608
      mkdir("$dirhtmlname", $dirmode) || die ("Cannot create directory $dirhtmlname: $! !");
2609
   };
2610
   closedir(CHECKDIR);
2611
2612
2613
   # read everything from this directory and process them
2614
   @ALLEFILES = readdir(AKTDIR);
2615
2616
   foreach $file (@ALLEFILES) {
2617
      # exclude . and .. directories
2618
      next if $file eq '.';  next if $file eq '..';
2619
2620
      # test for existense of entry (redundant, used for debugging)
2621
      if (-e $dirname.$file) {
2622
         # if it's a directory, call this function recursively
2623
         if (-d $dirname.$file) {
2624
            if ($var{'processtree'} eq 'yes') {
2625
               &ParseTreeReadFiles($dirname.$file.$dirsep, $localRecDeep+1);
2626
            }
2627
         }
2628
         # if it's a file - test for m-file, save name and create some arrays
2629
         elsif (-f $dirname.$file) {
2630
            if ($file =~ /\.$suffixforsearch$/i) {
2631
               # Remove the file suffix to establish the matlab identifiers
2632
               $filewosuffix = $file;
2633
               $filewosuffix =~ s/\.$suffixforsearch$//i;
2634
               # $filename = $name;
2635
2636
               # Contents file in unix must start with a capital letter (Contents.m)
2637
               # ensure, that m-file name is lower case, except the contents file
2638
               if (! ($filewosuffix =~ /^contents$/i)) {
2639 388:dad587ecb8d0 chris
		   # if ($var{'links2filescase'}  eq 'low') { $filewosuffix = "\L$filewosuffix\E"; }
2640 381:2dc8163e9150 Chris
                  $filewosuffixlow = "\L$filewosuffix\E";
2641
               }
2642
               else { $contentsname{$dirname} = $filewosuffix; }
2643
2644
               # internal handle name is always lower case
2645
               $name     = $filewosuffixlow;
2646
               # file name is not lower case
2647
               $filename = $filewosuffix;
2648
2649
               # if don't use C|contents.m, then forget all C|contents.m
2650
               if ($var{'usecontentsm'} eq 'no') { if ($name =~ /contents/i) { next; } }
2651
2652
               # if m-file with this name already exists, use directory and name for name
2653
               # only the first occurence of name will be used for links
2654
               if (defined $mfile{$name}) {
2655
                  if (! ($name =~ /^contents$/i) ) {
2656
                     print "\r ParseTree - Name conflict:  $name in $dirname already exists: $mfile{$name} !\n";
2657
                     print   "             $mfile{$name}  will be used for links!\n";
2658
                  }
2659
                  $name = $dirname.$name;
2660
               }
2661
               # mfile name with path
2662
               $mfile{$name} = $dirname.$file;
2663
               # mfile name (without path)
2664
               $mfilename{$name} = $filename;
2665
               # mfile directory
2666
               $mfiledir{$name} = $dirname;
2667
2668
               # html file name and full path, special extension of Contents files
2669
               if ($name =~ /contents/i) { $extrahtmlfilename = $dirnamesingle{$dirname}; }
2670
               else { $extrahtmlfilename = ''; }
2671
               $hfile{$name} = $dirhtmlname.$mfilename{$name}.$extrahtmlfilename.$var{'exthtml'};
2672
2673
               # save relative html path
2674
               # if ($var{'producetree'} eq 'yes') {
2675
               $hfilerelpath{$name} = $relpath;
2676
               # } else { # if no tree to produce, relative path is empty
2677
               #    $hfilerelpath{$name} = '';
2678
               # }
2679
2680
               # create relative path from html file to directory with global index file
2681
               $hfileindexpath{$name} = $relpathtoindex;
2682
2683
               # Function declaration, if one exists, set default to script
2684
               $synopsis{$name} = "";
2685
               $mtype{$name} = "script";
2686
2687
               # First comment line
2688
               $apropos{$name} = "";
2689
2690
               # count number of m-files in directories
2691
               $dirnumbermfiles{$dirname}++;
2692
2693
               if ($debug > 1) {
2694
                  if ($opt_silent) { print "\r"; }
2695
                  print "   ParseTree: $name \t\t $mfile{$name} \t\t $hfile{$name}\t\t";
2696
                  if (!$opt_silent) { print "\n"; }
2697
               }
2698
            }
2699
         }
2700
         else {
2701
            print "Unknown type of file in $dirname: $file\n";
2702
         }
2703
      }
2704
      else { print "Error: Not existing file in $dirname: $file\n"; }
2705
   }
2706
2707
   closedir(AKTDIR)
2708
2709
}
2710
2711
#------------------------------------------------------------------------
2712
# Construct Dependency matrix
2713
#    $dep{$x,$y} > 0 if $x includes a reference to $y.
2714
#------------------------------------------------------------------------
2715
sub ConstructDependencyMatrix
2716
{
2717
   &ConstructDependencyMatrixReadFiles('all');
2718
   &ConstructDependencyMatrixReally;
2719
}
2720
2721
2722
#------------------------------------------------------------------------
2723
# Construct Dependency matrix
2724
#    $dep{$x,$y} > 0 if $x includes a reference to $y.
2725
#------------------------------------------------------------------------
2726
sub ConstructDependencyMatrixReadFiles
2727
{
2728
   local($whatstring) = @_;
2729
   local(*MFILE);
2730
   local($name, $inames);
2731
   local(%symbolsdep, %symbolsall);
2732
2733
   # Initialize as all zeros.
2734
   # foreach $name (@names) { grep($dep{$name,$_}=0,@names); if ($debug > 0) { print "\r   DepMatrix anlegen: $name\t$#names\t"; } }
2735
2736
   # Compute the dependency matrix
2737
   $inames = -1;
2738
   foreach $name (@names) {
2739
      # Read each file and tabulate the distinct alphanumeric identifiers in
2740
      # an array of symbols. Also scan for:
2741
      #   synopsis: The function declaration line
2742
      #   apropos:  The first line of the help text
2743
2744
      # look for whatstring, if all: process every file, if contents: process only contents files
2745
      if ($whatstring eq 'contents') { if (! ($name =~ /contents$/i) ) { next; } }
2746
      elsif ($whatstring eq 'all') { }    # do nothing
2747
      else { print "\r   ConstructDependency: Unknown parameter whatstring: $whatstring \n"; }
2748
2749
      undef %symbolsall; undef %symbolsdep;
2750
      open(MFILE,"<$mfile{$name}") || die("Can't open $mfile{$name}: $!\n");
2751
      while (<MFILE>) {
2752
         chop;
2753
2754
         # Split on nonalphanumerics, then look for all words, used for links later
2755
         # this one for all references
2756
         @wordsall = grep(/[a-zA-Z]\w*/, split('\W',$_));
2757
         # set all words to lower case for link checking
2758
         undef @wordsall2;
2759
         # do case conversion not, case checking is done later
2760
         foreach (@wordsall) { push(@wordsall2, "\L$_\E"); }
2761
         # @wordsall2 = @wordsall;
2762
         grep($symbolsall{$_}++, @wordsall2);
2763
2764
         # Store first comment line, skip all others.
2765
         if (/^\s*%/) {
2766
            if (!$apropos{$name}) {
2767
               s/^\s*%\s*//;   # remove % and leading white spaces on line
2768
               $_ = &SubstituteHTMLEntities($_);
2769
               $apropos{$name} = $_;
2770
            }
2771
            next;
2772
         }
2773
2774
         # If it's the function declaration line, then store it and skip
2775
         # but only, when first function definition (multiple function lines when private subfunctions in file
2776
         if ($synopsis{$name} eq '') {
2777
            if (/^\s*function/) {
2778
               s/^\s*function\s*//;
2779
               $synopsis{$name} = $_;
2780
               $mtype{$name} = "function";
2781
               next;
2782
            }
2783
         }
2784
2785
         # Split off any trailing comments
2786
         if ($_ ne '') {
2787
            # this one for references in program code only
2788
            # when syntax parsing, here is a working place
2789
            ($statement) = split('%',$_,1);
2790
            @wordsdep = grep(/[a-zA-Z]\w*/,split('\W',$statement));
2791
            # do case conversion not, case checking is done later
2792
            undef @wordsdep2;
2793
            foreach (@wordsdep) { push(@wordsdep2, "\L$_\E"); }
2794
            grep($symbolsdep{$_}++, @wordsdep2);
2795
         }
2796
      }
2797
      close MFILE;
2798
2799
      # compute intersection between %symbolsall and @linknames
2800
      delete($symbolsall{$name});
2801
      # foreach $localsumall ($symbolsall) {
2802
      #    $localsumall = "\L$localsumall\E";
2803
      # }
2804
      @{'all'.$name} = grep($symbolsall{$_}, @linknames);
2805
2806
      # compute intersection between %symbolsdep and @linknames
2807
      delete($symbolsdep{$name});
2808
      @{'depcalls'.$name} = grep($symbolsdep{$_}, @linknames);
2809
2810
      $inames++; print "\r   DepCallsMatrix: $inames/$#names\t $name\t";
2811
      if ($debug > 2) { print "\n      depnames: @{'depcalls'.$name}\n      all: @{'all'.$name}\n"; }
2812
   }
2813
}
2814
2815
2816
#------------------------------------------------------------------------
2817
# Construct Dependency matrix
2818
#    $dep{$x,$y} > 0 if $x includes a reference to $y.
2819
#------------------------------------------------------------------------
2820
sub ConstructDependencyMatrixReally
2821
{
2822
   local($inames, $name);
2823
2824
   $inames = -1;
2825
   foreach $name (@names) { undef %{'depint'.$name}; }
2826
   foreach $name (@names) {
2827
      grep(${'depint'.$_}{$name}++, @{'depcalls'.$name});
2828
      $inames++; print "\r   DepCalledMatrix1: $inames/$#names\t $name\t";
2829
   }
2830
   $inames = -1;
2831
   foreach $name (@names) {
2832
      # compute intersection between %depint.name{$_} and @linknames
2833
      if (defined (%{'depint'.$name})) { @{'depcalled'.$name} = grep(${'depint'.$name}{$_}, @linknames); }
2834
      $inames++; print "\r   DepCalledMatrix2: $inames/$#names\t $name\t";
2835
      if ($debug > 2) { print "\n      depcalled: @{'depcalled'.$name}\n"; }
2836
   }
2837
2838
}
2839
2840
2841
#========================================================================
2842
# Construct all index files
2843
#========================================================================
2844
sub ConstructAllIndexFiles
2845
{
2846
   local(@localnames);
2847
   local($ActDir);
2848
   local($name);
2849
2850
   # define variables and names for frame target
2851
   $GlobalNameFrameMainLeft = 'Cont_Main';
2852
   $GlobalNameFrameMainRight = 'Cont_Lower';
2853
   $GlobalNameFrameAZIndexsmall = 'IndexAZindex';
2854
   $GlobalNameFrameAZIndexjump = 'IndexAZjump';
2855
2856
   $indexcreated = 0;
2857
2858
   &ConstructHighestIndexFile;
2859
   $indexcreated++;
2860
2861
   # if ($var{'producetree'} eq 'yes') {
2862
      # moved next 2 lines out of if for producetree no
2863
      # &ConstructHighestIndexFile;
2864
      # $indexcreated++;
2865
2866
      foreach $ActDir (@directories) {
2867
         undef @localnames;
2868
         foreach $name (@names) {
2869
            local($pathsubstr) = substr($mfile{$name}, 0, rindex($mfile{$name}, "/")+1);
2870
            if ($ActDir eq $pathsubstr) {
2871
               if ($debug > 1) { print "IndexFile: $pathsubstr    ActDir: $ActDir   Hfilerelpath: $hfilerelpath{$name}\n"; }
2872
               push(@localnames, $name);
2873
            }
2874
         }
2875
         if ($debug > 2) { print "localnames: @localnames\n"; }
2876
         # create contents file and short|long index of files in local directory
2877
         &ConstructContentsmFile($ActDir, @localnames);
2878
         &ConstructAZIndexFile($ActDir, 'short', 'local', @localnames);
2879
         &ConstructAZIndexFile($ActDir, 'long', 'local', @localnames);
2880
         $indexcreated+=2;
2881
      }
2882
   # } else {
2883
   #    &ConstructContentsmFile($var{'dirmfiles'}, @names);
2884
   # }
2885
2886
   # create short|long index of files in all directory
2887
   &ConstructAZIndexFile($var{'dirmfiles'}, 'short', 'global', @names);
2888
   &ConstructAZIndexFile($var{'dirmfiles'}, 'long', 'global', @names);
2889
   $indexcreated+=2;
2890
2891
   # if contents.m were created or updated, the dependency matrices should
2892
   # be updated as well
2893
   if ($var{'writecontentsm'} eq 'yes') { &ConstructDependencyMatrixReadFiles('contents');; }
2894
}
2895
2896
2897
#========================================================================
2898
# Construct the highest level index file
2899
#========================================================================
2900
sub ConstructHighestIndexFile
2901
{
2902
   local(*IFILE);
2903
   local($indexfile, $filename);
2904
2905
   # Build the frame layout file, this files includes the layout of the frames
2906
   # Build the frame layout file name (highest one)
2907
   $indexfile = $var{'dirhtml'}.$var{'filenametopframe'}.$var{'exthtml'};
2908
2909 382:baff1c482d98 Chris
   if ($var{'frames'} eq 'yes') {
2910 381:2dc8163e9150 Chris
2911 382:baff1c482d98 Chris
       open(IFILE,">$indexfile") || die("Cannot open frame layout file $indexfile\n");
2912 381:2dc8163e9150 Chris
2913 382:baff1c482d98 Chris
       # Write the header of frame file
2914
       print IFILE "$TextDocTypeFrame\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n";
2915
       print IFILE "   <title>$var{'texttitleframelayout'}</title>\n";
2916
       print IFILE "</head>\n";
2917 381:2dc8163e9150 Chris
2918 382:baff1c482d98 Chris
       # definition of 2 frames, left the tree of directories,
2919
       # right the index of that directory or the docu of a file
2920
       print IFILE "<frameset  cols=\"25%,75%\">\n";
2921
       print IFILE "   <frame src=\"$var{'filenamedirshort'}$var{'exthtml'}\" name=\"$GlobalNameFrameMainLeft\" />\n";
2922
       print IFILE "   <frame src=\"$var{'filenameindexshortglobal'}$var{'filenameextensionframe'}$var{'exthtml'}\" name=\"$GlobalNameFrameMainRight\" />\n";   print IFILE "</frameset>\n";
2923 381:2dc8163e9150 Chris
2924 382:baff1c482d98 Chris
       print IFILE "</html>\n";
2925
2926
       close(IFILE);
2927
2928
       if ($opt_silent) { print "\r"; }
2929
       print "   Frame layout file created: $indexfile\t";
2930
       if (!$opt_silent) { print "\n"; }
2931
   }
2932 381:2dc8163e9150 Chris
2933
   for($irun=0; $irun <= 2; $irun++) {
2934
      # Build the top directory index file, these files include the directory tree
2935
      # Build the directory tree index file name
2936
2937
      # Create no directory file for contents, when no contents to use
2938
      if (($irun == 2) && ($var{'usecontentsm'} eq 'no')) { next; }
2939
2940
      # Assign the correct index file name
2941
      if ($irun == 0) { $filename = $var{'filenamedirshort'}; }
2942
      elsif ($irun == 1) { $filename = $var{'filenamedirlong'}; }
2943
      elsif ($irun == 2) { $filename = $var{'filenamedircontents'}; }
2944
2945
      $indexfile = $var{'dirhtml'}.$filename.$var{'exthtml'};
2946
2947
      open(IFILE,">$indexfile") || die("Cannot open directory tree index file $indexfile\n");
2948
      # Write header of HTML file
2949
      print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
2950
2951
      if ($var{'texttitleindexalldirs'} eq '') {
2952
         print IFILE "<title>Index of Directories of $var{'dirmfiles'}</title>\n";
2953
      } else {
2954
         print IFILE "<title>$var{'texttitleindexalldirs'}</title>\n";
2955
      }
2956 382:baff1c482d98 Chris
2957
      if ($var{'frames'} eq 'yes') {
2958
	  print IFILE "<base target=\"$GlobalNameFrameMainRight\" />\n";
2959
      }
2960
2961 381:2dc8163e9150 Chris
      print IFILE "</head>\n";
2962
      print IFILE "<body $var{'codebodyindex'}>\n";
2963 410:675de8e6becf chris
      print IFILE "<div id=\"matlabdoc\">\n";
2964 381:2dc8163e9150 Chris
      if ($var{'textheaderindexalldirs'} eq '') {
2965
         print IFILE "<h1 $var{'codeheader'}>Index of Directories of <em>$var{'dirmfiles'}</em></h1>\n";
2966
      } else {
2967
         print IFILE "<h1 $var{'codeheader'}>$var{'textheaderindexalldirs'}</h1>\n";
2968
      }
2969 389:0bc92382a86b chris
      print IFILE "<p>\n";
2970 382:baff1c482d98 Chris
2971
      if ($var{'frames'} eq 'yes') {
2972
	  if ($irun == 0) { print IFILE "<strong>short</strong>\n"; }
2973
	  else { print IFILE "<a href=\"$var{'filenamedirshort'}$var{'exthtml'}\" target=\"$GlobalNameFrameMainLeft\">short</a>\n"; }
2974
	  if ($irun == 1) { print IFILE " | <strong>long</strong>\n"; }
2975
	  else { print IFILE " | <a href=\"$var{'filenamedirlong'}$var{'exthtml'}\" target=\"$GlobalNameFrameMainLeft\">long</a>\n"; }
2976
	  if ($var{'usecontentsm'} eq 'yes') {
2977
	      if ($irun == 2) { print IFILE " | <strong>contents</strong>\n"; }
2978
	      else { print IFILE " | <a href=\"$var{'filenamedircontents'}$var{'exthtml'}\" target=\"$GlobalNameFrameMainLeft\">contents</a>\n"; }
2979
	  }
2980
      } else {
2981
	  if ($irun == 0) { print IFILE "<strong>short</strong>\n"; }
2982
	  else { print IFILE "<a href=\"$var{'filenamedirshort'}$var{'exthtml'}\">short</a>\n"; }
2983
	  if ($irun == 1) { print IFILE " | <strong>long</strong>\n"; }
2984
	  else { print IFILE " | <a href=\"$var{'filenamedirlong'}$var{'exthtml'}\">long</a>\n"; }
2985
	  if ($var{'usecontentsm'} eq 'yes') {
2986
	      if ($irun == 2) { print IFILE " | <strong>contents</strong>\n"; }
2987
	      else { print IFILE " | <a href=\"$var{'filenamedircontents'}$var{'exthtml'}\">contents</a>\n"; }
2988
	  }
2989 381:2dc8163e9150 Chris
      }
2990
2991
      print IFILE "</p><br />\n\n";
2992
      print IFILE "<ul>\n";
2993
2994
      # go through all directories and create a list entry for each one,
2995
      # depending on recursion level create sublists
2996
      $prevrecdeeplevel = 0;
2997
      foreach $name (@alldirectories) {
2998
         $actrecdeeplevel = $dirnamerecdeep{$name};
2999
         for( ; $prevrecdeeplevel < $actrecdeeplevel; $prevrecdeeplevel++ ) { print IFILE "<ul>\n"; }
3000
         for( ; $prevrecdeeplevel > $actrecdeeplevel; $prevrecdeeplevel-- ) { print IFILE "</ul>\n"; }
3001
         if ($irun == 0) { $indexfilenameused = $var{'filenameindexshortlocal'}.$var{'filenameextensionframe'}; }
3002
         elsif ($irun == 1) { $indexfilenameused = $var{'filenameindexlonglocal'}.$var{'filenameextensionframe'}; }
3003
         elsif ($irun == 2) { $indexfilenameused = $contentsname{$name}; }
3004
         else { die "ConstructHighestIndexFile: Unknown value of irun"; }
3005
         if ($dirnumbermfiles{$name} > 0) {
3006
            # producetree no
3007
            # if ($var{'producetree'} eq 'no') { $dirnamehere = ''; }
3008
            # else { $dirnamehere = '$dirnamerelpath{$name}'; }
3009
            # print IFILE "<LI><A HREF=\"$dirnamehere$indexfilenameused_$dirnamesingle{$name}$var{'exthtml'}\">$dirnamesingle{$name}</A>\n";
3010
            print IFILE "<li><a href=\"$dirnamerelpath{$name}$indexfilenameused$dirnamesingle{$name}$var{'exthtml'}\">$dirnamesingle{$name}</a></li>\n";
3011
         } else {
3012
            # print directories with no m-files inside not
3013
            # print IFILE "<li>$dirnamesingle{$name}</li>\n";
3014
         }
3015
      }
3016
      $actrecdeeplevel = 0;
3017
      for( ; $prevrecdeeplevel > $actrecdeeplevel; $prevrecdeeplevel-- ) { print IFILE "</ul>\n"; }
3018
      print IFILE "</ul>\n<br />$var{'codehr'}\n";
3019
3020
      # Include info about author from authorfile
3021
      &WriteFile2Handle($var{'authorfile'}, IFILE);
3022
3023
      print IFILE "<!--navigate-->\n";
3024
      print IFILE "<!--copyright-->\n";
3025 410:675de8e6becf chris
      print IFILE "</div>\n</body>\n</html>\n";
3026 381:2dc8163e9150 Chris
3027
      close(IFILE);
3028
3029
      if ($opt_silent) { print "\r"; }
3030
      print "   Directory - Indexfile created: $indexfile\t";
3031
      if (!$opt_silent) { print "\n"; }
3032
   }
3033
}
3034
3035
3036
#========================================================================
3037
# Construct the A-Z index file (global/local and/or short/long)
3038
#========================================================================
3039
sub ConstructAZIndexFile
3040
{
3041
   local($LocalActDir, $LocalShortLong, $LocalGlobalLocal, @localnames) = @_;
3042
   local(*IFILE);
3043
   local($name, $indexfilename, $dirpath);
3044
   local($firstletter, $firstone);
3045
3046
   if ($debug > 2) { print "localnames in AZ small: @localnames\n"; print "     ActDir in A-Z: $LocalActDir\n"; }
3047
3048
   # extract filename of index file from parameters of function
3049
   if ($LocalShortLong eq 'short') {
3050
      if ($LocalGlobalLocal eq 'global') { $indexfilename = $var{'filenameindexshortglobal'}; }
3051
      elsif ($LocalGlobalLocal eq 'local') { $indexfilename = $var{'filenameindexshortlocal'}; }
3052
      else { die "wrong parameter for LocalGlobalLocal in ConstructAZIndexFile: $LocalGlobalLocal."; }
3053
   } elsif ($LocalShortLong eq 'long') {
3054
      if ($LocalGlobalLocal eq 'global') { $indexfilename = $var{'filenameindexlongglobal'}; }
3055
      elsif ($LocalGlobalLocal eq 'local') { $indexfilename = $var{'filenameindexlonglocal'}; }
3056
      else { die "wrong parameter for LocalGlobalLocal in ConstructAZIndexFile: $LocalGlobalLocal."; }
3057
   } else { die "wrong parameter for LocalShortLong in ConstructAZIndexFile: $LocalShortLong."; }
3058
3059
   # producetree no
3060
   # if ($var{'producetree'} eq 'no') { $dirnamehere = ''; }
3061
   # else { $dirnamehere = '$dirnamerelpath{$LocalActDir}'; }
3062
   # Build the index file name
3063
   # handle the global index file case separately (no extra directory name in file)
3064
   #    the local index file name must be extended by the name of the directory
3065
   if ($LocalGlobalLocal eq 'global') { $extradirfilename = ''; }
3066
   else { $extradirfilename = $dirnamesingle{$LocalActDir}; }
3067
   $indexfile = $var{'dirhtml'}.$dirnamerelpath{$LocalActDir}.$indexfilename.$var{'filenameextensionindex'}.$extradirfilename.$var{'exthtml'};
3068 382:baff1c482d98 Chris
3069 401:a0f6e994657f chris
   if ($LocalShortLong eq 'short' and $extradirfilename eq '' and $var{'frames'} ne 'yes') {
3070
       # With no frames and no subdir path, this must go in the
3071
       # top-level index file instead
3072 382:baff1c482d98 Chris
       $indexfile = $var{'dirhtml'}.$var{'filenametopframe'}.$var{'exthtml'};
3073
   }
3074
3075 381:2dc8163e9150 Chris
   if ($debug > 2) { print "   indexfilename (a-z small): $indexfile\n"; }
3076
3077
   open(IFILE,">$indexfile") || die("Cannot open index file $indexfile: $!\n");
3078
3079
   # Write the header of HTML file
3080
   print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3081
3082 410:675de8e6becf chris
   my $dirToPrint = $LocalActDir;
3083
   $dirToPrint =~ s,^./,,;
3084
3085 381:2dc8163e9150 Chris
   if ($var{'texttitleindex'} eq '') {
3086 410:675de8e6becf chris
      print IFILE "<title>Index of Matlab Files in Directory $dirToPrint</title>\n";
3087 381:2dc8163e9150 Chris
   } else {
3088
      if ($LocalGlobalLocal eq 'global') { print IFILE "<title>$var{'texttitleindex'}</title>\n"; }
3089 410:675de8e6becf chris
      else { print IFILE "<title>$var{'texttitleindex'} in Directory $dirToPrint</title>\n"; }
3090 381:2dc8163e9150 Chris
   }
3091 382:baff1c482d98 Chris
3092
   if ($var{'frames'} eq 'yes') {
3093
       print IFILE "<base target=\"$GlobalNameFrameMainRight\" />\n";
3094
   }
3095 381:2dc8163e9150 Chris
   print IFILE "</head>\n";
3096 382:baff1c482d98 Chris
3097 381:2dc8163e9150 Chris
   print IFILE "<body $var{'codebodyindex'}>\n";
3098 410:675de8e6becf chris
   print IFILE "<div id=\"matlabdoc\">\n";
3099 381:2dc8163e9150 Chris
   if ($var{'textheaderindex'} eq '') {
3100 410:675de8e6becf chris
      print IFILE "<h1 $var{'codeheader'}>Index of Matlab Files in Directory $dirToPrint</h1>\n";
3101 381:2dc8163e9150 Chris
   } else {
3102
      if ($LocalGlobalLocal eq 'global') { print IFILE "<h1 $var{'codeheader'}>$var{'textheaderindex'}</h1>\n"; }
3103 410:675de8e6becf chris
      else { print IFILE "<h1 $var{'codeheader'}>$var{'textheaderindex'} in Directory $dirToPrint</h1>\n"; }
3104 381:2dc8163e9150 Chris
   }
3105
3106
   # include links to indexes
3107
   &ConstructLinks2Index(IFILE, $dirnamerelpathtoindex{$LocalActDir}, $LocalActDir, $LocalGlobalLocal);
3108
3109
   # Collect the starting letters of m files in this directory or all m-files
3110
   for('a'..'z') { undef @{$_}; }
3111
   foreach $name (@localnames) {
3112
      if (! ($mfilename{$name} =~ /contents/i)) {
3113
         $firstletter = substr($mfilename{$name}, 0, 1);
3114
         # convert first letter always to lower case
3115
         # needed for reference to lower and upper case m-files
3116
         $firstletter = "\L$firstletter\E";
3117
         push(@{$firstletter}, $name);
3118
      }
3119
   }
3120
3121
   if ($LocalShortLong eq 'short') {
3122
      # begin create short index
3123
      print IFILE "<table width=\"100%\">\n";
3124
3125
      for('a'..'z') {
3126
         # print "   $_: @{$_}\n";
3127
         $numberofletter = $#{$_}+1;
3128 410:675de8e6becf chris
	 $cols = 3;
3129 381:2dc8163e9150 Chris
         if ($numberofletter > 0) {
3130 410:675de8e6becf chris
            print IFILE "\n<tr><td><br/><strong><a name=\"\U$_\E$_\"></a><span class=\"an\">\U$_\E</span></strong></td></tr>\n";
3131
            for ($count = 0; $count < $numberofletter; $count++) {
3132
		if (($count % $cols) == 0) {
3133
		    if ($count > 0) {
3134
			print IFILE "</tr><tr>\n";
3135
		    }
3136
		    print IFILE "<tr><td></td>";
3137
		}
3138
		$name = @{$_}[$count];
3139
		if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3140
		print IFILE "<td><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td>";
3141
	    }
3142
3143
	    print IFILE "</tr>\n";
3144
3145
            # $numberhalf = ($numberofletter + 1 - (($numberofletter+1) % 2))/2;
3146
            # if ($debug > 2) { print "   $_: @{$_} \t $numberhalf \t $numberofletter\n"; }
3147
            # for($count = 0; $count < $numberhalf; $count++) {
3148
            #    $name = @{$_}[$count];
3149
            #    if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3150
            #    print IFILE "<tr><td width=\"50%\"><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td>";
3151
            #    if (($count + $numberhalf) < $numberofletter) {
3152
            #       $name = @{$_}[$count + $numberhalf];
3153
            #       if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3154
            #       print IFILE "<td width=\"50%\"><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td></tr>\n";
3155
            #    } else {
3156
            #       print IFILE "<td width=\"50%\"></td></tr>\n";
3157
            #    }
3158
            # }
3159 381:2dc8163e9150 Chris
         }
3160
      }
3161
      print IFILE "</table>\n<br />$var{'codehr'}\n";
3162
3163
   } elsif ($LocalShortLong eq 'long') {
3164
      # begin create long index
3165 410:675de8e6becf chris
      print IFILE "<table width=\"100%\">\n";
3166 401:a0f6e994657f chris
      print IFILE "<tr><th>Name</th><th>Synopsis</th></tr>\n";
3167 381:2dc8163e9150 Chris
3168
      for('a'..'z') {
3169
         # print "   $_: @{$_}\n";
3170
         $numberofletter = $#{$_}+1;
3171
         if ($numberofletter > 0) {
3172
            $firstone = 1;
3173
            foreach $name (@{$_}) {
3174
               if ($debug > 1) { print "   AZinforeach1: $name \t\t $hfilerelpath{$name} \t\t $dirnamerelpath{$LocalActDir}\n"; }
3175
               if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3176
               if (! ($mfilename{$name} =~ /contents/i)) {
3177 400:4ad6499d7998 chris
                  if ($firstone == 1) { print IFILE "\n<tr><td colspan=\"2\"><br /><strong><a name=\"\U$_\E$_\"></a><span class=\"an\">\U$_\E</span></strong></td></tr>\n"; $firstone = 0; }
3178 381:2dc8163e9150 Chris
                  print IFILE "<tr><td valign=\"top\"><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td><td>$apropos{$name}</td></tr>\n";
3179
               }
3180
            }
3181
         }
3182
      }
3183
      print IFILE "</table>\n<br />$var{'codehr'}\n";
3184
   } else { die "wrong parameter for LocalShortLong in ConstructAZIndexFile: $LocalShortLong."; }
3185
3186
   # Include info about author from authorfile
3187
   &WriteFile2Handle($var{'authorfile'}, IFILE);
3188
3189
   print IFILE "<!--navigate-->\n";
3190
   print IFILE "<!--copyright-->\n";
3191 410:675de8e6becf chris
   print IFILE "</div>\n</body>\n</html>\n";
3192 381:2dc8163e9150 Chris
3193
   close(IFILE);
3194
3195
   if ($opt_silent) { print "\r"; }
3196
   print "   Indexfile small (A-Z) created: $indexfile\t";
3197
   if (!$opt_silent) { print "\n"; }
3198
3199
3200
   # Build the A-Z jump index file name
3201
   # handle the global index file case separately (no extra directory name in file)
3202
   if ($LocalGlobalLocal eq 'global') { $extradirfilename = ''; }
3203
   else { $extradirfilename = $dirnamesingle{$LocalActDir}; }
3204
3205 382:baff1c482d98 Chris
   if ($var{'frames'} eq 'yes') {
3206
3207
       $indexfile = $var{'dirhtml'}.$dirnamerelpath{$LocalActDir}.$indexfilename.$var{'filenameextensionjump'}.$extradirfilename.$var{'exthtml'};
3208
       if ($debug > 2) { print "   indexfilename (a-z jump): $indexfile\n"; }
3209
       open(IFILE,">$indexfile") || die("Cannot open jump index file $indexfile: $!\n");
3210
3211
       # Write the header of HTML file
3212
       print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3213
3214
       if ($var{'texttitleindex'} eq '') {
3215 410:675de8e6becf chris
	   print IFILE "<title>A-Z jump index in directory $dirToPrint</title>\n";
3216 382:baff1c482d98 Chris
       } else {
3217
	   if ($LocalGlobalLocal eq 'global') { print IFILE "<title>$var{'texttitleindex'}</title>\n"; }
3218 410:675de8e6becf chris
	   else { print IFILE "<title>$var{'texttitleindex'} in Directory $dirToPrint</title>\n"; }
3219 382:baff1c482d98 Chris
       }
3220
3221
       if ($var{'frames'} eq 'yes') {
3222
	   print IFILE "<base target=\"$GlobalNameFrameAZIndexsmall\" />\n";
3223
       }
3224
       print IFILE "</head>\n";
3225
       print IFILE "<body $var{'codebodyindex'}>\n";
3226 410:675de8e6becf chris
       print IFILE "<div id=\"matlabdoc\">\n";
3227 382:baff1c482d98 Chris
3228
       # Write the A-Z jump line, generate link for letters with files starting with this letter
3229
       # and only letters for no files starting with this letter
3230
       # use previously generated arrays with names of files sorted by starting letter
3231
       for('a'..'z') {
3232
	   $numberofletter = $#{$_}+1;
3233
	   if ($numberofletter > 0) {
3234
	       print IFILE "<strong><a href=\"$indexfilename$var{'filenameextensionindex'}$extradirfilename$var{'exthtml'}#\U$_\E$_\">\U$_\E</a> </strong>\n";
3235
	   } else {
3236
	       print IFILE "\U$_\E \n";
3237
	   }
3238
       }
3239
3240 410:675de8e6becf chris
       print IFILE "</div></body>\n</html>\n";
3241 382:baff1c482d98 Chris
3242
       close(IFILE);
3243
3244
       if ($opt_silent) { print "\r"; }
3245
       print "   Indexfile small (A-Z jump) created: $indexfile\t";
3246
       if (!$opt_silent) { print "\n"; }
3247 381:2dc8163e9150 Chris
   }
3248
3249
3250
   # Build the frame layout file, this file includes the layout of the frames
3251
   # Build the frame layout file name (for small/compact A-Z index)
3252
   # handle the global index file case separately (no extra directory name in file)
3253
   if ($LocalGlobalLocal eq 'global') { $extradirfilename = ''; }
3254
   else { $extradirfilename = $dirnamesingle{$LocalActDir}; }
3255
3256 382:baff1c482d98 Chris
   if ($var{'frames'} eq 'yes') {
3257 381:2dc8163e9150 Chris
3258 382:baff1c482d98 Chris
       $indexfile = $var{'dirhtml'}.$dirnamerelpath{$LocalActDir}.$indexfilename.$var{'filenameextensionframe'}.$extradirfilename.$var{'exthtml'};
3259
       if ($debug > 2) { print "   indexfilename (a-z frame): $indexfile\n"; }
3260 381:2dc8163e9150 Chris
3261 382:baff1c482d98 Chris
       open(IFILE,">$indexfile") || die("Cannot open jump index frame file $indexfile: $!\n");
3262
3263
       # Write the header of Frame file
3264
       print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3265
3266
       if ($var{'texttitleindex'} eq '') {
3267 410:675de8e6becf chris
	   print IFILE "<title>Index of Matlab Files in Directory $dirToPrint</title>\n";
3268 382:baff1c482d98 Chris
       } else {
3269
	   if ($LocalGlobalLocal eq 'global') { print IFILE "<title>$var{'texttitleindex'}</title>\n"; }
3270 410:675de8e6becf chris
	   else { print IFILE "<title>$var{'texttitleindex'} in Directory $dirToPrint</title>\n"; }
3271 382:baff1c482d98 Chris
       }
3272
       print IFILE "</head>\n";
3273
3274
       # definition of 2 frames, top the A-Z index, below the jump letter line
3275
       print IFILE "<frameset  rows=\"90%,10%\">\n";
3276
       print IFILE "   <frame src=\"$indexfilename$var{'filenameextensionindex'}$extradirfilename$var{'exthtml'}\" name=\"$GlobalNameFrameAZIndexsmall\" />\n";
3277
       print IFILE "   <frame src=\"$indexfilename$var{'filenameextensionjump'}$extradirfilename$var{'exthtml'}\" name=\"$GlobalNameFrameAZIndexjump\" />\n";
3278
       print IFILE "</frameset>\n";
3279
3280
       print IFILE "</html>\n";
3281
3282
       close(IFILE);
3283
3284
       if ($opt_silent) { print "\r"; }
3285
       print "   Frame layout file created: $indexfile\t";
3286
       if (!$opt_silent) { print "\n"; }
3287 381:2dc8163e9150 Chris
   }
3288
}
3289 382:baff1c482d98 Chris
3290 381:2dc8163e9150 Chris
3291
#========================================================================
3292
# Construct the links to all indexes
3293
#========================================================================
3294
sub ConstructLinks2Index
3295
{
3296
   local(*WRITEFILE, $LocalPath2Index, $PathContents, $LocalGlobalLocal) = @_;
3297
3298
   # include links to short/long - local/global index and C|contents.m
3299 389:0bc92382a86b chris
   print WRITEFILE "\n<p>";
3300
   print WRITEFILE "$var{'textjumpindexglobal'} ";
3301 382:baff1c482d98 Chris
3302
   if ($var{'frames'} eq 'yes') {
3303
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenameindexshortglobal'}$var{'filenameextensionframe'}$var{'exthtml'}\">short</a> | ";
3304 389:0bc92382a86b chris
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenameindexlongglobal'}$var{'filenameextensionframe'}$var{'exthtml'}\">long</a>\n";
3305 382:baff1c482d98 Chris
   } else {
3306 387:f89765996ef9 Chris
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenametopframe'}$var{'exthtml'}\">short</a> | ";
3307 389:0bc92382a86b chris
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenameindexlongglobal'}$var{'filenameextensionindex'}$var{'exthtml'}\">long</a>\n";
3308 382:baff1c482d98 Chris
   }
3309
3310 381:2dc8163e9150 Chris
   if ($LocalGlobalLocal eq 'local') {
3311
      if ($var{'usecontentsm'} eq 'yes') {
3312
         print WRITEFILE " | <a href=\"$contentsname{$PathContents}$dirnamesingle{$PathContents}$var{'exthtml'}\">Local contents</a>\n";
3313
      }
3314 389:0bc92382a86b chris
      if ($var{'frames'} eq 'yes') {
3315
         print WRITEFILE " | $var{'textjumpindexlocal'} ";
3316 382:baff1c482d98 Chris
         print WRITEFILE "<a href=\"$var{'filenameindexshortlocal'}$var{'filenameextensionframe'}$dirnamesingle{$PathContents}$var{'exthtml'}\">short</a> | ";
3317 389:0bc92382a86b chris
         print WRITEFILE "<a href=\"$var{'filenameindexlonglocal'}$var{'filenameextensionframe'}$dirnamesingle{$PathContents}$var{'exthtml'}\">long</a>\n";
3318
      } else {
3319
         print WRITEFILE " | $var{'textjumpindexlocal'} ";
3320
         print WRITEFILE "<a href=\"$var{'filenameindexshortlocal'}$var{'filenameextensionindex'}$dirnamesingle{$PathContents}$var{'exthtml'}\">short</a> | ";
3321
         print WRITEFILE "<a href=\"$var{'filenameindexlonglocal'}$var{'filenameextensionindex'}$dirnamesingle{$PathContents}$var{'exthtml'}\">long</a>\n";
3322
      }
3323 381:2dc8163e9150 Chris
   }
3324
   print WRITEFILE "</p>\n\n";
3325
   print WRITEFILE "$var{'codehr'}\n";
3326
}
3327
3328
3329
#========================================================================
3330
# Construct the contents.m files or update
3331
#========================================================================
3332
sub ConstructContentsmFile
3333
{
3334
   local($LocalActDir, @localnames) = @_;
3335
   local(*CFILE, $name,$newline);
3336
   local($contentsfile, $isincontentsonly);
3337
   local(@lines, @autoaddlines, @emptylines);
3338
   local($autoadd) = 'AutoAdd';
3339
   local($autoaddsection) = 0;
3340
   local($emptylineflag) = 0;
3341
   local(%nameincontents);
3342
3343
   # Build the contents file name
3344
   $contentsfile = $LocalActDir.$contentsname{$LocalActDir}.$suffix;
3345
3346
   if (-e $contentsfile) {
3347
      open(CFILE,"<$contentsfile") || die("Cannot open contents file $contentsfile: $!\n");
3348
      while (<CFILE>) {
3349
         # Search for the specified string pattern
3350
         @words = split;
3351
         if ((@words >= 3) && ($words[2] eq '-')) {
3352
            $isincontentsonly = 0;
3353
            foreach $name (@localnames) {
3354
               if ($name eq $words[1]) {    # old
3355
               # if ($mfilename{$name} eq $words[1]) {
3356
                  $isincontentsonly = 1;
3357
                  $nameincontents{$name} = 1;
3358
                  $newline = sprintf("%% %-13s - %s\n", $mfilename{$name}, $apropos{$name});
3359
                  push(@lines, $newline);
3360
               }
3361
            }
3362
            # issue a warning, if file is in contents, but not as file in the directory
3363
            if ($isincontentsonly == 0) {
3364
               print "\rConstructContents: Obsolete entry  $words[1]  in  $contentsfile ! Entry not used.\n";
3365
            }
3366
         } else {
3367
            # look for the AutoAdd section, should be the second word
3368
            if ((@words >= 2) && ($words[1] eq $autoadd)) { $autoaddsection = 1; }
3369
            # push the red line in an array
3370
            push(@lines, $_);
3371
         }
3372
      }
3373
      close(CFILE);
3374
   } else {
3375
      $newline = "% MATLAB Files in directory  $LocalActDir\n%\n";
3376
      push(@lines, $newline);
3377
3378
   }
3379
3380
   # collect the file names, that were not included in original C|contents.m
3381
   foreach $name (@localnames) {
3382
      if (! defined $nameincontents{$name}) {
3383
         if (! ($mfilename{$name} =~ /contents/i)) {
3384
            $newline = sprintf("%% %-13s - %s\n", $mfilename{$name}, $apropos{$name});
3385
            push(@autoaddlines, $newline);
3386
         }
3387
      }
3388
   }
3389
3390
   # write/update C|contents.m only if variable is set
3391
   if ($var{'writecontentsm'} eq 'yes') {
3392
      unlink($contentsfile);
3393
      open(CFILE,">$contentsfile") || die("Cannot open contents file $contentsfile: $!\n");
3394
      # write old C|contents.m or header of new file, as long as comment lines
3395
      foreach $line (@lines) {
3396
         if ($emptylineflag == 0) {
3397
            if ($line =~ /^\s*%/) { print CFILE $line; }
3398
            else { $emptylineflag = 1; push(@emptylines, $line); }
3399
         } else { push(@emptylines, $line); }
3400
      }
3401
      # add header of AutoAdd section
3402
      if (($autoaddsection == 0) && (@autoaddlines > 0)) { print CFILE "%\n% $autoadd\n"; }
3403
      # add autoadd section lines (previously undocumented files
3404
      foreach $line (@autoaddlines) { print CFILE $line; }
3405
      # add tail of original C|contents.m (everything behind first non-comment line)
3406
      foreach $line (@emptylines)   { print CFILE $line; }
3407
      print CFILE "\n";
3408
      close CFILE;
3409
      if ($opt_silent) { print "\r"; }
3410
      print "   Contents file created/updated: $contentsfile\t";
3411
      if (!$opt_silent) { print "\n"; }
3412
   }
3413
}
3414
3415
3416
#========================================================================
3417
# Replace found special characters with their HTMl Entities
3418
#========================================================================
3419
sub SubstituteHTMLEntities {
3420
   local($_) = @_;
3421
3422
   # Replace & <-> &amp;  < <-> &lt;  > <-> &gt;  " <-> &quot;
3423
   s/&/&amp;/g; s/\</&lt;/g; s/\>/&gt;/g; s/\"/&quot;/g;
3424
   return $_;
3425
}
3426
3427
#========================================================================
3428
# Replace found m-filenamestring with full link.
3429
#========================================================================
3430
sub SubstituteName2Link {
3431
   local($_, $funname) = @_;
3432
   local($refstr1, $refstr2, $reffound);
3433
3434
   # Look for something matching in the line
3435
   if ( /(\W+)($funname)(\W+)/i ) {
3436
      $reffound = $2;
3437 388:dad587ecb8d0 chris
      $refstr1 = "<a class=\"mfun\" href=\"$hfileindexpath{$name}$hfilerelpath{$funname}$mfilename{$funname}$var{'exthtml'}\">";
3438 381:2dc8163e9150 Chris
      $refstr2 = "<\/a>";
3439
      # Do links only for exact case match
3440
      if ( ($var{'links2filescase'}  eq 'exact') || ($var{'links2filescase'}  eq 'exactvery') ) {
3441
         if ( /(\W+)($funname)(\W+)/g ) {
3442
            s/(\W+)($funname)(\W+)/$1$refstr1$funname$refstr2$3/g;
3443
         }
3444
         else {
3445
            # Print info for not matching case in references, good for check up of files
3446
            if ( ($var{'links2filescase'}  eq 'exactvery') ) {
3447
               print "Diff in case found: $funname  (case of file name)   <->  $reffound  (case in source code)\n";
3448
               print "     (source line)  $_ \n";
3449
            }
3450
         }
3451
      }
3452
      # Do links for exact match and additionally for all upper case (often used in original matlab help text)
3453
      elsif ( ($var{'links2filescase'}  eq 'exactupper') ) {
3454
         s/(\W+)($funname)(\W+)/$1$refstr1$2$refstr2$3/g;
3455
         $funname2 = "\U$funname\E";
3456
         s/(\W+)($funname2)(\W+)/$1$refstr1$2$refstr2$3/g;
3457
      }
3458
      # Do links for all case mixes, this calls for trouble under LINUX/UNIX
3459
      else {  #elsif ( ($var{'links2filescase'}  eq 'all') )
3460
         s/(\W+)($funname)(\W+)/$1$refstr1$2$refstr2$3/ig;
3461
      }
3462
   }
3463
3464
   return $_;
3465
}
3466
3467
#========================================================================
3468
# Construct the html files for each matlab file.
3469
#    Need to reread each matlab file to find the help text.
3470
#    Note that we can't do this in a single loop because sometimes
3471
#    the help text maybe before the function declaration.
3472
#========================================================================
3473
sub ConstructHTMLFiles
3474
{
3475
   local(*MFILE);
3476
   local(*HFILE);
3477
3478
   local($filescreated) = 0;
3479
   local($functionline);
3480
3481
   foreach $name (@names) {
3482
      # Create cross reference information already here, used for keywords as well
3483
      # Construct list of referenced functions
3484
      @xref = @{'depcalls'.$name};    # the functions, that this m-file calls
3485
      @yref = @{'depcalled'.$name};   # the functions, that this m-file is called from
3486
      # print "   depcalls: @{'depcalls'.$name}\n   depcalled: @{'depcalled'.$name}\n";
3487
      # foreach $cname (@names) { next if $cname eq $name; push(@yref,$cname) if grep(/$name/,@{'depcalls'.$cname}); }
3488
3489
3490
      # Open m-file and html-file
3491
      open(MFILE,"<$mfile{$name}");
3492
      open(HFILE,">$hfile{$name}");
3493
3494
      # Write the header of HTML file
3495
      print HFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3496
3497
      # Write meta tags: use apropos (one line function description) for description
3498
      # and cross reference function names for keywords (any better ideas?)
3499
      print HFILE "<meta name=\"description\" content=\" $apropos{$name} \" />\n";
3500
      print HFILE "<meta name=\"keywords\" content=\" @xref @yref \" />\n";
3501
3502
      # Write Title and start body of html-file
3503
      print HFILE "<title>$var{'texttitlefiles'} $mfilename{$name}</title>\n</head>\n";
3504
      print HFILE "<body $var{'codebodyfiles'}>\n";
3505 410:675de8e6becf chris
      print HFILE "<div id=\"matlabdoc\">\n";
3506 381:2dc8163e9150 Chris
      print HFILE "<h1 $var{'codeheader'}>$var{'textheaderfiles'} $mfilename{$name}</h1>\n";
3507 401:a0f6e994657f chris
3508
# http://test.soundsoftware.ac.uk/cannam/projects/smallbox/repository/annotate/DL/RLS-DLA/SolveFISTA.m
3509 410:675de8e6becf chris
#      print HFILE "<a href=\"" . $hfileindexpath{$name} . "../../projects/smallbox/repository/annotate/" . $mfiledir{$name}  . $mfilename{$name} . ".m\">View in repository</a>\n";
3510 401:a0f6e994657f chris
3511 381:2dc8163e9150 Chris
      print HFILE "$var{'codehr'}\n";
3512
3513
      # include links to short/long - local/global index and C|contents.m
3514
      &ConstructLinks2Index(HFILE, $hfileindexpath{$name}, $mfiledir{$name}, 'local');
3515
3516
      # If this is a function, then write out the first line as a synopsis
3517
      if ($mtype{$name} eq "function") {
3518
         print HFILE "<h2 $var{'codeheader'}>Function Synopsis</h2>\n";
3519
         print HFILE "<pre>$synopsis{$name}</pre>\n$var{'codehr'}\n";
3520
      }
3521
3522
      # Look for the matlab help text block
3523
      $functionline = "\n";
3524
      do {
3525
         $_ = <MFILE>;
3526
         # remember functionline, if before help text block
3527
         if (/^\s*function/) { $functionline = $_; }
3528
      } until (/^\s*%/ || eof);
3529
      if (! (eof(MFILE))) {
3530
         print HFILE "<h2 $var{'codeheader'}>Help text</h2>\n";
3531
         print HFILE "<pre>\n";
3532
         while (/^\s*%/) {
3533
            # First remove leading % and white space, then Substitute special characlers
3534
            s/^\s*%//;
3535
            $_ = &SubstituteHTMLEntities($_);
3536
3537
            # check/create cross references
3538
            foreach $funname (@{'all'.$name}) {
3539
               if ($funname =~ /simulink/) { print "\n Simulink - Filename: $name;  scanname: $funname\n"; }
3540
               next if $funname eq $name;
3541
               $_ = &SubstituteName2Link($_, $funname);
3542
            }
3543
            print HFILE $_;
3544
            if (! eof) { $_ = <MFILE>; }
3545
         }
3546
         print HFILE "</pre>\n$var{'codehr'}\n";
3547
      }
3548
3549
      # Write the cross reference information
3550
      if (@xref || @yref) {
3551
         print HFILE "<h2 $var{'codeheader'}>Cross-Reference Information</H2>\n";
3552
         print HFILE "<table border=\"0\" width=\"100%\">\n<tr align=\"left\">\n<th width=\"50%\">";
3553
         if (@xref) {
3554
            print HFILE "This $mtype{$name} calls";
3555
         }
3556
         print HFILE "</th>\n<th width=\"50%\">";
3557
         if (@yref) {
3558
            print HFILE "This $mtype{$name} is called by";
3559
         }
3560
         print HFILE "</th>\n</tr>\n<tr valign=\"top\"><td>";
3561
         if (@xref) {
3562
            print HFILE "\n<ul>\n";
3563
            foreach $cname (sort @xref) {
3564
               print HFILE "<li><a class=\"mfun\" href=\"$hfileindexpath{$name}$hfilerelpath{$cname}$mfilename{$cname}$var{'exthtml'}\">$mfilename{$cname}</a></li>\n";
3565
            }
3566
            print HFILE "</ul>\n";
3567
         }
3568
         print HFILE "</td><td>";
3569
         if (@yref) {
3570
            print HFILE "\n<ul>\n";
3571
            foreach $cname (sort @yref) {
3572
               print HFILE "<li><a class=\"mfun\" href=\"$hfileindexpath{$name}$hfilerelpath{$cname}$mfilename{$cname}$var{'exthtml'}\">$mfilename{$cname}</a></li>\n";
3573
            }
3574
            print HFILE "</ul>\n";
3575
         }
3576
         print HFILE "</td>\n</tr>\n</table>\n";
3577
         print HFILE "$var{'codehr'}\n";
3578
      }
3579
3580
      # Include source text if requested
3581
      if (($var{'includesource'} eq 'yes') && (! ($mfilename{$name} =~ /^contents$/i))) {
3582
         print HFILE "<h2 $var{'codeheader'}>Listing of $mtype{$name} $mfilename{$name}</h2>\n";
3583
         seek(MFILE,0,0);
3584
         print HFILE "<pre>\n";
3585
         $IsStillHelp = 2;
3586
         print HFILE $functionline;    # functionline from scanning of help
3587
         while (<MFILE>) {
3588
            if ($IsStillHelp == 2) {
3589
               next     if (/^\s*$/);
3590
               next     if (/^\s*function/);
3591
               if (/^\s*%/) { $IsStillHelp = 1; next; }
3592
            } elsif ($IsStillHelp == 1) {
3593
               next     if (/^\s*%/);
3594
               $IsStillHelp = 0;
3595
            }
3596
3597
            # Substritute special characters
3598
            $_ = &SubstituteHTMLEntities($_);
3599
3600
            # check for comment in line and format with css em
3601 400:4ad6499d7998 chris
            s/^(.*)%(.*?)([\s\r\n]+)$/$1<em class=\"mcom\">%$2<\/em>$3/;
3602 381:2dc8163e9150 Chris
3603
            # check/create cross references
3604
            foreach $funname (@{'all'.$name}) {
3605
               next if $funname eq $name;
3606
               $_ = &SubstituteName2Link($_, $funname);
3607
            }
3608
            print HFILE $_;
3609
         }
3610
         print HFILE "</pre>\n$var{'codehr'}\n";
3611
      }
3612
3613
      # Include info about author from authorfile
3614
      &WriteFile2Handle($var{'authorfile'}, HFILE)   ;
3615
3616
      print HFILE "<!--navigate-->\n";
3617
      print HFILE "<!--copyright-->\n";
3618 410:675de8e6becf chris
      print HFILE "</div>\n</body>\n</html>\n";
3619 381:2dc8163e9150 Chris
      close(MFILE);
3620
      close(HFILE);
3621
3622
      # Print name of finished file
3623
      if ($opt_silent) { print "\r"; }
3624
      print "   HTML-File created: $hfile{$name}\t";
3625
      if (!$opt_silent) { print "\n"; }
3626
      $filescreated++;
3627
   }
3628
3629
   print "\n$PROGRAM: $indexcreated index and $filescreated files created.\n";
3630
}
3631
3632
#========================================================================
3633
# Function:	CheckFileName
3634
# Purpose:	.
3635
#========================================================================
3636
sub CheckFileName {
3637
   local($filename, $description) = @_;
3638
   local(*CHECKFILE);
3639
3640
   open(CHECKFILE,"<$filename") || do {
3641
      if ($description eq '') {$description = 'file';}
3642
      # if (!$opt_silent) { print "Cannot open $description $filename: $!\n"; }
3643
      print "Cannot open $description $filename: $!\n";
3644
      return 1;
3645
   };
3646
   close(CHECKFILE);
3647
   return 0;
3648
3649
}
3650
3651
#========================================================================
3652
# Function:	CheckDirName
3653
# Purpose:	.
3654
#========================================================================
3655
sub CheckDirName {
3656
   local($dirname, $description) = @_;
3657
   local(*CHECKDIR);
3658
3659
   opendir(CHECKDIR,"$dirname") || die ("Cannot open $description directory $dirname: $!\n");
3660
   closedir(CHECKDIR);
3661
}
3662
3663
#========================================================================
3664
# Function:	WriteFile2Handle
3665
# Purpose:	.
3666
#========================================================================
3667
sub WriteFile2Handle {
3668
   local($filename, *WRITEFILE) = @_;
3669
   local(*READFILE);
3670
3671
   if ($filename ne '') {
3672
      open(READFILE,"<$filename");
3673
      @filecontents = <READFILE>;
3674
      close(READFILE);
3675
      print WRITEFILE "@filecontents\n";
3676
      # if (!$opt_silent) {print "      Contents of $filename added\n"};
3677
   }
3678
}
3679
3680
3681
#========================================================================
3682
# Function:	GetConfigFile
3683
# Purpose:	Read user's configuration file, if such exists.
3684
#========================================================================
3685
sub GetConfigFile
3686
{
3687
   local($filename) = @_;
3688
   local(*CONFIG);
3689
   local($value);
3690
3691
   if (&CheckFileName($filename, 'configuration file')) {
3692
      # if (!$opt_silent) { print "   Proceeding using built-in defaults for configuration.\n"; }
3693
      print "   Proceeding using built-in defaults for configuration.\n";
3694
      return 0;
3695
   };
3696
3697
   open(CONFIG,"< $filename");
3698
   while (<CONFIG>) {
3699
      s/#.*$//;
3700
      next if /^\s*$/o;
3701
3702
      # match keyword: process one or more arguments
3703
      # keyword set
3704
      if (/^\s*set\s+(\S+)\s*=\s*(.*)/) {
3705
         # setting a configuration variable
3706
         if (defined $var{$1}) {
3707
            $var{$1} = $2;
3708
            if ($debug > 3) { print "$1:   $var{$1}\n"; }
3709
         }
3710
         else {
3711
            print "$PROGRAM: unknown variable `$1' in configuration file\n"
3712
         }
3713
      } else {
3714
         chop($_);
3715
         print "$PROGRAM: unknown keyword in configuration file in line: `$_'\n"
3716
      }
3717
   }
3718
   close CONFIG;
3719
   1;
3720
}
3721
3722
3723
#------------------------------------------------------------------------
3724
# DisplayHelp - display help text using -h or -help command-line switch
3725
#------------------------------------------------------------------------
3726
sub DisplayHelp
3727
{
3728
   $help=<<EofHelp;
3729
   $PROGRAM v$VERSION - generate html documentation from Matlab m-files
3730
3731
   Usage: $PROGRAM [-h] [-c config_file] [-m|dirmfiles matlab_dir] [-d|dirhtml html_dir]
3732
                   [-i yes|no] [-r yes|no] [-p yes|no] [-quiet|q] [-a authorfile]
3733
3734
   $PROGRAM is a perl script that reads each matlab .m file in a directory
3735
   to produce a corresponding .html file of help documentation and cross
3736
   reference information. An index file is written with links to all of
3737
   the html files produced. The options are:
3738
3739
      -quiet         or -q : be silent, no status information during generation
3740
      -help          or -h : display this help message
3741
      -todo          or -t : print the todo list for $PROGRAM
3742
      -version       or -v : display version
3743
3744
      -configfile    or -c : name of configuration file (default to $var{'configfile'}).
3745
      -dirmfiles     or -m : top level directory containing matlab files to generate html for;
3746
                             default to actual directory.
3747
      -dirhtml       or -d : top level directory for generated html files;
3748
                             default to actual directory.
3749
3750
      -includesource or -i : Include matlab source in the html documentation [yes|no]
3751
                             default to yes.
3752
      -processtree   or -r : create docu for m-file directory and all subdirectories [yes|no];
3753
                             default to yes.
3754
      -producetree   or -p : create multi-level docu identical to directory structure
3755
                             of m-files [yes|no]; default to yes.
3756
      -writecontentsm or -w: update or write contents.m files into the matlab source
3757
                             directories [yes|no]; default to no.
3758
3759
      -authorfile    or -a : name of file including author information, last element in html;
3760
                             default to empty.
3761
3762
   The command line setting overwrite all other settings (built-in and configuration file).
3763
   The configuration file settings overwrite the built-in settings (and not the command
3764
   line settings).
3765
3766
   Typical usages are:
3767
     $PROGRAM
3768
        (use default parameters from perl script, if configuration
3769
         file is found -> generation of docu, else display of help)
3770
3771
     $PROGRAM -dirmfiles matlab -dirhtml html
3772
        (generate html documentation for all m-files in directory matlab,
3773
         place html files in directory html, use built-in defaults for
3774
         all other parameters, this way all m-files in the directory
3775
         matlab and below are converted and the generated html-files are
3776
         placed in the directory html and below producing the same
3777
         directory structure than below matlab)
3778
3779
     $PROGRAM -quiet
3780
        (use built-in parameters from perl script, if configuration
3781
         file is found use these settings as well, do generation,
3782
         no display except critical errors, status of conversion and result)
3783
3784
     $PROGRAM -m toolbox -dirhtml doc/html -r yes -p no
3785
        (convert all m-files in directory toolbox and below and place
3786
         the generated html files in directory doc/html, read all m-files
3787
         recursively, however, the generated html files are placed in one
3788
         directory)
3789
3790
     $PROGRAM -m toolbox -dirhtml doc/html -i no -r no
3791
        (convert all m-files in directory toolbox and place
3792
         the generated html files in directory doc/html, do not read m-files
3793
         recursively, do not include source code in documentation)
3794
3795
EofHelp
3796
3797
   die "$help";
3798
}
3799
3800
#------------------------------------------------------------------------
3801
# DisplayTodo - display ToDo list using -t or -todo command-line switch
3802
#------------------------------------------------------------------------
3803
sub DisplayTodo
3804
{
3805
   $todo=<<EofToDo;
3806
      $PROGRAM v$VERSION - ToDo list
3807
3808
       o	use more than one high level directory
3809
3810
       o	what should/could be done here???
3811
3812
EofToDo
3813
3814
   die "$todo";
3815
}
3816
3817
3818
#------------------------------------------------------------------------
3819
# ListVariables - list all defined variables and their values
3820
#------------------------------------------------------------------------
3821
sub ListVariables
3822
{
3823
   local($value);
3824
3825
   if ($debug > 0) {
3826
      print "List of all variables and their values\n";
3827
      foreach (sort keys %var)
3828
      {
3829
         if ($var{$_} eq '') {
3830
            $value = "empty";
3831
         } else {
3832
            $value = $var{$_};
3833
         }
3834
         print "   $_\n      $value\n";
3835
      }
3836
      print "\n\n";
3837
   }
3838
}
3839
3840
3841
__END__
3842
:endofperl
3843 0:513646585e45 Chris
#!/usr/bin/env ruby
3844
3845
# == Synopsis
3846
#
3847
# reposman: manages your repositories with Redmine
3848
#
3849
# == Usage
3850
#
3851
#    reposman [OPTIONS...] -s [DIR] -r [HOST]
3852 441:cbce1fd3b1b7 Chris
#
3853 0:513646585e45 Chris
#  Examples:
3854 241:7658d21a1493 chris
#    reposman --scm-dir=/var/svn --redmine-host=redmine.example.net --scm subversion
3855 0:513646585e45 Chris
#    reposman -s /var/git -r redmine.example.net -u http://svn.example.net --scm git
3856
#
3857
# == Arguments (mandatory)
3858
#
3859 241:7658d21a1493 chris
#   -s, --scm-dir=DIR         use DIR as base directory for repositories
3860 0:513646585e45 Chris
#   -r, --redmine-host=HOST   assume Redmine is hosted on HOST. Examples:
3861
#                             -r redmine.example.net
3862
#                             -r http://redmine.example.net
3863
#                             -r https://example.net/redmine
3864 909:cbb26bc654de Chris
#   -k, --key=KEY             use KEY as the Redmine API key (you can use the
3865
#                             --key-file option as an alternative)
3866 0:513646585e45 Chris
#
3867
# == Options
3868
#
3869
#   -o, --owner=OWNER         owner of the repository. using the rails login
3870
#                             allow user to browse the repository within
3871
#                             Redmine even for private project. If you want to
3872
#                             share repositories through Redmine.pm, you need
3873
#                             to use the apache owner.
3874
#   -g, --group=GROUP         group of the repository. (default: root)
3875
#   --scm=SCM                 the kind of SCM repository you want to create (and
3876
#                             register) in Redmine (default: Subversion).
3877
#                             reposman is able to create Git and Subversion
3878
#                             repositories. For all other kind, you must specify
3879
#                             a --command option
3880
#   -u, --url=URL             the base url Redmine will use to access your
3881
#                             repositories. This option is used to automatically
3882
#                             register the repositories in Redmine. The project
3883
#                             identifier will be appended to this url. Examples:
3884
#                             -u https://example.net/svn
3885
#                             -u file:///var/svn/
3886 28:12420e46bed9 chris
#                             if this option isn't set, reposman will register
3887
#                             the repositories with local file paths in Redmine
3888 0:513646585e45 Chris
#   -c, --command=COMMAND     use this command instead of "svnadmin create" to
3889
#                             create a repository. This option can be used to
3890
#                             create repositories other than subversion and git
3891
#                             kind.
3892
#                             This command override the default creation for git
3893
#                             and subversion.
3894 13:80433603a2cd Chris
#   --http-user=USER          User for HTTP Basic authentication with Redmine WS
3895
#   --http-pass=PASSWORD      Password for Basic authentication with Redmine WS
3896 909:cbb26bc654de Chris
#       --key-file=PATH       path to a file that contains the Redmine API key
3897
#                             (use this option instead of --key if you don't
3898
#                             the key to appear in the command line)
3899 0:513646585e45 Chris
#   -t, --test                only show what should be done
3900
#   -h, --help                show help and exit
3901
#   -v, --verbose             verbose
3902
#   -V, --version             print version and exit
3903
#   -q, --quiet               no log
3904
#
3905
# == References
3906 441:cbce1fd3b1b7 Chris
#
3907 0:513646585e45 Chris
# You can find more information on the redmine's wiki : http://www.redmine.org/wiki/redmine/HowTos
3908
3909
3910
require 'getoptlong'
3911 1332:1d1cb01c0417 Chris
#require 'rdoc/usage'
3912 0:513646585e45 Chris
require 'find'
3913
require 'etc'
3914
3915
Version = "1.3"
3916
SUPPORTED_SCM = %w( Subversion Darcs Mercurial Bazaar Git Filesystem )
3917
3918
opts = GetoptLong.new(
3919 241:7658d21a1493 chris
                      ['--scm-dir',      '-s', GetoptLong::REQUIRED_ARGUMENT],
3920 0:513646585e45 Chris
                      ['--redmine-host', '-r', GetoptLong::REQUIRED_ARGUMENT],
3921
                      ['--key',          '-k', GetoptLong::REQUIRED_ARGUMENT],
3922 909:cbb26bc654de Chris
                      ['--key-file',           GetoptLong::REQUIRED_ARGUMENT],
3923 0:513646585e45 Chris
                      ['--owner',        '-o', GetoptLong::REQUIRED_ARGUMENT],
3924
                      ['--group',        '-g', GetoptLong::REQUIRED_ARGUMENT],
3925
                      ['--url',          '-u', GetoptLong::REQUIRED_ARGUMENT],
3926
                      ['--command' ,     '-c', GetoptLong::REQUIRED_ARGUMENT],
3927
                      ['--scm',                GetoptLong::REQUIRED_ARGUMENT],
3928 13:80433603a2cd Chris
                      ['--http-user',          GetoptLong::REQUIRED_ARGUMENT],
3929
                      ['--http-pass',          GetoptLong::REQUIRED_ARGUMENT],
3930 0:513646585e45 Chris
                      ['--test',         '-t', GetoptLong::NO_ARGUMENT],
3931
                      ['--verbose',      '-v', GetoptLong::NO_ARGUMENT],
3932
                      ['--version',      '-V', GetoptLong::NO_ARGUMENT],
3933
                      ['--help'   ,      '-h', GetoptLong::NO_ARGUMENT],
3934
                      ['--quiet'  ,      '-q', GetoptLong::NO_ARGUMENT]
3935
                      )
3936
3937
$verbose      = 0
3938
$quiet        = false
3939
$redmine_host = ''
3940
$repos_base   = ''
3941 13:80433603a2cd Chris
$http_user    = ''
3942
$http_pass    = ''
3943 0:513646585e45 Chris
$svn_owner    = 'root'
3944
$svn_group    = 'root'
3945
$use_groupid  = true
3946
$svn_url      = false
3947
$test         = false
3948
$scm          = 'Subversion'
3949
3950
def log(text, options={})
3951
  level = options[:level] || 0
3952
  puts text unless $quiet or level > $verbose
3953
  exit 1 if options[:exit]
3954
end
3955
3956
def system_or_raise(command)
3957
  raise "\"#{command}\" failed" unless system command
3958
end
3959
3960 1332:1d1cb01c0417 Chris
def usage
3961
  puts "See source code for supported options"
3962
  exit
3963
end
3964
3965 0:513646585e45 Chris
module SCM
3966
3967
  module Subversion
3968
    def self.create(path)
3969
      system_or_raise "svnadmin create #{path}"
3970
    end
3971
  end
3972
3973
  module Git
3974
    def self.create(path)
3975
      Dir.mkdir path
3976
      Dir.chdir(path) do
3977
        system_or_raise "git --bare init --shared"
3978
        system_or_raise "git update-server-info"
3979
      end
3980
    end
3981
  end
3982
3983
end
3984
3985
begin
3986
  opts.each do |opt, arg|
3987
    case opt
3988 241:7658d21a1493 chris
    when '--scm-dir';        $repos_base   = arg.dup
3989 0:513646585e45 Chris
    when '--redmine-host';   $redmine_host = arg.dup
3990
    when '--key';            $api_key      = arg.dup
3991 909:cbb26bc654de Chris
    when '--key-file'
3992
      begin
3993
        $api_key = File.read(arg).strip
3994
      rescue Exception => e
3995
        $stderr.puts "Unable to read the key from #{arg}: #{e.message}"
3996
        exit 1
3997
      end
3998 0:513646585e45 Chris
    when '--owner';          $svn_owner    = arg.dup; $use_groupid = false;
3999
    when '--group';          $svn_group    = arg.dup; $use_groupid = false;
4000
    when '--url';            $svn_url      = arg.dup
4001
    when '--scm';            $scm          = arg.dup.capitalize; log("Invalid SCM: #{$scm}", :exit => true) unless SUPPORTED_SCM.include?($scm)
4002 13:80433603a2cd Chris
    when '--http-user';      $http_user    = arg.dup
4003
    when '--http-pass';      $http_pass    = arg.dup
4004 0:513646585e45 Chris
    when '--command';        $command =      arg.dup
4005
    when '--verbose';        $verbose += 1
4006
    when '--test';           $test = true
4007
    when '--version';        puts Version; exit
4008 1332:1d1cb01c0417 Chris
    when '--help';           usage
4009 0:513646585e45 Chris
    when '--quiet';          $quiet = true
4010
    end
4011
  end
4012
rescue
4013
  exit 1
4014
end
4015
4016
if $test
4017
  log("running in test mode")
4018
end
4019
4020
# Make sure command is overridden if SCM vendor is not handled internally (for the moment Subversion and Git)
4021
if $command.nil?
4022
  begin
4023
    scm_module = SCM.const_get($scm)
4024
  rescue
4025
    log("Please use --command option to specify how to create a #{$scm} repository.", :exit => true)
4026
  end
4027
end
4028
4029
$svn_url += "/" if $svn_url and not $svn_url.match(/\/$/)
4030
4031
if ($redmine_host.empty? or $repos_base.empty?)
4032 1332:1d1cb01c0417 Chris
  usage
4033 0:513646585e45 Chris
end
4034
4035
unless File.directory?($repos_base)
4036 217:ed8222a04634 chris
  log("directory '#{$repos_base}' doesn't exist", :exit => true)
4037 0:513646585e45 Chris
end
4038
4039
begin
4040
  require 'active_resource'
4041
rescue LoadError
4042
  log("This script requires activeresource.\nRun 'gem install activeresource' to install it.", :exit => true)
4043
end
4044
4045 37:94944d00e43c chris
class Project < ActiveResource::Base
4046 217:ed8222a04634 chris
  self.headers["User-agent"] = "SoundSoftware repository manager/#{Version}"
4047 909:cbb26bc654de Chris
  self.format = :xml
4048 37:94944d00e43c chris
end
4049 0:513646585e45 Chris
4050
log("querying Redmine for projects...", :level => 1);
4051
4052
$redmine_host.gsub!(/^/, "http://") unless $redmine_host.match("^https?://")
4053
$redmine_host.gsub!(/\/$/, '')
4054
4055
Project.site = "#{$redmine_host}/sys";
4056 13:80433603a2cd Chris
Project.user = $http_user;
4057
Project.password = $http_pass;
4058 0:513646585e45 Chris
4059
begin
4060
  # Get all active projects that have the Repository module enabled
4061
  projects = Project.find(:all, :params => {:key => $api_key})
4062 909:cbb26bc654de Chris
rescue ActiveResource::ForbiddenAccess
4063
  log("Request was denied by your Redmine server. Make sure that 'WS for repository management' is enabled in application settings and that you provided the correct API key.")
4064 0:513646585e45 Chris
rescue => e
4065
  log("Unable to connect to #{Project.site}: #{e}", :exit => true)
4066
end
4067
4068
if projects.nil?
4069 909:cbb26bc654de Chris
  log('No project found, perhaps you forgot to "Enable WS for repository management"', :exit => true)
4070 0:513646585e45 Chris
end
4071
4072 1107:4f45ab104990 Chris
log("found #{projects.size} projects at " + Time.now.inspect);
4073 0:513646585e45 Chris
4074
def set_owner_and_rights(project, repos_path, &block)
4075 441:cbce1fd3b1b7 Chris
  if mswin?
4076 0:513646585e45 Chris
    yield if block_given?
4077
  else
4078
    uid, gid = Etc.getpwnam($svn_owner).uid, ($use_groupid ? Etc.getgrnam(project.identifier).gid : Etc.getgrnam($svn_group).gid)
4079 34:09b1d4349da3 Chris
    right = project.is_public ? 02775 : 02770
4080 0:513646585e45 Chris
    yield if block_given?
4081
    Find.find(repos_path) do |f|
4082
      File.chmod right, f
4083
      File.chown uid, gid, f
4084
    end
4085
  end
4086
end
4087
4088
def other_read_right?(file)
4089
  (File.stat(file).mode & 0007).zero? ? false : true
4090
end
4091
4092
def owner_name(file)
4093
  mswin? ?
4094
    $svn_owner :
4095 441:cbce1fd3b1b7 Chris
    Etc.getpwuid( File.stat(file).uid ).name
4096 0:513646585e45 Chris
end
4097 441:cbce1fd3b1b7 Chris
4098 0:513646585e45 Chris
def mswin?
4099
  (RUBY_PLATFORM =~ /(:?mswin|mingw)/) || (RUBY_PLATFORM == 'java' && (ENV['OS'] || ENV['os']) =~ /windows/i)
4100
end
4101
4102
projects.each do |project|
4103 1107:4f45ab104990 Chris
  log("inspecting project #{project.name}", :level => 1)
4104 0:513646585e45 Chris
4105
  if project.identifier.empty?
4106 1107:4f45ab104990 Chris
    log("\tno identifier for project #{project.name}!")
4107 0:513646585e45 Chris
    next
4108 1445:0c7b3bb73517 Chris
  elsif not project.identifier.match(/^[a-z0-9_\-]+$/)
4109 1107:4f45ab104990 Chris
    log("\tinvalid identifier for project #{project.name} : #{project.identifier}!");
4110 0:513646585e45 Chris
    next;
4111
  end
4112
4113
  repos_path = File.join($repos_base, project.identifier).gsub(File::SEPARATOR, File::ALT_SEPARATOR || File::SEPARATOR)
4114
4115 28:12420e46bed9 chris
  create_repos = false
4116
  # Logic required for SoundSoftware.ac.uk repositories:
4117
  #
4118
  # * If the project has a repository path declared already,
4119
  #   - if it's a local path,
4120
  #     - if it does not exist
4121
  #       - if it has the right root
4122
  #         - create it
4123
  #   - else
4124
  #     - leave alone (remote repository)
4125
  # * else
4126
  #   - create repository with same name as project
4127
  #   - set to project
4128
4129
  if project.respond_to?(:repository)
4130
4131
    repos_url = project.repository.url;
4132 1107:4f45ab104990 Chris
    log("\texisting url for project #{project.identifier} is #{repos_url}", :level => 2);
4133 28:12420e46bed9 chris
4134
    if repos_url.match(/^file:\//) || repos_url.match(/^\//)
4135
4136
      repos_url = repos_url.gsub(/^file:\/*/, "/");
4137 1107:4f45ab104990 Chris
      log("\tthis is a local file path, at #{repos_url}", :level => 2);
4138 28:12420e46bed9 chris
4139
      if repos_url.slice(0, $repos_base.length) != $repos_base
4140
        # leave repos_path set to our original suggestion
4141 1107:4f45ab104990 Chris
        log("\tpreparing to replace incorrect repo location #{repos_url} for #{project.name} with #{repos_path}");
4142 28:12420e46bed9 chris
        create_repos = true
4143
      else
4144
        if !File.directory?(repos_url)
4145 1107:4f45ab104990 Chris
          log("\tpreparing to create repo for #{project.name} at #{repos_url}");
4146 28:12420e46bed9 chris
          repos_path = repos_url
4147
          create_repos = true
4148
        else
4149 1107:4f45ab104990 Chris
          log("\tit exists and is in the right place", :level => 2);
4150 28:12420e46bed9 chris
        end
4151
      end
4152
    else
4153 1107:4f45ab104990 Chris
      log("\tthis is a remote path, leaving alone", :level => 2);
4154 28:12420e46bed9 chris
    end
4155
  else
4156 1107:4f45ab104990 Chris
    log("\tpreparing to set repo location and create for #{project.name} at #{repos_url}")
4157 28:12420e46bed9 chris
#    if File.directory?(repos_path)
4158
#      log("\trepository path #{repos_path} already exists, not creating")
4159
#    else
4160
      create_repos = true
4161
#    end
4162
  end
4163
4164
  if create_repos
4165
4166
    registration_url = repos_path
4167
    if $svn_url
4168
      registration_url = "#{$svn_url}#{project.identifier}"
4169
    end
4170 0:513646585e45 Chris
4171
    if $test
4172 28:12420e46bed9 chris
      log("\tproposal: create repository #{repos_path}")
4173
      log("\tproposal: register repository #{repos_path} in Redmine with vendor #{$scm}, url #{registration_url}")
4174 0:513646585e45 Chris
      next
4175
    end
4176
4177 52:8c3409528d3a Chris
# No -- we need "other" users to be able to read it.  Access control
4178
# is not handled through Unix user id anyway
4179
#    project.is_public ? File.umask(0002) : File.umask(0007)
4180
    File.umask(0002)
4181
4182 28:12420e46bed9 chris
    log("\taction: create repository #{repos_path}")
4183 0:513646585e45 Chris
4184
    begin
4185 28:12420e46bed9 chris
      if !File.directory?(repos_path)
4186
        set_owner_and_rights(project, repos_path) do
4187
          if scm_module.nil?
4188
            log("\trunning command: #{$command} #{repos_path}")
4189
            system_or_raise "#{$command} #{repos_path}"
4190
          else
4191
            scm_module.create(repos_path)
4192
          end
4193 0:513646585e45 Chris
        end
4194
      end
4195
    rescue => e
4196
      log("\tunable to create #{repos_path} : #{e}\n")
4197
      next
4198
    end
4199
4200 28:12420e46bed9 chris
    begin
4201
      log("\taction: register repository #{repos_path} in Redmine with vendor #{$scm}, url #{registration_url}");
4202
      project.post(:repository, :vendor => $scm, :repository => {:url => "#{registration_url}"}, :key => $api_key)
4203
    rescue => e
4204
      log("\trepository #{repos_path} not registered in Redmine: #{e.message}");
4205 0:513646585e45 Chris
    end
4206
    log("\trepository #{repos_path} created");
4207
  end
4208 37:94944d00e43c chris
end
4209 0:513646585e45 Chris
4210 1107:4f45ab104990 Chris
log("project review completed at " + Time.now.inspect);
4211
4212 241:7658d21a1493 chris
#!/bin/sh
4213
4214 242:bde4f47b6427 chris
mirrordir="/var/mirror"
4215 1336:b61a51fb42b9 Chris
hg="/usr/bin/hg"
4216 242:bde4f47b6427 chris
4217 241:7658d21a1493 chris
project="$1"
4218
local_repo="$2"
4219
remote_repo="$3"
4220
4221
if [ -z "$project" ] || [ -z "$local_repo" ] || [ -z "$remote_repo" ]; then
4222
    echo "Usage: $0 <project> <local-repo-path> <remote-repo-url>"
4223
    exit 2
4224
fi
4225
4226
  # We need to handle different source repository types separately.
4227
  #
4228
  # The convert extension cannot convert directly from a remote git
4229
  # repo; we'd have to mirror to a local repo first.  Incremental
4230
  # conversions do work though.  The hg-git plugin will convert
4231
  # directly from remote repositories, but not via all schemes
4232
  # (e.g. https is not currently supported).  It's probably easier to
4233
  # use git itself to clone locally and then convert or hg-git from
4234
  # there.
4235
  #
4236
  # We can of course convert directly from remote Subversion repos,
4237
  # but we need to keep track of that -- you can ask to convert into a
4238
  # repo that has already been used (for Mercurial) and it'll do so
4239
  # happily; we don't want that.
4240
  #
4241
  # Converting from a remote Hg repo should be fine!
4242
  #
4243
  # One other thing -- we can't actually tell the difference between
4244
  # the various SCM types based on URL alone.  We have to try them
4245
  # (ideally in an order determined by a guess based on the URL) and
4246
  # see what happens.
4247
4248 242:bde4f47b6427 chris
project_mirror="$mirrordir/$project"
4249
mkdir -p "$project_mirror"
4250
project_repo_mirror="$project_mirror/repo"
4251 241:7658d21a1493 chris
4252 242:bde4f47b6427 chris
  # Some test URLs:
4253
  #
4254
  # http://aimc.googlecode.com/svn/trunk/
4255
  # http://aimc.googlecode.com/svn/
4256
  # http://vagar.org/git/flam
4257
  # https://github.com/wslihgt/IMMF0salience.git
4258
  # http://hg.breakfastquay.com/dssi-vst/
4259
  # git://github.com/schacon/hg-git.git
4260
  # http://svn.drobilla.net/lad (externals!)
4261
4262
# If we are importing from another distributed system, then our aim is
4263
# to create either a Hg repo or a git repo at $project_mirror, which
4264
# we can then pull from directly to the Hg repo at $local_repo (using
4265
# hg-git, in the case of a git repo).
4266
4267
# Importing from SVN, we should use hg convert directly to the target
4268
# hg repo (or should we?) but keep a record of the last changeset ID
4269
# we brought in, and test each time whether it matches the last
4270
# changeset ID actually in the repo
4271
4272
success=""
4273
4274 436:4eb486dbf730 Chris
# If we have a record of the last successfully updated remote repo
4275
# URL, check it against our current remote URL: if it has changed, we
4276
# will need to start again with a new clone rather than pulling
4277
# updates into the existing local mirror
4278
4279
successfile="$project_mirror/last_successful_url"
4280
if [ -f "$successfile" ]; then
4281
    last=$(cat "$successfile")
4282 437:102056ec2de9 chris
    if [ x"$last" = x"$remote_repo" ]; then
4283 436:4eb486dbf730 Chris
	echo "$$: Remote URL is unchanged from last successful update"
4284
    else
4285
	echo "$$: Remote URL has changed since last successful update:"
4286
	echo "$$: Last URL was $last, current is $remote_repo"
4287
	suffix="$$.$(date +%s)"
4288
	echo "$$: Moving existing repos to $suffix suffix and starting afresh"
4289
	mv "$project_repo_mirror" "$project_repo_mirror"."$suffix"
4290
	mv "$local_repo" "$local_repo"."$suffix"
4291
	mv "$successfile" "$successfile"."$suffix"
4292 437:102056ec2de9 chris
	touch "$project_mirror/url_changed"
4293 436:4eb486dbf730 Chris
    fi
4294
fi
4295
4296 242:bde4f47b6427 chris
if [ -d "$project_repo_mirror" ]; then
4297
4298
    # Repo mirror exists: update it
4299
    echo "$$: Mirror for project $project exists at $project_repo_mirror, updating" 1>&2
4300
4301
    if [ -d "$project_repo_mirror/.hg" ]; then
4302 433:7fd72f22a42b Chris
	"$hg" --config extensions.convert= convert --datesort "$remote_repo" "$project_repo_mirror" && success=true
4303 439:d3faf348b287 chris
	if [ -z "$success" ]; then
4304
	    ( cd "$project_repo_mirror" && "$hg" pull "$remote_repo" ) && success=true
4305
	fi
4306 242:bde4f47b6427 chris
    elif [ -d "$project_repo_mirror/.git" ]; then
4307 431:d3af621ba9d4 Chris
	( cd "$project_repo_mirror" && git pull "$remote_repo" master ) && success=true
4308 242:bde4f47b6427 chris
    else
4309
	echo "$$: ERROR: Repo mirror dir $project_repo_mirror exists but is not an Hg or git repo" 1>&2
4310
    fi
4311
4312
else
4313
4314
    # Repo mirror does not exist yet
4315
    echo "$$: Mirror for project $project does not yet exist at $project_repo_mirror, trying to convert or clone" 1>&2
4316
4317
    case "$remote_repo" in
4318
	*git*)
4319
	    git clone "$remote_repo" "$project_repo_mirror" ||
4320 433:7fd72f22a42b Chris
	    "$hg" --config extensions.convert= convert --datesort "$remote_repo" "$project_repo_mirror"
4321 242:bde4f47b6427 chris
	    ;;
4322
	*)
4323 433:7fd72f22a42b Chris
	    "$hg" --config extensions.convert= convert --datesort "$remote_repo" "$project_repo_mirror" ||
4324 299:defe55be97b9 chris
	    git clone "$remote_repo" "$project_repo_mirror" ||
4325 433:7fd72f22a42b Chris
	    "$hg" clone "$remote_repo" "$project_repo_mirror"
4326 242:bde4f47b6427 chris
	    ;;
4327
    esac && success=true
4328
4329
fi
4330
4331
echo "Success=$success"
4332
4333
if [ -n "$success" ]; then
4334
    echo "$$: Update successful, pulling into local repo at $local_repo"
4335 436:4eb486dbf730 Chris
    if [ ! -d "$local_repo" ]; then
4336
	"$hg" init "$local_repo"
4337
    fi
4338 242:bde4f47b6427 chris
    if [ -d "$project_repo_mirror/.git" ]; then
4339 436:4eb486dbf730 Chris
	( cd "$local_repo" && "$hg" --config extensions.hggit= pull "$project_repo_mirror" ) && echo "$remote_repo" > "$successfile"
4340 242:bde4f47b6427 chris
    else
4341 436:4eb486dbf730 Chris
	( cd "$local_repo" && "$hg" pull "$project_repo_mirror" ) && echo "$remote_repo" > "$successfile"
4342 242:bde4f47b6427 chris
    fi
4343
fi