forked from verhas/ScriptBasic
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathssplit.pl
More file actions
102 lines (85 loc) · 2.18 KB
/
ssplit.pl
File metadata and controls
102 lines (85 loc) · 2.18 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
#!/usr/bin/perl
# LEGAL WARNING:
#
# This software is provided on an "AS IS", basis,
# without warranty of any kind, including without
# limitation the warranties of merchantability, fitness for
# a particular purpose and non-infringement. The entire
# risk as to the quality and performance of the Software is
# borne by you. Should the Software prove defective, you
# and not the author assume the entire cost of any service
# and repair.
#
$version = '1.0';
if( $#ARGV == 0 && $ARGV[0] eq '-h' ){
print <<END__HELP;
Source Splitter $version
Usage:
ssplit source_file [directory]
This program splits a text file. The primary
purpose of this tool was to maintain many small HTML files as a one
somewhat larger jamal source, compile it using jamal and then split
to small html files. The source file should contain lines
\%file file_name
to start a new file. The default directory is .
For further information see on-line documentation at
http://www.isys.hu/c/verhas/progs/perl/ssplit
END__HELP
exit;
}
$file = shift;
$dir = shift;
$dir = '.' unless $dir;
$subdir = '';
$output_opened = 0;
$buffer = '';
$output = '';
open(F,$file) or die "Can not open $file\n";
while( <F> ){
if( /^\s*%\s*file\s+(.*?)\s*$/ ){
my $new_output = $1;
&save_buffer($output);
$buffer = '';
$output = "$dir/$subdir/${new_output}";
$output =~ s{//}{/};
next;
}
if( /^\s*%\s*dir\s+(.*?)\s*$/ ){
$subdir = $1;
next;
}
$buffer .= $_;
}
&save_buffer($output);
close F;
exit;
sub save_buffer {
my $file = shift;
return unless $output || $buffer ;
if( $buffer && !$output ){
die "Is there text before the first '%file' ??";
}
if( open(OUT,"<$file") ){
my $os = $/; undef $/;
my $sbuffer = <OUT>;
$/ = $os;
close OUT;
return if $buffer eq $sbuffer;
}
&make_dir($file);
open(OUT,">$file") or die "Can not output $file";
print OUT $buffer;
close OUT;
}
sub make_dir {
my $dir = shift;
my @dlist = split '/' , $dir;
pop @dlist; # pop off file name
return if $#dlist == -1;
$root = '';
for( @dlist ){
$root .= '/' if $root;
$root .= $_; # take the next subdirectory
mkdir $root, 0777 unless -d $root
}
}