# # # add_file "Installer.pm" # content [5d7f0d6610fddf4c9693d91c32c7019fb46ba15c] # # patch "linux-install" # from [aceddec4b837cf70358e5350dc1f7916fedcb18a] # to [ed83eab524b9f196af92087e973a82b806cfe5fe] # ============================================================ --- Installer.pm 5d7f0d6610fddf4c9693d91c32c7019fb46ba15c +++ Installer.pm 5d7f0d6610fddf4c9693d91c32c7019fb46ba15c @@ -0,0 +1,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 +# . +# +# 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 aceddec4b837cf70358e5350dc1f7916fedcb18a +++ linux-install ed83eab524b9f196af92087e973a82b806cfe5fe @@ -50,6 +50,10 @@ use IO::File; use IO::Dir; use IO::File; + +# Modules specific to this application. + +use Installer; # ############################################################################## # @@ -71,8 +75,7 @@ use IO::File; $globs_file, $infile, $input, - $install, - $install_bin, + $installer, $lib_dir, $mas_path, $outfile, @@ -164,6 +167,8 @@ use IO::File; } } + $installer = Installer->new(0, 0, 0755, 0755, 0644); + # Install `executable'. die("IO::File failed with $!") @@ -180,9 +185,7 @@ use IO::File; $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. @@ -191,7 +194,7 @@ use IO::File; 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(); @@ -214,7 +217,8 @@ use IO::File; 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(); @@ -222,12 +226,13 @@ use IO::File; # 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(); @@ -243,9 +248,9 @@ use IO::File; 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();