martes, 17 de diciembre de 2013

Derreferenciamiento en Perl

Interpretación provisoria. No está basada en la teoría, sino en el caso empírico dado.
perl -w o bien use strict deberían quejarse de la mayoría de estos casos.


Código:
@ARY = ( [ qw(vilma palma vampiro) ], [ qw(zapallo zanahoria zapallito) ] );
print "@ARY\n";   # 1) Testigo
print ARY[1];   # 2) La expresión de derreferenciamiento requiere un caracter de tipo bien al principio. El subscript [] no es suficiente para que Perl sepa que nos estamos refiriendo al array ARY.
print "\n";
print "@{ARY[1]}\n";   # 3) Adentro de {}: no rige la regla del caso (2). Afuera de {}: derreferenciamento impropio de un escalar con @.
print "@ARY[1]\n"; # 4) El caracter de tipo tiene mayor precedencia que el subscript de matrices [] (perldsc sobre Perl 5.12.5, "Caveat on precedence"), excepto que la regla (2) tiene mayor prioridad. Mismo mecanismo que el caso (3).
print "@{@ARY[1]}\n"; # 5) Adentro de {}: Si hay un @ bien al principio, entonces la expresión se trata como en el caso (4), si no, es exactamente el caso (3). Afuera de {}: correcto derreferenciamiento de un array con @.
print "@{@{ARY[1]}}\n"; # 6) Expresión explícita del caso (5). Es exactamente el mismo caso.

Output:
1) ARRAY(0x989c818) ARRAY(0x98b7110)
2)
3) ARRAY(0x98b7110)
4) ARRAY(0x98b7110)
5) zapallo zanahoria zapallito
6) zapallo zanahoria zapallito


Código:
@ARY = (58, 90);
print ARY[1];   # 1) ARY: descriptor de archivo (en general nulo => el output no va a ningún lado). [1]: Arrayref anónimo con el elemento 1. Comparar por ejemplo con: print STDOUT"8";
print "\n";
print @{ARY[1]};   # 2) El contexto @{} aplicado a un escalar x, significa el array con el único elemento x.
print "\n";
print @ARY[1]; # El caracter de tipo tiene mayor precedencia que el subscript de matrices [] (perldsc sobre Perl 5.12.5, "Caveat on precedence").
print "\n";

print ( (\@ARY[1]) eq (\$ARY[1]) );   # 4
print "\n";
print ( (\@{ARY[1]}) eq (\@ARY[1]) );   # 5
print "\n";
print ( (\@{ARY[1]}) eq (\$ARY[1]) );   # 6
print "\n";


Output:
1)
2) 90
3) 90

4) 1
5) 1
6) 1



lunes, 16 de diciembre de 2013

Pruebas manejo de punteros y matrices en C

Código 1:
Compilador: gcc version 4.4.3 (Ubuntu 4.4.3-4ubuntu5), y a parte Visual C++ (ver nota a continuación)
Compilation flags -Wall -g


// matrix operations
#include <stdio.h>

void myPrint(int **table, int x, int y);

int main(int argc, char **argv) {

  int matrix[3][3];

  matrix[0][0] = 2;
  matrix[0][1] = 3;
  matrix[0][2] = 5;

  matrix[1][0] = 1;
  matrix[1][1] = 4;
  matrix[1][2] = 16;

  matrix[2][0] = 9;
  matrix[2][1] = 28;
  matrix[2][2] = 14;

  myPrint(matrix, 2, 1);
  return 0;
}

void myPrint(int **table, int x, int y) {

  printf("%d\n", table[x][y]);
}


Compilación:
warning: passing argument 1 of ‘myPrint’ from incompatible pointer type
note: expected ‘int **’ but argument is of type ‘int (*)[3]’

Ejecución:
Fallo de segmentación





Nota: en Visual C++ la validación de tipos es más estricta y hay que agregar
- myPrint((int **)matrix, 2, 1);   // conciliación de tipos entre parámetros formales y reales
Porque si no da error de compilación, que viene a ser justamente lo mismo que en gcc es warning. 

Código 2:
Compilador Visual C++

// matrix operations
#include <stdio.h>

void myPrint(int (*table)[3], int x, int y);

int main(int argc, char **argv) {

  int matrix[3][3];

  matrix[0][0] = 2;
  matrix[0][1] = 3;
  matrix[0][2] = 5;

  matrix[1][0] = 1;
  matrix[1][1] = 4;
  matrix[1][2] = 16;

  matrix[2][0] = 9;
  matrix[2][1] = 28;
  matrix[2][2] = 14;
  myPrint(matrix, 2, 1);
  return 0;
}

