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 @ 1540:322d7b57e5f0

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 1540:322d7b57e5f0 chris
# script/rails runner create-repo-authormaps.rb -s /var/hg -o /var/repo-export/authormap
1247 1538:87bea4981d6d Chris
#
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 1540:322d7b57e5f0 chris
  puts "input directory '#{$repos_base}' doesn't exist"
1285
  exit 1
1286 1538:87bea4981d6d Chris
end
1287
1288
unless File.directory?($out_base)
1289 1540:322d7b57e5f0 chris
  puts "output directory '#{$out_base}' doesn't exist"
1290
  exit 1
1291 1538:87bea4981d6d Chris
end
1292
1293
projects = Project.find(:all)
1294
1295
if projects.nil?
1296 1540:322d7b57e5f0 chris
  puts 'No projects found'
1297
  exit 1
1298 1538:87bea4981d6d Chris
end
1299
1300
projects.each do |proj|
1301
  next unless proj.respond_to?(:repository)
1302
1303
  repo = proj.repository
1304 1539:22d57b0e0a77 chris
  next if repo.nil? or repo.url.empty?
1305 1538:87bea4981d6d Chris
1306
  repo_url = repo.url
1307
  repo_url = repo_url.gsub(/^file:\/*/, "/");
1308
  if repo_url != File.join($repos_base, proj.identifier)
1309 1540:322d7b57e5f0 chris
    puts 'Project #{proj.identifier} has repo in unsupported location #{repo_url}, skipping'
1310 1538:87bea4981d6d Chris
    next
1311
  end
1312
1313
  csets = repo.changesets
1314
  committers = csets.map do |c| c.committer end.sort.uniq
1315
1316
  authormap = ""
1317
  committers.each do |c|
1318
    if not c =~ /[^<]+<.*@.*>/ then
1319
      user = repo.find_committer_user c
1320 1539:22d57b0e0a77 chris
      authormap << "#{c}=#{user.name} <#{user.mail}>\n" unless user.nil?
1321 1538:87bea4981d6d Chris
    end
1322
  end
1323
1324 1539:22d57b0e0a77 chris
  File.open(File.join($out_base, "authormap_#{proj.identifier}"), "w") do |f|
1325 1538:87bea4981d6d Chris
    f.puts(authormap)
1326
  end
1327
1328
end
1329
1330 226:5b028aef59a7 chris
#!/usr/bin/perl -w
1331
1332
# Read a Doxyfile and print it out again to stdout, with only
1333
# whitelisted keys in it and with some keys set to pre-fixed values.
1334
#
1335
# Note that OUTPUT_DIRECTORY is not included; it should be added by
1336
# the caller
1337
1338
use strict;
1339
1340
my $txt = join "", <>;
1341
$txt =~ s/^\s*#.*$//gm;
1342
$txt =~ s/\\\n//gs;
1343
$txt =~ s/\r//g;
1344
$txt =~ s/\n\s*\n/\n/gs;
1345
1346
my %fixed = (
1347
    FULL_PATH_NAMES => "NO",
1348
    SYMBOL_CACHE_SIZE => 2,
1349
    EXCLUDE_SYMLINKS => "YES",
1350
    GENERATE_HTML => "YES",
1351
    PERL_PATH => "/usr/bin/perl",
1352
    HAVE_DOT => "YES",
1353
    HTML_OUTPUT => ".",
1354 228:3c084a25d8ab chris
    HTML_DYNAMIC_SECTIONS => "NO",
1355 226:5b028aef59a7 chris
    SEARCHENGINE => "NO",
1356
    DOT_FONTNAME => "FreeMono",
1357
    DOT_FONTSIZE => 10,
1358
    DOT_FONTPATH => "/usr/share/fonts/truetype/freefont",
1359
    DOT_IMAGE_FORMAT => "png",
1360
    DOT_PATH => "/usr/bin/dot",
1361
    DOT_TRANSPARENT => "YES",
1362
);
1363
1364 233:df89e7aa3ce8 Chris
# These are the keys that are safe to take from the output and include
1365
# in the output; they may still need to be checked for safe values (if
1366
# file paths).
1367 226:5b028aef59a7 chris
my @safe = qw(
1368 233:df89e7aa3ce8 Chris
INPUT
1369
FILE_PATTERNS
1370
EXAMPLE_PATH
1371
EXAMPLE_PATTERNS
1372
IMAGE_PATH
1373
INCLUDE_PATH
1374
INCLUDE_FILE_PATTERNS
1375 226:5b028aef59a7 chris
DOXYFILE_ENCODING
1376
PROJECT_NAME
1377
PROJECT_NUMBER
1378
CREATE_SUBDIRS
1379
OUTPUT_LANGUAGE
1380
BRIEF_MEMBER_DESC
1381
REPEAT_BRIEF
1382
ABBREVIATE_BRIEF
1383
ALWAYS_DETAILED_SEC
1384
INLINE_INHERITED_MEMB
1385
STRIP_FROM_PATH
1386
STRIP_FROM_INC_PATH
1387
JAVADOC_AUTOBRIEF
1388
QT_AUTOBRIEF
1389
MULTILINE_CPP_IS_BRIEF
1390
INHERIT_DOCS
1391
SEPARATE_MEMBER_PAGES
1392
TAB_SIZE
1393
ALIASES
1394
OPTIMIZE_OUTPUT_FOR_C
1395
OPTIMIZE_OUTPUT_JAVA
1396
OPTIMIZE_FOR_FORTRAN
1397
OPTIMIZE_OUTPUT_VHDL
1398
EXTENSION_MAPPING
1399
BUILTIN_STL_SUPPORT
1400
CPP_CLI_SUPPORT
1401
SIP_SUPPORT
1402
IDL_PROPERTY_SUPPORT
1403
DISTRIBUTE_GROUP_DOC
1404
SUBGROUPING
1405
TYPEDEF_HIDES_STRUCT
1406
EXTRACT_ALL
1407
EXTRACT_PRIVATE
1408
EXTRACT_STATIC
1409
EXTRACT_LOCAL_CLASSES
1410
EXTRACT_LOCAL_METHODS
1411
EXTRACT_ANON_NSPACES
1412
HIDE_UNDOC_MEMBERS
1413
HIDE_UNDOC_CLASSES
1414
HIDE_FRIEND_COMPOUNDS
1415
HIDE_IN_BODY_DOCS
1416
INTERNAL_DOCS
1417
HIDE_SCOPE_NAMES
1418
SHOW_INCLUDE_FILES
1419
FORCE_LOCAL_INCLUDES
1420
INLINE_INFO
1421
SORT_MEMBER_DOCS
1422
SORT_BRIEF_DOCS
1423
SORT_MEMBERS_CTORS_1ST
1424
SORT_GROUP_NAMES
1425
SORT_BY_SCOPE_NAME
1426
GENERATE_TODOLIST
1427
GENERATE_TESTLIST
1428
GENERATE_BUGLIST
1429
GENERATE_DEPRECATEDLIST
1430
ENABLED_SECTIONS
1431
MAX_INITIALIZER_LINES
1432
SHOW_USED_FILES
1433
SHOW_DIRECTORIES
1434
SHOW_FILES
1435
SHOW_NAMESPACES
1436
QUIET
1437
WARNINGS
1438
WARN_IF_UNDOCUMENTED
1439
WARN_IF_DOC_ERROR
1440
WARN_NO_PARAMDOC
1441
INPUT_ENCODING
1442
RECURSIVE
1443
EXCLUDE
1444
EXCLUDE_SYMLINKS
1445
EXCLUDE_PATTERNS
1446
EXCLUDE_SYMBOLS
1447
EXAMPLE_RECURSIVE
1448
SOURCE_BROWSER
1449
INLINE_SOURCES
1450
STRIP_CODE_COMMENTS
1451
REFERENCED_BY_RELATION
1452
REFERENCES_RELATION
1453
REFERENCES_LINK_SOURCE
1454
VERBATIM_HEADERS
1455
ALPHABETICAL_INDEX
1456
COLS_IN_ALPHA_INDEX
1457
IGNORE_PREFIX
1458
HTML_TIMESTAMP
1459
HTML_ALIGN_MEMBERS
1460
ENABLE_PREPROCESSING
1461
MACRO_EXPANSION
1462
EXPAND_ONLY_PREDEF
1463
SEARCH_INCLUDES
1464
PREDEFINED
1465
EXPAND_AS_DEFINED
1466
SKIP_FUNCTION_MACROS
1467
ALLEXTERNALS
1468
EXTERNAL_GROUPS
1469
CLASS_DIAGRAMS
1470
HIDE_UNDOC_RELATIONS
1471
CLASS_GRAPH
1472
COLLABORATION_GRAPH
1473
GROUP_GRAPHS
1474
UML_LOOK
1475
TEMPLATE_RELATIONS
1476
INCLUDE_GRAPH
1477
INCLUDED_BY_GRAPH
1478
CALL_GRAPH
1479
CALLER_GRAPH
1480
GRAPHICAL_HIERARCHY
1481
DIRECTORY_GRAPH
1482
DOT_GRAPH_MAX_NODES
1483
MAX_DOT_GRAPH_DEPTH
1484
DOT_MULTI_TARGETS
1485
DOT_CLEANUP
1486
);
1487
1488
my %safehash;
1489
for my $sk (@safe) { $safehash{$sk} = 1; }
1490
1491
my @lines = split "\n", $txt;
1492
1493
my %settings;
1494
1495
sub is_safe {
1496
    my $key = shift;
1497
    defined $safehash{$key} and $safehash{$key} == 1;
1498
}
1499
1500
sub has_file_path {
1501
    # Returns true if the given key expects a file path as a value.
1502
    # We only need to test keys that are safe; unsafe keys have been
1503
    # rejected already.
1504
    my $key = shift;
1505
    $key eq "INPUT" or
1506
	$key =~ /^OUTPUT_/ or
1507
	$key =~ /_PATH$/ or
1508
	$key =~ /_PATTERNS$/;
1509
}
1510
1511
sub is_safe_file_path {
1512
    my $value = shift;
1513
    not $value =~ /^\// and not $value =~ /\.\./;
1514
}
1515
1516
foreach my $line (@lines) {
1517
1518
    chomp $line;
1519
    my ($key, $value) = split /\s*=\s*/, $line;
1520
1521
    next if !defined $key;
1522
1523
    if ($key =~ /^GENERATE_/ and not $key =~ /LIST$/) {
1524
	print STDERR "NOTE: Setting $key explicitly to NO\n";
1525
	$settings{$key} = "NO";
1526
	next;
1527
    }
1528
1529
    if (!is_safe($key)) {
1530
	print STDERR "NOTE: Skipping non-whitelisted key $key\n";
1531
	next;
1532
    }
1533
1534
    if (has_file_path($key) and !is_safe_file_path($value)) {
1535
	print STDERR "ERROR: Unsafe file path \"$value\" for key $key\n";
1536
	exit 1;
1537
    }
1538
1539
    $settings{$key} = $value;
1540
}
1541
1542 228:3c084a25d8ab chris
foreach my $key (keys %fixed) {
1543
    my $value = $fixed{$key};
1544
    print STDERR "NOTE: Setting $key to fixed value $value\n";
1545
    $settings{$key} = $value;
1546
}
1547
1548 226:5b028aef59a7 chris
print join "\n", map { "$_ = $settings{$_}" } keys %settings;
1549
print "\n";
1550 203:1e55195bca45 chris
#!/bin/bash
1551
1552
# Run this script from anywhere
1553
1554
# Enumerate Hg repos; make sure they're up to date; extract docs for
1555
# each
1556
1557
hgdir="/var/hg"
1558
docdir="/var/doc"
1559 223:c3544e9fd588 chris
logfile="/var/www/test-cannam/log/extract-docs.log"
1560
1561
redgrp="redmine"
1562 203:1e55195bca45 chris
1563 218:292cde42265a chris
apikey=""
1564 339:5410d82c12df chris
apischeme="https"
1565 218:292cde42265a chris
apihost=""
1566
apiuser=""
1567
apipass=""
1568
1569 203:1e55195bca45 chris
progdir=$(dirname $0)
1570
case "$progdir" in
1571
    /*) ;;
1572
    *) progdir="$(pwd)/$progdir" ;;
1573
esac
1574
1575 411:e7ba81c8dc5a chris
types="doxygen javadoc matlabdocs" # Do Doxygen first (it can be used for Java too)
1576 203:1e55195bca45 chris
1577
for x in $types; do
1578
    if [ ! -x "$progdir/extract-$x.sh" ]; then
1579
	echo "Helper script not available: $progdir/extract-$x.sh"
1580
	exit 1
1581
    fi
1582
done
1583
1584 218:292cde42265a chris
enable_embedded()
1585
{
1586
    p="$1"
1587 228:3c084a25d8ab chris
    if [ -n "$apikey" ]; then
1588
	if [ -n "$apiuser" ]; then
1589 339:5410d82c12df chris
	    sudo -u docgen curl -u "$apiuser":"$apipass" "$apischeme://$apihost/sys/projects/$p/embedded.xml?enable=1&key=$apikey" -d ""
1590 228:3c084a25d8ab chris
	else
1591 339:5410d82c12df chris
	    sudo -u docgen curl "$apischeme://$apihost/sys/projects/$p/embedded.xml?enable=1&key=$apikey" -d ""
1592 228:3c084a25d8ab chris
	fi
1593
    else
1594
	echo "Can't enable Embedded, API not configured" 1>&2
1595 218:292cde42265a chris
    fi
1596
}
1597
1598 223:c3544e9fd588 chris
# We want to ensure the doc extraction is done by the unprivileged
1599
# user docgen, which is not a member of any interesting group
1600
#
1601
# To this end, we create the tmpdir with user docgen and group
1602
# www-data, and use the www-data user to pull out an archive of the Hg
1603
# repo tip into a location beneath that, before using the docgen user
1604
# to extract docs from that location and write them into the tmpdir
1605
1606
# Same tmpdir for each project: we delete and recreate to avoid
1607
# cleanup duty from lots of directories being created
1608
#
1609
tmpdir=$(mktemp -d "$docdir/tmp_XXXXXX")
1610
1611
fail()
1612
{
1613
    message="$1"
1614
    echo "$message" 1>&2
1615
    case "$tmpdir" in
1616
	*/tmp*) rm -rf "$tmpdir";;
1617
	*);;
1618
    esac
1619
    exit 1
