SYNOPSIS

use Mail::Toaster::Utility;
my $toaster = Mail::Toaster::Utility->new;

$util->file_write($file, lines=> @lines);

This is just one of the many handy little methods I have amassed here. Rather than try to remember all of the best ways to code certain functions and then attempt to remember them, I have consolidated years of experience and countless references from Learning Perl, Programming Perl, Perl Best Practices, and many other sources into these subroutines.

DESCRIPTION

This Mail::Toaster::Utility package is my most frequently used one. Each method has its own documentation but in general, all methods accept as input a hashref with at least one required argument and a number of optional arguments.

DIAGNOSTICS

All methods set and return error codes (0 = fail, 1 = success) unless otherwise stated.

Unless otherwise mentioned, all methods accept two additional parameters:

verbose - to print status and verbose error messages, set verbose=>1.
fatal - die on errors. This is the default, set fatal=>0 to override.

DEPENDENCIES

Perl.
Scalar::Util -  built-in as of perl 5.8

Almost nothing else. A few of the methods do require certian things, like extract_archive requires tar and file. But in general, this package (Mail::Toaster::Utility) should run flawlessly on any UNIX-like system. Because I recycle this package in other places (not just Mail::Toaster), I avoid creating dependencies here.

METHODS

new

To use any of the methods below, you must first create a utility object. The methods can be accessed via the utility object.

############################################
# Usage      : use Mail::Toaster::Utility;
#            : my $util = Mail::Toaster::Utility->new;
# Purpose    : create a new Mail::Toaster::Utility object
# Returns    : a bona fide object
# Parameters : none
############################################
ask

Get a response from the user. If the user responds, their response is returned. If not, then the default response is returned. If no default was supplied, 0 is returned.

############################################
# Usage      :  my $ask = $util->ask( "Would you like fries with that",
#  		           default  => "SuperSized!",
#  		           timeout  => 30
#               );
# Purpose    : prompt the user for information
#
# Returns    : S - the users response (if not empty) or
#            : S - the default ask or
#            : S - an empty string
#
# Parameters
#   Required : S - question - what to ask
#   Optional : S - default  - a default answer
#            : I - timeout  - how long to wait for a response
# Throws     : no exceptions
# See Also   : yes_or_no
extract_archive

Decompresses a variety of archive formats using your systems built in tools.

############### extract_archive ##################
# Usage      : $util->extract_archive( 'example.tar.bz2' );
# Purpose    : test the archiver, determine its contents, and then
#              use the best available means to expand it.
# Returns    : 0 - failure, 1 - success
# Parameters : S - archive - a bz2, gz, or tgz file to decompress
cwd_source_dir

Changes the current working directory to the supplied one. Creates it if it does not exist. Tries to create the directory using perl's builtin mkdir, then the system mkdir, and finally the system mkdir with sudo.

############ cwd_source_dir ###################
# Usage      : $util->cwd_source_dir( "/usr/local/src" );
# Purpose    : prepare a location to build source files in
# Returns    : 0 - failure,  1 - success
# Parameters : S - dir - a directory to build programs in
check_homedir_ownership

Checks the ownership on all home directories to see if they are owned by their respective users in /etc/password. Offers to repair the permissions on incorrectly owned directories. This is useful when someone that knows better does something like "chown -R user /home /user" and fouls things up.

######### check_homedir_ownership ############
# Usage      : $util->check_homedir_ownership();
# Purpose    : repair user homedir ownership
# Returns    : 0 - failure,  1 - success
# Parameters :
#   Optional : I - auto - no prompts, just fix everything
# See Also   : sysadmin

Comments: Auto mode should be run with great caution. Run it first to see the results and then, if everything looks good, run in auto mode to do the actual repairs.

chown_system

The advantage this sub has over a Pure Perl implementation is that it can utilize sudo to gain elevated permissions that we might not otherwise have.