void myPrint(int (*table)[3], int x, int y) {

  printf("%d\n", table[x][y]);
}

Compilación: sin warnings
Ejecución:
28

Código 3:
Compilador: Por separado gcc y Visual C++ (ver nota abajo)
// matrix operations
#include
<stdio.h>
#include <stdlib.h>

void myPrint(int **table, int x, int y);

int main(int argc, char **argv) {

  int *matrix[3];

  matrix[0] = malloc(3*sizeof(int));
  matrix[0][0] = 2;
  matrix[0][1] = 3;
  matrix[0][2] = 5;

  matrix[1] = malloc(3*sizeof(int));
  matrix[1][0] = 1;
  matrix[1][1] = 4;
  matrix[1][2] = 16;

  matrix[2] = malloc(3*sizeof(int));
  matrix[2][0] = 9;
  matrix[2][1] = 28;
  matrix[2][2] = 14;

  myPrint(&matrix, 2, 1);
  return 0;
}


void myPrint(int **table, int x, int y) {

  printf("%d\n", table[x][y]);
}


Compilación: warning: passing argument 1 of ‘myPrint’ from incompatible pointer type
note: expected ‘int **’ but argument is of type ‘int * (*)[3]’

Ejecución:
28



Nota: en Visual C++ para Windows la validación de tipos es más estricta y hace falta las siguientes adaptaciones:

- (int*)malloc(3*sizeof(int)); // explícitamente decir el tipo de puntero con el que se va a usar lo que devuelva malloc.

- myPrint((int **)&matrix, 2, 1); // conciliar tipos entre parámetros formales y actuales Porque si no da error de compilación, que viene a ser justamente lo mismo que en gcc es warning. 

SQL - selección en base a rangos de fechas

Patrón:
- La relación tiene atributos de fecha inicio y fin (fecha_inicio_relación y fecha_fin_relación).
- La selección se quiere hacer según un rango fecha inicio y fin (fecha_inicio_selección y fecha_fin_selección), seleccionando todas en las que los segmentos se toquen o se superpongan (ver imagen):




fecha_inicio_relación                         fecha_fin_relación
|——————————————|
fecha_inicio_selección                       fecha_fin_selección
|——————————————|


Query:

select * from relación where (fecha_inicio_relación <= fecha_inicio_selección and fecha_fin_relación >= fecha_inicio_selección or fecha_inicio_relación <= fecha_fin_selección and fecha_fin_relación >= fecha_fin_selección or fecha_inicio_relación >= fecha_inicio_selección and fecha_fin_relación <= fecha_fin_selección or fecha_inicio_relación <= fecha_inicio_selección and fecha_fin_relación >= fecha_fin_selección)
-- validaciones de consistencia
and fecha_inicio_relación <= fecha_fin_relación and fecha_inicio_selección <= fecha_fin_selección

jueves, 21 de noviembre de 2013

CVS desde la línea de comandos

Software: http://www.nongnu.org/cvs/

Login
cvs -d:método_acceso*:user@host:/path login
Emitir un log de tags: archivo, revisión actual head, branch y su revisión actual, todas las revisiones
cvs -d:método_acceso*:user@host:/path_1 rlog path_2 (relativo a path_1)
Emitir un reporte histórico: movimiento, fecha hora, revisión, archivo, path
cvs -d:método_acceso*:user@host:/path_1 history path_2 (relativo a path_1) -c

*método_acceso: pserver, local, etc.

martes, 5 de noviembre de 2013

Tokens - programa en Perl para parsear XML

Sinopsis
use Tokens;

open my $regex_fh, '&lt;', $ARGV[0]; #regex.txt
open my $target_fh, '&lt;', $ARGV[1]; #file.txt

my $target;
{
  local $/ = undef;
  $target = &lt;$target_fh&gt;; #the content
  $target =~ s/\n/ /g;
}

my $regex;
{
  local $/ = undef;
  $regex = &lt;$regex_fh&gt;; #the content
}

printAll parse $target, $regex;
 

Códio (archivo: Tokens.pm):
=pod
 Copyright 2013 Gabriel Czernikier



    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see .
=cut
use strict;
#package declarations
sub digest_single;
sub parse_programme;
sub printAll;

my @token_separator = ('<', '/', '"', '=', '>', ' ');

my @REGEX;
my @MASK;
my $long_tokens;
my @DIGEST_SINGLE;

sub min_token_separator_left {
  my $regex = shift;
  my $T;
  $regex =~ /([@token_separator])/og;
  my $min = (pos $regex) - (length $1);
  my $T = $1;
  return ($T, $min) if $regex =~ m/([@token_separator])/o;
}

