#!/usr/bin/perl
# @(#) BIPclient.pl     CUPS backend filter which emails print jobs to a
#                       Brother print-server whose address matches the
#                       printer name. Rev'd: 2011-10-28.
#
# Copyright (c) 2007 Graham Jenkins <grahjenk@cpan.org>. All rights reserved.
# This program is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.

use strict;
use warnings;
use File::Basename;
use File::Spec;
use Net::CUPS::Destination;
use Net::Config qw(%NetConfig);
use MIME::Lite;
use Sys::Hostname;
use Socket;
use Compress::Zlib;
use vars qw($VERSION);
$VERSION = "2.10";
my $size =  9728 ;      # Maximum part-size (kb) .. adjust as appropriate. 

# Check Usage, open input-file name
if ($#ARGV<0) { # With no arguments, must supply backend info for: lpinfo -l -v
  print 'direct '.basename($0).' "Unknown" "Brother Print-Server"'."\n"; exit 0
}
die "Usage: ", basename($0)." Job User Title Copies Options [Filename]\n"
  if(($#ARGV<4) || ($#ARGV>5) || ($ARGV[0]!~m/\d+$/) || ($ARGV[3]!~m/\d+$/));
my $infi="-";$infi=$ARGV[5] if defined($ARGV[5]);
die "Can't read: $infi\n"   if ! open (INFILE, "$infi");

# Get printer-name from job-number
my $name;
my $cups = Net::CUPS->new();
L:foreach my $printer (my @destinations=$cups->getDestinations()) {
  foreach my $job (my @jobs=$printer->getJobs(0,0)) {
    if ($job==$ARGV[0]) {$name=$printer->getName(); last L}
  }
}
die "Can't identify printer for SeqNo: $ARGV[0]\n" if ! defined ($name);

# Read reply-address and part-size for this printer from ~/.BIPclient.cf
my ($addr, $compress);
if ( my @p=getpwnam($ARGV[1]) ) {
  if ( open(CF,File::Spec->catdir($p[7],".BIPclient.cf"))) {
    while (<CF>) {
      my @l=split;
      if ( ($#l==0) && ($l[0]=~m/\@/) && ($l[0]!~m/^#/   ) ){$addr=$l[0];next}
      if ( ($#l==1) && ($l[0]eq$name) && ($l[1]=~m/^\d+$/) ){$size=$l[1];next}
      if ( ($#l==1) && ($l[0]eq$name) && ($l[1]=~m/^-\d+$/)){
                                             $compress="Y";$size=0-$l[1];next}
    }
  }
}
if ($size<16) {$size=16384} else {$size=1024*$size}

# If a Perl SMTP host is defined, use it; also check for a sendmail alias 
my $smtp_host = $NetConfig{smtp_hosts}->[0];
if ( defined ($smtp_host) ) {
  if (open(ALIASES,File::Spec->catdir(File::Spec->rootdir,"etc","aliases"))) {
    while(<ALIASES>) {
      my @r=split;
      if ( ($#r>0) && ($r[0] eq $name.":") ) {$name=$r[1];last}
    }
  }
}

# Read, compress and split input file
my $data=do {local $/; <INFILE>};
$data=compress($data,Z_BEST_COMPRESSION) if defined ($compress);
my $parts=1 + int(length($data)/$size);

# Compose and send the message(s)
if ( defined($addr) ) {$addr="Always\nBRO-REPLY=".$addr}
else                  {$addr="None"                    }
my @host=gethostbyaddr(inet_aton(hostname),AF_INET);
my $logname=$ENV{LOGNAME} || $ENV{USER} || "root";
for (my $copy=1;$copy<=$ARGV[3];$copy++) {
  my @l=localtime();
  my $uid=$ARGV[1]."\@".$host[0].sprintf "%04d%02d%02d%02d%02d%02d%03d%d",
     $l[5]+1900,$l[4]+1,$l[3],$l[2],$l[1],$l[0],$$%1000,$copy;
  foreach my $part (1..$parts) { 
    my $msg=MIME::Lite->new(To      =>$name,
                            Subject =>'Printing: '.$ARGV[2].'  Copy: '.$copy.
                                      '  Part:'.  $part."/".$parts,
                            From    =>$logname."\@".$host[0],
                            Type    =>'multipart/mixed'                      );
    $msg->attach(           Encoding=>'7bit',
                            Data    =>"START-BROBROBRO-START\n".
                                      "BRO-SERVICE=ZYXWVUTSRQ980\n".
                                      "BRO-NOTIFY=".$addr."\n".
                                      "BRO-PARTIAL=".$part."/".$parts."\n".
                                      "BRO-UID=".$uid."\n".
                                      "BRO-LANG=0x09\nSTOP-BROBROBRO-STOP\n" );
    $msg->attach(           Type    =>'application/octet-stream',
                            Filename=>'PrintJob.PRN',
                            Encoding=>'base64',
                            Data    =>substr($data,($part-1)*$size,$size)    );
    if (defined ($smtp_host)) { $msg->send('smtp',$smtp_host) }
    else                      { $msg->send                    }
  }
}
__END__

=head1 NAME

BIPclient - Brother print-server backend filter for CUPS

=head1 README

BIPclient is a CUPS backend filter for the Brother-Internet-Print
protocol.

=head1 DESCRIPTION

C<BIPclient> is a CUPS backend filter which sends Brother-Internet-Print
jobs to an email address that matches the printer name. It should be
installed in the CUPS backend directory and made execute-and-readable
only by root.

=head1 USAGE

=over 6

BIPclient Job User Title Copies Options [Filename]

=back

BIPclient will normally be invoked with the appropriate parameters
through CUPS. After installing BIPclient as indicated above,
you need to restart CUPS so that it is recognised.

You can then add a printer with a name which matches the
the destination email address used by your BIP print-server.

When a job is sent to that printer, BIPclient will package
and send the job to the corresponding address.

A file named ".BIPclient.cf" can be placed in a user's home directory
to supply a notification address and an optional part-size for one or more
printers thus:

  janedoe@hotmail.com
  janelp1@bluebottle.com 128
  janelp2@bluebottle.com 64

If a part size is shown as negative, then (non-standard) compression will
be performed.

=head1 SCRIPT CATEGORIES

Networking
UNIX/System_administration

=head1 AUTHOR

Graham Jenkins <grahjenk@cpan.org>

=head1 COPYRIGHT

Copyright (c) 2007 Graham Jenkins. All rights reserved.
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut