view release on metacpan or  search on metacpan

lib/MDK/Common/System.pm  view on Meta::CPAN

    my ($file, $l, @fields) = @_;
    addVarsInShMode($file, 0777 ^ umask(), $l, @fields);
}

sub addVarsInShMode {
    my ($file, $mod, $l, @fields) = @_;
    my %l = @fields ? map { $_ => $l->{$_} } @fields : %$l;
    my %l2 = getVarsFromSh($file);

    # below is add2hash_(\%l, \%l2);
    exists $l{$_} or $l{$_} = $l2{$_} foreach keys %l2; 

    setVarsInShMode($file, $mod, \%l);
}

sub setVarsInSh {
    my ($file, $l, @fields) = @_;
    setVarsInShMode($file, 0777 ^ umask(), $l, @fields);
}

sub quoteForSh {
    my ($val) = @_;
    if ($val =~ /["`\$]/) {
	$val =~ s/(')/$1\\$1$1/g;
	$val = qq('$val');
    } elsif ($val =~ /[\(\)'|\s\\;<>&#\[\]~{}*?]/) {
	$val = qq("$val");
    }
    $val;
}

sub setVarsInShMode {
    my ($file, $mod, $l, @fields) = @_;
    @fields = sort keys %$l unless @fields;
    my $string = join('',
	map { "$_=" . quoteForSh($l->{$_}) . "\n" } grep { $l->{$_} } @fields
    );
    if ($file =~ m!^/home/!) {
        MDK::Common::File::secured_output($file, $string);
    } else {
        MDK::Common::File::output($file, $string);
    }

    chmod $mod, $file;
}

sub setExportedVarsInSh {
    my ($file, $l, @fields) = @_;
    @fields = keys %$l unless @fields;

    MDK::Common::File::output($file, 
	(map { $l->{$_} ? "$_=" . quoteForSh($l->{$_}) . "\n" : () } @fields), 
	@fields ? "export " . join(" ", @fields) . "\n" : (),
    );
}

sub setExportedVarsInCsh {
    my ($file, $l, @fields) = @_;
    @fields = keys %$l unless @fields;

    MDK::Common::File::output($file, map { $l->{$_} ? "setenv $_ " . quoteForSh($l->{$_}) . "\n" : () } @fields);
}

sub template2file {
    my ($in, $out, %toreplace) = @_;
    MDK::Common::File::output($out, map { s/@@@(.*?)@@@/$toreplace{$1}/g; $_ } MDK::Common::File::cat_($in));
}
sub template2userfile {
    my ($prefix, $in, $out_rel, $force, %toreplace) = @_;

    foreach (list_skels($prefix, $out_rel)) {
	-d MDK::Common::File::dirname($_) or !-e $_ or $force or next;

	template2file($in, $_, %toreplace);
	m|/home/(.+?)/| and chown(getpwnam($1), getgrnam($1), $_);
    }
}

sub read_gnomekderc {
    my ($file, $category) = @_;
    my %h;
    foreach (MDK::Common::File::cat_($file), "[NOCATEGORY]\n") {
	if (/^\s*\[\Q$category\E\]/i ... /^\[/) {
	    $h{$1} = $2 if /^\s*([^=]*?)=(.*)/;
	}
    }
    %h;
}

sub update_gnomekderc {
    my ($file, $category, %subst_) = @_;

    my %subst = map { lc($_) => [ $_, $subst_{$_} ] } keys %subst_;

    my $s;
    defined($category) or $category = "DEFAULTCATEGORY";
    foreach ("[DEFAULTCATEGORY]\n", MDK::Common::File::cat_($file), "[NOCATEGORY]\n") {
	if (my $i = /^\s*\[\Q$category\E\]/i ... /^\[/) {
	    if ($i =~ /E/) { #- for last line of category
		chomp $s; $s .= "\n";
		$s .= "$_->[0]=$_->[1]\n" foreach values %subst;
		%subst = ();
	    } elsif (/^\s*([^=]*?)=/) {
		if (my $e = delete $subst{lc($1)}) {
		    $_ = "$1=$e->[1]\n";
		}
	      }
	}
	$s .= $_ if !/^\[(NO|DEFAULT)CATEGORY\]/;
    }

    #- if category has not been found above (DEFAULTCATEGORY is always found).
    if (keys %subst) {
	chomp $s;
	$s .= "\n[$category]\n";
	$s .= "$_->[0]=$_->[1]\n" foreach values %subst;
    }

    MDK::Common::File::output_p($file, $s);

}