1620
}
1621
1622
case "$tmpdir" in
1623
    /*) ;;
1624
    *) fail "Temporary directory creation failed";;
1625
esac
1626
1627
chown docgen.www-data "$tmpdir" || fail "Temporary directory ownership change failed"
1628
chmod g+rwx "$tmpdir" || fail "Temporary directory permissions change failed"
1629
1630 203:1e55195bca45 chris
for projectdir in "$hgdir"/* ; do
1631
1632
    if [ -d "$projectdir" ] && [ -d "$projectdir/.hg" ]; then
1633
1634 223:c3544e9fd588 chris
	if ! sudo -u www-data hg -R "$projectdir" -q update; then
1635
	    echo "Failed to update Hg in $projectdir, skipping" 1>&2
1636
	    continue
1637
	fi
1638
1639 203:1e55195bca45 chris
	project=$(basename "$projectdir")
1640
1641 223:c3544e9fd588 chris
	tmptargetdir="$tmpdir/doc"
1642
	snapshotdir="$tmpdir/hgsnapshot"
1643 203:1e55195bca45 chris
1644 223:c3544e9fd588 chris
	rm -rf "$tmptargetdir" "$snapshotdir"
1645
1646 226:5b028aef59a7 chris
	mkdir -m 770 "$tmptargetdir" || fail "Temporary target directory creation failed"
1647
	chown docgen.www-data "$tmptargetdir" || fail "Temporary target directory ownership change failed"
1648 223:c3544e9fd588 chris
1649
	mkdir -m 770 "$snapshotdir" || fail "Snapshot directory creation failed"
1650
	chown docgen.www-data "$snapshotdir" || fail "Snapshot directory ownership change failed"
1651
1652
	hgparents=$(sudo -u www-data hg -R "$projectdir" parents)
1653
	if [ -z "$hgparents" ]; then
1654
	    echo "Hg repo at $projectdir has no working copy (empty repo?), skipping"
1655
	    continue
1656
	else
1657
	    echo "Found non-empty Hg repo: $projectdir for project $project"
1658
	fi
1659
1660
	if ! sudo -u www-data hg -R "$projectdir" archive -r tip -t files "$snapshotdir"; then
1661
	    echo "Failed to pick archive from $projectdir, skipping" 1>&2
1662
	    continue
1663
	fi
1664 203:1e55195bca45 chris
1665
	targetdir="$docdir/$project"
1666
1667 223:c3544e9fd588 chris
	echo "Temporary dir is $tmpdir, temporary doc dir is $tmptargetdir, snapshot dir is $snapshotdir, eventual target is $targetdir"
1668 203:1e55195bca45 chris
1669
	for x in $types; do
1670 226:5b028aef59a7 chris
	    if sudo -u docgen "$progdir/extract-$x.sh" "$project" "$snapshotdir" "$tmptargetdir" >> "$logfile" 2>&1; then
1671
		break
1672
	    else
1673 203:1e55195bca45 chris
		echo "Failed to extract via type $x"
1674
	    fi
1675
	done
1676
1677 223:c3544e9fd588 chris
        if [ -f "$tmptargetdir/index.html" ]; then
1678 203:1e55195bca45 chris
	    echo "Processing resulted in an index.html being created, looks good!"
1679
	    if [ ! -d "$targetdir" ] || [ ! -f "$targetdir/index.html" ]; then
1680 223:c3544e9fd588 chris
		echo "This project hasn't had doc extracted before: enabling Embedded"
1681 218:292cde42265a chris
		enable_embedded "$project"
1682 203:1e55195bca45 chris
	    fi
1683
1684
	    if [ -d "$targetdir" ]; then
1685
		mv "$targetdir" "$targetdir"_"$$" && \
1686 223:c3544e9fd588 chris
		    mv "$tmptargetdir" "$targetdir" && \
1687 203:1e55195bca45 chris
		    rm -rf "$targetdir"_"$$"
1688 223:c3544e9fd588 chris
		chgrp -R "$redgrp" "$targetdir"
1689 203:1e55195bca45 chris
	    else
1690 223:c3544e9fd588 chris
		mv "$tmptargetdir" "$targetdir"
1691
		chgrp -R "$redgrp" "$targetdir"
1692 203:1e55195bca45 chris
	    fi
1693 228:3c084a25d8ab chris
	else
1694
	    echo "Processing did not result in an index.html being created"
1695 203:1e55195bca45 chris
	fi
1696
    fi
1697
done
1698
1699 223:c3544e9fd588 chris
rm -rf "$tmpdir"
1700 203:1e55195bca45 chris
#!/bin/bash
1701
1702
docdir="/var/doc"
1703
1704 228:3c084a25d8ab chris
progdir=$(dirname $0)
1705
case "$progdir" in
1706
    /*) ;;
1707
    *) progdir="$(pwd)/$progdir" ;;
1708
esac
1709
1710 203:1e55195bca45 chris
project="$1"
1711 223:c3544e9fd588 chris
projectdir="$2"
1712
targetdir="$3"
1713 203:1e55195bca45 chris
1714 223:c3544e9fd588 chris
if [ -z "$project" ] || [ -z "$targetdir" ] || [ -z "$projectdir" ]; then
1715
    echo "Usage: $0 <project> <projectdir> <targetdir>"
1716 203:1e55195bca45 chris
    exit 2
1717
fi
1718
1719 223:c3544e9fd588 chris
if [ ! -d "$projectdir" ]; then
1720
    echo "Project directory $projectdir not found"
1721 203:1e55195bca45 chris
    exit 1
1722
fi
1723
1724
if [ ! -d "$targetdir" ]; then
1725
    echo "Target dir $targetdir not found"
1726
    exit 1
1727
fi
1728
1729
if [ -f "$targetdir/index.html" ]; then
1730
    echo "Target dir $targetdir already contains index.html"
1731
    exit 1
1732
fi
1733
1734
doxyfile=$(find "$projectdir" -type f -name Doxyfile -print | head -1)
1735
1736
if [ -z "$doxyfile" ]; then
1737
    echo "No Doxyfile found for project $project"
1738
    exit 1
1739
fi
1740
1741
echo "Project $project contains a Doxyfile at $doxyfile"
1742
1743
cd "$projectdir" || exit 1
1744
1745 228:3c084a25d8ab chris
"$progdir/doxysafe.pl" "$doxyfile" | \
1746
    sed -e '$a OUTPUT_DIRECTORY='"$targetdir" | \
1747 203:1e55195bca45 chris
    doxygen -
1748
1749
#!/bin/bash
1750 168:c1e9f2dab1d5 chris
1751 203:1e55195bca45 chris
docdir="/var/doc"
1752 168:c1e9f2dab1d5 chris
1753 203:1e55195bca45 chris
project="$1"
1754 223:c3544e9fd588 chris
projectdir="$2"
1755
targetdir="$3"
1756 168:c1e9f2dab1d5 chris
1757 223:c3544e9fd588 chris
if [ -z "$project" ] || [ -z "$targetdir" ] || [ -z "$projectdir" ]; then
1758
    echo "Usage: $0 <project> <projectdir> <targetdir>"
1759 203:1e55195bca45 chris
    exit 2
1760 168:c1e9f2dab1d5 chris
fi
1761
1762 223:c3544e9fd588 chris
if [ ! -d "$projectdir" ]; then
1763
    echo "Project directory $projectdir not found"
1764 203:1e55195bca45 chris
    exit 1
1765
fi
1766 168:c1e9f2dab1d5 chris
1767 203:1e55195bca45 chris
if [ ! -d "$targetdir" ]; then
1768
    echo "Target dir $targetdir not found"
1769
    exit 1
1770
fi
1771 168:c1e9f2dab1d5 chris
1772 203:1e55195bca45 chris
if [ -f "$targetdir/index.html" ]; then
1773
    echo "Target dir $targetdir already contains index.html"
1774
    exit 1
1775 178:2cec5c53cd68 chris
fi
1776 168:c1e9f2dab1d5 chris
1777 191:0d1c6fa50d3a chris
# Identify Java files whose packages match the trailing parts of their
1778
# paths, and list the resulting packages and the path prefixes with
1779
# the packages removed (so as to find code in subdirs,
1780
# e.g. src/com/example/...)
1781
1782
# Regexp match is very rough; check what is actually permitted for
1783
# package declarations
1784
1785 203:1e55195bca45 chris
find "$projectdir" -type f -name \*.java \
1786 989:3549525ba22a Chris
    -exec egrep '^ *package +[a-zA-Z][a-zA-Z0-9\._-]*;.*$' \{\} /dev/null \; |
1787
    sed -e 's/\/[^\/]*: *package */:/' -e 's/;.*$//' |
1788 191:0d1c6fa50d3a chris
    sort | uniq | (
1789
	current_prefix=
1790
	current_packages=
1791
	while IFS=: read filepath package; do
1792
	    echo "Looking at $package in $filepath"
1793
	    packagepath=${package//./\/}
1794
	    prefix=${filepath%$packagepath}
1795 203:1e55195bca45 chris
	    prefix=${prefix:=$projectdir}
1796 191:0d1c6fa50d3a chris
	    if [ "$prefix" = "$filepath" ]; then
1797
		echo "Package $package does not match suffix of path $filepath, skipping"
1798
		continue
1799
	    fi
1800
	    if [ "$prefix" != "$current_prefix" ]; then
1801 450:73401a15037b Chris
		echo "Package $package matches file path and has new prefix $prefix"
1802 191:0d1c6fa50d3a chris
		if [ -n "$current_packages" ]; then
1803
		    echo "Running Javadoc for packages $current_packages from prefix $current_prefix"
1804 450:73401a15037b Chris
		    echo "Command is: javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages"
1805 203:1e55195bca45 chris
		    javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages
1806 191:0d1c6fa50d3a chris
		fi
1807
		current_prefix="$prefix"
1808 450:73401a15037b Chris
		current_packages="$package"
1809 191:0d1c6fa50d3a chris
	    else
1810 450:73401a15037b Chris
		echo "Package $package matches file path with same prefix as previous file"
1811 191:0d1c6fa50d3a chris
		current_packages="$current_packages $package"
1812
	    fi
1813
	done
1814 203:1e55195bca45 chris
	prefix=${prefix:=$projectdir}
1815 191:0d1c6fa50d3a chris
	if [ -n "$current_packages" ]; then
1816
	    echo "Running Javadoc for packages $current_packages in prefix $current_prefix"
1817 450:73401a15037b Chris
  	    echo "Command is: javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages"
1818 203:1e55195bca45 chris
	    javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages
1819 191:0d1c6fa50d3a chris
	fi
1820
    )
1821
1822 450:73401a15037b Chris
if [ -f "$targetdir"/overview-tree.html ]; then
1823
    cp "$targetdir"/overview-tree.html "$targetdir"/index.html
1824
fi
1825
1826 203:1e55195bca45 chris
# for exit code:
1827
[ -f "$targetdir/index.html" ]
1828 168:c1e9f2dab1d5 chris
1829 411:e7ba81c8dc5a chris
#!/bin/bash
1830
1831
docdir="/var/doc"
1832
1833
progdir=$(dirname $0)
1834
case "$progdir" in
1835
    /*) ;;
1836
    *) progdir="$(pwd)/$progdir" ;;
1837
esac
1838
1839
project="$1"
1840
projectdir="$2"
1841
targetdir="$3"
1842
1843
if [ -z "$project" ] || [ -z "$targetdir" ] || [ -z "$projectdir" ]; then
1844
    echo "Usage: $0 <project> <projectdir> <targetdir>"
1845
    exit 2
1846
fi
1847
1848
if [ ! -d "$projectdir" ]; then
1849
    echo "Project directory $projectdir not found"
1850
    exit 1
1851
fi
1852
1853
if [ ! -d "$targetdir" ]; then
1854
    echo "Target dir $targetdir not found"
1855
    exit 1
1856
fi
1857
1858
if [ -f "$targetdir/index.html" ]; then
1859
    echo "Target dir $targetdir already contains index.html"
1860
    exit 1
1861
fi
1862
1863
mfile=$(find "$projectdir" -type f -name \*.m -print0 | xargs -0 grep -l '^% ' | head -1)
1864
1865
if [ -z "$mfile" ]; then
1866
    echo "No MATLAB files with comments found for project $project"
1867
    exit 1
1868
fi
1869
1870
echo "Project $project contains at least one MATLAB file with comments"
1871
1872
cd "$projectdir" || exit 1
1873
1874
perl "$progdir/matlab-docs.pl" -c "$progdir/matlab-docs.conf" -d "$targetdir"
1875
1876 978:bbb88c44f805 Chris
1877 980:9b4919de5317 Chris
# Read an Apache log file in SoundSoftware site format from stdin and
1878
# produce some per-project stats.
1879 978:bbb88c44f805 Chris
#
1880
# Invoke with e.g.
1881
#
1882
# cat /var/log/apache2/code-access.log | \
1883
#   script/runner -e production extra/soundsoftware/get-apache-log-stats.rb
1884
1885 975:198f764e734c Chris
1886
# Use the ApacheLogRegex parser, a neat thing
1887
# See http://www.simonecarletti.com/blog/2009/02/apache-log-regex-a-lightweight-ruby-apache-log-parser/
1888
require 'apachelogregex'
1889
1890
# This is the format defined in our httpd.conf
1891
vhost_combined_format = '%v:%p %h %{X-Forwarded-For}i %l %u %t \"%r\" %>s %O \"%{Referer}i\" \"%{User-Agent}i\"'
1892
1893
parser = ApacheLogRegex.new(vhost_combined_format)
1894
1895
# project name -> count of hg clones
1896
clones = Hash.new(0)
1897
1898
# project name -> count of hg pulls
1899
pulls = Hash.new(0)
1900
1901 978:bbb88c44f805 Chris
# project name -> count of hg pushes
1902
pushes = Hash.new(0)
1903 975:198f764e734c Chris
1904
# project name -> count of hg archive requests (i.e. Download as Zip)
1905
zips = Hash.new(0)
1906
1907
# project name -> count of hits to pages under /projects/projectname
1908
hits = Hash.new(0)
1909
1910 978:bbb88c44f805 Chris
# project name -> Project object
1911
@projects = Hash.new
1912
1913 975:198f764e734c Chris
parseable = 0
1914
unparseable = 0
1915
1916 979:56a38a9f6204 Chris
def is_public_project?(project)
1917 978:bbb88c44f805 Chris
  if !project
1918
    false
1919 983:a97e573d7f87 Chris
  elsif project =~ /^\d+$/
1920
    # ignore numerical project ids, they are only used when editing projects
1921
    false
1922 978:bbb88c44f805 Chris
  elsif @projects.key?(project)
1923 979:56a38a9f6204 Chris
    @projects[project].is_public?
1924 978:bbb88c44f805 Chris
  else
1925
    pobj = Project.find_by_identifier(project)
1926
    if pobj
1927
      @projects[project] = pobj
1928 979:56a38a9f6204 Chris
      pobj.is_public?
1929 978:bbb88c44f805 Chris
    else
1930 979:56a38a9f6204 Chris
      print "Project not found: ", project, "\n"
1931 978:bbb88c44f805 Chris
      false
1932
    end
1933
  end
1934
end
1935
1936 980:9b4919de5317 Chris
def print_stats(h)
1937
  h.keys.sort { |a,b| h[b] <=> h[a] }.each do |p|
1938 982:6edb748be064 Chris
    if h[p] > 0
1939 983:a97e573d7f87 Chris
      print h[p], " ", @projects[p].name, " [", p, "]\n"
1940 982:6edb748be064 Chris
    end
1941 980:9b4919de5317 Chris
  end
1942
end
1943
1944 979:56a38a9f6204 Chris
STDIN.each do |line|
1945 975:198f764e734c Chris
1946
  record = parser.parse(line)
1947
1948
  # most annoyingly, the parser can't handle the comma-separated list
1949
  # in X-Forwarded-For where it has more than one element. If it has
1950 983:a97e573d7f87 Chris
  # failed, remove any IP addresses or the word "unknown" with
1951
  # trailing commas and try again
1952 975:198f764e734c Chris
  if not record
1953 983:a97e573d7f87 Chris
    filtered = line.gsub(/(unknown|([0-9]+\.){3}[0-9]+),\s*/, "")
1954 975:198f764e734c Chris
    record = parser.parse(filtered)
1955
  end
1956
1957
  # discard, but count, unparseable lines
1958
  if not record
1959 979:56a38a9f6204 Chris
    print "Line not parseable: ", line, "\n"
1960 975:198f764e734c Chris
    unparseable += 1
1961
    next
1962
  end
1963
1964
  # discard everything that isn't a 200 OK response
1965
  next if record["%>s"] != "200"
1966
1967
  # discard anything apparently requested by a crawler
1968
  next if record["%{User-Agent}i"] =~ /(bot|slurp|crawler|spider|Redmine)\b/i
1969
1970
  # pull out request e.g. GET / HTTP/1.0
1971
  request = record["%r"]
1972
1973
  # split into method, path, protocol
1974
  if not request =~ /^[^\s]+ ([^\s]+) [^\s]+$/
1975 979:56a38a9f6204 Chris
    print "Line not parseable (bad method, path, protocol): ", line, "\n"
1976 975:198f764e734c Chris
    unparseable += 1
1977
    next
1978
  end
1979
1980
  # get the path e.g. /projects/weevilmatic and split on /
1981
  path = $~[1]
1982
  components = path.split("/")
1983
1984
  # should have at least two elements unless path is "/"; first should
1985
  # be empty (begins with /)
1986
  if path != "/" and (components.size < 2 or components[0] != "")
1987 979:56a38a9f6204 Chris
    print "Line not parseable (degenerate path): ", line, "\n"
1988 975:198f764e734c Chris
    unparseable += 1
1989
    next
1990
  end
1991
1992
  if components[1] == "hg"
1993
1994
    # path is /hg/project?something or /hg/project/something
1995
1996
    project = components[2].split("?")[0]
1997 979:56a38a9f6204 Chris
    if not is_public_project?(project)
1998 978:bbb88c44f805 Chris
      next
1999
    end
2000 975:198f764e734c Chris
2001
    if components[2] =~ /&roots=00*$/
2002
      clones[project] += 1
2003
    elsif components[2] =~ /cmd=capabilities/
2004
      pulls[project] += 1
2005 978:bbb88c44f805 Chris
    elsif components[2] =~ /cmd=unbundle/
2006
      pushes[project] += 1
2007 975:198f764e734c Chris
    elsif components[3] == "archive"
2008
      zips[project] += 1
2009
    end
2010
2011
  elsif components[1] == "projects"
2012
2013
    # path is /projects/project or /projects/project/something
2014
2015
    project = components[2]
2016 979:56a38a9f6204 Chris
    project = project.split("?")[0] if project
2017
    if not is_public_project?(project)
2018 978:bbb88c44f805 Chris
      next
2019 975:198f764e734c Chris
    end
2020
2021 978:bbb88c44f805 Chris
    hits[project] += 1
2022
2023 975:198f764e734c Chris
  end
2024
2025
  parseable += 1
2026
end
2027
2028
# Each clone is also a pull; deduct it from the pulls hash, because we
2029
# want that to contain only non-clone pulls
2030
2031
clones.keys.each do |project|
2032
  pulls[project] -= 1
2033
end
2034
2035 982:6edb748be064 Chris
print parseable, " parseable\n"
2036
print unparseable, " unparseable\n"
2037
2038
2039 980:9b4919de5317 Chris
print "\nMercurial clones:\n"
2040
print_stats clones
2041
2042
print "\nMercurial pulls (excluding clones):\n"
2043
print_stats pulls
2044
2045
print "\nMercurial pushes:\n"
2046
print_stats pushes
2047
2048
print "\nMercurial archive (zip file) downloads:\n"
2049
print_stats zips
2050
2051 982:6edb748be064 Chris
print "\nProject page hits (excluding crawlers):\n"
2052 980:9b4919de5317 Chris
print_stats hits
2053 975:198f764e734c Chris
2054
2055 1536:e2a3230f61fa Chris
2056
# Print out an authormap file for hg-to-git conversion using
2057
# hg-fast-export
2058
#
2059
# Invoke with the project identifier as argument, e.g.
2060
#
2061
# ./script/rails runner -e production extra/soundsoftware/get-repo-authormap.rb soundsoftware-site
2062
2063 1537:e55cbb9ba8bf Chris
proj_ident = ARGV.last
2064 1536:e2a3230f61fa Chris
proj = Project.find_by_identifier(proj_ident)
2065
repo = Repository.where(:project_id => proj.id).first
2066
csets = Changeset.where(:repository_id => repo.id)
2067
committers = csets.map do |c| c.committer end.sort.uniq
2068
committers.each do |c|
2069 1537:e55cbb9ba8bf Chris
  if not c =~ /[^<]+<.*@.*>/ then
2070
    u = repo.find_committer_user c
2071
    print "#{c}=#{u.name} <#{u.mail}>\n" unless u.nil?
2072
  end
2073 1536:e2a3230f61fa Chris
end
2074 970:6bd8364eafae luis
2075 1453:b554eb79ec7b luis
# Log user and project information
2076
#
2077
# Invoke with e.g.
2078
#
2079
# ./script/rails runner -e production extra/soundsoftware/get-statistics.rb
2080 970:6bd8364eafae luis
#
2081
2082 1454:02a05da0bedc luis
projectStats =  {
2083
        :all => Project.active.all.count,
2084
        :private => Project.active.find(:all, :conditions => {:is_public => false}).count,
2085
        :top_level => Project.active.find(:all, :conditions => {:parent_id => nil}).count,
2086
        :top_level_and_private => Project.active.find(:all, :conditions => {:is_public => false, :parent_id => nil}).count
2087
      }
2088 970:6bd8364eafae luis
2089 1453:b554eb79ec7b luis
userStats = {:all => User.active.all.count}
2090 1002:f6ede18f3e6e Chris
2091 1453:b554eb79ec7b luis
stats = {:date => Date.today, :projects => projectStats, :users => userStats}.to_json
2092 1002:f6ede18f3e6e Chris
2093 1453:b554eb79ec7b luis
print "#{stats}\n"
2094 1002:f6ede18f3e6e Chris
2095 383:47ae83ce8db8 Chris
<div style="clear: both; float: right"><small><i>Produced by mtree2html by Hartmut Pohlheim</i></small></div>
2096
# configuration file for generation of html-docu from m-files
2097
#
2098
# Author:   Hartmut Pohlheim
2099
# History:  05.11.2000  file created (parameters for mtree2html2001)
2100
#
2101
# The following options/variables must be changed/adapted:
2102
#   dirmfiles
2103
#   dirhtml
2104
#   csslink
2105
#   texttitleframelayout
2106
#   texttitlefiles
2107
#
2108
# The following options/variables should be adapted:
2109
#   authorfile
2110
#   filenametopframe
2111
#   codeheadmeta
2112
2113
#========================================================================
2114
# Variables (possible keywords: set)
2115
# to use the built-in settings, comment the line using # in first column
2116
#========================================================================
2117
2118
#------------------------------------------------------------------------
2119
# dirmfiles: name of directory containing Matlab m-files
2120
# dirhtml: name of directory to place the html-files into
2121
# exthtml: extension used for the html files (.html or .htm)
2122
#          don't forget the point in front of the extension
2123
#------------------------------------------------------------------------
2124
set dirmfiles = .
2125
set dirhtml = doc-output
2126
set exthtml = .html
2127
2128
#------------------------------------------------------------------------
2129
# authorfile:   name of file containing info about author (in html)
2130
#               if defined, this text is included at the bottom of the
2131
#               html files
2132
#------------------------------------------------------------------------
2133 410:675de8e6becf chris
set authorfile = matlab-docs-credit.html
2134 383:47ae83ce8db8 Chris
2135
#------------------------------------------------------------------------
2136
# csslink:   text for linking to css file (style sheets)
2137
#            the text defined here is directly included into the head
2138
#            of the html file
2139
#------------------------------------------------------------------------
2140 410:675de8e6becf chris
#set csslink = <link rel=stylesheet type="text/css" href="CSSFILENAME.css" />
2141 383:47ae83ce8db8 Chris
2142
#------------------------------------------------------------------------
2143
# links2filescase: this is a bit difficult
2144
#                  Matlab is case sensitive on UNIX, but case insensitive
2145
#                  on Windows. Under UNIX Matlab function calls work
2146
#                  only, when the case of file name and function call are
2147
#                  identical, under Windows you can do what you want.
2148
#                  This scripts help you, to keep an exact case in your
2149
#                  project.
2150
#          exact - internal links are only generated, when case of file
2151
#                  name and in source code are identical
2152
#            all - case doesn't matter
2153
#     exactupper - same as exact, additionally links are also vreated to
2154
#                  all upper case function names in source code (often
2155
#                  used by Mathworks)
2156
#      exactvery - same as exact, additionally info about not matching
2157
#                  case is written to screen (stdout), this can be very
2158
#                  helpful in cleaning up the case in a project
2159
#------------------------------------------------------------------------
2160
set links2filescase = all
2161
2162
#------------------------------------------------------------------------
2163
# texttitleframelayout:    text of title for frame layout file (whole docu)
2164
#------------------------------------------------------------------------
2165 389:0bc92382a86b chris
set texttitleframelayout = MATLAB Function Documentation
2166 383:47ae83ce8db8 Chris
2167
#------------------------------------------------------------------------
2168
# texttitle/headerindexalldirs: text of title and header for directory index
2169
#------------------------------------------------------------------------
2170
set texttitleindexalldirs = Index of Directories
2171
set textheaderindexalldirs = Index of Directories
2172
2173
#------------------------------------------------------------------------
2174
# texttitle/headerindex:    text of title and header for index file
2175
#------------------------------------------------------------------------
2176
set texttitleindex = A-Z Index of Functions
2177
set textheaderindex = A-Z Index of Functions
2178
2179
#------------------------------------------------------------------------
2180
# texttitle/headerfiles:    text of title and header for files
2181
#                           name of file will be added at the end
2182
#------------------------------------------------------------------------
2183 389:0bc92382a86b chris
set texttitlefiles = Function
2184 383:47ae83ce8db8 Chris
set textheaderfiles = Documentation of
2185
2186
#------------------------------------------------------------------------
2187
# frames: whether to use frames in layout (yes or no)
2188
#------------------------------------------------------------------------
2189
set frames = no
2190
2191
#------------------------------------------------------------------------
2192
# filenametopframe: name of file including frame layout (highest level file)
2193
# [default: index]
2194
#------------------------------------------------------------------------
2195
set filenametopframe = index
2196
2197
#------------------------------------------------------------------------
2198
# textjumpindexglobal: text displayed for jump to index of all files
2199
#                      (global)
2200
# textjumpindexlocal:  text displayed for jump to index of files in actual
2201
#                      directory (local)
2202
#------------------------------------------------------------------------
2203 389:0bc92382a86b chris
set textjumpindexglobal = <b>Index of</b> all files:
2204
set textjumpindexlocal = this subdirectory only:
2205 383:47ae83ce8db8 Chris
2206
#------------------------------------------------------------------------
2207
# includesource: include source of m-files in documentation [YES|no]
2208
#------------------------------------------------------------------------
2209
set includesource = yes
2210
2211
#------------------------------------------------------------------------
2212
# usecontentsm: use contents.m files as well for structured
2213
#               (hopefully) index [YES|no]
2214
#------------------------------------------------------------------------
2215
set usecontentsm = no
2216
2217
#------------------------------------------------------------------------
2218
# includesource: write/update contents.m files [yes|NO]
2219
#------------------------------------------------------------------------
2220
set writecontentsm = no
2221
2222
#------------------------------------------------------------------------
2223
# processtree:  parse whole directory tree recursively [YES|no]
2224
#------------------------------------------------------------------------
2225
set processtree = yes
2226
2227
#------------------------------------------------------------------------
2228
# producetree:  produce tree for html-files in same structure than
2229
#		          tree of m-files [yes|NO]
2230
#               if no, all files are saved in the same directory, often
2231
#               easier for outside linking to files
2232
#------------------------------------------------------------------------
2233 401:a0f6e994657f chris
set producetree = yes
2234 383:47ae83ce8db8 Chris
2235
#------------------------------------------------------------------------
2236
# codebodyindex/files: HTML-code for adding to BODY tag
2237
#                      can be used for defining colors and
2238
#                      backgroundimages of the files
2239
#                      No longer recommended, use the css file
2240
#------------------------------------------------------------------------
2241
set codebodyindex =
2242
set codebodyfiles =
2243
2244
#------------------------------------------------------------------------
2245
# codeheadmeta: HTML-code added in HEAD area, use for supplying META info
2246
#------------------------------------------------------------------------
2247
set codeheadmeta =
2248
2249
#------------------------------------------------------------------------
2250
# codehr: HTML-code used to define a <HR>, do what you want
2251
#------------------------------------------------------------------------
2252 411:e7ba81c8dc5a chris
set codehr = <hr>
2253 383:47ae83ce8db8 Chris
2254
#------------------------------------------------------------------------
2255
# codeheader: HTML-code added to <H*> tags, use for centering header text
2256
#             or changing the colour/size/font of the header text
2257
#------------------------------------------------------------------------
2258 389:0bc92382a86b chris
set codeheader =
2259 383:47ae83ce8db8 Chris
2260
2261
# End of parameter file
2262 381:2dc8163e9150 Chris
@rem = '--*-Perl-*--';
2263
@rem = '
2264
@echo off
2265
perl -w -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
2266
goto endofperl
2267
@rem ';
2268
# perl -w -S %0.bat "$@"
2269 382:baff1c482d98 Chris
#!/usr/bin/perl
2270 381:2dc8163e9150 Chris
#
2271
# mtree2html_2000 - produce html files from Matlab m-files.
2272
#                   use configuration file for flexibility
2273
#                   can process tree of directories
2274
#
2275
# Copyright (C) 1996-2000 Hartmut Pohlheim.  All rights reserved.
2276
# includes small parts of m2html from Jeffrey C. Kantor 1995
2277
#
2278
# Author:  Hartmut Pohlheim
2279
# History: 06.03.1996  file created
2280
#          07.03.1996  first working version
2281
#          08.03.1996  modularized, help text only once included
2282
#          11.03.1996  clean up, some functions rwritten
2283
#          18.04.1996  silent output with writing in one line only
2284
#                      version 0.20 fixed
2285
#          14.05.1996  start of adding tree structure, could create tree
2286
#          15.05.1996  creating of index files for every directory
2287
#          17.05.1996  first working version except compact A-Z index
2288
#          20.05.1996  cleanup of actual version, more variables and
2289
#                      configurable settings
2290
#          21.05.1996  reading, update and creation of contents.m added
2291
#          22.05.1996  creation of short index started
2292
#          28.05.1996  jump letters for short index,
2293
#                      3 different directory indexes (short/long/contents)
2294
#          29.05.1996  major cleanup, short and long index created from one function
2295
#                      links for HTML and Indexes from 1 function,
2296
#                      version 0.9
2297
#          30.05.1996  contents.m changed to Contents.m (because unix likes it)
2298
#                      function definition can be in first line of m file before comments
2299
#                      version 0.91 fixed
2300
#          03.06.1996  contents file can be written as wanted, the links will be correct
2301
#                      cross references in help block of m-file will be found and
2302
#                      converted, even if the name of the function is written upper case
2303
#                      version 0.92 fixed
2304
#          05.06.1996  construction of dependency matrix changed, is able now to process
2305
#                      even the whole matlab tree (previous version needed to much memory)
2306
#                      removed warning for contents files in different directories
2307
#                      version 0.94 fixed
2308
#          06.06.1996  new link name matrices for ConstructHTMLFile created,
2309
#                      everything is done in ConstructDependencyMatrix,
2310
#                      both dependencies (calls and called) and matrix
2311
#                      with all mentioned names in this m-file, thus, much
2312
#                      less scanning in html construction
2313
#                      script is now (nearly) linear scalable, thus, matlab-toolbox
2314
#                      tree takes less than 1 hour on a Pentium120, with source
2315
#                      version 0.96 fixed
2316
#          10.06.1996  order of creation changed, first all indexes (includes
2317
#                      update/creation of contents.m) and then ConstructDepency
2318
#                      thus, AutoAdd section will be linked as well
2319
#                      excludenames extended, some more common word function names added
2320
#                      version 0.97 fixed
2321
#          17.02.1998  writecontentsm as command line parameter added
2322
#                      error of file not found will even appear when silent
2323
#                      version 1.02
2324
#          21.05.2000  mark comments in source code specially (no fully correct,
2325
#                      can't handle % in strings)
2326
#                      version 1.11
2327
#          05.11.2000  link also to upper and mixed case m-files
2328
#                      searching for .m files now really works (doesn't find grep.com any longer)
2329
#                      file renamed to mtree2html2001
2330
#                      generated html code now all lower case
2331
#                      inclusion of meta-description and meta-keywords in html files
2332
#                      HTML4 compliance done (should be strict HTML4.0, quite near XHTML)
2333
#                      version 1.23
2334
#
2335 383:47ae83ce8db8 Chris
#	   29.03.2011  (Chris Cannam) add frames option.
2336 381:2dc8163e9150 Chris
2337
$VERSION  = '1.23';
2338
($PROGRAM = $0) =~ s@.*/@@; $PROGRAM = "\U$PROGRAM\E";
2339 411:e7ba81c8dc5a chris
$debug = 1;
2340 381:2dc8163e9150 Chris
2341
#------------------------------------------------------------------------
2342
# Define platform specific things
2343
#------------------------------------------------------------------------
2344
# suffix for files to search is defined twice
2345
# the first ($suffix) is for string creation and contains the . as well
2346
# the second ($suffixforsearch) is for regular expression, handling of . is quite special
2347
$suffix = ".m";
2348
$suffixforsearch = "m";
2349
# the directory separator
2350
$dirsep = "/";
2351
# what is the current directory
2352
$diract = ".";
2353
2354
#------------------------------------------------------------------------
2355 382:baff1c482d98 Chris
#  Define all variables and their standard settings
2356 381:2dc8163e9150 Chris
#  documentation of variables is contained in accompanying rc file
2357
#------------------------------------------------------------------------
2358
%var =
2359
(
2360
   'authorfile',                '',
2361
   'codebodyfiles',             '',
2362
   'codebodyindex',             '',
2363
   'codeheadmeta',              '<meta name="author of conversion perl script" content="Hartmut Pohlheim" />',
2364
   'codehr',                    '<hr size="3" noshade="noshade" />',
2365
   'codeheader',                '',
2366 383:47ae83ce8db8 Chris
   'configfile',                'matlab-docs.conf',
2367 381:2dc8163e9150 Chris
   'csslink',                   '',
2368
   'dirmfiles',                 $diract,
2369
   'dirhtml',                   $diract,
2370
   'exthtml',                   '.html',
2371 382:baff1c482d98 Chris
   'frames',                    'yes',
2372 381:2dc8163e9150 Chris
   'filenametopframe',          'index',
2373
   'filenameindexlongglobal',   'indexlg',
2374
   'filenameindexlonglocal',    'indexll',
2375
   'filenameindexshortglobal',  'indexsg',
2376
   'filenameindexshortlocal',   'indexsl',
2377
   'filenameextensionframe',    'f',
2378
   'filenameextensionindex',    'i',
2379
   'filenameextensionjump',     'j',
2380
   'filenamedirshort',          'dirtops',
2381
   'filenamedirlong',           'dirtopl',
2382
   'filenamedircontents',       'dirtopc',
2383
   'includesource',             'yes',
2384
   'links2filescase',           'all',
2385
   'processtree',               'yes',
2386
   'producetree',               'yes',
2387
   'textjumpindexlocal',        'Local Index',
2388
   'textjumpindexglobal',       'Global Index',
2389
   'texttitleframelayout',      'Documentation of Matlab Files',
2390
   'texttitleindexalldirs',     'Index of Directories',
2391
   'textheaderindexalldirs',    'Index of Directories',
2392
   'texttitleindex',            '',
2393
   'textheaderindex',           '',
2394
   'texttitlefiles',            'Documentation of ',
2395
   'textheaderfiles',           'Documentation of ',
2396
   'usecontentsm',              'yes',
2397
   'writecontentsm',            'no'
2398
);
2399
2400
2401
# define all m-file names, that should be excluded from linking
2402
# however, files will still be converted
2403
@excludenames = ( 'all','ans','any','are',
2404
                  'cs',
2405
                  'demo','dos',
2406
                  'echo','edit','else','elseif','end','exist',
2407
                  'flag','for','function',
2408
                  'global',
2409
                  'help',
2410
                  'i','if','inf','info',
2411
                  'j',
2412
                  'more',
2413
                  'null',
2414
                  'return',
2415
                  'script','strings',
2416
                  'what','which','while','who','whos','why',
2417
                );
2418
2419
# Text for inclusion in created HTML/Frame files: Doctype and Charset
2420
$TextDocTypeHTML  = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">';
2421
$TextDocTypeFrame = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN" "http://www.w3.org/TR/REC-html40/frameset.dtd">';
2422
$TextMetaCharset = '<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />';
2423
2424
#------------------------------------------------------------------------
2425
# Read the command line arguments
2426
#------------------------------------------------------------------------
2427
if (@ARGV == 0) {
2428
   &DisplayHelp()  if &CheckFileName($var{'configfile'}, 'configuration file');
2429
}
2430
2431
# Print provided command line arguments on screen
2432
foreach (@ARGV) { print "   $_\n      "; }
2433
2434
# Get the options
2435
use Getopt::Long;
2436
@options = ('help|h', 'todo|t', 'version|v',
2437
            'authorfile|a=s', 'configfile|c=s', 'dirhtml|html|d=s',
2438
            'dirmfiles|mfiles|m=s', 'includesource|i=s',
2439
            'processtree|r=s', 'producetree|p=s',
2440
            'silent|quiet|q', 'writecontentsm|w=s');