############### chown_system #################
# Usage      : $util->chown_system( dir=>"/tmp/example", user=>'matt' );
# Purpose    : change the ownership of a file or directory
# Returns    : 0 - failure,  1 - success
# Parameters : S - dir    - the directory to chown
#            : S - user   - a system username
#   Optional : S - group  - a sytem group name
#            : I - recurse - include all files/folders in directory?
# Comments   : Uses the system chown binary
# See Also   : n/a
clean_tmp_dir
############## clean_tmp_dir ################
# Usage      : $util->clean_tmp_dir( $dir );
# Purpose    : clean up old build stuff before rebuilding
# Returns    : 0 - failure,  1 - success
# Parameters : S - $dir - a directory or file.
# Throws     : die on failure
# Comments   : Running this will delete its contents. Be careful!
get_mounted_drives
############# get_mounted_drives ############
# Usage      : my $mounts = $util->get_mounted_drives();
# Purpose    : Uses mount to fetch a list of mounted drive/partitions
# Returns    : a hashref of mounted slices and their mount points.
archive_file
############### archive_file #################
# Purpose    : Make a backup copy of a file by copying the file to $file.timestamp.
# Usage      : my $archived_file = $util->archive_file( $file );
# Returns    : the filename of the backup file, or 0 on failure.
# Parameters : S - file - the filname to be backed up
# Comments   : none
chmod

Set the permissions (ugo-rwx) of a file. Will use the native perl methods (by default) but can also use system calls and prepend sudo if additional permissions are needed.

  $util->chmod(
		file_or_dir => '/etc/resolv.conf',
		mode => '0755',
		sudo => $sudo
  )

 arguments required:
   file_or_dir - a file or directory to alter permission on
   mode   - the permissions (numeric)

 arguments optional:
   sudo  - the output of $util->sudo

 result:
   0 - failure
   1 - success
chown

Set the ownership (user and group) of a file. Will use the native perl methods (by default) but can also use system calls and prepend sudo if additional permissions are needed.

  $util->chown(
		file_or_dir => '/etc/resolv.conf',
		uid => 'root',
		gid => 'wheel',
		sudo => 1
  );

 arguments required:
   file_or_dir - a file or directory to alter permission on
   uid   - the uid or user name
   gid   - the gid or group name

 arguments optional:
   file  - alias for file_or_dir
   dir   - alias for file_or_dir
   sudo  - the output of $util->sudo

 result:
   0 - failure
   1 - success
file_delete
 ############################################
 # Usage      : $util->file_delete( $file );
 # Purpose    : Deletes a file.
 # Returns    : 0 - failure, 1 - success
 # Parameters
 #   Required : file - a file path
 # Comments   : none
 # See Also   :

Uses unlink if we have appropriate permissions, otherwise uses a system rm call, using sudo if it is not being run as root. This sub will try very hard to delete the file!
get_url
$util->get_url( $url, verbose=>1 );

Use the standard URL fetching utility (fetch, curl, wget) for your OS to download a file from the $url handed to us.

arguments required:
  url - the fully qualified URL

arguments optional:
  timeout - the maximum amount of time to try

result:
  1 - success
  0 - failure
file_is_newer

compares the mtime on two files to determine if one is newer than another.

file_mode
usage:
  my @lines = "1", "2", "3";  # named array
  $util->file_write ( "/tmp/foo", lines=>\@lines );
       or
  $util->file_write ( "/tmp/foo", lines=>['1','2','3'] );  # anon arrayref

required arguments:
  mode - the files permissions mode

result:
  0 - failure
  1 - success
file_read

Reads in a file, and returns it in an array. All lines in the array are chomped.

  my @lines = $util->file_read( $file, max_lines=>100 )

arguments required:
  file - the file to read in

arguments optional:
  max_lines  - integer - max number of lines
  max_length - integer - maximum length of a line

result:
  0 - failure
  success - returns an array with the files contents, one line per array element
file_write
usage:
  my @lines = "1", "2", "3";  # named array
  $util->file_write ( "/tmp/foo", lines=>\@lines );
       or
  $util->file_write ( "/tmp/foo", lines=>['1','2','3'] );  # anon arrayref

required arguments:
  file - the file path you want to write to
  lines - an arrayref. Each array element will be a line in the file

result:
  0 - failure
  1 - success
files_diff

Determine if the files are different. $type is assumed to be text unless you set it otherwise. For anthing but text files, we do a MD5 checksum on the files to determine if they are different or not.

  $util->files_diff( f1=>$file1,f2=>$file2,type=>'text',verbose=>1 );

  if ( $util->files_diff( f1=>"foo", f2=>"bar" ) )
  {
      print "different!\n";
  };

required arguments:
  f1 - the first file to compare
  f2 - the second file to compare

arguments optional:
  type - the type of file (text or binary)

