#!/usr/bin/perl

use strict;
use warnings;
use bytes;

use CUPS::Backend;
use YAML::Syck;

######################################################
eval {
    my $config = LoadFile ($ENV{CONFIG}||"/usr/local/etc/cups-capture.yml");

    my $exec = delete $config->{exec};
    my $queue = delete $config->{queue};

    $config->{backend} ||= 'dw';
    $config->{name}    ||= 'Document Warehouse';
    $config->{type}    ||= 'direct';

    ######################################################
    my $backend = My::Backend->new( $config );
    eval {
        $backend->cmdline( \@ARGV );
        $backend->parse_env;

        $backend->info( "title=", $backend->title );

        ######################################################
        my $fh = $backend->file_open;
        die "Unable to open a file: $!" unless $fh;
        if( 1 ) {
            my $size = $backend->slurp( $fh );
            $backend->info( "Got $size bytes" );
        }
        else {
            my( $content, $size ) = $backend->slurp;
            $backend->info( "Got $size bytes" );
            my $n = syswrite( $fh, $content, $size );
            $backend->info( "Wrote $n bytes" );
        }

        # Tell CUPS about pages being printed (/var/log/cups/page_log)
        $backend->page( 1, $backend->copies );

        my $file = $backend->file_close;

        ######################################################
        if( $queue ) {
            my $cmd = "lp -s -d $queue";
            $cmd .= " -U ".$backend->user if $backend->user;
            $cmd .= " -n ".$backend->copies if $backend->copies;
            $cmd .= " -t ".quotemeta( $backend->title ) if $backend->title;
            $cmd .= " " . $backend->lp_options;
            $cmd .= " -- $file";
            $backend->info( $cmd );
            system $cmd;    
        }

        ######################################################
        if( $exec ) {
            unless( $exec =~ s/\[file\]/$file/g ) {
                $exec .= " $file";
            }
            $queue = $backend->env( 'PRINTER' );
            $exec =~ s/\[queue\]/$queue/g if $queue;
            $backend->info( "EXEC $exec" );

            open E1, "$exec 2>&1|" or die "Unable to run $exec: $!\n";
            while( <E1> ) {
                $backend->info( $_ );
            }
        }
        else {
            $backend->info( $file );
        }
    };
    if( $@ ) {
        $backend->error( "cups-capture: $@" );
    }
};
if( $@ ) {
    print STDERR "ERROR: cups-capture: $@\n";
}

##############################################################################
package My::Backend;

use strict;
use warnings;

use File::Temp qw( tempfile );
use File::Path qw( mkpath );
use File::Spec;
use Data::Dumper;

use base qw( CUPS::Backend );

######################################################
sub init 
{
    my( $self, $args ) = @_;
#     warn Dumper $args;
    $self->{owner}        = $args->{'user'};
    $self->{page_dir}    = $args->{'page-dir'};
    $self->{file_prefix} = $args->{'file-prefix'} || 'C';
    $self->SUPER::init( $args );
}

######################################################
sub file_dir
{
    my( $self ) = @_;
    die "No DEVICE_URI in ENV ", Dumper \%ENV unless $self->uri;
    my @dir = $self->uri->path_segments;
    my $dir = File::Spec->catfile( @dir );
    if( $self->{page_dir} and not File::Spec->file_name_is_absolute( $dir ) ) {
        unshift @dir, $self->{page_dir};
    }
    push @dir, 'tmp';   # TODO : configurable

    $dir = File::Spec->catfile( @dir );
    return $dir;
}

######################################################
sub file_open
{
    my( $self ) = @_;
    my $dir = $self->file_dir;
    unless( -d $dir ) {
        mkpath( [ $dir ], 0, 0700 );
    }

    # $self->info( $dir );

    $self->info( "dir=$dir, <=$< >=$>" );
    my $prefix = $self->{file_prefix};
    $prefix =~ s/\[TS\]/sprintf "%08X", time/ge;
    my( $fh, $file ) = tempfile( "${prefix}XXXXXXXX", 
                                    DIR    => $dir,
                                    SUFFIX => '.txt' 
                               );
    $self->info( "file=$file" );
    die "Can't open a temporary file in $dir: $!" unless $file;
    $self->{file} = $file;
    $self->{fh}   = $fh;
    return $fh;
}


#################################################################
sub file_close
{
    my( $self ) = @_;
    $self->{fh}->close;
    delete $self->{fh};
    my $file = delete $self->{file};

    if( $self->{owner} ) {
        my($login,$pass,$uid,$gid) = getpwnam( $self->{owner} );
        unless( $login ) {
            $self->error( "$self->{owner} not in passwd file" );
        }
        else {
            $self->info( "chown $uid $uid $file # owner=$self->{owner} login=$login" );
            chown( $uid, $gid, $file )
                or $self->error( "Unable to chown $file: $!" );
        }
    }
    else {
        # $self->info( "No user:" );
    }

    my @dirs = File::Spec->splitdir( $file );
    my $tmp = splice @dirs, -2, 1; # /tmp/
    if( $tmp eq 'tmp' ) {
        my $filename = join '/', @dirs;
        rename $file, $filename 
            or die "Can't rename $file -> $filename: $!\n";
        return $filename;
    }
    return $file;
}