sub min_token_separator_right {
  my $regex = shift;
  $regex =~ /.*([@token_separator])/og;
  my $min = (pos $regex) - (length $1);
  my $T = $1;
  return ($T, $min) if $regex =~ m/([@token_separator])/o;
}

sub expand_left {
  $_[0] =~ s/^\(\?:(?:[^)]|\)[^+*])+\)\*//;
  $_[0] =~ s/^\(\?:((?:[^)]|\)[^+*])+)\)\+/\1\(\?:\1\)\*/;
}

sub trim_left {
  $_[0] =~ s/^\(\.\*\?\)//;
}

sub expand_right {
  $_[0] =~ s/\(\?:(?:[^)]|\)[^+*])+\)\*$//;
  $_[0] =~ s/\(\?:((?:[^)]|\)[^+*])+)\)\+$/\(\?:\1\)\*\1/;
}

sub trim_right {
  $_[0] =~ s/\(\.\*\?\)$//;
}

sub digest_single {
  my $target = shift;
  my $regex = shift;
  return unless $regex ne '';
  my $token_desde = shift;
  my $token_hasta = shift;
  return @{$DIGEST_SINGLE[$token_desde][$token_hasta]} if defined $DIGEST_SINGLE[$token_desde][$token_hasta];
  my ($T, $pos)=min_token_separator_left($regex);
  return unless $target =~ /$regex/ or defined $pos;
  $target =~ /($regex)/g;
  my $digit = 2;
  while( my $cg = eval '$'.$digit++ ) {
    goto VISITING if $cg =~ /$long_tokens/;
  }
  my $pff = (pos $target);
  my $pii = $pff - (length $1) if defined $pff;
  VISITING:
  return ($token_desde, $token_hasta, $pii, $pff) unless defined $pos;
  my $re = $regex;
  expand_left $re;
  ($T, $pos)=min_token_separator_left($re);
  my $pos_aux = $pos+length($T);
  $re =~ s/.{$pos_aux}//;
  trim_left $re;
  my ($td, $th, $pi, $pf) = digest_single $target, $re, $token_desde+1, $token_hasta;
  $re = $regex;
  expand_right $re;
  ($T, $pos) = min_token_separator_right($re);
  $re =~ s/(.{$pos}).*/\1/;
  trim_right $re;
  my ($td2, $th2, $pi2, $pf2) = digest_single $target, $re, $token_desde, $token_hasta-1;
  $DIGEST_SINGLE[$token_desde][$token_hasta] = [$token_desde, $token_hasta, $pii, $pff] if (defined $pii) && ($pff-$pii>=$pf-$pi || !defined $pi) && ($pff-$pii>=$pf2-$pi2 || !defined $pi2);
  return @{$DIGEST_SINGLE[$token_desde][$token_hasta]} if defined $DIGEST_SINGLE[$token_desde][$token_hasta];
  $DIGEST_SINGLE[$token_desde][$token_hasta] = [$td, $th, $pi, $pf] if (defined $pi) && ($pf-$pi>$pff-$pii || !defined $pii) && ($pf-$pi>=$pf2-$pi2 || !defined $pi2);
  return @{$DIGEST_SINGLE[$token_desde][$token_hasta]} if defined $DIGEST_SINGLE[$token_desde][$token_hasta];
  $DIGEST_SINGLE[$token_desde][$token_hasta] = [$td2, $th2, $pi2, $pf2] if (defined $pi2) && ($pf2-$pi2>$pff-$pii || !defined $pii) && ($pf2-$pi2>$pf-$pi || !defined $pi);
  return @{$DIGEST_SINGLE[$token_desde][$token_hasta]} if defined $DIGEST_SINGLE[$token_desde][$token_hasta];
  $DIGEST_SINGLE[$token_desde][$token_hasta] = [];
  return @{$DIGEST_SINGLE[$token_desde][$token_hasta]};
}

sub token_count {
  my $regex = shift;
  my @matches = $regex =~ /[@token_separator]/og;
  return scalar @matches;
}

