##
# Copyright (c) 2008 Health Market Science, Inc
##
package _TMP;
use strict;
use warnings;
our $CVS_ID = '$Id: emacs-utils.el,v 1.82 2008/07/11 13:35:40 kburton Exp $'; #'
our $VERSION = ( qw$Revision: 1.82 $ )[1];

=head1 NAME

This program, when run with the 'break' command, introduces a bit
error into the given file.  It turns on the high bit (the 8th bit)
every 32 characters.  When run with the 'fix' command, it sets the
high bit (the 8th bit) to zero.

=cut

sub run {
  my($self,$cmd,$input,$output) = @_;

  die "Error, you must supply a valid command, try one of 'break' or 'fix'\n" 
    unless $cmd;

  unless ($input && -f $input) {
    die "Error you must supply an input file and it must exist.";
  }

  unless ($output) {
    die "Error you must supply an output.";
  }

  my $size = 32;
  return $self->breakFile($input,$output,$size) if $cmd eq 'break';
  return $self->fixFile($input,$output,$size)   if $cmd eq 'fix';
  die "Error, you must supply a valid command, try one of 'break' or 'fix'\n";
}

sub breakFile {
  my($self,$input,$output,$size) = @_;
  my $data = $self->readFile($input);
  my @result;
  my $mask = 128;
  while (length $data > $size) {
    my $seg = substr $data, 0, $size, '';
    my $ch = substr $seg, -1, 1, '';
    print "break, changing ch=$ch:",ord($ch)," to: ",chr( ord($ch) | $mask ),":",( ord($ch) | $mask ),"\n";
    $ch = chr( ord($ch) | $mask );
    push @result, $seg, $ch;
  }
  $self->writeFile($output,@result,$data);
  return 1;
}

sub fixFile {
  my($self,$input,$output,$size) = @_;
  my $data = $self->readFile($input);
  my @result;
  my $mask = 127;
  while (length $data > $size) {
    my $seg = substr $data, 0, $size, '';
    my $ch = substr $seg, -1, 1, '';
    print "fix, changing ch=$ch:",ord($ch)," to: ",chr( ord($ch) & $mask ),":",( ord($ch) & $mask ),"\n";
    $ch = chr( ord($ch) & $mask );
    push @result, $seg, $ch;
  }
  $self->writeFile($output,@result,$data);
  return 1;
}

sub writeFile {
  my($self,$file,@data) = @_;
  my $fh = $self->openFile($file,">");
  print $fh @data;
  close $fh;
  return 1;
}

sub readFile {
  my($self,$file) = @_;
  local $/ = undef;
  my $fh = $self->openFile($file);
  my $d = <$fh>;
  close $fh;
  return $d;
}

sub openFile {
  my($self,$file,$mode) = @_;
  $mode = '<' unless defined $mode;
  my $fh;
  unless (open $fh, $mode, $file) {
    die "Error opening file: '$mode' '$file' : $!\n";
  }
  return $fh;
}



1;

_TMP->run(@ARGV);