view release on metacpan or  search on metacpan

Cfe.pm  view on Meta::CPAN

=head1 set_debug [debug [verbose]]

If B<debug> is non-zero then B<write_file> will write
the new file but B<not> rename the file from I<file.new> to I<file>.
B<verbose> greater than 0 will print out debug info.

 Example:

 use Getopt::Std;
 getopt('dv');

 $host = hostname;
 set_debug($opt_d, $opt_v);

=cut

sub set_debug {
	$debug = $_[0];
	$verbose = $_[1];
	for my $i (@verb_save) {
		print $i if $verbose;
	}
	@verb_save = ();
}

=head1 new_file filename

Start editing a new file, will overwrite any existing file.
A new file will get file mode 0666 & umask.

=cut

sub new_file {
	my ($file) = @_;

#	&lock($file);
	$par->{'file_name'} = $file;
	$par->{'edit'} = $par->{'cur_line'} = 0;
	$par->{'lines'} = [];
	&verbose("new_file", $file);
}

=head1 read_file filename [,1]

Start editing an existing file.
If I<filename> doesn't exist, B<read_file> will
either complain or, if optional second argument is true, create
the file.

=cut

sub read_file {
	my ($file, $exist_flag) = @_;

#	&lock($file);
	if ($exist_flag && !-e $file) {
		&new_file($file);
		$par->{'mode'} = 0666 & umask;
		$par->{'uid'} = $>;
		$par->{'gid'} = $);
		&verbose('read_file', sprintf("mode=0%o, uid=%d, gid=%d",
			$par->{'mode'}, $par->{'uid'}, $par->{'gid'}));
		return;
	}
		
	&get_filemode($file);
	$par->{'file_name'} = $file;
	$par->{'edit'} = $par->{'cur_line'} = 0;
	my $lines = $par->{'lines'} = [];
	unless (-e $file) {
		&verbose("read_file", "$file does not exist");
		return;
	}
	open(FILE, $file) || croak "open $file:$!";
	while(<FILE>) {
		chop;
		push(@$lines, $_);
		croak "too many lines" if @$lines >= $par->{'max_lines'};
	}
	close(FILE);
	&verbose("read_file", "$file, ".(@$lines*1)." lines");
}

=head1 write_file [\%par]

Write the current file if it has been changed.
Control of the file can be done thru the hash parameter B<par>.
The old file will be renamed to B<.>I<filename>B<.cfe>.
Will not rename the final file (I<filename.new>) to I<filename>
if debug is active.

Accepted keys for B<par>:

 key	name			default
 --------------------------------------
 mode	filemode		0666 & umask.
 uid	numeric userid		0
 gid	numeric groupid		0

=cut

sub write_file {
	my (%tpar) = @_;
	my ($tmp, $fsize, $file);

	return unless $par->{'edit'};

	$tpar{'mode'} = $par->{'mode'} unless $tpar{'mode'}; 
	$tpar{'uid'} = $par->{'uid'} unless $tpar{'uid'}; 
	$tpar{'gid'} = $par->{'gid'} unless $tpar{'gid'}; 

	croak "No filename!" unless $file = $par->{'file_name'};
	($tmp = $file) =~ s/$/.new/;
	open(FILEO, ">$tmp") || croak "can't create $tmp:$!";
	chmod $tpar{'mode'}, $tmp;
	chown $tpar{'uid'}, $tpar{'gid'}, $tmp;
	for my $line (@{$par->{'lines'}}) {
		print FILEO "$line\n";
		$fsize += length($line)+1;
	}
	close(FILEO);
	&abort_file("incorrect filesize, abort") if -s $tmp != $fsize;
	unless ($debug) {
		rename($file, ".$file.cfe");
		rename($tmp, $file) || &abort_file("rename $tmp to $file:$!");
	}
	$par->{'lines'} = [];
	&verbose('write_file', "wrote $file, ".
		(@{$par->{'lines'}}*1)." lines, $fsize bytes");
#	&unlock($file);
	&reset_par;
}

=head1 abort_file

Quit editing the current file.

=cut

sub abort_file {
	my ($txt) = @_;
	my ($tmp, $fsize, $file);

	croak "No filename!" unless $file = $par->{'file_name'};
	($tmp = $file) =~ s/$/.new/;
	unlink($tmp) || croak "unlink $tmp:$!";
	croak $txt if $txt;
#	&unlock($file);
	&reset_par;
}

=head1 append_file filename

Appends B<filename> at the current line.

=cut