2441
&GetOptions(@options) || die "use -h switch to display help statement\n";
2442
2443
2444
# Display help or todo list, when requested
2445
&DisplayHelp()                         if $opt_help;
2446
&DisplayTodo()                         if $opt_todo;
2447
die "$PROGRAM v$VERSION\n"             if $opt_version;
2448
2449
$exit_status = 0;
2450
2451
#------------------------------------------------------------------------
2452
# Read the config file
2453
#------------------------------------------------------------------------
2454
$var{'configfile'} = $opt_configfile         if $opt_configfile;
2455
&GetConfigFile($var{'configfile'});
2456
2457
2458
#------------------------------------------------------------------------
2459
# Process/Check the command line otions
2460
#------------------------------------------------------------------------
2461
$var{'dirhtml'}   = $opt_dirhtml              if $opt_dirhtml;
2462
if (!(substr($var{'dirhtml'}, -1, 1) eq $dirsep)) { $var{'dirhtml'} = $var{'dirhtml'}.$dirsep; }
2463
$var{'dirmfiles'} = $opt_dirmfiles            if $opt_dirmfiles;
2464
if (!(substr($var{'dirmfiles'}, -1, 1) eq $dirsep)) { $var{'dirmfiles'} = $var{'dirmfiles'}.$dirsep; }
2465
2466
$var{'authorfile'} = $opt_author              if $opt_author;
2467
$var{'includesource'} = $opt_includesource    if $opt_includesource;
2468
if ($var{'includesource'} ne 'no') { $var{'includesource'} = 'yes'; }
2469
$var{'processtree'} = $opt_processtree        if $opt_processtree;
2470
if ($var{'processtree'} ne 'no') { $var{'processtree'} = 'yes'; }
2471
$var{'producetree'} = $opt_producetree        if $opt_producetree;
2472
if ($var{'producetree'} ne 'no') { $var{'producetree'} = 'yes'; }
2473
if ($var{'processtree'} eq 'no') { $var{'producetree'} = 'no'; }
2474 382:baff1c482d98 Chris
if ($var{'frames'} ne 'no') { $var{'frames'} = 'yes'; }
2475 381:2dc8163e9150 Chris
# if (($var{'processtree'} eq 'yes') && ($var{'producetree'} eq 'no')) { $var{'usecontentsm'} = 'no'; }
2476
2477
$var{'writecontentsm'} = $opt_writecontentsm  if $opt_writecontentsm;
2478
2479
#------------------------------------------------------------------------
2480
# Do the real stuff
2481
#------------------------------------------------------------------------
2482
2483
# Print variables on screen, when not silent
2484
&ListVariables                          if !$opt_silent;
2485
2486
# Check the author file
2487
if ($var{'authorfile'} ne '') {
2488 410:675de8e6becf chris
    if (!($var{'authorfile'} =~ m,^/,)) {
2489
	# relative path: treat as relative to config file
2490
	my $cfd = $var{'configfile'};
2491
	$cfd =~ s,/[^/]*$,/,;
2492
	$cfd =~ s,^[^/]*$,.,;
2493
	$var{'authorfile'} = "$cfd/" . $var{'authorfile'};
2494
    }
2495
    if (&CheckFileName($var{'authorfile'}, 'author file')) {
2496
	$var{'authorfile'} = '';
2497
	if (!$opt_silent) { print "   Proceeding without author information!\n"; }
2498
    }
2499 381:2dc8163e9150 Chris
}
2500
2501
# Call the function doing all the real work
2502
&ConstructNameMatrix;
2503
2504
&ConstructDependencyMatrix;
2505
2506
&ConstructAllIndexFiles;
2507
2508
&ConstructHTMLFiles;
2509
2510
exit $exit_status;
2511
2512
#------------------------------------------------------------------------
2513
# Construct list of all mfile names and initialize various data arrays.
2514
#------------------------------------------------------------------------
2515
sub ConstructNameMatrix
2516
{
2517
   local(*MFILE);
2518
   local($file, $dirname);
2519
   local(@newdirectories);
2520
   local(%localnames);
2521
2522
   $RecDeep = 0;
2523
   &ParseTreeReadFiles($var{'dirmfiles'}, $RecDeep);
2524
2525
   foreach $dirname (@directories) {
2526
      if ($dirnumbermfiles{$dirname} > 0) {
2527
         push(@newdirectories, $dirname);
2528
         if (! defined($contentsname{$dirname})) {
2529
            $contentsname{$dirname} = 'Contents';
2530
            if (($var{'writecontentsm'} eq 'no') && ($var{'usecontentsm'} eq 'yes')) {
2531
               print "\r ParseTree - for directory  $dirname  no contents file found!\n";
2532
               print   "             create one or enable writing of contents file (writecontentsm = yes)!\n";
2533
            }
2534
         }
2535
      }
2536
   }
2537
   @alldirectories = @directories;
2538
   @directories = @newdirectories;
2539
2540
   foreach $dirname (@directories) {
2541
      if ($debug > 0) { print "Dir: $dirname \t\t $dirnumbermfiles{$dirname} \t$contentsname{$dirname}\n"; }
2542
   }
2543
2544
   @names = sort(keys %mfile);
2545
2546
   # check, if name of directory is identical to name of file
2547
   @dirsinglenames = values(%dirnamesingle);
2548
   grep($localnames{$_}++, @dirsinglenames);
2549
   @dirandfilename = grep($localnames{$_}, @names);
2550
   if (@dirandfilename) {
2551
      print "\r   Name clash between directory and file name: @dirandfilename\n";
2552
      print   "      These files will be excluded from linking!\n";
2553
      push(@excludenames, @dirandfilename);
2554
   }
2555
2556
   # construct names matrix for help text linking
2557
   #    exclude some common words (and at the same time m-functions) from linking in help text
2558
   grep($localnames{$_}++, @excludenames);
2559
   @linknames = grep(!$localnames{$_}, @names);
2560
2561
   if ($debug > 2) { print "linknames (names of found m-files):\n    @linknames\n"; }
2562
2563
}
2564
2565
#------------------------------------------------------------------------
2566
# Parse tree and collect all Files
2567
#------------------------------------------------------------------------
2568
sub ParseTreeReadFiles
2569
{
2570
   local($dirname, $localRecDeep) = @_;
2571
   local($file, $name, $filewosuffix);
2572
   local($dirhtmlname, $dirmode);
2573
   local($relpath, $relpathtoindex, $replacevardir);
2574
   local(*CHECKDIR, *AKTDIR);
2575
   local(@ALLEFILES);
2576
2577
   opendir(AKTDIR, $dirname) || die "ParseTree - Can't open directory $dirname: $!";
2578
   if ($debug > 1) { print "\nDirectory: $dirname\n"; }
2579
2580
   # create relative path
2581
   $_ = $dirname; $replacevardir = $var{'dirmfiles'};
2582
   s/$replacevardir//; $relpath = $_;
2583
   s/[^\/]+/../g; $relpathtoindex = $_;
2584
2585
   # producetree no
2586
   if ($var{'producetree'} eq 'no') { $relpath = ''; $relpathtoindex = ''; }
2587
2588
   # names of directories (top-level and below top-level m-file-directory)
2589
   push(@directories, $dirname);
2590
   $dirnumbermfiles{$dirname} = 0;    # set number of m-files for this dir to zero
2591
   # relative path from top-level directory, depends on directory name
2592
   $dirnamerelpath{$dirname} = $relpath;
2593
   # relative path from actual directory to top-level directory, depends on directory name
2594
   $dirnamerelpathtoindex{$dirname} = $relpathtoindex;
2595
   # recursion level for directory, depends on directory name
2596
   $dirnamerecdeep{$dirname} = $localRecDeep;
2597
2598
   # only the name of the directory, without path
2599
   $rindexprint = rindex($dirname, $dirsep, length($dirname)-2);
2600
   $rindsub = substr($dirname, $rindexprint+1, length($dirname)-$rindexprint-2);
2601
   $dirnamesingle{$dirname} = $rindsub;
2602
2603
   # create name of html-directories
2604
   $_ = $dirname;
2605
   s/$var{'dirmfiles'}/$var{'dirhtml'}/;
2606
   $dirhtmlname = $_;
2607
   if ($var{'producetree'} eq 'no') { $dirhtmlname = $var{'dirhtml'}; }
2608
   # try to open html directory, if error, then create directory,
2609
   # use same mode as for corresponding m-file directory
2610
   opendir(CHECKDIR,"$dirhtmlname") || do {
2611
      $dirmode = (stat($dirname))[2]; # print "$dirmode\n";
2612
      mkdir("$dirhtmlname", $dirmode) || die ("Cannot create directory $dirhtmlname: $! !");
2613
   };
2614
   closedir(CHECKDIR);
2615
2616
2617
   # read everything from this directory and process them
2618
   @ALLEFILES = readdir(AKTDIR);
2619
2620
   foreach $file (@ALLEFILES) {
2621
      # exclude . and .. directories
2622
      next if $file eq '.';  next if $file eq '..';
2623
2624
      # test for existense of entry (redundant, used for debugging)
2625
      if (-e $dirname.$file) {
2626
         # if it's a directory, call this function recursively
2627
         if (-d $dirname.$file) {
2628
            if ($var{'processtree'} eq 'yes') {
2629
               &ParseTreeReadFiles($dirname.$file.$dirsep, $localRecDeep+1);
2630
            }
2631
         }
2632
         # if it's a file - test for m-file, save name and create some arrays
2633
         elsif (-f $dirname.$file) {
2634
            if ($file =~ /\.$suffixforsearch$/i) {
2635
               # Remove the file suffix to establish the matlab identifiers
2636
               $filewosuffix = $file;
2637
               $filewosuffix =~ s/\.$suffixforsearch$//i;
2638
               # $filename = $name;
2639
2640
               # Contents file in unix must start with a capital letter (Contents.m)
2641
               # ensure, that m-file name is lower case, except the contents file
2642
               if (! ($filewosuffix =~ /^contents$/i)) {
2643 388:dad587ecb8d0 chris
		   # if ($var{'links2filescase'}  eq 'low') { $filewosuffix = "\L$filewosuffix\E"; }
2644 381:2dc8163e9150 Chris
                  $filewosuffixlow = "\L$filewosuffix\E";
2645
               }
2646
               else { $contentsname{$dirname} = $filewosuffix; }
2647
2648
               # internal handle name is always lower case
2649
               $name     = $filewosuffixlow;
2650
               # file name is not lower case
2651
               $filename = $filewosuffix;
2652
2653
               # if don't use C|contents.m, then forget all C|contents.m
2654
               if ($var{'usecontentsm'} eq 'no') { if ($name =~ /contents/i) { next; } }
2655
2656
               # if m-file with this name already exists, use directory and name for name
2657
               # only the first occurence of name will be used for links
2658
               if (defined $mfile{$name}) {
2659
                  if (! ($name =~ /^contents$/i) ) {
2660
                     print "\r ParseTree - Name conflict:  $name in $dirname already exists: $mfile{$name} !\n";
2661
                     print   "             $mfile{$name}  will be used for links!\n";
2662
                  }
2663
                  $name = $dirname.$name;
2664
               }
2665
               # mfile name with path
2666
               $mfile{$name} = $dirname.$file;
2667
               # mfile name (without path)
2668
               $mfilename{$name} = $filename;
2669
               # mfile directory
2670
               $mfiledir{$name} = $dirname;
2671
2672
               # html file name and full path, special extension of Contents files
2673
               if ($name =~ /contents/i) { $extrahtmlfilename = $dirnamesingle{$dirname}; }
2674
               else { $extrahtmlfilename = ''; }
2675
               $hfile{$name} = $dirhtmlname.$mfilename{$name}.$extrahtmlfilename.$var{'exthtml'};
2676
2677
               # save relative html path
2678
               # if ($var{'producetree'} eq 'yes') {
2679
               $hfilerelpath{$name} = $relpath;
2680
               # } else { # if no tree to produce, relative path is empty
2681
               #    $hfilerelpath{$name} = '';
2682
               # }
2683
2684
               # create relative path from html file to directory with global index file
2685
               $hfileindexpath{$name} = $relpathtoindex;
2686
2687
               # Function declaration, if one exists, set default to script
2688
               $synopsis{$name} = "";
2689
               $mtype{$name} = "script";
2690
2691
               # First comment line
2692
               $apropos{$name} = "";
2693
2694
               # count number of m-files in directories
2695
               $dirnumbermfiles{$dirname}++;
2696
2697
               if ($debug > 1) {
2698
                  if ($opt_silent) { print "\r"; }
2699
                  print "   ParseTree: $name \t\t $mfile{$name} \t\t $hfile{$name}\t\t";
2700
                  if (!$opt_silent) { print "\n"; }
2701
               }
2702
            }
2703
         }
2704
         else {
2705
            print "Unknown type of file in $dirname: $file\n";
2706
         }
2707
      }
2708
      else { print "Error: Not existing file in $dirname: $file\n"; }
2709
   }
2710
2711
   closedir(AKTDIR)
2712
2713
}
2714
2715
#------------------------------------------------------------------------
2716
# Construct Dependency matrix
2717
#    $dep{$x,$y} > 0 if $x includes a reference to $y.
2718
#------------------------------------------------------------------------
2719
sub ConstructDependencyMatrix
2720
{
2721
   &ConstructDependencyMatrixReadFiles('all');
2722
   &ConstructDependencyMatrixReally;
2723
}
2724
2725
2726
#------------------------------------------------------------------------
2727
# Construct Dependency matrix
2728
#    $dep{$x,$y} > 0 if $x includes a reference to $y.
2729
#------------------------------------------------------------------------
2730
sub ConstructDependencyMatrixReadFiles
2731
{
2732
   local($whatstring) = @_;
2733
   local(*MFILE);
2734
   local($name, $inames);
2735
   local(%symbolsdep, %symbolsall);
2736
2737
   # Initialize as all zeros.
2738
   # foreach $name (@names) { grep($dep{$name,$_}=0,@names); if ($debug > 0) { print "\r   DepMatrix anlegen: $name\t$#names\t"; } }
2739
2740
   # Compute the dependency matrix
2741
   $inames = -1;
2742
   foreach $name (@names) {
2743
      # Read each file and tabulate the distinct alphanumeric identifiers in
2744
      # an array of symbols. Also scan for:
2745
      #   synopsis: The function declaration line
2746
      #   apropos:  The first line of the help text
2747
2748
      # look for whatstring, if all: process every file, if contents: process only contents files
2749
      if ($whatstring eq 'contents') { if (! ($name =~ /contents$/i) ) { next; } }
2750
      elsif ($whatstring eq 'all') { }    # do nothing
2751
      else { print "\r   ConstructDependency: Unknown parameter whatstring: $whatstring \n"; }
2752
2753
      undef %symbolsall; undef %symbolsdep;
2754
      open(MFILE,"<$mfile{$name}") || die("Can't open $mfile{$name}: $!\n");
2755
      while (<MFILE>) {
2756
         chop;
2757
2758
         # Split on nonalphanumerics, then look for all words, used for links later
2759
         # this one for all references
2760
         @wordsall = grep(/[a-zA-Z]\w*/, split('\W',$_));
2761
         # set all words to lower case for link checking
2762
         undef @wordsall2;
2763
         # do case conversion not, case checking is done later
2764
         foreach (@wordsall) { push(@wordsall2, "\L$_\E"); }
2765
         # @wordsall2 = @wordsall;
2766
         grep($symbolsall{$_}++, @wordsall2);
2767
2768
         # Store first comment line, skip all others.
2769
         if (/^\s*%/) {
2770
            if (!$apropos{$name}) {
2771
               s/^\s*%\s*//;   # remove % and leading white spaces on line
2772
               $_ = &SubstituteHTMLEntities($_);
2773
               $apropos{$name} = $_;
2774
            }
2775
            next;
2776
         }
2777
2778
         # If it's the function declaration line, then store it and skip
2779
         # but only, when first function definition (multiple function lines when private subfunctions in file
2780
         if ($synopsis{$name} eq '') {
2781
            if (/^\s*function/) {
2782
               s/^\s*function\s*//;
2783
               $synopsis{$name} = $_;
2784
               $mtype{$name} = "function";
2785
               next;
2786
            }
2787
         }
2788
2789
         # Split off any trailing comments
2790
         if ($_ ne '') {
2791
            # this one for references in program code only
2792
            # when syntax parsing, here is a working place
2793
            ($statement) = split('%',$_,1);
2794
            @wordsdep = grep(/[a-zA-Z]\w*/,split('\W',$statement));
2795
            # do case conversion not, case checking is done later
2796
            undef @wordsdep2;
2797
            foreach (@wordsdep) { push(@wordsdep2, "\L$_\E"); }
2798
            grep($symbolsdep{$_}++, @wordsdep2);
2799
         }
2800
      }
2801
      close MFILE;
2802
2803
      # compute intersection between %symbolsall and @linknames
2804
      delete($symbolsall{$name});
2805
      # foreach $localsumall ($symbolsall) {
2806
      #    $localsumall = "\L$localsumall\E";
2807
      # }
2808
      @{'all'.$name} = grep($symbolsall{$_}, @linknames);
2809
2810
      # compute intersection between %symbolsdep and @linknames
2811
      delete($symbolsdep{$name});
2812
      @{'depcalls'.$name} = grep($symbolsdep{$_}, @linknames);
2813
2814
      $inames++; print "\r   DepCallsMatrix: $inames/$#names\t $name\t";
2815
      if ($debug > 2) { print "\n      depnames: @{'depcalls'.$name}\n      all: @{'all'.$name}\n"; }
2816
   }
2817
}
2818
2819
2820
#------------------------------------------------------------------------
2821
# Construct Dependency matrix
2822
#    $dep{$x,$y} > 0 if $x includes a reference to $y.
2823
#------------------------------------------------------------------------
2824
sub ConstructDependencyMatrixReally
2825
{
2826
   local($inames, $name);
2827
2828
   $inames = -1;
2829
   foreach $name (@names) { undef %{'depint'.$name}; }
2830
   foreach $name (@names) {
2831
      grep(${'depint'.$_}{$name}++, @{'depcalls'.$name});
2832
      $inames++; print "\r   DepCalledMatrix1: $inames/$#names\t $name\t";
2833
   }
2834
   $inames = -1;
2835
   foreach $name (@names) {
2836
      # compute intersection between %depint.name{$_} and @linknames
2837
      if (defined (%{'depint'.$name})) { @{'depcalled'.$name} = grep(${'depint'.$name}{$_}, @linknames); }
2838
      $inames++; print "\r   DepCalledMatrix2: $inames/$#names\t $name\t";
2839
      if ($debug > 2) { print "\n      depcalled: @{'depcalled'.$name}\n"; }
2840
   }
2841
2842
}
2843
2844
2845
#========================================================================
2846
# Construct all index files
2847
#========================================================================
2848
sub ConstructAllIndexFiles
2849
{
2850
   local(@localnames);
2851
   local($ActDir);
2852
   local($name);
2853
2854
   # define variables and names for frame target
2855
   $GlobalNameFrameMainLeft = 'Cont_Main';
2856
   $GlobalNameFrameMainRight = 'Cont_Lower';
2857
   $GlobalNameFrameAZIndexsmall = 'IndexAZindex';
2858
   $GlobalNameFrameAZIndexjump = 'IndexAZjump';
2859
2860
   $indexcreated = 0;
2861
2862
   &ConstructHighestIndexFile;
2863
   $indexcreated++;
2864
2865
   # if ($var{'producetree'} eq 'yes') {
2866
      # moved next 2 lines out of if for producetree no
2867
      # &ConstructHighestIndexFile;
2868
      # $indexcreated++;
2869
2870
      foreach $ActDir (@directories) {
2871
         undef @localnames;
2872
         foreach $name (@names) {
2873
            local($pathsubstr) = substr($mfile{$name}, 0, rindex($mfile{$name}, "/")+1);
2874
            if ($ActDir eq $pathsubstr) {
2875
               if ($debug > 1) { print "IndexFile: $pathsubstr    ActDir: $ActDir   Hfilerelpath: $hfilerelpath{$name}\n"; }
2876
               push(@localnames, $name);
2877
            }
2878
         }
2879
         if ($debug > 2) { print "localnames: @localnames\n"; }
2880
         # create contents file and short|long index of files in local directory
2881
         &ConstructContentsmFile($ActDir, @localnames);
2882
         &ConstructAZIndexFile($ActDir, 'short', 'local', @localnames);
2883
         &ConstructAZIndexFile($ActDir, 'long', 'local', @localnames);
2884
         $indexcreated+=2;
2885
      }
2886
   # } else {
2887
   #    &ConstructContentsmFile($var{'dirmfiles'}, @names);
2888
   # }
2889
2890
   # create short|long index of files in all directory
2891
   &ConstructAZIndexFile($var{'dirmfiles'}, 'short', 'global', @names);
2892
   &ConstructAZIndexFile($var{'dirmfiles'}, 'long', 'global', @names);
2893
   $indexcreated+=2;
2894
2895
   # if contents.m were created or updated, the dependency matrices should
2896
   # be updated as well
2897
   if ($var{'writecontentsm'} eq 'yes') { &ConstructDependencyMatrixReadFiles('contents');; }
2898
}
2899
2900
2901
#========================================================================
2902
# Construct the highest level index file
2903
#========================================================================
2904
sub ConstructHighestIndexFile
2905
{
2906
   local(*IFILE);
2907
   local($indexfile, $filename);
2908
2909
   # Build the frame layout file, this files includes the layout of the frames
2910
   # Build the frame layout file name (highest one)
2911
   $indexfile = $var{'dirhtml'}.$var{'filenametopframe'}.$var{'exthtml'};
2912
2913 382:baff1c482d98 Chris
   if ($var{'frames'} eq 'yes') {
2914 381:2dc8163e9150 Chris
2915 382:baff1c482d98 Chris
       open(IFILE,">$indexfile") || die("Cannot open frame layout file $indexfile\n");
2916 381:2dc8163e9150 Chris
2917 382:baff1c482d98 Chris
       # Write the header of frame file
2918
       print IFILE "$TextDocTypeFrame\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n";
2919
       print IFILE "   <title>$var{'texttitleframelayout'}</title>\n";
2920
       print IFILE "</head>\n";
2921 381:2dc8163e9150 Chris
2922 382:baff1c482d98 Chris
       # definition of 2 frames, left the tree of directories,
2923
       # right the index of that directory or the docu of a file
2924
       print IFILE "<frameset  cols=\"25%,75%\">\n";
2925
       print IFILE "   <frame src=\"$var{'filenamedirshort'}$var{'exthtml'}\" name=\"$GlobalNameFrameMainLeft\" />\n";
2926
       print IFILE "   <frame src=\"$var{'filenameindexshortglobal'}$var{'filenameextensionframe'}$var{'exthtml'}\" name=\"$GlobalNameFrameMainRight\" />\n";   print IFILE "</frameset>\n";
2927 381:2dc8163e9150 Chris
2928 382:baff1c482d98 Chris
       print IFILE "</html>\n";
2929
2930
       close(IFILE);
2931
2932
       if ($opt_silent) { print "\r"; }
2933
       print "   Frame layout file created: $indexfile\t";
2934
       if (!$opt_silent) { print "\n"; }
2935
   }
2936 381:2dc8163e9150 Chris
2937
   for($irun=0; $irun <= 2; $irun++) {
2938
      # Build the top directory index file, these files include the directory tree
2939
      # Build the directory tree index file name
2940
2941
      # Create no directory file for contents, when no contents to use
2942
      if (($irun == 2) && ($var{'usecontentsm'} eq 'no')) { next; }
2943
2944
      # Assign the correct index file name
2945
      if ($irun == 0) { $filename = $var{'filenamedirshort'}; }
2946
      elsif ($irun == 1) { $filename = $var{'filenamedirlong'}; }
2947
      elsif ($irun == 2) { $filename = $var{'filenamedircontents'}; }
2948
2949
      $indexfile = $var{'dirhtml'}.$filename.$var{'exthtml'};
2950
2951
      open(IFILE,">$indexfile") || die("Cannot open directory tree index file $indexfile\n");
2952
      # Write header of HTML file
2953
      print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
2954
2955
      if ($var{'texttitleindexalldirs'} eq '') {
2956
         print IFILE "<title>Index of Directories of $var{'dirmfiles'}</title>\n";
2957
      } else {
2958
         print IFILE "<title>$var{'texttitleindexalldirs'}</title>\n";
2959
      }
2960 382:baff1c482d98 Chris
2961
      if ($var{'frames'} eq 'yes') {
2962
	  print IFILE "<base target=\"$GlobalNameFrameMainRight\" />\n";
2963
      }
2964
2965 381:2dc8163e9150 Chris
      print IFILE "</head>\n";
2966
      print IFILE "<body $var{'codebodyindex'}>\n";
2967 410:675de8e6becf chris
      print IFILE "<div id=\"matlabdoc\">\n";
2968 381:2dc8163e9150 Chris
      if ($var{'textheaderindexalldirs'} eq '') {
2969
         print IFILE "<h1 $var{'codeheader'}>Index of Directories of <em>$var{'dirmfiles'}</em></h1>\n";
2970
      } else {
2971
         print IFILE "<h1 $var{'codeheader'}>$var{'textheaderindexalldirs'}</h1>\n";
2972
      }
2973 389:0bc92382a86b chris
      print IFILE "<p>\n";
2974 382:baff1c482d98 Chris
2975
      if ($var{'frames'} eq 'yes') {
2976
	  if ($irun == 0) { print IFILE "<strong>short</strong>\n"; }
2977
	  else { print IFILE "<a href=\"$var{'filenamedirshort'}$var{'exthtml'}\" target=\"$GlobalNameFrameMainLeft\">short</a>\n"; }
2978
	  if ($irun == 1) { print IFILE " | <strong>long</strong>\n"; }
2979
	  else { print IFILE " | <a href=\"$var{'filenamedirlong'}$var{'exthtml'}\" target=\"$GlobalNameFrameMainLeft\">long</a>\n"; }
2980
	  if ($var{'usecontentsm'} eq 'yes') {
2981
	      if ($irun == 2) { print IFILE " | <strong>contents</strong>\n"; }
2982
	      else { print IFILE " | <a href=\"$var{'filenamedircontents'}$var{'exthtml'}\" target=\"$GlobalNameFrameMainLeft\">contents</a>\n"; }
2983
	  }
2984
      } else {
2985
	  if ($irun == 0) { print IFILE "<strong>short</strong>\n"; }
2986
	  else { print IFILE "<a href=\"$var{'filenamedirshort'}$var{'exthtml'}\">short</a>\n"; }
2987
	  if ($irun == 1) { print IFILE " | <strong>long</strong>\n"; }
2988
	  else { print IFILE " | <a href=\"$var{'filenamedirlong'}$var{'exthtml'}\">long</a>\n"; }
2989
	  if ($var{'usecontentsm'} eq 'yes') {
2990
	      if ($irun == 2) { print IFILE " | <strong>contents</strong>\n"; }
2991
	      else { print IFILE " | <a href=\"$var{'filenamedircontents'}$var{'exthtml'}\">contents</a>\n"; }
2992
	  }
2993 381:2dc8163e9150 Chris
      }
2994
2995
      print IFILE "</p><br />\n\n";
2996
      print IFILE "<ul>\n";
2997
2998
      # go through all directories and create a list entry for each one,
2999
      # depending on recursion level create sublists
3000
      $prevrecdeeplevel = 0;
3001
      foreach $name (@alldirectories) {
3002
         $actrecdeeplevel = $dirnamerecdeep{$name};
3003
         for( ; $prevrecdeeplevel < $actrecdeeplevel; $prevrecdeeplevel++ ) { print IFILE "<ul>\n"; }
3004
         for( ; $prevrecdeeplevel > $actrecdeeplevel; $prevrecdeeplevel-- ) { print IFILE "</ul>\n"; }
3005
         if ($irun == 0) { $indexfilenameused = $var{'filenameindexshortlocal'}.$var{'filenameextensionframe'}; }
3006
         elsif ($irun == 1) { $indexfilenameused = $var{'filenameindexlonglocal'}.$var{'filenameextensionframe'}; }
3007
         elsif ($irun == 2) { $indexfilenameused = $contentsname{$name}; }
3008
         else { die "ConstructHighestIndexFile: Unknown value of irun"; }
3009
         if ($dirnumbermfiles{$name} > 0) {
3010
            # producetree no
3011
            # if ($var{'producetree'} eq 'no') { $dirnamehere = ''; }
3012
            # else { $dirnamehere = '$dirnamerelpath{$name}'; }
3013
            # print IFILE "<LI><A HREF=\"$dirnamehere$indexfilenameused_$dirnamesingle{$name}$var{'exthtml'}\">$dirnamesingle{$name}</A>\n";
3014
            print IFILE "<li><a href=\"$dirnamerelpath{$name}$indexfilenameused$dirnamesingle{$name}$var{'exthtml'}\">$dirnamesingle{$name}</a></li>\n";
3015
         } else {
3016
            # print directories with no m-files inside not
3017
            # print IFILE "<li>$dirnamesingle{$name}</li>\n";
3018
         }
3019
      }
3020
      $actrecdeeplevel = 0;
3021
      for( ; $prevrecdeeplevel > $actrecdeeplevel; $prevrecdeeplevel-- ) { print IFILE "</ul>\n"; }
3022
      print IFILE "</ul>\n<br />$var{'codehr'}\n";
3023
3024
      # Include info about author from authorfile
3025
      &WriteFile2Handle($var{'authorfile'}, IFILE);
3026
3027
      print IFILE "<!--navigate-->\n";
3028
      print IFILE "<!--copyright-->\n";
3029 410:675de8e6becf chris
      print IFILE "</div>\n</body>\n</html>\n";
3030 381:2dc8163e9150 Chris
3031
      close(IFILE);
3032
3033
      if ($opt_silent) { print "\r"; }
3034
      print "   Directory - Indexfile created: $indexfile\t";
3035
      if (!$opt_silent) { print "\n"; }
3036
   }
3037
}
3038
3039
3040
#========================================================================
3041
# Construct the A-Z index file (global/local and/or short/long)
3042
#========================================================================
3043
sub ConstructAZIndexFile
3044
{
3045
   local($LocalActDir, $LocalShortLong, $LocalGlobalLocal, @localnames) = @_;
3046
   local(*IFILE);
3047
   local($name, $indexfilename, $dirpath);
3048
   local($firstletter, $firstone);
3049
3050
   if ($debug > 2) { print "localnames in AZ small: @localnames\n"; print "     ActDir in A-Z: $LocalActDir\n"; }
3051
3052
   # extract filename of index file from parameters of function
3053
   if ($LocalShortLong eq 'short') {
3054
      if ($LocalGlobalLocal eq 'global') { $indexfilename = $var{'filenameindexshortglobal'}; }
3055
      elsif ($LocalGlobalLocal eq 'local') { $indexfilename = $var{'filenameindexshortlocal'}; }
3056
      else { die "wrong parameter for LocalGlobalLocal in ConstructAZIndexFile: $LocalGlobalLocal."; }
3057
   } elsif ($LocalShortLong eq 'long') {
3058
      if ($LocalGlobalLocal eq 'global') { $indexfilename = $var{'filenameindexlongglobal'}; }
3059
      elsif ($LocalGlobalLocal eq 'local') { $indexfilename = $var{'filenameindexlonglocal'}; }
3060
      else { die "wrong parameter for LocalGlobalLocal in ConstructAZIndexFile: $LocalGlobalLocal."; }
3061
   } else { die "wrong parameter for LocalShortLong in ConstructAZIndexFile: $LocalShortLong."; }
3062
3063
   # producetree no
3064
   # if ($var{'producetree'} eq 'no') { $dirnamehere = ''; }
3065
   # else { $dirnamehere = '$dirnamerelpath{$LocalActDir}'; }
3066
   # Build the index file name
3067
   # handle the global index file case separately (no extra directory name in file)
3068
   #    the local index file name must be extended by the name of the directory
3069
   if ($LocalGlobalLocal eq 'global') { $extradirfilename = ''; }
3070
   else { $extradirfilename = $dirnamesingle{$LocalActDir}; }
3071
   $indexfile = $var{'dirhtml'}.$dirnamerelpath{$LocalActDir}.$indexfilename.$var{'filenameextensionindex'}.$extradirfilename.$var{'exthtml'};
3072 382:baff1c482d98 Chris
3073 401:a0f6e994657f chris
   if ($LocalShortLong eq 'short' and $extradirfilename eq '' and $var{'frames'} ne 'yes') {
3074
       # With no frames and no subdir path, this must go in the
3075
       # top-level index file instead
3076 382:baff1c482d98 Chris
       $indexfile = $var{'dirhtml'}.$var{'filenametopframe'}.$var{'exthtml'};
3077
   }
3078
3079 381:2dc8163e9150 Chris
   if ($debug > 2) { print "   indexfilename (a-z small): $indexfile\n"; }
3080
3081
   open(IFILE,">$indexfile") || die("Cannot open index file $indexfile: $!\n");
3082
3083
   # Write the header of HTML file
3084
   print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3085
3086 410:675de8e6becf chris
   my $dirToPrint = $LocalActDir;
3087
   $dirToPrint =~ s,^./,,;
3088
3089 381:2dc8163e9150 Chris
   if ($var{'texttitleindex'} eq '') {
3090 410:675de8e6becf chris
      print IFILE "<title>Index of Matlab Files in Directory $dirToPrint</title>\n";
3091 381:2dc8163e9150 Chris
   } else {
3092
      if ($LocalGlobalLocal eq 'global') { print IFILE "<title>$var{'texttitleindex'}</title>\n"; }
3093 410:675de8e6becf chris
      else { print IFILE "<title>$var{'texttitleindex'} in Directory $dirToPrint</title>\n"; }
3094 381:2dc8163e9150 Chris
   }
3095 382:baff1c482d98 Chris
3096
   if ($var{'frames'} eq 'yes') {
3097
       print IFILE "<base target=\"$GlobalNameFrameMainRight\" />\n";
3098
   }
3099 381:2dc8163e9150 Chris
   print IFILE "</head>\n";
3100 382:baff1c482d98 Chris
3101 381:2dc8163e9150 Chris
   print IFILE "<body $var{'codebodyindex'}>\n";
3102 410:675de8e6becf chris
   print IFILE "<div id=\"matlabdoc\">\n";
3103 381:2dc8163e9150 Chris
   if ($var{'textheaderindex'} eq '') {
3104 410:675de8e6becf chris
      print IFILE "<h1 $var{'codeheader'}>Index of Matlab Files in Directory $dirToPrint</h1>\n";
3105 381:2dc8163e9150 Chris
   } else {
3106
      if ($LocalGlobalLocal eq 'global') { print IFILE "<h1 $var{'codeheader'}>$var{'textheaderindex'}</h1>\n"; }
3107 410:675de8e6becf chris
      else { print IFILE "<h1 $var{'codeheader'}>$var{'textheaderindex'} in Directory $dirToPrint</h1>\n"; }
3108 381:2dc8163e9150 Chris
   }
3109
3110
   # include links to indexes
3111
   &ConstructLinks2Index(IFILE, $dirnamerelpathtoindex{$LocalActDir}, $LocalActDir, $LocalGlobalLocal);
3112
3113
   # Collect the starting letters of m files in this directory or all m-files
3114
   for('a'..'z') { undef @{$_}; }
3115
   foreach $name (@localnames) {
3116
      if (! ($mfilename{$name} =~ /contents/i)) {
3117
         $firstletter = substr($mfilename{$name}, 0, 1);
3118
         # convert first letter always to lower case
3119
         # needed for reference to lower and upper case m-files
3120
         $firstletter = "\L$firstletter\E";
3121
         push(@{$firstletter}, $name);
3122
      }
3123
   }
3124
3125
   if ($LocalShortLong eq 'short') {
3126
      # begin create short index
3127
      print IFILE "<table width=\"100%\">\n";
3128
3129
      for('a'..'z') {
3130
         # print "   $_: @{$_}\n";
3131
         $numberofletter = $#{$_}+1;
3132 410:675de8e6becf chris
	 $cols = 3;
3133 381:2dc8163e9150 Chris
         if ($numberofletter > 0) {
3134 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";
3135
            for ($count = 0; $count < $numberofletter; $count++) {
3136
		if (($count % $cols) == 0) {
3137
		    if ($count > 0) {
3138
			print IFILE "</tr><tr>\n";
3139
		    }
3140
		    print IFILE "<tr><td></td>";
3141
		}
3142
		$name = @{$_}[$count];
3143
		if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3144
		print IFILE "<td><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td>";
3145
	    }
3146
3147
	    print IFILE "</tr>\n";
3148
3149
            # $numberhalf = ($numberofletter + 1 - (($numberofletter+1) % 2))/2;
3150
            # if ($debug > 2) { print "   $_: @{$_} \t $numberhalf \t $numberofletter\n"; }
3151
            # for($count = 0; $count < $numberhalf; $count++) {
3152
            #    $name = @{$_}[$count];
3153
            #    if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3154
            #    print IFILE "<tr><td width=\"50%\"><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td>";
3155
            #    if (($count + $numberhalf) < $numberofletter) {
3156
            #       $name = @{$_}[$count + $numberhalf];
3157
            #       if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3158
            #       print IFILE "<td width=\"50%\"><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td></tr>\n";
3159
            #    } else {
3160
            #       print IFILE "<td width=\"50%\"></td></tr>\n";
3161
            #    }
3162
            # }
3163 381:2dc8163e9150 Chris
         }
3164
      }
3165
      print IFILE "</table>\n<br />$var{'codehr'}\n";
3166
3167
   } elsif ($LocalShortLong eq 'long') {
3168
      # begin create long index
3169 410:675de8e6becf chris
      print IFILE "<table width=\"100%\">\n";
3170 401:a0f6e994657f chris
      print IFILE "<tr><th>Name</th><th>Synopsis</th></tr>\n";
3171 381:2dc8163e9150 Chris
3172
      for('a'..'z') {
3173
         # print "   $_: @{$_}\n";
3174
         $numberofletter = $#{$_}+1;
3175
         if ($numberofletter > 0) {
3176
            $firstone = 1;
3177
            foreach $name (@{$_}) {
3178
               if ($debug > 1) { print "   AZinforeach1: $name \t\t $hfilerelpath{$name} \t\t $dirnamerelpath{$LocalActDir}\n"; }
3179
               if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3180
               if (! ($mfilename{$name} =~ /contents/i)) {
3181 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; }
3182 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";
3183
               }
3184
            }
3185
         }
3186
      }
3187
      print IFILE "</table>\n<br />$var{'codehr'}\n";
3188
   } else { die "wrong parameter for LocalShortLong in ConstructAZIndexFile: $LocalShortLong."; }