result:
  0 - files are the same
  1 - files are different
 -1 - error.
find_bin

Check all the "normal" locations for a binary that should be on the system and returns the full path to the binary.

$util->find_bin( 'dos2unix', dir=>'/opt/local/bin' );

Example:

  my $sudo = $util->find_bin( "sudo", dir => "/usr/local/sbin" );


arguments required:
  bin - the name of the program (its filename)

arguments optional:
  dir - a directory to check first

results:
  0 - failure
  success will return the full path to the binary.
find_config

This sub is called by several others to determine which configuration file to use. The general logic is as follows:

If the etc dir and file name are provided and the file exists, use it.

If that fails, then go prowling around the drive and look in all the usual places, in order of preference:

/opt/local/etc/
/usr/local/etc/
/etc

Finally, if none of those work, then check the working directory for the named .conf file, or a .conf-dist.

Example: my $twconf = $util->find_config ( 'toaster-watcher.conf', etcdir => '/usr/local/etc', )

arguments required:
  file - the .conf file to read in

arguments optional:
  etcdir - the etc directory to prefer

result:
  0 - failure
  the path to $file
get_my_ips

returns an arrayref of IP addresses on local interfaces.

is_process_running

Verify if a process is running or not.

$util->is_process_running($process) ? print "yes" : print "no";

$process is the name as it would appear in the process table.

is_readable
############################################
# Usage      : $util->is_readable( file=>$file );
# Purpose    : ????
# Returns    : 0 = no (not reabable), 1 = yes
# Parameters : S - file - a path name to a file
# Throws     : no exceptions
# Comments   : none
# See Also   : n/a

result:
   0 - no (file is not readable)
   1 - yes (file is readable)
is_writable

If the file exists, it checks to see if it is writable. If the file does not exist, it checks to see if the enclosing directory is writable.

############################################
# Usage      : $util->is_writable( "/tmp/boogers");
# Purpose    : make sure a file is writable
# Returns    : 0 - no (not writable), 1 - yes (is writeable)
# Parameters : S - file - a path name to a file
# Throws     : no exceptions
fstab_list
############ fstab_list ###################
# Usage      : $util->fstab_list;
# Purpose    : Fetch a list of drives that are mountable from /etc/fstab.
# Returns    : an arrayref
# Comments   : used in backup.pl
# See Also   : n/a
get_dir_files
  $util->get_dir_files( $dir, verbose=>1 )

required arguments:
  dir - a directory

result:
  an array of files names contained in that directory.
  0 - failure
get_the_date

Returns the date split into a easy to work with set of strings.

   $util->get_the_date( bump=>$bump, verbose=>$verbose )

 required arguments:
   none

 optional arguments:
   bump - the offset (in days) to subtract from the date.

 result: (array with the following elements)
	$dd = day
	$mm = month
	$yy = year
	$lm = last month
	$hh = hours
	$mn = minutes
	$ss = seconds

	my ($dd, $mm, $yy, $lm, $hh, $mn, $ss) = $util->get_the_date();
install_from_source
  usage:

	$util->install_from_source(
		package => 'simscan-1.07',
   	    site    => 'http://www.inter7.com',
		url     => '/simscan/',
		targets => ['./configure', 'make', 'make install'],
		patches => '',
		verbose => 1,
	);

Downloads and installs a program from sources.

required arguments:
   conf    - hashref - mail-toaster.conf settings.
   site    -
   url     -
   package -

optional arguments:
   targets - arrayref - defaults to [./configure, make, make install].
   patches - arrayref - patch(es) to apply to the sources before compiling
   patch_args -
   source_sub_dir - a subdirectory within the sources build directory
   bintest - check the usual places for an executable binary. If found, it will assume the software is already installed and require confirmation before re-installing.

result:
  1 - success
  0 - failure
install_from_source_php

Downloads a PHP program and installs it. This function is not completed due to lack o interest.

is_interactive

tests to determine if the running process is attached to a terminal.

logfile_append
$util->logfile_append( $file, lines=>\@lines )

Pass a filename and an array ref and it will append a timestamp and the array contents to the file. Here's a working example:

$util->logfile_append( $file, prog=>"proggy", lines=>["Starting up", "Shutting down"] )

That will append a line like this to the log file:

  2004-11-12 23:20:06 proggy Starting up
  2004-11-12 23:20:06 proggy Shutting down

