App-Fetchware
view release on metacpan or search on metacpan
bin/fetchware view on Meta::CPAN
sub cmd_list {
my @installed_packages = glob catfile(fetchware_database_path(), '*');
if (@installed_packages == 0) {
msg 'No fetchware packages are currently installed.';
return;
}
msg 'Listing all currently installed packages:';
for my $fetchware_package (@installed_packages) {
# Clean up $fetchware_package.
$fetchware_package = file($fetchware_package)->basename();
$fetchware_package =~ s/\.fpkg$//;
msg $fetchware_package;
}
}
###BUGALERT### It could parse all installed Fetchwarefile's to obtain a listing
#of all temp_dirs that are used, and clean them as well!!!!
###BUGALERT### Use --force to parse all temp_dir's in installed packages, and
#clean them too?? Let it receive an arg to a dir to clean of fetchware crap???
sub cmd_clean {
# If user specified no specific directories to clean, then clean the default
# system tmpdir().
my @fetchware_temp_dirs = scalar @_ ? @_ : tmpdir();
my @globbed_fetchware_temp_dirs;
# Build a list of fetchware temporary directories across tmpdir() and any
# user provided paths on the command line.
for my $fetchware_temp_dir (@fetchware_temp_dirs) {
# What the user specified or tmpdir() must be a directory.
die <<EOD if not -d $fetchware_temp_dir;
fetchware: The specified directory [$fetchware_temp_dir] is not a directory or
does not exist. Please only specify directories that exist, and ones you have
read and write permission in. OS error [$!].
EOD
# Store all of the fetchware-* temp dirs in @globbed_fetchware_temp_dirs
# for later processing.
for my $fetchware_file_or_dir (
glob(catfile($fetchware_temp_dir, 'fetchware-*')),
glob(catfile($fetchware_temp_dir, 'Fetchwarefile-*'))
) {
# If it's a directory add it to the queue of directories to delete
# below.
if (-d $fetchware_file_or_dir) {
push @globbed_fetchware_temp_dirs, $fetchware_file_or_dir;
# If it's just a file just delete right away.
} else {
###BUGALERT### Should I check if the current user has perms to
#delete the file before deleting it? What about root? Should
#root delete all files found even for other users? I'll go with
#the Unix default of just doing the operation, and dealing with
#the error message you receive to avoid the complexity of
#checking perms. Furthermore, what about Unix ACLs and Windows'
#ACL style perms? It's not worth dealing with that hassel.
unlink $fetchware_file_or_dir or die <<EOD;
fetchware: Failed to unlink file [$fetchware_file_or_dir]. OS error [$!].
EOD
vmsg <<EOM;
fetchware clean found and deleted file [$fetchware_file_or_dir].
EOM
}
}
}
msg "fetchware clean found no fetchware temporary directories to clean"
if @globbed_fetchware_temp_dirs < 1;
# Holds the number of directories that had errors when they were
# deleted.
my $num_remove_tree_errors = 0;
# Number of directories remove_tree removed successfully.
my $num_remove_tree_successes = 0;
# Loop over fetchware temp dirs, and delete the ones that are not locked.
for my $temp_dir (@globbed_fetchware_temp_dirs) {
# Try to lock the 'fetchware.sem' semaphore lock file
# I annoying must open the file before I can see if I can lock it or
# not.
my $sem_lock_file = catfile($temp_dir, 'fetchware.sem');
my $fh_sem;
if (open $fh_sem, '>', $sem_lock_file) {
vmsg "Successfully created [fetchware.sem] semaphore lock file.";
} else {
# Test if the lockfile has the same owner uid as this running perl
# process, and if they differ skip deleting this one, because we
# lack the perms to do it anyway.
if ($> != (stat($sem_lock_file))[4]) {
msg "Skipping file [$sem_lock_file], because a different user created it.";
next;
} else {
die <<EOD;
App-Fetchware-Util: Failed to create [$sem_lock_file] semaphore lock file! This
should not happen, because fetchware is creating this file in a brand new
directory that only fetchware should be accessing. You simply shouldn't see this
error unless some one is messing with fetchware, or perphaps there actually is a
bug? I don't know, but this just shouldn't happen. It's so hard to trigger it to
happen, it can't easily be tested in fetchware's test suite. OS error [$!].
EOD
}
}
# Now flock 'fetchware.sem.' This should
# Use LOCK_NB so flock won't stupidly wait forever and ever until
# he lock becomes available.
# If flock fails, don't die! Instead, just skip deleting this
# fetchware temporary directory, and go on to the next one.
unless (flock $fh_sem, LOCK_EX | LOCK_NB) {
# Flock failed, something else has the lock, print message, and skip
# this directory, and go on to the next one.
msg <<EOM;
[$temp_dir] locked by another fetchware process. Skipping.
EOM
bin/fetchware view on Meta::CPAN
# will use the exact filenames that you provide, so I need to remove the
# unneeded machine specific paths from the paths that will be stored in the
# fetchware package.
$_ = abs2rel($_) for @file_list;
my $tar = Archive::Tar->new();
# Add the $fetchwarefile to the new fetchware package.
#
# Create a Archive::Tar::File object to represent the Fetchwarefile without
# bothering to write it to disk, or use the Fetchwarefile, which may or may
# not already be on the disk.
#
# Be sure to deref $fetchwarefile, becauses it's passed in as a ref.
my $tar_fetchwarefile
=
Archive::Tar::File->new(data => './Fetchwarefile', $$fetchwarefile)
or die <<EOD;
fetchware: Failed to create a Archive::Tar::File object to represent your
Fetchwarefile
[$fetchwarefile]
Archive::Tar error [@{[Archive::Tar->error()]}].
EOD
$tar->add_files($tar_fetchwarefile) or die <<EOD;
fetchware: Failed to add your Fetchwarefile to fetchware's internal Archive::Tar
object. Archive::Tar error [@{[Archive::Tar->error()]}].
EOD
# Add all of the other files to the Fetchware package.
$tar->add_files(@file_list) or die <<EOD;
fetchware: Failed to add all of your program's files to fetchware's internal
Archvie::Tar object. Archive::Tar error [@{[Archive::Tar->error()]}].
EOD
$tar->write($fetchware_package_full_path, COMPRESS_GZIP) or die <<EOD;
fetchware: Failed to write Archive::Tar's in-memeory tar file to disk.
Archive::Tar error [@{[Archive::Tar->error()]}].
EOD
# chdir() back to original directory.
chdir($previous_cwd) or die <<EOD;
fetchware: run-time error. Fetchware failed to change its working directory from
[@{[cwd()]}] to [$previous_cwd]. The os error was [$!].
EOD
# Return a fullpath version of $fetchware_package_name.
return $fetchware_package_full_path;
}
sub fetchware_database_path {
# If user specifically specifies their own fetchware database path in their
# fetchwarefile use it instead of the default one.
my $fetchware_database_path;
if (defined config('fetchware_db_path')) {
$fetchware_database_path = config('fetchware_db_path');
} elsif (defined $ENV{FETCHWARE_DATABASE_PATH}) {
$fetchware_database_path = $ENV{FETCHWARE_DATABASE_PATH};
} elsif (is_os_type('Unix', $^O)) {
# If we're effectively root use a "system" directory.
if ($> == 0) {
# Fetchware is modeled slightly after Slackware's package manager,
# which keeps its package database under /var/log/packages.
$fetchware_database_path = '/var/log/fetchware';
# else use a "user" directory.
} else {
$fetchware_database_path
=
File::HomeDir->my_dist_data('fetchware', { create => 1 });
}
} elsif ($^O eq "MSWin32") {
# Load main Windows module to use to see if we're Administrator or not.
BEGIN {
if ($^O eq "MSWin32")
{
require Win32;
Win32->import(); # assuming you would not be passing arguments to "use Module"
}
}
if (Win32::IsAdminUser()) {
# Is this an appropriate default?
$fetchware_database_path = 'C:\Fetchware';
} else {
$fetchware_database_path
=
File::HomeDir->my_dist_data('fetchware' , { create => 1 });
}
# Fall back on File::HomeDir's recommendation if not "Unix" or windows.
###BUGALERT### Is this appropriate for Mac OSX???? /Fetchware perhaps?????
} else {
$fetchware_database_path
=
File::HomeDir->my_dist_data('fetchware', { create => 1 });
}
vmsg <<EOM;
Determined fetchware database path to be: [$fetchware_database_path]
EOM
return $fetchware_database_path;
}
sub determine_fetchware_package_path {
my $fetchware_package = shift;
my ($package, $filename, $line) = caller;
my $fetchware_db_glob = catfile(fetchware_database_path(), '*');
my @fetchware_package_filenames
=
grep /$fetchware_package/, glob $fetchware_db_glob;
die <<EOD if @fetchware_package_filenames == 0;
fetchware: Fetchware failed to determine the fetchware package that is
associated with the argument that you provided to fetchware
[$fetchware_package]. In this case, fetchware only allows arguments for
fetchware packages that have already been installed. Please run fetchware list
to obtain a list of installed packages to choose from.
EOD
###BUGALERT### Use Term::UI, and output a numbered list for the user to
#choose from using a prompt, and then rerun upgrade with that argument.
if (@fetchware_package_filenames > 1) {
# Print beginning of message to STDERR.
warn <<EOW;
fetchware: Too many installed packages match the argument you provided to the
upgrade command. Your argument was [$fetchware_package], and the multiple
results it returned were:
EOW
# Print modified array values to STDERR.
for (@fetchware_package_filenames) {
warn file($_)->basename(), "\n";
}
# Print closing of message to STDERR.
die <<EOD;
Choose which package from the list above you want to upgrade, and rerun
fetchware upgrade using it as the argument for the package you want to upgrade.
EOD
}
# Return the first and only result.
return $fetchware_package_filenames[0];
}
sub extract_fetchwarefile {
my ($fetchware_package_path) = @_;
# safe_open() the fetchware package path, which ends with .fpkg, but it
# actually a .tar.gz.
my $fh = safe_open($fetchware_package_path, <<EOD);
fetchware: run-time error. fetchware failed to open the Fetchwarefile you
specified on the command line [$fetchware_package_path]. Please check
permissions and try again. See perldoc App::Fetchware. OS error [$!].
EOD
# Create a temporary file to write the ungzipped file to.
my ($output_fh, $gunzipped_path) = tempfile("fetchware-$$-XXXXXXXXXXX",
TMPDIR => 1, UNLINK => 1);
gunzip($fh => $output_fh) or die <<EOD;
fetchware: IO::Uncompress::Gunzip::gunzip failed to un gzip
[$fetchware_package_path]. Gunzip's error [$GunzipError].
EOD
my $tar = Archive::Tar->new();
# seek the $output_fh back to its beginning, so tar can reuse it.
seek $output_fh, 0, SEEK_SET;
# read in the same output filehandle that gunzip() wrote the uncompressed tar
# file to. This prevents any race conditions, and other users from messing
# with our version of the open file.
$tar->read($output_fh) or die <<EOD;
fetchware: Archive::Tar failed to read in the gunziped file [$gunzipped_path]
that was previously gziped as [$fetchware_package_path].
Archive::Tar error [@{[Archive::Tar->error()]}].
EOD
my $fetchwarefile = $tar->get_content('./Fetchwarefile')
or die <<EOD;
fetchware: run-time error. fetchware failed to extract your fetchware package's
Fetchwarefile from the argument you specified on the command line [@ARGV].
Archive::Tar error [@{[$tar->error()]}]. Please see perldoc App::Fetchware.
EOD
# Return a scalar ref of the $fetchwarefile that makes up the Fetchwarefile.
# Do not
return \$fetchwarefile;
}
sub copy_fpkg_to_fpkg_database {
my $fetchware_package_path = shift;
my $fetchware_db_path = fetchware_database_path();
unless (-e $fetchware_db_path) {
# Just use make_path() from File::Path to avoid having to check if
# directories that contain the fetchware db directory have been created
# or not. I doubt /var and /var/log won't exist on *nix systems, but
# they probably don't on Mac OSX, which is kinda *nix.
make_path($fetchware_db_path) or die <<EOD;
fetchware: run-time error. fetchware failed to create the directory that it
needs to store its database of installed packages in [$fetchware_db_path].
Library function error [$@].
EOD
}
cp($fetchware_package_path, $fetchware_db_path) or die <<EOD;
fetchware: run-time error. fetchware failed to copy the specified
fetchware package path [$fetchware_package_path] to [$fetchware_db_path]. Please
see perldoc App::Fetchware.
EOD
# Return the full path to the fetchware package that has been copied.
my $fetchware_package_path_basename
= dir($fetchware_package_path)->basename();
return catfile($fetchware_db_path, $fetchware_package_path_basename);
}
sub uninstall_fetchware_package_from_database {
my $uninstall_package_name = shift;
# Don't make preexisting absolute paths absolute again.
$uninstall_package_name
=
catfile(fetchware_database_path(), $uninstall_package_name)
unless file_name_is_absolute($uninstall_package_name);
unlink $uninstall_package_name
or die <<EOD;
fetchware: Fetchware successfully uninstalled the fetchware package you
requested [$uninstall_package_name], but it failed to also delete the
corresponding fetchware package from its database Os error [$!].
EOD
}
1;
=pod
=head1 NAME
fetchware - Fetchware is a package manager for source code distributions.
=head1 VERSION
version 1.016
=head1 SYNOPSIS
=head2 Manpage synopsis.
fetchware [-v | --verbose] [-q | --quiet] [-h | -? | --help]
[-V | --version] <command> [<filenames | paths | Fetchwarfiles>]
=head2 L<Create a new fetchware package.|/new>
bin/fetchware view on Meta::CPAN
# But some uses in test suites thanks to safe_open() need to be able to
# specify where they should write the new fetchware package's path to.
my $fetchware_package_full_path
=
create_fetchware_package($fetchwarefile,
$unarchived_package_path
$path_to_new_fpkg);
Creates a fetchware package, ending in .fpkg, using $unarchived_package_path, as
the directory to archive. Also, adds the C<Fetchwarefile> stored in the
scalar $fetchwarefile argument to the fethware package that is created.
You can specify an optional $path_to_new_fpkg, which will be a directory where
create_fetchware_package() will write the new fetchware package to.
Returns the full pathname to the fetchware package that was created.
=head2 fetchware_database_path()
my $fetchware_database_path = fetchware_database_path();
Returns the correct path for the fetchware package database based on operating
system and if super user or not.
Also, supports user customizable fetchware database paths via the
C<FETCHWARE_DATABASE_PATH> environment variable, and the
C<fetchware_database_path> Fetchwarefile configuration file. If both are
specified C<fetchware_database_path> is prefered over
C<FETCHWARE_DATABASE_PATH>.
=head2 determine_fetchware_package_path()
my $fetchware_package_filename = determine_fetchware_package_path($fetchware_package);
Looks up the $fetchware_package in C<fetchware_database_path()>, and returns the
full path to that given $fetchware_package.
=over
=item NOTE
determine_fetchware_package_path() could potentially come up with more than one
result if you have multiple versions of apache or other similarly named packages
installed at the same time. If this happens an exception is thrown asking the
user to specify a more specific name to query the fetchware database with.
=back
=head2 extract_fetchwarefile()
my $fetchwarefile = extract_fetchwarefile($fetchware_package_path);
Extracts out the Fetchwarefile of the provided fetchware package as specified by
$fetchware_package_path, and returns the content of the Fetchwarefile as a
scalar reference. Throws an exception if it it fails.
=head2 copy_fpkg_to_fpkg_database()
my $fetchware_package_path = copy_fpkg_to_fpkg_database($fetchwarefile_path);
Installs (just copies) the specified fetchware package to the fetchware
database, which is /var/log/fetchware on UNIX, C:\FETCHWARE on Windows with
root or Administrator. All others are whatever L<File::HomeDir> says. For Unix
or Unix-like systems such as linux, L<File::HomeDir> will put your own user
fetchware database independent of the system-wide one in C</var/log/fetchware>
in C<~/.local/share/Perl/dist/fetchware/>. This correctly follows some sort of
standard. XDG or FreeDesktop perhaps?
Creates the directory the fetchware database is stored in if it does not already
exist.
Returns the full path of the copied fetchware package.
=head2 uninstall_fetchware_package_from_database()
uninstall_fetchware_package_from_database($uninstall_package_name);
Deletes the specified $uninstall_package_name from the fetchware package
database. Throws an exception on error.
=head1 THE FETCHWARE PACKAGE
Like other package managers, fetchware has its own package format:
=over
=item *
It ends with a C<.fpkg> file extension.
=item *
The package path, the location of the unarchived downloaded program, is simply
archived again using L<Archive::Tar>, and compressed with gzip.
=item *
But before the package path is archived the currently used Fetchwarefile is
copied into the current directory, so that it is included with your fetchware
package:
./Fetchwarefile
httpd-2.2.x
httpd-2.2.x/README
httpd-2.2.x/INSTALL
....
=back
This simple package format was chosen instead of using a native package format
such as a Microsoft C<.msi> package, Slackware format, rpm format, C<.deb>
format, and so on. Thanks to distros like Gentoo and Arch, there are even more
formats now. Also, each version of BSD has its own package format, and each
version of commerical UNIX has its own package format too. ...It was easier to
create a new format, then deal with all of the existing ones.
This custom package format is unique, bare bones, and retains all of the power
that installing the software from source manaully gives you.
=over
=item *
Simple, and retains backward compatibility with manual installation.
=item *
The package format includes the source code, so it can be recompiled if you
move the fetchware package to an architecture different than the one it was
compiled on.
=item *
You can specify whatever configure and build options you want, so you're not
stuck with whatever your distro's package maintainer has chosen.
=back
=head1 FAQ
=head2 How does fetchware's database work?
The design of fetchware's database was copied after Slackware's package database
design. In Slackware each package is a file in C</var/log/packages>, an
example: C</var/log/packages/coreutils-8.14-x86_64_slack13.37>. And inside that
file is a list of files, whoose names are the locations of all of the files that
this Slackware package installed. This format is really simple and flexible.
Fetchware's database is simply the directory C</var/log/fetchware> (on Unix when
run as root), or whatever File::HomeDir recommends. When packages are installed
the final version of that package that ends with C<.fpkg> is copied to your
fetchware database path. So after you install apache your fetchware database
will look like:
ls /var/log/fetchware
httpd-2.4.3.fpkg
It's not a real database or anything cool like that. It is simply a directory
containting a list of fetchware packages that have been installed. However, this
directory is managed by fetchware, and should not be messed with unless you are
sure of what you are doing.
=head2 What exactly is a fetchware package?
A fetchware package is a gziped tar archive with its file extension changed to
C<.fpkg>. This archive consists of the package that was downloaded in addition
to your Fetchwarefile. For example.
tar tvf httpd-2.4.3.fpkg
./Fetchwarefile
httpd-2.4.3/README
httpd-2.4.3/...
...
See the section L<THE FETCHWARE PACKAGE> to see all of the cool things you can
do with them.
=head1 ERRORS
As with the rest of Fetchware, fetchware does not return any
error codes; instead, all errors are die()'d if it's fetchware's
error, or croak()'d if its the caller's fault.
=head1 CAVEATS
=over
=item WINDOWS COMPATIBILITY
Fetchware was written on Linux and tested by its author B<only> on Linux.
However, it should work on popular Unixes without any changes. But it has B<not>
been ported or tested on Windows yet, so it may work, or parts of it may work,
but some might not. However, I have used File::Spec and Path::Class to support
path and file manipulation accross all Perl-supported platorms, so that code
should work on Windows. I intend to add Windows support, and add tests for Windows
in the future, but for now it is unsupported, but may work. This is likely to
improve in the future.
=back
=head1 SEE ALSO
L<pkgsrc|http://www.pkgsrc.org/>, L<paco|http://paco.sourceforge.net/>,
L<porg|http://porg.sourceforge.net/>, L<slackbuilds|http://slackbuilds.org/>,
L<sbopkg|http://sbopkg.org/>, L<fpm|https://github.com/jordansissel/fpm>,
L<checkinstall|http://asic-linux.com.mx/~izto/checkinstall/>
=head1 AUTHOR
David Yingling <deeelwy@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2016 by David Yingling.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__END__
###BUGALERT###Should I implement dryrun functionality???
#=head2 -d or --dryrun
#
#Just prints out what fetchware will do when you run fetchware. No external
#commands are run, and fetchware itself doesn't read or create any files
#including any temporary directories.
#
####BUGALERT### dryrun functionality is not implemnted.
## Should be easy to implement in run_prog(), and create a sub like
## skip_all_unless_release_testing() to test for -d.
###BUGALERT###What about -f and --force too??????
#=head2 -f or --force
#
####BUGALERT### Do I want or need --force???
#
( run in 1.206 second using v1.01-cache-2.11-cpan-64ef6c95b5d )