3189
3190
   # Include info about author from authorfile
3191
   &WriteFile2Handle($var{'authorfile'}, IFILE);
3192
3193
   print IFILE "<!--navigate-->\n";
3194
   print IFILE "<!--copyright-->\n";
3195 410:675de8e6becf chris
   print IFILE "</div>\n</body>\n</html>\n";
3196 381:2dc8163e9150 Chris
3197
   close(IFILE);
3198
3199
   if ($opt_silent) { print "\r"; }
3200
   print "   Indexfile small (A-Z) created: $indexfile\t";
3201
   if (!$opt_silent) { print "\n"; }
3202
3203
3204
   # Build the A-Z jump index file name
3205
   # handle the global index file case separately (no extra directory name in file)
3206
   if ($LocalGlobalLocal eq 'global') { $extradirfilename = ''; }
3207
   else { $extradirfilename = $dirnamesingle{$LocalActDir}; }
3208
3209 382:baff1c482d98 Chris
   if ($var{'frames'} eq 'yes') {
3210
3211
       $indexfile = $var{'dirhtml'}.$dirnamerelpath{$LocalActDir}.$indexfilename.$var{'filenameextensionjump'}.$extradirfilename.$var{'exthtml'};
3212
       if ($debug > 2) { print "   indexfilename (a-z jump): $indexfile\n"; }
3213
       open(IFILE,">$indexfile") || die("Cannot open jump index file $indexfile: $!\n");
3214
3215
       # Write the header of HTML file
3216
       print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3217
3218
       if ($var{'texttitleindex'} eq '') {
3219 410:675de8e6becf chris
	   print IFILE "<title>A-Z jump index in directory $dirToPrint</title>\n";
3220 382:baff1c482d98 Chris
       } else {
3221
	   if ($LocalGlobalLocal eq 'global') { print IFILE "<title>$var{'texttitleindex'}</title>\n"; }
3222 410:675de8e6becf chris
	   else { print IFILE "<title>$var{'texttitleindex'} in Directory $dirToPrint</title>\n"; }
3223 382:baff1c482d98 Chris
       }
3224
3225
       if ($var{'frames'} eq 'yes') {
3226
	   print IFILE "<base target=\"$GlobalNameFrameAZIndexsmall\" />\n";
3227
       }
3228
       print IFILE "</head>\n";
3229
       print IFILE "<body $var{'codebodyindex'}>\n";
3230 410:675de8e6becf chris
       print IFILE "<div id=\"matlabdoc\">\n";
3231 382:baff1c482d98 Chris
3232
       # Write the A-Z jump line, generate link for letters with files starting with this letter
3233
       # and only letters for no files starting with this letter
3234
       # use previously generated arrays with names of files sorted by starting letter
3235
       for('a'..'z') {
3236
	   $numberofletter = $#{$_}+1;
3237
	   if ($numberofletter > 0) {
3238
	       print IFILE "<strong><a href=\"$indexfilename$var{'filenameextensionindex'}$extradirfilename$var{'exthtml'}#\U$_\E$_\">\U$_\E</a> </strong>\n";
3239
	   } else {
3240
	       print IFILE "\U$_\E \n";
3241
	   }
3242
       }
3243
3244 410:675de8e6becf chris
       print IFILE "</div></body>\n</html>\n";
3245 382:baff1c482d98 Chris
3246
       close(IFILE);
3247
3248
       if ($opt_silent) { print "\r"; }
3249
       print "   Indexfile small (A-Z jump) created: $indexfile\t";
3250
       if (!$opt_silent) { print "\n"; }
3251 381:2dc8163e9150 Chris
   }