sub digest_multiple {
  my $target = shift;
  my @R = @REGEX;
  my $regex_num = 0;
  my $Pos_Ini;
  my $Token_Desde;
  my $Token_Hasta;
  my $Pos_Fin;
  my $Regex_Num;

  my @DIGEST_MULTIPLE = ();
  while( defined(my $regex = shift @R)) {
    @DIGEST_SINGLE = undef;
    my ($token_desde, $token_hasta, $pos_ini, $pos_fin) = digest_single $target, $regex, 0, token_count($regex);
    return $token_desde, $token_hasta, $pos_ini, $pos_fin, $regex_num if($token_desde==0 && $token_hasta==token_count($regex));
    push @DIGEST_MULTIPLE, [$token_desde, $token_hasta, $pos_ini, $pos_fin, $regex_num] if defined $pos_ini;
    $regex_num++;
  }

  $regex_num = 0;
  while(@DIGEST_MULTIPLE!=0) {
    my ($token_desde, $token_hasta, $pos_ini, $pos_fin) = @{shift @DIGEST_MULTIPLE};
    if(defined $pos_ini && $pos_fin!=0 && ($pos_ini<$Pos_Ini || !defined $Pos_Ini)) {
      $Pos_Ini = $pos_ini;
      $Token_Desde = $token_desde;
      $Token_Hasta = $token_hasta;
      $Pos_Fin = $pos_fin;
      $Regex_Num = $regex_num;
    }
    $regex_num++;
  }
  return $Token_Desde, $Token_Hasta, $Pos_Ini, $Pos_Fin, $Regex_Num if defined $Pos_Ini;
}

sub parse_programme {
  my $target = shift;
  return if $target eq '';
  my ($token_desde, $token_hasta, $pos_ini, $pos_fin, $regex_num) = digest_multiple($target);
  if(not defined $pos_ini) {
    #my $oldfh = select;
    #select STDERR;
    #print "$ARGV[1], [ini-no-parseable]${target}[fin-no-parseable]\n";
    #select $oldfh;
    return $target;
  }
  my $mask_right = @MASK[$regex_num];
  my $repetitions = token_count($mask_right)-$token_hasta;
  $mask_right =~ s/.*((?:[@token_separator][^@token_separator]*){$repetitions})$/\1/;
  my $mask_left = @MASK[$regex_num];
  $mask_left =~ s/^((?:[^@token_separator]*[@token_separator]){$token_desde}).*/\1/;
  my $match = $target;
  $match =~ s/(.{$pos_fin}).*/\1/;
  $match =~ s/.{$pos_ini}//;
  my $produccion = $mask_left . $match . $mask_right;
  $target =~ /(.{$pos_ini})/;
  my $target_left = $1;
  $target =~ /.{$pos_fin}(.*)/;
  my $target_right = $1;
  return $produccion, +[parse_programme $target_left], +[parse_programme $target_right];
}

sub printAll {
  return if @_==0;
  if (@_==1) {
    print "[ini-nonparse]${_[0]}[fin-nonparse]\n";
    return;
  }
  printAll @{$_[1]};
  print "[ini-prod]${_[0]}[fin-prod]\n";
  printAll @{$_[2]};
}

sub parse {
  my $target = shift;
  my $regex = shift;
  while($regex =~ /^(.+)$/mg) {
    my $_ = $1;
    my $other = $_;
    $other =~ s/\(\?:(.+?)\)\+/\1/g;
    $other =~ s/\.\*\?//g;
    push @MASK, $other;
    s/(\.\*\?)/\(\1\)/g;
    push @REGEX, $_;
  }

  $long_tokens = join '|', grep length>=3,keys %{+{  map +($_=>undef), map /\w+/g, @REGEX  }};

  parse_programme $target;
}

1;



Input: 

regex2-group.txt
&lt;MyTag1 myAttr1=".*?" myAttr2=".*?"&gt;(?:&lt;MyTag2 myAttr3=".*?" myAttr4=".*?"&gt;.*?&lt;/MyTag2&gt;)+&lt;/MyTag1&gt;

regex3-multiple.txt
&lt;MyTag1 myAttr1=".*?" myAttr2=".*?"&gt;(?:&lt;MyTag2 myAttr3=".*?" myAttr4=".*?"&gt;.*?&lt;/MyTag2&gt;)+&lt;/MyTag1&gt;
&lt;Foo myFoo=".*?" myFoo2=".*?"&gt;&lt;Bar1 myBar1=".*?" myBar1b=".*?" myBar1c=".*?"&gt;&lt;/Bar1&gt;&lt;Bar2 myBar2=".*?" myBar2b=".*?"&gt;&lt;Bar2Sub1&gt;.*?&lt;/Bar2Sub1&gt;&lt;/Bar2&gt;&lt;/Foo&gt;
&lt;MyA myA=".*?"&gt;&lt;MyAB&gt;(?:&lt;MyB myB=".*?"&gt;&lt;/MyB&gt;)+&lt;/MyAB&gt;&lt;MyAC&gt;(?:&lt;MyC myC=".*?"&gt;&lt;/MyC&gt;)+&lt;/MyAC&gt;&lt;/MyA&gt;
&lt;TagT attrT=".*?"&gt;.*?&lt;/TagT&gt;

