#!/usr/bin/perl
# @(#) CIPclient.pl	CUPS backend filter which emails print jobs to a
#			Castelle print-server whose address matches the
#			printer name. Rev'd: 2007-06-16.
#
# 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 MIME::Lite;
use Compress::Zlib;
use vars qw($VERSION);
$VERSION = "1.05";

# Check Usage, open input-file name
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);

# Check if there is a sendmail alias for this printer-name
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 reply-address and compress-option from ~/.CIPclient.cf
my $addr=$ARGV[1];
my $noti="No";
my $compress;
if ( my @p=getpwnam($ARGV[1]) ) {
  if ( open(CF,File::Spec->catdir($p[7],".CIPclient.cf"))) {
    while (<CF>) {
      my @l=split;
      if ( ($#l==0)&&($l[0]=~m/\@/)&&($l[0]!~m/^#/) ) {$addr=$l[0];$noti="Yes"}
      if ( ($#l==0)&&($l[0] eq "Compress")          ) {$compress="Y"          }
    }
  }
}

# Slurp from input file, compress if required
undef $/; my $data=<INFILE>;
$data=compress($data,Z_BEST_COMPRESSION) if defined ($compress);

# Compose and send the message
for (my $copy=1;$copy<=$ARGV[3];$copy++) {
  my $msg=MIME::Lite->new(From    =>$addr,
                          To      =>$name,
                          Subject =>'printing data from remote',
                          Type    =>'multipart/mixed'                     );
  $msg->attach(           Encoding=>'7bit',
                          Data    =>"PrintServerPD:\nNotify: ".$noti."\n" );
  $msg->attach(           Type    =>'application/remote-printing',
                          Encoding=>'base64',
                          Data    =>$data                                 );
  # MIME::Lite->send(     'smtp', Timeout=>60                             );
  $msg->send
}

__END__

=head1 NAME

CIPclient - Castelle/Kingston print-server backend filter for CUPS

=head1 README

CIPclient is a CUPS backend filter for the Castelle-Internet-Print
protocol.

=head1 DESCRIPTION

C<CIPclient> is a CUPS backend filter which sends Castelle-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. The line containing 'smtp' should be uncommented if an SMTP
gateway (as defined by Net::Config) is to be used.

=head1 USAGE

=over 6

CIPclient Job User Title Copies Options [Filename]

=back

CIPclient will normally be invoked with the appropriate parameters
through CUPS. After installing CIPclient 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 CIP print-server;
CIPclient understands sendmail address aliases in this context.

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

A file named ".CIPclient.cf" can be placed in a user's home directory
to supply a notification address and/or a (non-standard) compression
directive thus:

  janedoe@hotmail.com
  Compress

=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