3252
3253
3254
   # Build the frame layout file, this file includes the layout of the frames
3255
   # Build the frame layout file name (for small/compact A-Z index)
3256
   # handle the global index file case separately (no extra directory name in file)
3257
   if ($LocalGlobalLocal eq 'global') { $extradirfilename = ''; }
3258
   else { $extradirfilename = $dirnamesingle{$LocalActDir}; }
3259
3260 382:baff1c482d98 Chris
   if ($var{'frames'} eq 'yes') {
3261 381:2dc8163e9150 Chris
3262 382:baff1c482d98 Chris
       $indexfile = $var{'dirhtml'}.$dirnamerelpath{$LocalActDir}.$indexfilename.$var{'filenameextensionframe'}.$extradirfilename.$var{'exthtml'};
3263
       if ($debug > 2) { print "   indexfilename (a-z frame): $indexfile\n"; }
3264 381:2dc8163e9150 Chris
3265 382:baff1c482d98 Chris
       open(IFILE,">$indexfile") || die("Cannot open jump index frame file $indexfile: $!\n");
3266
3267
       # Write the header of Frame file
3268
       print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3269
3270
       if ($var{'texttitleindex'} eq '') {
3271 410:675de8e6becf chris
	   print IFILE "<title>Index of Matlab Files in Directory $dirToPrint</title>\n";
3272 382:baff1c482d98 Chris
       } else {
3273
	   if ($LocalGlobalLocal eq 'global') { print IFILE "<title>$var{'texttitleindex'}</title>\n"; }
3274 410:675de8e6becf chris
	   else { print IFILE "<title>$var{'texttitleindex'} in Directory $dirToPrint</title>\n"; }
3275 382:baff1c482d98 Chris
       }
3276
       print IFILE "</head>\n";
3277
3278
       # definition of 2 frames, top the A-Z index, below the jump letter line
3279
       print IFILE "<frameset  rows=\"90%,10%\">\n";
3280
       print IFILE "   <frame src=\"$indexfilename$var{'filenameextensionindex'}$extradirfilename$var{'exthtml'}\" name=\"$GlobalNameFrameAZIndexsmall\" />\n";
3281
       print IFILE "   <frame src=\"$indexfilename$var{'filenameextensionjump'}$extradirfilename$var{'exthtml'}\" name=\"$GlobalNameFrameAZIndexjump\" />\n";
3282
       print IFILE "</frameset>\n";
3283
3284
       print IFILE "</html>\n";
3285
3286
       close(IFILE);
3287
3288
       if ($opt_silent) { print "\r"; }
3289
       print "   Frame layout file created: $indexfile\t";
3290
       if (!$opt_silent) { print "\n"; }
3291 381:2dc8163e9150 Chris
   }