file2-broken-left-broken-right-repetitions.txt
Tag2 myAttr3="myVal3Pre" myAttr4="myVal4Pre"&gt;MyText1Pre&lt;/MyTag2&gt;&lt;MyTag2 myAttr3="myVal3" myAttr4="myVal4"&gt;MyText1&lt;/MyTag2&gt;&lt;/MyTag1&gt;&lt;MyTag1 myAttr1="myVal1b" myAttr2="myVal2b"&gt;&lt;MyTag2 myAttr3="myVal3b" myAttr4="myVal4b"&gt;MyText1b&lt;/MyTag2&gt;&lt;MyTag2 myAttr3="myVal3bPos" myAttr4="myVal4bPos"&gt;MyText1bPos&lt;/MyTag2&gt;&lt;/MyTag1&gt;&lt;MyTag1 myAttr1="myVal1c" myAttr2="myVal2c"&gt;&lt;MyTag2 myAttr3="myVal3c" myAttr4="myVal4c"&gt;MyText1c&lt;/MyTag2&gt;&lt;MyTag2 myAttr3="myVal3cPos" myAtt

file3-broken-left-broken-right-repetitions-multiple.txt
Tag2 myAttr3="myVal3Pre" myAttr4="myVal4Pre"&gt;MyText1Pre&lt;/MyTag2&gt;&lt;MyTag2 myAttr3="myVal3" myAttr4="myVal4"&gt;MyText1&lt;/MyTag2&gt;&lt;/MyTag1&gt;&lt;Foo myFoo="foo-123" myFoo2="foo-456"&gt;&lt;Bar1 myBar1="bar-123" myBar1b="bar-456" myBar1c="bar-789"&gt;&lt;/Bar1&gt;&lt;Bar2 myBar2="bar-135" myBar2b="bar-790"&gt;&lt;Bar2Sub1&gt;BarSubText&lt;/Bar2Sub1&gt;&lt;/Bar2&gt;&lt;/Foo&gt;&lt;MyTag1 myAttr1="myVal1b" myAttr2="myVal2b"&gt;&lt;MyTag2 myAttr3="myVal3b" myAttr4="myVal4b"&gt;MyText1b&lt;/MyTag2&gt;&lt;MyTag2 myAttr3="myVal3bPos" myAttr4="myVal4bPos"&gt;MyText1bPos&lt;/MyTag2&gt;&lt;/MyTag1&gt;&lt;MyA myA="MYa-123"&gt;&lt;MyAB&gt;&lt;MyB myB="MYb-123"&gt;&lt;/MyB&gt;&lt;MyB myB="MYb-456"&gt;&lt;/MyB&gt;&lt;MyB myB="MYb-123-bis"&gt;&lt;/MyB&gt;&lt;/MyAB&gt;&lt;MyAC&gt;&lt;MyC myC="mycR"&gt;&lt;/My M&amp;; &lt;MyTag1 myAttr1="myVal1c" myAttr2="myVal2c"&gt;&lt;MyTag2 myAttr3="myVal3c" myAttr4="myVal4c"&gt;MyText1c&lt;/MyTag2&gt;&lt;MyTag2 myAttr3="myVal3cPos" myAtt  &lt;TagT attrT="valueT"&gt;TextT-pr


martes, 3 de septiembre de 2013

DB2 - manejar jerarquías de idiomas

En DB2, seleccionar datos de una tabla "tabla_origen", buscando con una "mi_clave_busqueda" que tiene multiplicidad n (los datos están en n idiomas), de los cuales me interesa recuperar el idioma que (para mí) tenga mayor prioridad, si no el siguiente, y así sucesivamente.



with mis_idiomas as(
      select * from table (
            select 'es',  1 from sysibm.sysdummy1 union all
            select 'fr',  2 from sysibm.sysdummy1 union all
            select 'en',  3 from sysibm.sysdummy1 union all
            select 'he',  4 from sysibm.sysdummy1
      ) as t (idioma, ord)
),
T2 as(
      select tor.mi_clave_busqueda, min(ord) as ord from tabla_origen tor inner join mis_idiomas ml on tor.cod_idioma=ml.idioma group by tor.mi_clave_busqueda
)
select tor.mis_valores_buscados from T2 inner join mis_idiomas ml on T2.ord=ml.ord inner join tabla_origen tor on T2.mi_clave_busqueda=tor.mi_clave_busqueda and ml.idioma=tor.idioma