monotone

monotone Commit Details

Date:2009-01-17 13:25:44 (10 years 5 months ago)
Author:Tony Cooper
Branch:net.venge.monotone.contrib.mtn-browse
Commit:d077cb27b7487d5b718f0e4cd87b5ea3c0b9315f
Parents: b0ba770a8e3f2df2d77a6252bbe33b7ead1aec1c
Message:Removed the use of the install program and now do it internally. Helps with the

Mac port that Thomas Keller is doing.
Changes:
AInstaller.pm (full)
Mlinux-install (8 diffs)

File differences

Installer.pm
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
##############################################################################
#
# File Name - Installer.pm
#
# Description - Class module that provides a simple installer.
#
# Author - A.E.Cooper.
#
# Legal Stuff - Copyright (c) 2009 Anthony Edward Cooper
# <aecooper@coosoft.plus.com>.
#
# This library is free software; you can redistribute it
# and/or modify it under the terms of the GNU Lesser General
# Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your
# option) any later version.
#
# This library is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied
# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE. See the GNU Lesser General Public License for
# more details.
#
# You should have received a copy of the GNU Lesser General
# Public License along with this library; if not, write to
# the Free Software Foundation, Inc., 59 Temple Place - Suite
# 330, Boston, MA 02111-1307 USA.
#
##############################################################################
#
##############################################################################
#
# Package - Installer
#
# Description - See above.
#
##############################################################################
# ***** PACKAGE DECLARATION *****
package Installer;
# ***** DIRECTIVES *****
require 5.008;
use integer;
use strict;
use warnings;
# ***** REQUIRED PACKAGES *****
# Standard Perl and CPAN modules.
use Carp;
use File::Copy;
use File::Spec;
# ***** FUNCTIONAL PROTOTYPES *****
# Public methods.
sub install($$$);
sub new($$$$$$);
# ***** PACKAGE INFORMATION *****
# We are just a base class.
use base qw(Exporter);
our @EXPORT = qw();
our @EXPORT_OK = qw();
our $VERSION = 0.1;
#
##############################################################################
#
# Routine - new
#
# Description - Class constructor.
#
# Data - $class : Either the name of the class that is to be
# created or an object of that class.
# $owner : The owner id for any destination files and
# directories.
# $group : The group id for any destination files and
# directories.
# $dir_perms : Permissions for any created directories.
# $nexec_perms : Permissions for any created non-executable
# files.
# $exec_perms : Permissions for any created executable
# files.
# Return Value : A reference to the newly created object.
#
##############################################################################
sub new($$$$$$)
{
my $class = (ref($_[0]) ne "") ? ref($_[0]) : $_[0];
shift();
my($owner, $group, $dir_perms, $nexec_perms, $exec_perms) = @_;
my $this = {owner => $owner,
group => $group,
dir_perms => $dir_perms,
non_exec_perms => $nexec_perms,
exec_perms => $exec_perms};
bless($this, $class);
return $this;
}
#
##############################################################################
#
# Routine - install
#
# Description - Install the specified file to the specified location.
#
# Data - $this : The object.
# $src_file : The name of the file to be installed.
# $dest_file : The name of where the file is to be installed
# to. Single `.' file names are allowed and are
# taken to mean same file name.
#
##############################################################################
sub install($$$)
{
my($this, $src_file, $dest_file) = @_;
my($file,
$full_path,
@dirs,
$path,
$vol);
# Is the source file readable?
croak("Source file `" . $src_file . "' does not exist or is unreadable")
unless (-r $src_file);
# Deal with the destination directory path.
$dest_file = File::Spec->rel2abs($dest_file);
($vol, $path) = (File::Spec->splitpath($dest_file, 1))[0, 1];
@dirs = File::Spec->splitdir($path);
$file = pop(@dirs);
$path = "";
foreach my $dir (@dirs)
{
$path = File::Spec->catdir($path, $dir);
$full_path = File::Spec->catpath($vol, $path, "");
if (! -d $full_path)
{
mkdir($full_path)
or croak ("mkdir " . $full_path . "failed with: " . $!);
chmod($this->{dir_perms}, $full_path)
or croak ("chmod " . $full_path . "failed with: " . $!);
chown($this->{owner}, $this->{group}, $full_path);
}
}
# Copy the file across.
$full_path = File::Spec->catpath($vol, $path, $file);
copy($src_file, $full_path)
or croak("copy " . $src_file . " " . $full_path . " failed with: "
. $!);
if (-x $src_file)
{
chmod($this->{exec_perms}, $full_path)
or croak ("chmod " . $full_path . "failed with: " . $!);
}
else
{
chmod($this->{non_exec_perms}, $full_path)
or croak ("chmod " . $full_path . "failed with: " . $!);
}
chown($this->{owner}, $this->{group}, $full_path);
}
1;
linux-install
5050
5151
5252
53
54
55
56
5357
5458
5559
......
7175
7276
7377
74
75
78
7679
7780
7881
......
164167
165168
166169
170
171
167172
168173
169174
......
180185
181186
182187
183
184
185
188
186189
187190
188191
......
191194
192195
193196
194
197
195198
196199
197200
......
214217
215218
216219
217
220
221
218222
219223
220224
......
222226
223227
224228
225
229
230
226231
227232
228233
229234
230
235
231236
232237
233238
......
243248
244249
245250
246
247
248
251
252
253
249254
250255
251256
use IO::Dir;
use IO::File;
# Modules specific to this application.
use Installer;
#
##############################################################################
#
$globs_file,
$infile,
$input,
$install,
$install_bin,
$installer,
$lib_dir,
$mas_path,
$outfile,
}
}
$installer = Installer->new(0, 0, 0755, 0755, 0644);
# Install `executable'.
die("IO::File failed with $!")
$infile->close();
$outfile->close();
$infile = $outfile = undef;
$install_bin = "install -D -o 0 -g 0";
$install = "install -D -o 0 -g 0 -m 644";
system("$install_bin mtn-browse.out ${prefix_dir}/bin/mtn-browse");
$installer->install("mtn-browse.out", "${prefix_dir}/bin/mtn-browse");
unlink("mtn-browse.out");
# Install modules and libraries.
if (! defined($dir = IO::Dir->new("lib/perl")));
while (defined($file = $dir->read()))
{
system("$install lib/perl/$file ${lib_dir}/perl/$file")
$installer->install("lib/perl/$file", "${lib_dir}/perl/$file")
if ($file =~ m/.*\.pm$/);
}
$dir->close();
if (! defined($dir = IO::Dir->new($mas_dir)));
while (defined($file = $dir->read()))
{
system("$install ${mas_dir}/$file ${lib_dir}/perl/Monotone/$file")
$installer->install("${mas_dir}/$file",
"${lib_dir}/perl/Monotone/$file")
if ($file =~ m/.*\.pm$/ || $file =~ m/.*\.pod$/);
}
$dir->close();
# Install GUI components.
system("$install lib/ui/mtn-browse.glade ${lib_dir}/ui/mtn-browse.glade");
$installer->install("lib/ui/mtn-browse.glade",
"${lib_dir}/ui/mtn-browse.glade");
die("IO::Dir failed with $!")
if (! defined($dir = IO::Dir->new("lib/ui/pixmaps")));
while (defined($file = $dir->read()))
{
system("$install lib/ui/pixmaps/$file ${lib_dir}/ui/$file")
$installer->install("lib/ui/pixmaps/$file", "${lib_dir}/ui/$file")
if ($file =~ m/.*\.png$/);
}
$dir->close();
my $locale = $1;
system("msgfmt --output-file=translations/${locale}.mo "
. "translations/$file");
system("$install translations/${locale}.mo "
. "${prefix_dir}/share/locale/${locale}/LC_MESSAGES/"
. "mtn-browse.mo");
$installer->install("translations/${locale}.mo",
"${prefix_dir}/share/locale/${locale}/"
. "LC_MESSAGES/mtn-browse.mo");
}
}
$dir->close();

Archive Download the corresponding diff file

Branches

Tags

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