monotone

monotone Mtn Source Tree

Root/contrib/mtn_makepermissions

1#! /usr/bin/perl
2
3use strict;
4use warnings;
5use Getopt::Long;
6use Pod::Usage;
7use File::Spec::Functions qw(:ALL);
8
9my $VERSION = '0.1';
10
11######################################################################
12# User options
13#
14my $help = 0;
15my $man = 0;
16my $user_config = "/etc/monotone";
17my $quiet = 0;
18my $debug = 0;
19my $monotone = "mtn";
20
21GetOptions('help|?' => \$help,
22 'man' => \$man,
23 'config|s=s' => \$user_config,
24 'quiet' => \$quiet,
25 'debug' => \$debug,
26 'monotone=s' => \$monotone) or pod2usage(2);
27
28$SIG{HUP} = \&my_exit;
29$SIG{KILL} = \&my_exit;
30$SIG{TERM} = \&my_exit;
31$SIG{INT} = \&my_exit;
32
33######################################################################
34# Respond to user input
35#
36
37# For starters, output help if requested
38pod2usage(1) if $help;
39pod2usage(-exitstatus => 0, -verbose => 2) if $man;
40
41######################################################################
42# Read the directories "read-permissions.d" and "write-permissions.d"
43# and concatenates all files found there into "read-permissions" and
44# "write-permissions", respectively.
45#
46my @files_to_clean_up = ();
47
48for my $d (("read-permissions", "write-permissions")) {
49 if (opendir D,catdir($user_config,$d.".d")) {
50if (open OUT_PERM,">".catdir($user_config,$d)) {
51 foreach my $d2 (readdir D) {
52open IN_PERM,catfile($user_config,$d.".d",$d2);
53while (<IN_PERM>) {
54 print OUT_PERM $_;
55}
56print OUT_PERM "\n";
57close IN_PERM;
58 }
59 close OUT_PERM;
60}
61closedir D;
62 }
63}
64
65######################################################################
66# Clean up.
67#
68my_exit();
69
70######################################################################
71# Subroutines
72#
73
74# my_log will simply output all it's arguments, prefixed with "Notify: ",
75# unless $quiet is true.
76sub my_log
77{
78 if (!$quiet && $#_ >= 0) {
79print STDERR "Makepermissions: ", join("\nMakepermissions: ",
80 split("\n",
81 join('', @_))), "\n";
82 }
83}
84
85# my_errlog will simply output all it's arguments, prefixed with "Makepermissions: ".
86sub my_errlog
87{
88 if ($#_ >= 0) {
89print STDERR "Makepermissions: ", join("\nMakepermissions: ",
90 split("\n",
91 join('', @_))), "\n";
92 }
93}
94
95# my_error will output all it's arguments, prefixed with "Makepermissions: ", then die.
96sub my_error
97{
98 my $save_syserr = "$!";
99 if ($#_ >= 0) {
100print STDERR "Makepermissions: ", join("\nMakepermissions: ",
101 split("\n",
102 join('', @_))), "\n";
103 }
104 die "$save_syserr";
105}
106
107# debug will simply output all it's arguments, prefixed with "DEBUG: ",
108# when $debug is true.
109sub my_debug
110{
111 if ($debug && $#_ >= 0) {
112print STDERR "DEBUG: ", join("\nDEBUG: ",
113 split("\n",
114 join('', @_))), "\n";
115 }
116}
117
118# my_system does the same thing as system, but will print a bit of debugging
119# output when $debug is true. It will also die if the subprocess returned
120# an error code.
121sub my_system
122{
123 my $command = shift @_;
124
125 my_debug("'${command}'\n");
126 my $return = system($command);
127 my $exit = $? >> 8;
128 die "'${command}' returned with exit code $exit\n" if ($exit);
129 return $return;
130}
131
132# my_conditional_system does the same thing as system, but will print a bit
133# of debugging output when $debug is true, and will only actually run the
134# command if the condition is true. It will also die if the subprocess
135# returned an error code.
136sub my_conditional_system
137{
138 my $condition = shift @_;
139 my $command = shift @_;
140 my $return = 0;# exit code for 'true'
141
142 my_debug("'${command}'\n");
143 if ($condition) {
144$return = system($command);
145my $exit = $? >> 8;
146die "'${command}' returned with exit code $exit\n" if ($exit);
147 } else {
148my_debug("... not actually executed.\n");
149 }
150 return $return;
151}
152
153# my_exit removes temporary files and then exits.
154sub my_exit
155{
156 my_log("cleaning up.");
157 unlink @files_to_clean_up;
158 my_log("all done.");
159 exit(0);
160}
161
162# my_backtick does the same thing as backtick commands, but will print a bit
163# of debugging output when $debug is true. It will also die if the subprocess
164# returned an error code.
165sub my_backtick
166{
167 my $command = shift @_;
168
169 my_debug("\`$command\`\n");
170 my @return = `$command`;
171 my $exit = $? >> 8;
172 if ($exit) {
173my_debug(map { "> ".$_ } @ return);
174die "'${command}' returned with exit code $exit\n";
175 }
176 return @return;
177}
178

Archive Download this file

Branches

Tags

Quick Links:     www.monotone.ca    -     Downloads    -     Documentation    -     Wiki    -     Code Forge    -     Build Status