arguments required:
  file  - the log file to append to
  prog  - the name of the application
  lines - arrayref - elements are events to log.

result:
  1 - success
  0 - failure
mailtoaster
$util->mailtoaster();

Downloads and installs Mail::Toaster.

mkdir_system
$util->mkdir_system( dir => $dir, verbose=>$verbose );

creates a directory using the system mkdir binary. Can also make levels of directories (-p) and utilize sudo if necessary to escalate.

check_pidfile

check_pidfile is a process management method. It will check to make sure an existing pidfile does not exist and if not, it will create the pidfile.

$pidfile = $util->check_pidfile( "/var/run/program.pid" );

The above example is all you need to do to add process checking (avoiding multiple daemons running at the same time) to a program or script. This is used in toaster-watcher.pl. toaster-watcher normally completes a run in a few seconds and is run every 5 minutes.

However, toaster-watcher can be configured to do things like expire old messages from maildirs and feed spam through a processor like sa-learn. This can take a long time on a large mail system so we don't want multiple instances of toaster-watcher running.

result:
  the path to the pidfile (on success).

Example:

my $pidfile = $util->check_pidfile( "/var/run/changeme.pid" );
unless ($pidfile) {
	warn "WARNING: couldn't create a process id file!: $!\n";
	exit 0;
};

do_a_bunch_of_cool_stuff;
unlink $pidfile;
regexp_test

Prints out a string with the regexp match bracketed. Credit to Damien Conway from Perl Best Practices.

 Example:
    $util->regexp_test(
		exp    => 'toast',
		string => 'mailtoaster rocks',
	);

 arguments required:
   exp    - the regular expression
   string - the string you are applying the regexp to

 result:
   printed string highlighting the regexp match
source_warning

Checks to see if the old build sources are present. If they are, offer to remove them.

 Usage:

   $util->source_warning(
		package => "Mail-Toaster-5.26",
		clean   => 1,
		src     => "/usr/local/src"
   );

 arguments required:
   package - the name of the packages directory

 arguments optional:
   src     - the source directory to build in (/usr/local/src)
   clean   - do we try removing the existing sources? (enabled)
   timeout - how long to wait for an answer (60 seconds)

 result:
   1 - removed
   0 - failure, package exists and needs to be removed.
sources_get

Tries to download a set of sources files from the site and url provided. It will try first fetching a gzipped tarball and if that files, a bzipped tarball. As new formats are introduced, I will expand the support for them here.

  usage:
	$self->sources_get(
		package => 'simscan-1.07',
		site    => 'http://www.inter7.com',
		path    => '/simscan/',
	)

 arguments required:
   package - the software package name
   site    - the host to fetch it from
   url     - the path to the package on $site

 arguments optional:
   conf    - hashref - values from toaster-watcher.conf

This sub proved quite useful during 2005 as many packages began to be distributed in bzip format instead of the traditional gzip.

sudo
my $sudo = $util->sudo();

$util->syscmd( "$sudo rm /etc/root-owned-file" );

Often you want to run a script as an unprivileged user. However, the script may need elevated privileges for a plethora of reasons. Rather than running the script suid, or as root, configure sudo allowing the script to run system commands with appropriate permissions.

If sudo is not installed and you're running as root, it'll offer to install sudo for you. This is recommended, as is properly configuring sudo.

arguments required:

result:
  0 - failure
  on success, the full path to the sudo binary
syscmd
Just a little wrapper around system calls, that returns any failure codes and prints out the error(s) if present. A bit of sanity testing is also done to make sure the command to execute is safe.

   my $r = $util->syscmd( "gzip /tmp/example.txt" );
   $r ? print "ok!\n" : print "not ok.\n";

 arguments required:
   cmd     - the command to execute

 result
   the exit status of the program you called.
_try_mkdir

try creating a directory using perl's builtin mkdir.

yes_or_no
  my $r = $util->yes_or_no(
      "Would you like fries with that?",
      timeout  => 30
  );

	$r ? print "fries are in the bag\n" : print "no fries!\n";

 arguments required:
   none.

 arguments optional:
   question - the question to ask
   timeout  - how long to wait for an answer (in seconds)

 result:
   0 - negative (or null)
   1 - success (affirmative)

TODO

make all errors raise exceptions
write test cases for every method

SEE ALSO

The following are all man/perldoc pages:

Mail::Toaster