package CQP;

require 5.005_62;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT = qw(&cqp_corpus &pergunta &pergunta1 &wordfreq);
our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our $VERSION = '0.01';

$ENV{'LC_CTYPE'} = $ENV{'LC_CTYPE'} || 'pt_PT';
use locale;
use IPC::Open3;  # para redireccionar stdin, stdout stderr dum comando

my $x;
my $tmp;
my $cqp;
my $registry="/corpora/c1/registry";
my $corpusname="NAO SEI";
#our ($DW,$DR,$DE);
local (*DW,*DR,*DE);


BEGIN{
use Exporter ();
@ISA=qw(Exporter);

chop($cqp = `which cqp`);
die ("cant find cqp\n") unless (-e $cqp );

$tmp="/tmp";
}

sub cqp_corpus{
  $corpusname= shift;
  my $pid1 = open3(\*DW,\*DR,\*DE,
         "$cqp -e") ||
                die "cant find 'cqp' program";
#  my $lixo = <DR>;                       #skip first line
  print DW "$corpusname;\n";
  print DW "set h no;\n";
	print DW "set Pager \"cat\";";
#  my $lixo=<DR>;
#  $lixo=<DR>;
}

sub pergunta {
  my $w = shift;
  my %opt = @_;
  my $old=$/;
  my $a;
  my @r=();
  $/="\n";

  print DW "set C 1 s;\n";
  print DW "set h no;\n";
  if($opt{tag}){print DW "<$opt{tag}>[]*\"$w\"[]*</$opt{tag}>;\n";}
  else         {print DW "\"$w\";set pager;\n";}
  while ($a = <DR>){
    last if ($a =~ /Pager.*cat/);
    chomp $a;
    $a=~s/^.*?:\s*//;
    push(@r,$a);
  }
  $/=$old;
  @r
}

sub perguntaN {
  my $w = shift;
  my $n = shift;
  my %opt = @_;
  my $old=$/;
  my $a;
  my @r=();
  $/="\n";

  print DW "set C 1 s;\n";
  print DW "set h no;\n";
  if($opt{tag}){print DW "<$opt{tag}>[]*\"$w\"[]*</$opt{tag}>;\n";}
  else         {print DW "\"$w\" cut $n;set pager;\n";}
  while ($a = <DR>){
    last if ($a =~ /Pager.*cat/);
    chomp $a;
    $a=~s/^.*?:\s*//;
    push(@r,$a);
  }
  $/=$old;
  @r
}

sub pergunta1 {
  my $w = shift;
  my %opt = @_;
  my $old=$/;
  my $a;
  my @r=();
  $/="\n";
  #print DW "\"$w\";\n";
  if($opt{tag}){print DW "<$opt{tag}>[]*\"$w\"[]*</$opt{tag}>;\n";}
  else         {print DW "\"$w\";\n";}
  print DW "set h no;\n";
  my $lixo=<DR>;
  while ($a = <DR>){
#    print "...$a";
    chomp $a;
    $a =~ s/^.*?://;
    last if ($a =~ /$corpusname/);
	print "$a\n\n\n\n\n";
    push(@r,$a);
  }
  $/=$old;
  @r
}

sub wordfreq{
  my $opt;

  my $c1="";

  if(ref($_[0])){ $opt = shift;
    if(defined $opt->{pattern}){ $c1 = "|grep '$opt->{pattern}'"; }
    if(defined $opt->{reject}){ $c1 = "|grep -v '$opt->{reject}'"; }
  }

  my ($corpusname, $output) = @_;
  system("lexdecode -f $corpusname  $c1 | sort -n -r  > $output");
}

1;
__END__

=head1 NAME

CQP.pm - 

=head1 SYNOPSIS


=head1 DESCRIPTION


=head1 Example

  #!/usr/bin/perl

  use CQP;
  cqp_corpus("CETEMPUBLICO");
  pergunta(word);
  pergunta(word, tag=>"s");
  pergunta1(word);

  use CQP;
  wordfreq({pattern => 'batata'}, 'cetempublico', 'out');

=head1 DESCRIPTION



=head1 AUTHOR

 J.Joao Almeida                 jj@di.uminho.pt
 Alberto Simoes                 albie@alfarrabio.di.uminho.pt
 Paulo Alexandre Rocha          paulo.rocha@di.uminho.pt

=head1 SEE ALSO

 perl(1).
 cqp

=head1 BUGS

=cut

lexdecode -f <corpusname> -n m*
