### SPAR <http://www.cpan.org/scripts/>
### 2 644 1380406064 1380406064 hint
This tests the spar utility that is only used for packaging tests.
Failure has nothing to do with makepp.
### 13 444 1120166745 1501106800 is_relevant.pl
# This tests spar itself, and not any makepp functionality. The test is
# integrated here because spar is hosted in the test section of makepp (for
# which it was originally conceived.)
# FreeBSD 4.10 and Darwin 5.5 allow truncating a write protected file :-(
die if open my $fh, '>', 'd.spar';
$] ge '5.01' and
# Can we chmod on this fs?
((stat 'd.spar')[2] & 0777) == 0444 and
chmod 0650, 'd.spar' and
# chmod fails with success on Samba.
((stat 'd.spar')[2] & 0777) == 0650;
### 28 755 1079987495 1079987351 makepp_test_script
#!/bin/sh -x
unset LANG LC_MESSAGES LC_ALL
PATH=..:../..:$PATH; export PATH
spar="${PERL-perl} -S spar"
$spar -e >spar-mode.el
$spar -p >un_spar.pl
$spar -x answers/dir.pl
$spar -c dir.pl dir
rm -fr dir
${PERL-perl} answers/dir.pl
$spar dir.spar dir
${PERL-perl} answers/dir.pl
$spar -a dir-a.spar dir
${PERL-perl} answers/dir.pl
$spar -d dir-d.spar dir
$spar -x d.spar
$spar -a dir-a.spar dir/d
rm -fr dir/a
chmod a-w dir/b dir
echo junk line >>dir.spar
$spar -x dir.spar 2>errors
chmod u+w dir/b dir
### 4 444 1079987495 1079872464 d.spar
### SPAR <http://www.cpan.org/scripts/>
### D 755 1079872401 1079870636 dir/d/
### 1 644 1079872401 1079872401 dir/d/d
ddd
### D 755 1164319650 1079870636 .makepp/
### 3 644 1164319650 1190056091 .makepp/log
This is a dummy file present so as to satisfy makepp's test harness.
N_FILES000
### D 755 1079988067 1079987490 answers/
### 67 755 1120163193 1366490088 answers/dir.pl
#! /usr/bin/env perl
# -*-spar-*-
# This file was generated by spar <http://www.cpan.org/scripts/>
# Run it with perl to unpack it.
my( $lines, $kind, %dirs, $mode, %mode, $atime, $mtime, $name, $nl ) = (-1, 0);
while( <DATA> ) {
s/\r?\n$//; # cross-plattform chomp
if( $lines >= 0 ) {
print F $_, $lines ? "\n" : $nl;
} elsif( $kind eq 'L' ) {
if( $mode eq 'S' ) {
symlink $_, $name;
} else {
link $_, $name;
}
$kind = 0;
} elsif( /^###\t(?!SPAR)/ ) {
(undef, $kind, $mode, $atime, $mtime, $name) = split /\t/, $_, 6;
$_ = $name // '';
if( length ) {
my @dirs;
while( s!/[^/]+/?$!! and length and !mkdir ) {
unshift @dirs, $_;
undef $dirs{$_};
}
mkdir if $_ ne $name;
mkdir for @dirs;
if( $kind eq 'D' ) {
$name =~ s!/+$!!;
-d $name or mkdir $name, 0700 or warn "spar: can't mkdir `$name': $!\n";
$mode{$name} = [$atime, $mtime, oct $mode];
undef $dirs{$name};
} elsif( $kind ne 'L' ) {
open F, ">$name" or warn "spar: can't open >`$name': $!\n";
$lines = abs $kind;
$nl = ($kind < 0) ? '' : "\n";
}
}
} elsif( defined $mode ) {
warn "spar: $archive:$.: trailing garbage ignored\n";
} # else before beginning of spar
} continue {
if( !$lines-- ) {
close F;
chmod oct( $mode ), $name and
utime $atime, $mtime, $name or
warn "spar: $archive:$name: Failed to set file attributes: $!\n";
}
}
for( keys %mode ) {
chmod pop @{$mode{$_}}, $_ and
utime @{$mode{$_}}, $_ or
warn "spar: $archive:$_: Failed to set directory attributes: $!\n";
}
__DATA__
### D 755 1079872402 1079872572 dir/
### -1 644 1079872401 1079820029 dir/b
bbb
### 1 644 1079872401 1079820044 dir/c
ccc
### D 755 1079872401 1079869652 dir/a/
### 1 644 1079872401 1079820004 dir/a/a
aaa
### 55 644 1120163329 1217802687 answers/un_spar.pl
# spar <http://www.cpan.org/scripts/> extraction function
# assumes DATA to be opened to the spar
sub un_spar() {
my( $lines, $kind, %dirs, $mode, %mode, $atime, $mtime, $name, $nl ) = (-1, 0);
while( <DATA> ) {
s/\r?\n$//; # cross-plattform chomp
if( $lines >= 0 ) {
print F $_, $lines ? "\n" : $nl;
} elsif( $kind eq 'L' ) {
if( $mode eq 'S' ) {
symlink $_, $name;
} else {
link $_, $name;
}
$kind = 0;
} elsif( /^###\t(?!SPAR)/ ) {
(undef, $kind, $mode, $atime, $mtime, $name) = split /\t/, $_, 6;
$_ = $name // '';
if( length ) {
my @dirs;
while( s!/[^/]+/?$!! and length and !mkdir ) {
unshift @dirs, $_;
undef $dirs{$_};
}
mkdir if $_ ne $name;
mkdir for @dirs;
if( $kind eq 'D' ) {
$name =~ s!/+$!!;
-d $name or mkdir $name, 0700 or warn "spar: can't mkdir `$name': $!\n";
$mode{$name} = [$atime, $mtime, oct $mode];
undef $dirs{$name};
} elsif( $kind ne 'L' ) {
open F, ">$name" or warn "spar: can't open >`$name': $!\n";
$lines = abs $kind;
$nl = ($kind < 0) ? '' : "\n";
}
}
} elsif( defined $mode ) {
warn "spar: $archive:$.: trailing garbage ignored\n";
} # else before beginning of spar
} continue {
if( !$lines-- ) {
close F;
chmod oct( $mode ), $name and
utime $atime, $mtime, $name or
warn "spar: $archive:$name: Failed to set file attributes: $!\n";
}
}
for( keys %mode ) {
chmod pop @{$mode{$_}}, $_ and
utime @{$mode{$_}}, $_ or
warn "spar: $archive:$_: Failed to set directory attributes: $!\n";
}
}
### 12 644 1079987495 1079872624 answers/dir-a.spar
### SPAR <http://www.cpan.org/scripts/>
### D 755 1079872402 1079872572 dir/
### -1 644 1079872401 1079820029 dir/b
bbb
### 1 644 1079872401 1079820044 dir/c
ccc
### D 755 1079872401 1079869652 dir/a/
### 1 644 1079872401 1079820004 dir/a/a
aaa
### D 755 1079872401 1079870636 dir/d/
### 1 644 1079872401 1079872401 dir/d/d
ddd
### 9 644 1079987495 1079872623 answers/dir-d.spar
### SPAR <http://www.cpan.org/scripts/>
### D 755 1079872402 1079872572 dir/
### -1 644 1079872401 1079820029 dir/b
bbb
### 1 644 1079872401 1079820044 dir/c
ccc
### D 755 1079872401 1079869652 dir/a/
### 1 644 1079872401 1079820004 dir/a/a
aaa
### 10 644 1079987495 1079872624 answers/dir.spar
### SPAR <http://www.cpan.org/scripts/>
### D 755 1079872402 1079872572 dir/
### -1 644 1079872401 1079820029 dir/b
bbb
### 1 644 1079872401 1079820044 dir/c
ccc
### D 755 1079872401 1079869652 dir/a/
### 1 644 1079872401 1079820004 dir/a/a
aaa
junk line
### 6 644 1079987495 1216459969 answers/errors
spar: can't open >`dir/b': Permission denied
spar: can't mkdir `dir/a': Permission denied
spar: can't open >`dir/a/a': No such file or directory
spar: dir.spar:dir/a/a: Failed to set file attributes: No such file or directory
spar: dir.spar:10: trailing garbage ignored
spar: dir.spar:dir/a: Failed to set directory attributes: No such file or directory
### 71 644 1120163292 1167363038 answers/spar-mode.el
(setq auto-mode-alist `(("\\.spar$\\|/makepp.+\\.test$" . spar-mode)
,@auto-mode-alist))
(defun spar-show ()
"Show this subfile in an indirect buffer with right mode.
It is in fact the same buffer as the SPAR, so be careful not to
change the number of lines, or the SPAR will become inconsistent."
(interactive)
(let ((obuf (current-buffer))
(fl font-lock-mode)
a z buf)
(save-excursion
(outline-back-to-heading)
(beginning-of-line 2)
(setq buf (match-string-no-properties 1)
a (point))
(outline-next-heading)
(setq z (point)))
(switch-to-buffer (make-indirect-buffer (current-buffer) buf t))
(narrow-to-region a z)
(let ((buffer-file-name buf))
(set-auto-mode))
(and fl (not font-lock-mode)
(set-buffer obuf)
(font-lock-mode fl))))
(defun spar-fix ()
"Fix the number of lines declared in the heading of this subfile.
If this subfile is within a nested SPAR, the outer heading will
not be fixed."
(interactive)
(save-match-data
(outline-back-to-heading)
(if (looking-at "### -?\\([0-9]+\\) [0-9]+ [0-9]+ \\([0-9]+\\)")
(let ((a (point))
n)
(save-match-data (outline-next-heading))
(setq n (prin1-to-string (1- (count-lines a (point)))))
(replace-match (format "%.0f" (float-time)) nil nil nil 2)
(unless (string= n (match-string-no-properties 1))
(replace-match n nil nil nil 1)))
(error "Not on a normal file"))))
(defun spar-level ()
(let ((z (1- (match-end 1)))
(n 1))
(save-excursion
(goto-char (match-beginning 1))
(while (search-forward "/" z t)
(setq n (1+ n))))
n))
(define-derived-mode spar-mode outline-mode "Spar"
"Major mode for editing Simple Perl ARchives.
Command \\[spar-show] allows editing one subfile section.
Command \\[spar-fix] fixes the lenth of one subfile section.
Note that SPARs can contain other SPARs. But this mode does not
recognize that. Outline levels are the same for nested SPARs as
for outer ones, so you cannot normally hide a subtree containing
a nested SPAR."
(set (make-local-variable 'outline-regexp)
"^### .+ \\(.+\\)")
(set (make-local-variable 'outline-level) 'spar-level)
(setq imenu-generic-expression
'(("links" "^### [LS] .+ \\(.+\\)" 1)
("directories" "^### D .+ \\(.+\\)" 1)
(nil "^### .+ \\(.+\\)" 1))))
(define-key spar-mode-map "\C-cs" 'spar-show)
(define-key spar-mode-map "\C-cf" 'spar-fix)