sub append_file {
	my ($file) = @_;
	my (@tmp);

	&verbose("append_file", "**** $file");
	open(FILE, $file) || croak "open $file:$!";
	while(<FILE>) {
		chop;
		push(@tmp, $_);
		&verbose("append_file", $_);
		croak "too many lines"
			if @{$par->{'lines'}} >= $par->{'max_lines'};
	}
	close(FILE);
	&append(@tmp);
}

=head1 list_lines [from_line [to_line]]

Cfe.pm  view on Meta::CPAN

	&verbose("get_sect", $section);
	return 0 unless &locate(sprintf($par->{'find_sect'},
		'begin', $section));
	my $from = &incr();
	my $to = &find_row($from,
		sprintf($par->{'find_sect'}, 'end', $section));
	return [] unless $to >= $from;
	return &get_line($from, $to);
	
}
######################################################################
# Internal subroutine
# start searching from line 'start' for 'regexp';
# Returns the line number or -1 if not found.
sub find_row {
	my ($start, $regexp) = @_;
	my ($i, $line);

	my $lines = $par->{'lines'};
	my $l = -1;
	for ($i = $start; $i < @$lines; $i++) {
		$l = $i, last if $lines->[$i] =~ /$regexp/;
	}
	return $l;
}
# splits any multilined string and returns an array of
# guaranteed single lines.
sub split_cr {
	my ($i, @new);
	for my $i (@_) {
		push(@new, ''), next if $i eq '';
		push(@new, split(/\n/, $i));
	}
	return @new;
}
# Print out debug info if verbose is active.
# 
sub verbose {
	my ($func, @txt) = @_;
	my ($l, $i);

	
	return if $verbose == 0;
	$l = $par->{'cur_line'};
	for my $i (@txt) {
		push(@verb_save, "$func($l): $i\n"), next if $verbose < 0;
		print "$func($l): $i\n";
	}
}

sub reset_par {
	$par->{'max_lines'} = 100000;
	$par->{'file_name'} = '';
	$par->{'num_lines'} = 0;
	$par->{'lines'} = [];
	$par->{'cur_line'} = 0;
	$par->{'edit'} = 0;
	$par->{'mode'} = 0666 & umask;
	$par->{'uid'} = 0;
	$par->{'gid'} = 0;
	&set_comment;
}
sub get_filemode {
	my ($f) = @_;

	($par->{'mode'}, $par->{'uid'}, $par->{'gid'}) = (stat($f))[2,4,5];
	$par->{'mode'} &= 0777;
	&verbose('get_filemode',
		sprintf("mode=0%o, uid=%d, gid=%d", $par->{'mode'},
			$par->{'uid'}, $par->{'gid'}));
}

sub BEGIN {
	my (%type, $uname, $r, $ostype, $version, $mach_type);

	$par = {};
	&reset_par;
	chop($uname = `uname -srm`);
	($ostype, $version, $mach_type) = split(/\s+/, $uname);
	($r = $version) =~ tr/0-9//cd;
	$r .= '0' if length($r) < 3;
	$r *= 1.0;

	($par->{'os_type'} = $ostype) =~ tr/A-Z/a-z/;
	$par->{'os_rev'} = $r;
	($par->{'mach_type'} = $mach_type) =~ tr/A-Z/a-z/;

	$type{'sunos4'} = $ostype eq 'SunOS' && $version < 5 ? $r : 0;
	$type{'sunos5'} = $ostype eq 'SunOS' && $version > 5 ? $r : 0;
	$type{'freebsd'} = $ostype eq 'FreeBSD' ? $r : 0;
	$type{'sunos'} = $ostype eq 'SunOS' ? $r : 0;
	$type{'linux'} = $ostype eq 'Linux' ? $r : 0;

	$type{$1} = $mach_type =~ /^(i[3-9]86)/ ? $r : 0;

	$verbose = -1;

	if (-f '/etc/debian_version') {
		my $deb;

		open(IN, '/etc/debian_version');
		chop($deb = <IN>);
		close(IN);
		$deb =~ s/\.//;
		$deb .= '0' if length($deb) < 3;
		$type{'debian'} = $deb;
	}
	for my $i (keys %type) {
		&verbose('init', "sub is_$i\{return $type{$i};}");
		eval "sub is_$i\{ &verbose('is_$i','$type{$i}');".
			"return \"$type{$i}\";}";
	}
	for my $i (qw(os_type os_rev mach_type)) {
		&verbose('init', "sub par_$i { return \"$par->{$i}\"; }");
		eval "sub par_$i { ".
			"&verbose('par_$i','$par->{$i}');".
			"return \"$par->{$i}\"; }";
	}
	&set_comment;
	$verbose = 0;
}