File Coverage

blib/lib/Term/CallEditor.pm

Criterion	Covered	Total	%
statement	24	71	33.8
branch	0	38	0.0
condition	0	16	0.0
subroutine	8	10	80.0
pod	0	1	0.0
total	32	136	23.5

# -*- Perl -*-
#
# Solicits data from an external editor as determined by the EDITOR
# environment variable. Run perldoc(1) on this module for additional
# documentation.
#
# Copyright 2004-2005,2009-2010,2012 Jeremy Mates
#
# This module is free software; you can redistribute it and/or modify it
# under the Artistic license.

package Term::CallEditor;

use strict;
use warnings;

require 5.006;

use vars qw(@EXPORT @ISA $VERSION $errstr);
@EXPORT = qw(solicit);
@ISA    = qw(Exporter);
use Exporter;

use Fcntl qw(:DEFAULT :flock);
use File::Temp qw(tempfile);
use IO::Handle;

use POSIX qw(getpgrp tcgetpgrp);

$VERSION = '0.66';

sub solicit {
  my $message = shift;
  my $params = shift || {};

  unless ( exists $params->{skip_interative} and $params->{skip_interative} ) {
    return unless _is_interactive();
  }

  File::Temp->safe_level( $params->{safe_level} ) if exists $params->{safe_level};
  my ( $tfh, $filename ) = tempfile( UNLINK => 1 );

  unless ( $tfh and $filename ) {
    $errstr = 'no temporary file';
    return;
  }

  if ( exists $params->{binmode_layer}
    and defined $params->{binmode_layer} ) {
    binmode( $tfh, $params->{binmode_layer} );
  } elsif ( exists $params->{BINMODE} and $params->{BINMODE} ) {
    binmode($tfh);
  }

  select( ( select($tfh), $|++ )[0] );

  if ( defined $message ) {
    my $ref = ref $message;
    if ( not $ref ) {
      print $tfh $message;
    } elsif ( $ref eq 'SCALAR' ) {
      print $tfh $$message;
    } elsif ( $ref eq 'ARRAY' ) {
      print $tfh "@$message";
    } elsif ( $ref eq 'GLOB' ) {
      while ( my $line = <$message> ) {
        print $tfh $line;
      }
    } elsif ( UNIVERSAL::can( $message, 'getlines' ) ) {
      print $tfh $message->getlines;
    }
    # Help the bits reach the disk
    $tfh->flush();
    # TODO may need eval or exclude on other platforms
    if ( $^O !~ m/Win32/ ) {
      $tfh->sync();
    }
  }

  my $editor = $ENV{EDITOR} || 'vi';

  # need to unlock for external editor
  flock $tfh, LOCK_UN;

  my $status = system $editor, $filename;
  if ( $status != 0 ) {
    $errstr =
      ( $status != -1 )
      ? "external editor failed: editor=$editor, errstr=$?"
      : "could not launch program: editor=$editor, errstr=$!";
    return;
  }

  # Must reopen filename, as editor could have done a rename() on us, in
  # which case the $tfh is then invalid.
  my $outfh;
  unless ( open( $outfh, '<', $filename ) ) {
    $errstr = "could not reopen tmp file: errstr=$!";
    return;
  }

  return wantarray ? ( $outfh, $filename ) : $outfh;
}

# Perl CookBook code to check whether terminal is interactive
sub _is_interactive {
  my $tty;
  unless ( open $tty, '<', '/dev/tty' ) {
    $errstr = "cannot open /dev/tty: errno=$!";
    return;
  }
  my $tpgrp = tcgetpgrp fileno $tty;
  my $pgrp  = getpgrp();
  close $tty;
  unless ( $tpgrp == $pgrp ) {
    $errstr = "no exclusive control of tty: pgrp=$pgrp, tpgrp=$tpgrp";
    return;
  }
  return 1;
}

1;

__END__