#!/usr/bin/perl
#
# Perl script to punch a membership card for CUCPS.
# We don't bother to try to parse the membership list file because
# this is almost certainly going to be run to punch only one or two
# cards, so why make life difficult for ourselves?
#
# To set things up we need to run 'tunelp /dev/lp1 -w 2000 -a on'.
# To reset the printer we use 'tunelp /dev/lp1 -w 0 -a off'.
# We send single bytes to the punch with a hefty delay in between.
# The format of the card is as follows:
# bytes 1-5: null
# 6-10: "CUCPS"
# 11: member status == 1 for hon. member, 0 for others
# 12-14: three bytes for membership number
# 15+: userid, trailing nulls to 34th character.

# config constants:
$CHARDELAY=2;      	# delay between chars, seconds
$DEVICE='/dev/lp1'; 	# lp device to which punch is connected
$TUNELP='tunelp';
#$DEVICE='/home/pm215/test.out';
#$TUNELP='/bin/echo';
$PULSELEN=2000;         # width of pulse for tunelp -w 

sub punch;

# We need to obtain the following information:
# $memnum: membership number
# $userid: member's CRSid
# $honmem: true if honorary member
do
{
   print "Enter membership number:\n";
   $memnum = <STDIN>;
   chop($memnum);
   # handle octal (0nnn), hex (0xnnn) or decimal (no leading 0)
   $memnum = oct $memnum if $memnum =~ /^0/;
   print "Enter CRSid:\n";
   $userid = <STDIN>;
   chop($userid);
   print "Honorary member? (y/n)\n";
   $honmem = <STDIN>;
   $honmem = (lc(substr($honmem,0,1)) eq "y");
   
   print ("Member number $memnum, CRSid $userid", ($honmem ? ", honorary" : ""), "\n");
   print "Is this correct? (y/n)\n";
   $ans = <STDIN>;
} while (lc(substr($ans,0,1)) ne "y");
   

# First set the width of the punch pulse for the 4070:
system("$TUNELP $DEVICE -w $PULSELEN -a on") && die "setup tunelp failed: $!";

# now open the device. This locks the lp module in memory so we
# don't have to worry about tunelp parameters being forgotten...
open(PUNCH,">$DEVICE") || die "couldn't open $DEVICE: $!";
select PUNCH; $| = 1; select STDOUT;

punch "\0\0\0\0\0CUCPS";             	# standard header
punch ($honmem ? "\001" : "\000");	# honorary member status
punch pack("ccc", $memnum >> 16, $memnum >> 8, $memnum); # member number
punch pack("a20", $userid);		# userid + nulls to 34th char

close PUNCH;
system("$TUNELP $DEVICE -w 0 -a off") && die "final tunelp failed: $!";

exit 0;

sub punch
{
   # punch a string. We assume PUNCH to be open.
   local($str) = @_;

   for ($i = 0; $i < length($str); $i++)
   { 
      print PUNCH substr($str, $i, 1);
      sleep $CHARDELAY;
   }
}