3292
}
3293 382:baff1c482d98 Chris
3294 381:2dc8163e9150 Chris
3295
#========================================================================
3296
# Construct the links to all indexes
3297
#========================================================================
3298
sub ConstructLinks2Index
3299
{
3300
   local(*WRITEFILE, $LocalPath2Index, $PathContents, $LocalGlobalLocal) = @_;
3301
3302
   # include links to short/long - local/global index and C|contents.m
3303 389:0bc92382a86b chris
   print WRITEFILE "\n<p>";
3304
   print WRITEFILE "$var{'textjumpindexglobal'} ";
3305 382:baff1c482d98 Chris
3306
   if ($var{'frames'} eq 'yes') {
3307
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenameindexshortglobal'}$var{'filenameextensionframe'}$var{'exthtml'}\">short</a> | ";
3308 389:0bc92382a86b chris
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenameindexlongglobal'}$var{'filenameextensionframe'}$var{'exthtml'}\">long</a>\n";
3309 382:baff1c482d98 Chris
   } else {
3310 387:f89765996ef9 Chris
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenametopframe'}$var{'exthtml'}\">short</a> | ";
3311 389:0bc92382a86b chris
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenameindexlongglobal'}$var{'filenameextensionindex'}$var{'exthtml'}\">long</a>\n";
3312 382:baff1c482d98 Chris
   }
3313
3314 381:2dc8163e9150 Chris
   if ($LocalGlobalLocal eq 'local') {
3315
      if ($var{'usecontentsm'} eq 'yes') {
3316
         print WRITEFILE " | <a href=\"$contentsname{$PathContents}$dirnamesingle{$PathContents}$var{'exthtml'}\">Local contents</a>\n";
3317
      }
3318 389:0bc92382a86b chris
      if ($var{'frames'} eq 'yes') {
3319
         print WRITEFILE " | $var{'textjumpindexlocal'} ";
3320 382:baff1c482d98 Chris
         print WRITEFILE "<a href=\"$var{'filenameindexshortlocal'}$var{'filenameextensionframe'}$dirnamesingle{$PathContents}$var{'exthtml'}\">short</a> | ";
3321 389:0bc92382a86b chris
         print WRITEFILE "<a href=\"$var{'filenameindexlonglocal'}$var{'filenameextensionframe'}$dirnamesingle{$PathContents}$var{'exthtml'}\">long</a>\n";
3322
      } else {
3323
         print WRITEFILE " | $var{'textjumpindexlocal'} ";
3324
         print WRITEFILE "<a href=\"$var{'filenameindexshortlocal'}$var{'filenameextensionindex'}$dirnamesingle{$PathContents}$var{'exthtml'}\">short</a> | ";
3325
         print WRITEFILE "<a href=\"$var{'filenameindexlonglocal'}$var{'filenameextensionindex'}$dirnamesingle{$PathContents}$var{'exthtml'}\">long</a>\n";
3326
      }
3327 381:2dc8163e9150 Chris
   }
3328
   print WRITEFILE "</p>\n\n";
3329
   print WRITEFILE "$var{'codehr'}\n";
3330
}
3331
3332
3333
#========================================================================
3334
# Construct the contents.m files or update
3335
#========================================================================
3336
sub ConstructContentsmFile
3337
{
3338
   local($LocalActDir, @localnames) = @_;
3339
   local(*CFILE, $name,$newline);
3340
   local($contentsfile, $isincontentsonly);
3341
   local(@lines, @autoaddlines, @emptylines);
3342
   local($autoadd) = 'AutoAdd';
3343
   local($autoaddsection) = 0;
3344
   local($emptylineflag) = 0;
3345
   local(%nameincontents);
3346
3347
   # Build the contents file name
3348
   $contentsfile = $LocalActDir.$contentsname{$LocalActDir}.$suffix;
3349
3350
   if (-e $contentsfile) {
3351
      open(CFILE,"<$contentsfile") || die("Cannot open contents file $contentsfile: $!\n");
3352
      while (<CFILE>) {
3353
         # Search for the specified string pattern
3354
         @words = split;
3355
         if ((@words >= 3) && ($words[2] eq '-')) {
3356
            $isincontentsonly = 0;
3357
            foreach $name (@localnames) {
3358
               if ($name eq $words[1]) {    # old
3359
               # if ($mfilename{$name} eq $words[1]) {
3360
                  $isincontentsonly = 1;
3361
                  $nameincontents{$name} = 1;
3362
                  $newline = sprintf("%% %-13s - %s\n", $mfilename{$name}, $apropos{$name});
3363
                  push(@lines, $newline);
3364
               }
3365
            }
3366
            # issue a warning, if file is in contents, but not as file in the directory
3367
            if ($isincontentsonly == 0) {
3368
               print "\rConstructContents: Obsolete entry  $words[1]  in  $contentsfile ! Entry not used.\n";
3369
            }
3370
         } else {
3371
            # look for the AutoAdd section, should be the second word
3372
            if ((@words >= 2) && ($words[1] eq $autoadd)) { $autoaddsection = 1; }
3373
            # push the red line in an array
3374
            push(@lines, $_);
3375
         }
3376
      }
3377
      close(CFILE);
3378
   } else {
3379
      $newline = "% MATLAB Files in directory  $LocalActDir\n%\n";
3380
      push(@lines, $newline);
3381
3382
   }
3383
3384
   # collect the file names, that were not included in original C|contents.m
3385
   foreach $name (@localnames) {
3386
      if (! defined $nameincontents{$name}) {
3387
         if (! ($mfilename{$name} =~ /contents/i)) {
3388
            $newline = sprintf("%% %-13s - %s\n", $mfilename{$name}, $apropos{$name});
3389
            push(@autoaddlines, $newline);
3390
         }
3391
      }
3392
   }
3393
3394
   # write/update C|contents.m only if variable is set
3395
   if ($var{'writecontentsm'} eq 'yes') {
3396
      unlink($contentsfile);
3397
      open(CFILE,">$contentsfile") || die("Cannot open contents file $contentsfile: $!\n");
3398
      # write old C|contents.m or header of new file, as long as comment lines
3399
      foreach $line (@lines) {
3400
         if ($emptylineflag == 0) {
3401
            if ($line =~ /^\s*%/) { print CFILE $line; }
3402
            else { $emptylineflag = 1; push(@emptylines, $line); }
3403
         } else { push(@emptylines, $line); }
3404
      }
3405
      # add header of AutoAdd section
3406
      if (($autoaddsection == 0) && (@autoaddlines > 0)) { print CFILE "%\n% $autoadd\n"; }
3407
      # add autoadd section lines (previously undocumented files
3408
      foreach $line (@autoaddlines) { print CFILE $line; }
3409
      # add tail of original C|contents.m (everything behind first non-comment line)
3410
      foreach $line (@emptylines)   { print CFILE $line; }
3411
      print CFILE "\n";
3412
      close CFILE;
3413
      if ($opt_silent) { print "\r"; }
3414
      print "   Contents file created/updated: $contentsfile\t";
3415
      if (!$opt_silent) { print "\n"; }
3416
   }
3417
}
3418
3419
3420
#========================================================================
3421
# Replace found special characters with their HTMl Entities
3422
#========================================================================
3423
sub SubstituteHTMLEntities {
3424
   local($_) = @_;
3425
3426
   # Replace & <-> &amp;  < <-> &lt;  > <-> &gt;  " <-> &quot;
3427
   s/&/&amp;/g; s/\</&lt;/g; s/\>/&gt;/g; s/\"/&quot;/g;
3428
   return $_;
3429
}
3430
3431
#========================================================================
3432
# Replace found m-filenamestring with full link.
3433
#========================================================================
3434
sub SubstituteName2Link {
3435
   local($_, $funname) = @_;
3436
   local($refstr1, $refstr2, $reffound);
3437
3438
   # Look for something matching in the line
3439
   if ( /(\W+)($funname)(\W+)/i ) {
3440
      $reffound = $2;
3441 388:dad587ecb8d0 chris
      $refstr1 = "<a class=\"mfun\" href=\"$hfileindexpath{$name}$hfilerelpath{$funname}$mfilename{$funname}$var{'exthtml'}\">";
3442 381:2dc8163e9150 Chris
      $refstr2 = "<\/a>";
3443
      # Do links only for exact case match
3444
      if ( ($var{'links2filescase'}  eq 'exact') || ($var{'links2filescase'}  eq 'exactvery') ) {
3445
         if ( /(\W+)($funname)(\W+)/g ) {
3446
            s/(\W+)($funname)(\W+)/$1$refstr1$funname$refstr2$3/g;
3447
         }
3448
         else {
3449
            # Print info for not matching case in references, good for check up of files
3450
            if ( ($var{'links2filescase'}  eq 'exactvery') ) {
3451
               print "Diff in case found: $funname  (case of file name)   <->  $reffound  (case in source code)\n";
3452
               print "     (source line)  $_ \n";
3453
            }
3454
         }
3455
      }
3456
      # Do links for exact match and additionally for all upper case (often used in original matlab help text)
3457
      elsif ( ($var{'links2filescase'}  eq 'exactupper') ) {
3458
         s/(\W+)($funname)(\W+)/$1$refstr1$2$refstr2$3/g;
3459
         $funname2 = "\U$funname\E";
3460
         s/(\W+)($funname2)(\W+)/$1$refstr1$2$refstr2$3/g;
3461
      }
3462
      # Do links for all case mixes, this calls for trouble under LINUX/UNIX
3463
      else {  #elsif ( ($var{'links2filescase'}  eq 'all') )
3464
         s/(\W+)($funname)(\W+)/$1$refstr1$2$refstr2$3/ig;
3465
      }
3466
   }
3467
3468
   return $_;
3469
}
3470
3471
#========================================================================
3472
# Construct the html files for each matlab file.
3473
#    Need to reread each matlab file to find the help text.
3474
#    Note that we can't do this in a single loop because sometimes
3475
#    the help text maybe before the function declaration.
3476
#========================================================================
3477
sub ConstructHTMLFiles
3478
{
3479
   local(*MFILE);
3480
   local(*HFILE);
3481
3482
   local($filescreated) = 0;
3483
   local($functionline);
3484
3485
   foreach $name (@names) {
3486
      # Create cross reference information already here, used for keywords as well
3487
      # Construct list of referenced functions
3488
      @xref = @{'depcalls'.$name};    # the functions, that this m-file calls
3489
      @yref = @{'depcalled'.$name};   # the functions, that this m-file is called from
3490
      # print "   depcalls: @{'depcalls'.$name}\n   depcalled: @{'depcalled'.$name}\n";
3491
      # foreach $cname (@names) { next if $cname eq $name; push(@yref,$cname) if grep(/$name/,@{'depcalls'.$cname}); }
3492
3493
3494
      # Open m-file and html-file
3495
      open(MFILE,"<$mfile{$name}");
3496
      open(HFILE,">$hfile{$name}");
3497
3498
      # Write the header of HTML file
3499
      print HFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3500
3501
      # Write meta tags: use apropos (one line function description) for description
3502
      # and cross reference function names for keywords (any better ideas?)
3503
      print HFILE "<meta name=\"description\" content=\" $apropos{$name} \" />\n";
3504
      print HFILE "<meta name=\"keywords\" content=\" @xref @yref \" />\n";
3505
3506
      # Write Title and start body of html-file
3507
      print HFILE "<title>$var{'texttitlefiles'} $mfilename{$name}</title>\n</head>\n";
3508
      print HFILE "<body $var{'codebodyfiles'}>\n";
3509 410:675de8e6becf chris
      print HFILE "<div id=\"matlabdoc\">\n";
3510 381:2dc8163e9150 Chris
      print HFILE "<h1 $var{'codeheader'}>$var{'textheaderfiles'} $mfilename{$name}</h1>\n";
3511 401:a0f6e994657f chris
3512
# http://test.soundsoftware.ac.uk/cannam/projects/smallbox/repository/annotate/DL/RLS-DLA/SolveFISTA.m
3513 410:675de8e6becf chris
#      print HFILE "<a href=\"" . $hfileindexpath{$name} . "../../projects/smallbox/repository/annotate/" . $mfiledir{$name}  . $mfilename{$name} . ".m\">View in repository</a>\n";
3514 401:a0f6e994657f chris
3515 381:2dc8163e9150 Chris
      print HFILE "$var{'codehr'}\n";
3516
3517
      # include links to short/long - local/global index and C|contents.m
3518
      &ConstructLinks2Index(HFILE, $hfileindexpath{$name}, $mfiledir{$name}, 'local');
3519
3520
      # If this is a function, then write out the first line as a synopsis
3521
      if ($mtype{$name} eq "function") {
3522
         print HFILE "<h2 $var{'codeheader'}>Function Synopsis</h2>\n";
3523
         print HFILE "<pre>$synopsis{$name}</pre>\n$var{'codehr'}\n";
3524
      }
3525
3526
      # Look for the matlab help text block
3527
      $functionline = "\n";
3528
      do {
3529
         $_ = <MFILE>;
3530
         # remember functionline, if before help text block
3531
         if (/^\s*function/) { $functionline = $_; }
3532
      } until (/^\s*%/ || eof);
3533
      if (! (eof(MFILE))) {
3534
         print HFILE "<h2 $var{'codeheader'}>Help text</h2>\n";
3535
         print HFILE "<pre>\n";
3536
         while (/^\s*%/) {
3537
            # First remove leading % and white space, then Substitute special characlers
3538
            s/^\s*%//;
3539
            $_ = &SubstituteHTMLEntities($_);
3540
3541
            # check/create cross references
3542
            foreach $funname (@{'all'.$name}) {
3543
               if ($funname =~ /simulink/) { print "\n Simulink - Filename: $name;  scanname: $funname\n"; }
3544
               next if $funname eq $name;
3545
               $_ = &SubstituteName2Link($_, $funname);
3546
            }
3547
            print HFILE $_;
3548
            if (! eof) { $_ = <MFILE>; }
3549
         }
3550
         print HFILE "</pre>\n$var{'codehr'}\n";
3551
      }
3552
3553
      # Write the cross reference information
3554
      if (@xref || @yref) {
3555
         print HFILE "<h2 $var{'codeheader'}>Cross-Reference Information</H2>\n";
3556
         print HFILE "<table border=\"0\" width=\"100%\">\n<tr align=\"left\">\n<th width=\"50%\">";
3557
         if (@xref) {
3558
            print HFILE "This $mtype{$name} calls";
3559
         }
3560
         print HFILE "</th>\n<th width=\"50%\">";
3561
         if (@yref) {
3562
            print HFILE "This $mtype{$name} is called by";
3563
         }
3564
         print HFILE "</th>\n</tr>\n<tr valign=\"top\"><td>";
3565
         if (@xref) {
3566
            print HFILE "\n<ul>\n";
3567
            foreach $cname (sort @xref) {
3568
               print HFILE "<li><a class=\"mfun\" href=\"$hfileindexpath{$name}$hfilerelpath{$cname}$mfilename{$cname}$var{'exthtml'}\">$mfilename{$cname}</a></li>\n";
3569
            }
3570
            print HFILE "</ul>\n";
3571
         }
3572
         print HFILE "</td><td>";
3573
         if (@yref) {
3574
            print HFILE "\n<ul>\n";
3575
            foreach $cname (sort @yref) {
3576
               print HFILE "<li><a class=\"mfun\" href=\"$hfileindexpath{$name}$hfilerelpath{$cname}$mfilename{$cname}$var{'exthtml'}\">$mfilename{$cname}</a></li>\n";
3577
            }
3578
            print HFILE "</ul>\n";
3579
         }
3580
         print HFILE "</td>\n</tr>\n</table>\n";
3581
         print HFILE "$var{'codehr'}\n";
3582
      }
3583
3584
      # Include source text if requested
3585
      if (($var{'includesource'} eq 'yes') && (! ($mfilename{$name} =~ /^contents$/i))) {
3586
         print HFILE "<h2 $var{'codeheader'}>Listing of $mtype{$name} $mfilename{$name}</h2>\n";
3587
         seek(MFILE,0,0);
3588
         print HFILE "<pre>\n";
3589
         $IsStillHelp = 2;
3590
         print HFILE $functionline;    # functionline from scanning of help
3591
         while (<MFILE>) {
3592
            if ($IsStillHelp == 2) {
3593
               next     if (/^\s*$/);
3594
               next     if (/^\s*function/);
3595
               if (/^\s*%/) { $IsStillHelp = 1; next; }
3596
            } elsif ($IsStillHelp == 1) {
3597
               next     if (/^\s*%/);
3598
               $IsStillHelp = 0;
3599
            }
3600
3601
            # Substritute special characters
3602
            $_ = &SubstituteHTMLEntities($_);
3603
3604
            # check for comment in line and format with css em
3605 400:4ad6499d7998 chris
            s/^(.*)%(.*?)([\s\r\n]+)$/$1<em class=\"mcom\">%$2<\/em>$3/;
3606 381:2dc8163e9150 Chris
3607
            # check/create cross references
3608
            foreach $funname (@{'all'.$name}) {
3609
               next if $funname eq $name;
3610
               $_ = &SubstituteName2Link($_, $funname);
3611
            }
3612
            print HFILE $_;
3613
         }
3614
         print HFILE "</pre>\n$var{'codehr'}\n";
3615
      }
3616
3617
      # Include info about author from authorfile
3618
      &WriteFile2Handle($var{'authorfile'}, HFILE)   ;
3619
3620
      print HFILE "<!--navigate-->\n";
3621
      print HFILE "<!--copyright-->\n";
3622 410:675de8e6becf chris
      print HFILE "</div>\n</body>\n</html>\n";
3623 381:2dc8163e9150 Chris
      close(MFILE);
3624
      close(HFILE);
3625
3626
      # Print name of finished file
3627
      if ($opt_silent) { print "\r"; }
3628
      print "   HTML-File created: $hfile{$name}\t";
3629
      if (!$opt_silent) { print "\n"; }
3630
      $filescreated++;
3631
   }
3632
3633
   print "\n$PROGRAM: $indexcreated index and $filescreated files created.\n";
3634
}
3635
3636
#========================================================================
3637
# Function:	CheckFileName
3638
# Purpose:	.
3639
#========================================================================
3640
sub CheckFileName {
3641
   local($filename, $description) = @_;
3642
   local(*CHECKFILE);
3643
3644
   open(CHECKFILE,"<$filename") || do {
3645
      if ($description eq '') {$description = 'file';}
3646
      # if (!$opt_silent) { print "Cannot open $description $filename: $!\n"; }
3647
      print "Cannot open $description $filename: $!\n";
3648
      return 1;
3649
   };
3650
   close(CHECKFILE);
3651
   return 0;
3652
3653
}
3654
3655
#========================================================================
3656
# Function:	CheckDirName
3657
# Purpose:	.
3658
#========================================================================
3659
sub CheckDirName {
3660
   local($dirname, $description) = @_;
3661
   local(*CHECKDIR);
3662
3663
   opendir(CHECKDIR,"$dirname") || die ("Cannot open $description directory $dirname: $!\n");
3664
   closedir(CHECKDIR);
3665
}
3666
3667
#========================================================================
3668
# Function:	WriteFile2Handle
3669
# Purpose:	.
3670
#========================================================================
3671
sub WriteFile2Handle {
3672
   local($filename, *WRITEFILE) = @_;
3673
   local(*READFILE);
3674
3675
   if ($filename ne '') {
3676
      open(READFILE,"<$filename");
3677
      @filecontents = <READFILE>;
3678
      close(READFILE);
3679
      print WRITEFILE "@filecontents\n";
3680
      # if (!$opt_silent) {print "      Contents of $filename added\n"};
3681
   }
3682
}
3683
3684
3685
#========================================================================
3686
# Function:	GetConfigFile
3687
# Purpose:	Read user's configuration file, if such exists.
3688
#========================================================================
3689
sub GetConfigFile
3690
{
3691
   local($filename) = @_;
3692
   local(*CONFIG);
3693
   local($value);
3694
3695
   if (&CheckFileName($filename, 'configuration file')) {
3696
      # if (!$opt_silent) { print "   Proceeding using built-in defaults for configuration.\n"; }
3697
      print "   Proceeding using built-in defaults for configuration.\n";
3698
      return 0;
3699
   };
3700
3701
   open(CONFIG,"< $filename");
3702
   while (<CONFIG>) {
3703
      s/#.*$//;
3704
      next if /^\s*$/o;
3705
3706
      # match keyword: process one or more arguments
3707
      # keyword set
3708
      if (/^\s*set\s+(\S+)\s*=\s*(.*)/) {
3709
         # setting a configuration variable
3710
         if (defined $var{$1}) {
3711
            $var{$1} = $2;
3712
            if ($debug > 3) { print "$1:   $var{$1}\n"; }
3713
         }
3714
         else {
3715
            print "$PROGRAM: unknown variable `$1' in configuration file\n"
3716
         }
3717
      } else {
3718
         chop($_);
3719
         print "$PROGRAM: unknown keyword in configuration file in line: `$_'\n"
3720
      }
3721
   }
3722
   close CONFIG;
3723
   1;
3724
}
3725
3726
3727
#------------------------------------------------------------------------
3728
# DisplayHelp - display help text using -h or -help command-line switch
3729
#------------------------------------------------------------------------
3730
sub DisplayHelp
3731
{
3732
   $help=<<EofHelp;
3733
   $PROGRAM v$VERSION - generate html documentation from Matlab m-files
3734
3735
   Usage: $PROGRAM [-h] [-c config_file] [-m|dirmfiles matlab_dir] [-d|dirhtml html_dir]
3736
                   [-i yes|no] [-r yes|no] [-p yes|no] [-quiet|q] [-a authorfile]
3737
3738
   $PROGRAM is a perl script that reads each matlab .m file in a directory
3739
   to produce a corresponding .html file of help documentation and cross
3740
   reference information. An index file is written with links to all of
3741
   the html files produced. The options are:
3742
3743
      -quiet         or -q : be silent, no status information during generation
3744
      -help          or -h : display this help message
3745
      -todo          or -t : print the todo list for $PROGRAM
3746
      -version       or -v : display version
3747
3748
      -configfile    or -c : name of configuration file (default to $var{'configfile'}).
3749
      -dirmfiles     or -m : top level directory containing matlab files to generate html for;
3750
                             default to actual directory.
3751
      -dirhtml       or -d : top level directory for generated html files;
3752
                             default to actual directory.
3753
3754
      -includesource or -i : Include matlab source in the html documentation [yes|no]
3755
                             default to yes.
3756
      -processtree   or -r : create docu for m-file directory and all subdirectories [yes|no];
3757
                             default to yes.
3758
      -producetree   or -p : create multi-level docu identical to directory structure
3759
                             of m-files [yes|no]; default to yes.
3760
      -writecontentsm or -w: update or write contents.m files into the matlab source
3761
                             directories [yes|no]; default to no.
3762
3763
      -authorfile    or -a : name of file including author information, last element in html;
3764
                             default to empty.
3765
3766
   The command line setting overwrite all other settings (built-in and configuration file).
3767
   The configuration file settings overwrite the built-in settings (and not the command
3768
   line settings).
3769
3770
   Typical usages are:
3771
     $PROGRAM
3772
        (use default parameters from perl script, if configuration
3773
         file is found -> generation of docu, else display of help)
3774
3775
     $PROGRAM -dirmfiles matlab -dirhtml html
3776
        (generate html documentation for all m-files in directory matlab,
3777
         place html files in directory html, use built-in defaults for
3778
         all other parameters, this way all m-files in the directory
3779
         matlab and below are converted and the generated html-files are
3780
         placed in the directory html and below producing the same
3781
         directory structure than below matlab)
3782
3783
     $PROGRAM -quiet
3784
        (use built-in parameters from perl script, if configuration
3785
         file is found use these settings as well, do generation,
3786
         no display except critical errors, status of conversion and result)
3787
3788
     $PROGRAM -m toolbox -dirhtml doc/html -r yes -p no
3789
        (convert all m-files in directory toolbox and below and place
3790
         the generated html files in directory doc/html, read all m-files
3791
         recursively, however, the generated html files are placed in one
3792
         directory)
3793
3794
     $PROGRAM -m toolbox -dirhtml doc/html -i no -r no
3795
        (convert all m-files in directory toolbox and place
3796
         the generated html files in directory doc/html, do not read m-files
3797
         recursively, do not include source code in documentation)
3798
3799
EofHelp
3800
3801
   die "$help";
3802
}
3803
3804
#------------------------------------------------------------------------
3805
# DisplayTodo - display ToDo list using -t or -todo command-line switch
3806
#------------------------------------------------------------------------
3807
sub DisplayTodo
3808
{
3809
   $todo=<<EofToDo;
3810
      $PROGRAM v$VERSION - ToDo list
3811
3812
       o	use more than one high level directory
3813
3814
       o	what should/could be done here???
3815
3816
EofToDo
3817
3818
   die "$todo";
3819
}
3820
3821
3822
#------------------------------------------------------------------------
3823
# ListVariables - list all defined variables and their values
3824
#------------------------------------------------------------------------
3825
sub ListVariables
3826
{
3827
   local($value);
3828
3829
   if ($debug > 0) {
3830
      print "List of all variables and their values\n";
3831
      foreach (sort keys %var)
3832
      {
3833
         if ($var{$_} eq '') {
3834
            $value = "empty";
3835
         } else {
3836
            $value = $var{$_};
3837
         }
3838
         print "   $_\n      $value\n";
3839
      }
3840
      print "\n\n";
3841
   }
3842
}
3843
3844
3845
__END__
3846
:endofperl
3847 0:513646585e45 Chris
#!/usr/bin/env ruby
3848
3849
# == Synopsis
3850
#
3851
# reposman: manages your repositories with Redmine
3852
#
3853
# == Usage
3854
#
3855
#    reposman [OPTIONS...] -s [DIR] -r [HOST]
3856 441:cbce1fd3b1b7 Chris
#
3857 0:513646585e45 Chris
#  Examples:
3858 241:7658d21a1493 chris
#    reposman --scm-dir=/var/svn --redmine-host=redmine.example.net --scm subversion
3859 0:513646585e45 Chris
#    reposman -s /var/git -r redmine.example.net -u http://svn.example.net --scm git
3860
#
3861
# == Arguments (mandatory)
3862
#
3863 241:7658d21a1493 chris
#   -s, --scm-dir=DIR         use DIR as base directory for repositories
3864 0:513646585e45 Chris
#   -r, --redmine-host=HOST   assume Redmine is hosted on HOST. Examples:
3865
#                             -r redmine.example.net
3866
#                             -r http://redmine.example.net
3867
#                             -r https://example.net/redmine
3868 909:cbb26bc654de Chris
#   -k, --key=KEY             use KEY as the Redmine API key (you can use the
3869
#                             --key-file option as an alternative)
3870 0:513646585e45 Chris
#
3871
# == Options
3872
#
3873
#   -o, --owner=OWNER         owner of the repository. using the rails login
3874
#                             allow user to browse the repository within
3875
#                             Redmine even for private project. If you want to
3876
#                             share repositories through Redmine.pm, you need
3877
#                             to use the apache owner.
3878
#   -g, --group=GROUP         group of the repository. (default: root)
3879
#   --scm=SCM                 the kind of SCM repository you want to create (and
3880
#                             register) in Redmine (default: Subversion).
3881
#                             reposman is able to create Git and Subversion
3882
#                             repositories. For all other kind, you must specify
3883
#                             a --command option
3884
#   -u, --url=URL             the base url Redmine will use to access your
3885
#                             repositories. This option is used to automatically
3886
#                             register the repositories in Redmine. The project
3887
#                             identifier will be appended to this url. Examples:
3888
#                             -u https://example.net/svn
3889
#                             -u file:///var/svn/
3890 28:12420e46bed9 chris
#                             if this option isn't set, reposman will register
3891
#                             the repositories with local file paths in Redmine
3892 0:513646585e45 Chris
#   -c, --command=COMMAND     use this command instead of "svnadmin create" to
3893
#                             create a repository. This option can be used to
3894
#                             create repositories other than subversion and git
3895
#                             kind.
3896
#                             This command override the default creation for git
3897
#                             and subversion.
3898 13:80433603a2cd Chris
#   --http-user=USER          User for HTTP Basic authentication with Redmine WS
3899
#   --http-pass=PASSWORD      Password for Basic authentication with Redmine WS
3900 909:cbb26bc654de Chris
#       --key-file=PATH       path to a file that contains the Redmine API key
3901
#                             (use this option instead of --key if you don't
3902
#                             the key to appear in the command line)
3903 0:513646585e45 Chris
#   -t, --test                only show what should be done
3904
#   -h, --help                show help and exit
3905
#   -v, --verbose             verbose
3906
#   -V, --version             print version and exit
3907
#   -q, --quiet               no log
3908
#
3909
# == References
3910 441:cbce1fd3b1b7 Chris
#
3911 0:513646585e45 Chris
# You can find more information on the redmine's wiki : http://www.redmine.org/wiki/redmine/HowTos
3912
3913
3914
require 'getoptlong'
3915 1332:1d1cb01c0417 Chris
#require 'rdoc/usage'
3916 0:513646585e45 Chris
require 'find'
3917
require 'etc'
3918
3919
Version = "1.3"
3920
SUPPORTED_SCM = %w( Subversion Darcs Mercurial Bazaar Git Filesystem )
3921
3922
opts = GetoptLong.new(
3923 241:7658d21a1493 chris
                      ['--scm-dir',      '-s', GetoptLong::REQUIRED_ARGUMENT],
3924 0:513646585e45 Chris
                      ['--redmine-host', '-r', GetoptLong::REQUIRED_ARGUMENT],
3925
                      ['--key',          '-k', GetoptLong::REQUIRED_ARGUMENT],
3926 909:cbb26bc654de Chris
                      ['--key-file',           GetoptLong::REQUIRED_ARGUMENT],
3927 0:513646585e45 Chris
                      ['--owner',        '-o', GetoptLong::REQUIRED_ARGUMENT],
3928
                      ['--group',        '-g', GetoptLong::REQUIRED_ARGUMENT],
3929
                      ['--url',          '-u', GetoptLong::REQUIRED_ARGUMENT],
3930
                      ['--command' ,     '-c', GetoptLong::REQUIRED_ARGUMENT],
3931
                      ['--scm',                GetoptLong::REQUIRED_ARGUMENT],
3932 13:80433603a2cd Chris
                      ['--http-user',          GetoptLong::REQUIRED_ARGUMENT],
3933
                      ['--http-pass',          GetoptLong::REQUIRED_ARGUMENT],
3934 0:513646585e45 Chris
                      ['--test',         '-t', GetoptLong::NO_ARGUMENT],
3935
                      ['--verbose',      '-v', GetoptLong::NO_ARGUMENT],
3936
                      ['--version',      '-V', GetoptLong::NO_ARGUMENT],
3937
                      ['--help'   ,      '-h', GetoptLong::NO_ARGUMENT],
3938
                      ['--quiet'  ,      '-q', GetoptLong::NO_ARGUMENT]
3939
                      )
3940
3941
$verbose      = 0
3942
$quiet        = false
3943
$redmine_host = ''
3944
$repos_base   = ''
3945 13:80433603a2cd Chris
$http_user    = ''
3946
$http_pass    = ''
3947 0:513646585e45 Chris
$svn_owner    = 'root'
3948
$svn_group    = 'root'
3949
$use_groupid  = true
3950
$svn_url      = false
3951
$test         = false
3952
$scm          = 'Subversion'
3953
3954
def log(text, options={})
3955
  level = options[:level] || 0
3956
  puts text unless $quiet or level > $verbose
3957
  exit 1 if options[:exit]
3958
end
3959
3960
def system_or_raise(command)
3961
  raise "\"#{command}\" failed" unless system command
3962
end
3963
3964 1332:1d1cb01c0417 Chris
def usage
3965
  puts "See source code for supported options"
