—
—
—
—
—
—

              
package Emacs::Run::Testorama;
#                                doom@kzsu.stanford.edu
#                                24 Mar 2008
HideShow 31 lines of Pod
=head1 NAME
Emacs::Run::Testorama - routines for just for writing tests of Emacs::Run
=head1 SYNOPSIS
   use Emacs::Run::Testorama ':all';
   my $mock_home = "$Bin/dat/home/mockingbird";
   my $code_lib = "$USR/lib";
   my $code_lib_alt = "$USR/lib-alt";
   my $dot_emacs_tpl = "$SRC_LOC/templates/.emacs-template";
   create_dot_emacs_in_mock_home( $mock_home, $code_lib, $code_lib_alt, $dot_emacs_tpl );
=head1 DESCRIPTION
Emacs::Run::Testorama is a small collection of utility routines
to be used in testing the Emacs::Run package.  It is not expected
that there will be any reason to install this for use on the
system at large.
=head2 EXPORT
None by default.  The follow are available on request (all
can be requested at once using the ':all" tag).
=over
=cut
use 5.8.0;
use strict;
use warnings;
my $DEBUG = 0;
use Carp;
use Data::Dumper;
use File::Path     qw( mkpath );
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [
  # TODO Add names of items to export here.
  qw(
      create_dot_emacs_in_mock_home
      clean_whitespace
      create_dot
      echo_home
      slurp_files
      get_short_label_from_name
    ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(  );
our $VERSION = '0.01';
HideShow 8 lines of Pod
=item clean_whitespace
# trims leading and trailing whitespace on multi-line text.
# eliminates blank lines.
# this is used to make it eaisier to compare generated and expected elisp
=cut
sub clean_whitespace {
  my $text = shift;
  my $output;
  my @lines = split /\n/, $text;
  foreach my $line (@lines) {
    $line =~ s{^\s+}{}xms;
    $line =~ s{\s+$}{}xms;
    next if ($line =~ m{^ \s* $}xms);
    $output .= "$line\n";
  }
  return $output;
}
HideShow 21 lines of Pod
=item create_dot_emacs_in_mock_home
# create a .emacs for $mock_home
Args:
  first:    (path) a mock home location for a non-existant user
  second:   (path) a dummy location of elisp libraries
  third:    (path) another dummy location of elisp libraries
  fourth:   (file) the dot emacs "template" used to create a .emacs
                 for the dummy user
Note: this resorts to a number of cheesy expedients that would
not be recommended in production use: The .emacs files are
generated using a home grown template "language" where the second
and third arguments of this routine are subsituted for the
strings 'XXX' and 'YYY'.  For our current purposes, we expect
that these are elisp library locations, but nothing enforces this.
=cut
sub create_dot_emacs_in_mock_home {
  my $mock_home     = shift;
  my $code_lib      = shift;
  my $code_lib_alt  = shift;
  my $dot_emacs_tpl = shift;
  if ($DEBUG) {
    print STDERR "mock_home: $mock_home\n";
    print STDERR "code_lib: $code_lib\n";
    print STDERR "code_lib_alt: $code_lib_alt\n";
    print STDERR "dot_emacs_tpl: $dot_emacs_tpl\n";
  }
  # make sure $mock_home exists
  mkpath( $mock_home ) unless -d $mock_home;
  # read in template used to create a mock .emacs
  open my $fh_in, "<", $dot_emacs_tpl
    or die "Could not open $dot_emacs_tpl for read:$!";
  my $slurpie;
  {
    undef $/;
    $slurpie =<$fh_in>;
  }
  # munge template placeholders XXX and YYY with mock library locations.
  $slurpie =~ s{XXX}{$code_lib}xmsg;
  $slurpie =~ s{YYY}{$code_lib_alt}xmsg;
  # output the mock .emacs file in the mock home directory
  my $dot_emacs = "$mock_home/.emacs";
  open my $fh_out, ">", $dot_emacs
    or die "Could not open $dot_emacs for read:$!";
  print {$fh_out} $slurpie;
  close($fh_out);
  return $dot_emacs;
}
HideShow 6 lines of Pod
=item echo_home
Prints the current home location to STDERR (for debugging purposes).
=cut
sub echo_home {
  print STDERR "HOME is now: $ENV{HOME}\n";
}
HideShow 20 lines of Pod
=item slurp_files
Given two files (with full paths, most likely) open them, slurp in
their contents, and return a list of both of them.
This is a utility to make it slightly easier to compare the effects
of a file munging operation to an archived copy of the expected
results.
Example usage:
  my ($result, $expected) = slurp_files($result_file, $expected_file);
  eq_or_diff( $result, $expected,
              "$test_name: checking effects of upcase-region on $result_file");
  # Note: presumes Test::Differences is in use.
=cut
sub slurp_files {
  my $result_file   = shift;
  my $expected_file = shift;
  # open each file, slurp in.
  local $/; # mister slurpie
  open my $fh, "<", $result_file or die "Could not open $result_file for read:$!";
  my $result = <$fh>;
  close( $fh );
  open $fh, "<", $expected_file or die "Could not open $expected_file for read:$!";
  my $expected = <$fh>;
  close( $fh );
  return ($result, $expected);
}
sub  get_short_label_from_name {
  my $varname = shift;
  my @frags = split /-/, $varname;
  my $varlabel;
  if (scalar @frags > 3) {
    $varlabel = $frags[3];
  } else {
    $varlabel = $varname;
  }
  return $varlabel;
}
1;
HideShow 22 lines of Pod
=head1 SEE ALSO
L<Emacs::Run>
=head1 AUTHOR
Joseph Brenner, E<lt>doom@kzsu.stanford.eduE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2008 by Joseph Brenner
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.
=head1 BUGS
None reported... yet.
=cut