3966
  exit
3967
end
3968
3969 0:513646585e45 Chris
module SCM
3970
3971
  module Subversion
3972
    def self.create(path)
3973
      system_or_raise "svnadmin create #{path}"
3974
    end
3975
  end
3976
3977
  module Git
3978
    def self.create(path)
3979
      Dir.mkdir path
3980
      Dir.chdir(path) do
3981
        system_or_raise "git --bare init --shared"
3982
        system_or_raise "git update-server-info"
3983
      end
3984
    end
3985
  end
3986
3987
end
3988
3989
begin
3990
  opts.each do |opt, arg|
3991
    case opt
3992 241:7658d21a1493 chris
    when '--scm-dir';        $repos_base   = arg.dup
3993 0:513646585e45 Chris
    when '--redmine-host';   $redmine_host = arg.dup
3994
    when '--key';            $api_key      = arg.dup
3995 909:cbb26bc654de Chris
    when '--key-file'
3996
      begin
3997
        $api_key = File.read(arg).strip
3998
      rescue Exception => e
3999
        $stderr.puts "Unable to read the key from #{arg}: #{e.message}"
4000
        exit 1
4001
      end
4002 0:513646585e45 Chris
    when '--owner';          $svn_owner    = arg.dup; $use_groupid = false;
4003
    when '--group';          $svn_group    = arg.dup; $use_groupid = false;
4004
    when '--url';            $svn_url      = arg.dup
4005
    when '--scm';            $scm          = arg.dup.capitalize; log("Invalid SCM: #{$scm}", :exit => true) unless SUPPORTED_SCM.include?($scm)
4006 13:80433603a2cd Chris
    when '--http-user';      $http_user    = arg.dup
4007
    when '--http-pass';      $http_pass    = arg.dup
4008 0:513646585e45 Chris
    when '--command';        $command =      arg.dup
4009
    when '--verbose';        $verbose += 1
4010
    when '--test';           $test = true
4011
    when '--version';        puts Version; exit
4012 1332:1d1cb01c0417 Chris
    when '--help';           usage
4013 0:513646585e45 Chris
    when '--quiet';          $quiet = true
4014
    end
4015
  end
4016
rescue
4017
  exit 1
4018
end
4019
4020
if $test
4021
  log("running in test mode")
4022
end
4023
4024
# Make sure command is overridden if SCM vendor is not handled internally (for the moment Subversion and Git)
4025
if $command.nil?
4026
  begin
4027
    scm_module = SCM.const_get($scm)
4028
  rescue
4029
    log("Please use --command option to specify how to create a #{$scm} repository.", :exit => true)
4030
  end
4031
end
4032
4033
$svn_url += "/" if $svn_url and not $svn_url.match(/\/$/)
4034
4035
if ($redmine_host.empty? or $repos_base.empty?)
4036 1332:1d1cb01c0417 Chris
  usage
4037 0:513646585e45 Chris
end
4038
4039
unless File.directory?($repos_base)
4040 217:ed8222a04634 chris
  log("directory '#{$repos_base}' doesn't exist", :exit => true)
4041 0:513646585e45 Chris
end
4042
4043
begin
4044
  require 'active_resource'
4045
rescue LoadError
4046
  log("This script requires activeresource.\nRun 'gem install activeresource' to install it.", :exit => true)
4047
end
4048
4049 37:94944d00e43c chris
class Project < ActiveResource::Base
4050 217:ed8222a04634 chris
  self.headers["User-agent"] = "SoundSoftware repository manager/#{Version}"
4051 909:cbb26bc654de Chris
  self.format = :xml
4052 37:94944d00e43c chris
end
4053 0:513646585e45 Chris
4054
log("querying Redmine for projects...", :level => 1);
4055
4056
$redmine_host.gsub!(/^/, "http://") unless $redmine_host.match("^https?://")
4057
$redmine_host.gsub!(/\/$/, '')
4058
4059
Project.site = "#{$redmine_host}/sys";
4060 13:80433603a2cd Chris
Project.user = $http_user;
4061
Project.password = $http_pass;
4062 0:513646585e45 Chris
4063
begin
4064
  # Get all active projects that have the Repository module enabled
4065
  projects = Project.find(:all, :params => {:key => $api_key})
4066 909:cbb26bc654de Chris
rescue ActiveResource::ForbiddenAccess
4067
  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.")
4068 0:513646585e45 Chris
rescue => e
4069
  log("Unable to connect to #{Project.site}: #{e}", :exit => true)
4070
end
4071
4072
if projects.nil?
4073 909:cbb26bc654de Chris
  log('No project found, perhaps you forgot to "Enable WS for repository management"', :exit => true)
4074 0:513646585e45 Chris
end
4075
4076 1107:4f45ab104990 Chris
log("found #{projects.size} projects at " + Time.now.inspect);
4077 0:513646585e45 Chris
4078
def set_owner_and_rights(project, repos_path, &block)
4079 441:cbce1fd3b1b7 Chris
  if mswin?
4080 0:513646585e45 Chris
    yield if block_given?
4081
  else
4082
    uid, gid = Etc.getpwnam($svn_owner).uid, ($use_groupid ? Etc.getgrnam(project.identifier).gid : Etc.getgrnam($svn_group).gid)
4083 34:09b1d4349da3 Chris
    right = project.is_public ? 02775 : 02770
4084 0:513646585e45 Chris
    yield if block_given?
4085
    Find.find(repos_path) do |f|
4086
      File.chmod right, f
4087
      File.chown uid, gid, f
4088
    end
4089
  end
4090
end
4091
4092
def other_read_right?(file)
4093
  (File.stat(file).mode & 0007).zero? ? false : true
4094
end
4095
4096
def owner_name(file)
4097
  mswin? ?
4098
    $svn_owner :
4099 441:cbce1fd3b1b7 Chris
    Etc.getpwuid( File.stat(file).uid ).name
4100 0:513646585e45 Chris
end
4101 441:cbce1fd3b1b7 Chris
4102 0:513646585e45 Chris
def mswin?
4103
  (RUBY_PLATFORM =~ /(:?mswin|mingw)/) || (RUBY_PLATFORM == 'java' && (ENV['OS'] || ENV['os']) =~ /windows/i)
4104
end
4105
4106
projects.each do |project|
4107 1107:4f45ab104990 Chris
  log("inspecting project #{project.name}", :level => 1)
4108 0:513646585e45 Chris
4109
  if project.identifier.empty?
4110 1107:4f45ab104990 Chris
    log("\tno identifier for project #{project.name}!")
4111 0:513646585e45 Chris
    next
4112 1445:0c7b3bb73517 Chris
  elsif not project.identifier.match(/^[a-z0-9_\-]+$/)
4113 1107:4f45ab104990 Chris
    log("\tinvalid identifier for project #{project.name} : #{project.identifier}!");
4114 0:513646585e45 Chris
    next;
4115
  end
4116
4117
  repos_path = File.join($repos_base, project.identifier).gsub(File::SEPARATOR, File::ALT_SEPARATOR || File::SEPARATOR)
4118
4119 28:12420e46bed9 chris
  create_repos = false
4120
  # Logic required for SoundSoftware.ac.uk repositories:
4121
  #
4122
  # * If the project has a repository path declared already,
4123
  #   - if it's a local path,
4124
  #     - if it does not exist
4125
  #       - if it has the right root
4126
  #         - create it
4127
  #   - else
4128
  #     - leave alone (remote repository)
4129
  # * else
4130
  #   - create repository with same name as project
4131
  #   - set to project
4132
4133
  if project.respond_to?(:repository)
4134
4135
    repos_url = project.repository.url;
4136 1107:4f45ab104990 Chris
    log("\texisting url for project #{project.identifier} is #{repos_url}", :level => 2);
4137 28:12420e46bed9 chris
4138
    if repos_url.match(/^file:\//) || repos_url.match(/^\//)
4139
4140
      repos_url = repos_url.gsub(/^file:\/*/, "/");
4141 1107:4f45ab104990 Chris
      log("\tthis is a local file path, at #{repos_url}", :level => 2);
4142 28:12420e46bed9 chris
4143
      if repos_url.slice(0, $repos_base.length) != $repos_base
4144
        # leave repos_path set to our original suggestion
4145 1107:4f45ab104990 Chris
        log("\tpreparing to replace incorrect repo location #{repos_url} for #{project.name} with #{repos_path}");
4146 28:12420e46bed9 chris
        create_repos = true
4147
      else
4148
        if !File.directory?(repos_url)
4149 1107:4f45ab104990 Chris
          log("\tpreparing to create repo for #{project.name} at #{repos_url}");
4150 28:12420e46bed9 chris
          repos_path = repos_url
4151
          create_repos = true
4152
        else
4153 1107:4f45ab104990 Chris
          log("\tit exists and is in the right place", :level => 2);
4154 28:12420e46bed9 chris
        end
4155
      end
4156
    else
4157 1107:4f45ab104990 Chris
      log("\tthis is a remote path, leaving alone", :level => 2);
4158 28:12420e46bed9 chris
    end
4159
  else
4160 1107:4f45ab104990 Chris
    log("\tpreparing to set repo location and create for #{project.name} at #{repos_url}")
4161 28:12420e46bed9 chris
#    if File.directory?(repos_path)
4162
#      log("\trepository path #{repos_path} already exists, not creating")
4163
#    else
4164
      create_repos = true
4165
#    end
4166
  end
4167
4168
  if create_repos
4169
4170
    registration_url = repos_path
4171
    if $svn_url
4172
      registration_url = "#{$svn_url}#{project.identifier}"
4173
    end
4174 0:513646585e45 Chris
4175
    if $test
4176 28:12420e46bed9 chris
      log("\tproposal: create repository #{repos_path}")
4177
      log("\tproposal: register repository #{repos_path} in Redmine with vendor #{$scm}, url #{registration_url}")
4178 0:513646585e45 Chris
      next
4179
    end
4180
4181 52:8c3409528d3a Chris
# No -- we need "other" users to be able to read it.  Access control
4182
# is not handled through Unix user id anyway
4183
#    project.is_public ? File.umask(0002) : File.umask(0007)
4184
    File.umask(0002)
4185
4186 28:12420e46bed9 chris
    log("\taction: create repository #{repos_path}")
4187 0:513646585e45 Chris
4188
    begin
4189 28:12420e46bed9 chris
      if !File.directory?(repos_path)
4190
        set_owner_and_rights(project, repos_path) do
4191
          if scm_module.nil?
4192
            log("\trunning command: #{$command} #{repos_path}")
4193
            system_or_raise "#{$command} #{repos_path}"
4194
          else
4195
            scm_module.create(repos_path)
4196
          end
4197 0:513646585e45 Chris
        end
4198
      end
4199
    rescue => e
4200
      log("\tunable to create #{repos_path} : #{e}\n")
4201
      next
4202
    end
4203
4204 28:12420e46bed9 chris
    begin
4205
      log("\taction: register repository #{repos_path} in Redmine with vendor #{$scm}, url #{registration_url}");
4206
      project.post(:repository, :vendor => $scm, :repository => {:url => "#{registration_url}"}, :key => $api_key)
4207
    rescue => e
4208
      log("\trepository #{repos_path} not registered in Redmine: #{e.message}");
4209 0:513646585e45 Chris
    end
4210
    log("\trepository #{repos_path} created");
4211
  end
4212 37:94944d00e43c chris
end
4213 0:513646585e45 Chris
4214 1107:4f45ab104990 Chris
log("project review completed at " + Time.now.inspect);
4215
4216 241:7658d21a1493 chris
#!/bin/sh
4217
4218 242:bde4f47b6427 chris
mirrordir="/var/mirror"
4219 1336:b61a51fb42b9 Chris
hg="/usr/bin/hg"
4220 242:bde4f47b6427 chris
4221 241:7658d21a1493 chris
project="$1"
4222
local_repo="$2"
4223
remote_repo="$3"
4224
4225
if [ -z "$project" ] || [ -z "$local_repo" ] || [ -z "$remote_repo" ]; then
4226
    echo "Usage: $0 <project> <local-repo-path> <remote-repo-url>"
4227
    exit 2
4228
fi
4229
4230
  # We need to handle different source repository types separately.
4231
  #
4232
  # The convert extension cannot convert directly from a remote git
4233
  # repo; we'd have to mirror to a local repo first.  Incremental
4234
  # conversions do work though.  The hg-git plugin will convert
4235
  # directly from remote repositories, but not via all schemes
4236
  # (e.g. https is not currently supported).  It's probably easier to
4237
  # use git itself to clone locally and then convert or hg-git from
4238
  # there.
4239
  #
4240
  # We can of course convert directly from remote Subversion repos,
4241
  # but we need to keep track of that -- you can ask to convert into a
4242
  # repo that has already been used (for Mercurial) and it'll do so
4243
  # happily; we don't want that.
4244
  #
4245
  # Converting from a remote Hg repo should be fine!
4246
  #
4247
  # One other thing -- we can't actually tell the difference between
4248
  # the various SCM types based on URL alone.  We have to try them
4249
  # (ideally in an order determined by a guess based on the URL) and
4250
  # see what happens.
4251
4252 242:bde4f47b6427 chris
project_mirror="$mirrordir/$project"
4253
mkdir -p "$project_mirror"
4254
project_repo_mirror="$project_mirror/repo"
4255 241:7658d21a1493 chris
4256 242:bde4f47b6427 chris
  # Some test URLs:
4257
  #
4258
  # http://aimc.googlecode.com/svn/trunk/
4259
  # http://aimc.googlecode.com/svn/
4260
  # http://vagar.org/git/flam
4261
  # https://github.com/wslihgt/IMMF0salience.git
4262
  # http://hg.breakfastquay.com/dssi-vst/
4263
  # git://github.com/schacon/hg-git.git
4264
  # http://svn.drobilla.net/lad (externals!)
4265
4266
# If we are importing from another distributed system, then our aim is
4267
# to create either a Hg repo or a git repo at $project_mirror, which
4268
# we can then pull from directly to the Hg repo at $local_repo (using
4269
# hg-git, in the case of a git repo).
4270
4271
# Importing from SVN, we should use hg convert directly to the target
4272
# hg repo (or should we?) but keep a record of the last changeset ID
4273
# we brought in, and test each time whether it matches the last
4274
# changeset ID actually in the repo
4275
4276
success=""
4277
4278 436:4eb486dbf730 Chris
# If we have a record of the last successfully updated remote repo
4279
# URL, check it against our current remote URL: if it has changed, we
4280
# will need to start again with a new clone rather than pulling
4281
# updates into the existing local mirror
4282
4283
successfile="$project_mirror/last_successful_url"
4284
if [ -f "$successfile" ]; then
4285
    last=$(cat "$successfile")
4286 437:102056ec2de9 chris
    if [ x"$last" = x"$remote_repo" ]; then
4287 436:4eb486dbf730 Chris
	echo "$$: Remote URL is unchanged from last successful update"
4288
    else
4289
	echo "$$: Remote URL has changed since last successful update:"
4290
	echo "$$: Last URL was $last, current is $remote_repo"
4291
	suffix="$$.$(date +%s)"
4292
	echo "$$: Moving existing repos to $suffix suffix and starting afresh"
4293
	mv "$project_repo_mirror" "$project_repo_mirror"."$suffix"
4294
	mv "$local_repo" "$local_repo"."$suffix"
4295
	mv "$successfile" "$successfile"."$suffix"
4296 437:102056ec2de9 chris
	touch "$project_mirror/url_changed"
4297 436:4eb486dbf730 Chris
    fi
4298
fi
4299
4300 242:bde4f47b6427 chris
if [ -d "$project_repo_mirror" ]; then
4301
4302
    # Repo mirror exists: update it
4303
    echo "$$: Mirror for project $project exists at $project_repo_mirror, updating" 1>&2
4304
4305
    if [ -d "$project_repo_mirror/.hg" ]; then
4306 433:7fd72f22a42b Chris
	"$hg" --config extensions.convert= convert --datesort "$remote_repo" "$project_repo_mirror" && success=true
4307 439:d3faf348b287 chris
	if [ -z "$success" ]; then
4308
	    ( cd "$project_repo_mirror" && "$hg" pull "$remote_repo" ) && success=true
4309
	fi
4310 242:bde4f47b6427 chris
    elif [ -d "$project_repo_mirror/.git" ]; then
4311 431:d3af621ba9d4 Chris
	( cd "$project_repo_mirror" && git pull "$remote_repo" master ) && success=true
4312 242:bde4f47b6427 chris
    else
4313
	echo "$$: ERROR: Repo mirror dir $project_repo_mirror exists but is not an Hg or git repo" 1>&2
4314
    fi
4315
4316
else
4317
4318
    # Repo mirror does not exist yet
4319
    echo "$$: Mirror for project $project does not yet exist at $project_repo_mirror, trying to convert or clone" 1>&2
4320
4321
    case "$remote_repo" in
4322
	*git*)
4323
	    git clone "$remote_repo" "$project_repo_mirror" ||
4324 433:7fd72f22a42b Chris
	    "$hg" --config extensions.convert= convert --datesort "$remote_repo" "$project_repo_mirror"
4325 242:bde4f47b6427 chris
	    ;;
4326
	*)
4327 433:7fd72f22a42b Chris
	    "$hg" --config extensions.convert= convert --datesort "$remote_repo" "$project_repo_mirror" ||
4328 299:defe55be97b9 chris
	    git clone "$remote_repo" "$project_repo_mirror" ||
4329 433:7fd72f22a42b Chris
	    "$hg" clone "$remote_repo" "$project_repo_mirror"
4330 242:bde4f47b6427 chris
	    ;;
4331
    esac && success=true
4332
4333
fi
4334
4335
echo "Success=$success"
4336
4337
if [ -n "$success" ]; then
4338
    echo "$$: Update successful, pulling into local repo at $local_repo"
4339 436:4eb486dbf730 Chris
    if [ ! -d "$local_repo" ]; then
4340
	"$hg" init "$local_repo"
4341
    fi
4342 242:bde4f47b6427 chris
    if [ -d "$project_repo_mirror/.git" ]; then
4343 436:4eb486dbf730 Chris
	( cd "$local_repo" && "$hg" --config extensions.hggit= pull "$project_repo_mirror" ) && echo "$remote_repo" > "$successfile"
4344 242:bde4f47b6427 chris
    else
4345 436:4eb486dbf730 Chris
	( cd "$local_repo" && "$hg" pull "$project_repo_mirror" ) && echo "$remote_repo" > "$successfile"
4346 242:bde4f47b6427 chris
    fi
4347
fi