Programemos Cosas

sábado, 5 de abril de 2014

Creación de sitios web con Drupal

Sitios multi idioma:

- El orden en que se crean los contenidos multi idioma no afecta al funcionamiento correcto de multi idioma. Es decir, se puede crear primero en inglés o bien en otro idioma.

- Si el idioma L1 no tiene path prefijo (1) (ej. sin prefijo: inglés -> misitio.com ; ej. con prefijo: castellano -> misitio.com/es) Cuando el idioma detectado (2) no es L1, no se puede pasar a L1 a través del bloque idiomas (3).
(1) Configuration › Regional and language > Languages (misitio.com/admin/config/regional)
(2) Configuration > Regional and Language > Languages > Language Detection and Selection,
(3) Structure > Blocks > Language switcher (User interface text)
Ejemplo 1:
El sitio web tiene contenido de la home page en idiomas L1 (misitio.com) y en L2 (misitio.com/l2)
El usuario entra a la home: misitio.com
La detección del idioma del usuario es: L1
Se puede cambiar de L1 a L2 y vice versa
Ejemplo 2:
El sitio web tiene contenido de la home page en idiomas L1 (misitio.com/l1) y en L2(misitio.com/l2)
Otro usuario entra a la página home: misitio.com
La detección del idioma de este usuario es: L2
La página se muestra en L2
El link a la versión en L1 en el bloque de idiomas apunta a la URL en L1 de la home (misitio.com), pero al ir ahí, el contenido se presenta siempre en L2.

Solución de compromiso: setear path prefijo a todos los idiomas, incluso inglés.

jueves, 3 de abril de 2014

Configuración de dominio personalizado para Blogger a través de NIC.ar y CDMon

Configuración de dominio personalizado para Blogger a través de NIC.ar y CDMon.

En NIC.ar

Dominios

Dominio
midominio.com.ar

No delegar

Delegar

Delegaciones

Host	IPv4
ns1.cdmon.net
ns2.cdmon.net
ns3.cdmon.net

En CDMon
Ejemplo de configuración 1: midominio.com.ar

En esta página puede configurar los registros DNS de su domino midominio.com.ar.

Listado registros DNS

Seleccionar

Acciones

Añadir registro | Copiar datos | Editar SOA

Registros A Añadir Mostrar/ocultar registros
	Subdominio	Destino	Acciones
	@	46.16.56.42 (Redirecciones web)	Editar registro Eliminar registro
Registros CNAME Añadir Mostrar/ocultar registros
	Subdominio	Destino	Acciones
	*	midominio.com.ar	Editar registro Eliminar registro

Ejemplo de configuración 2: midominio2.com.ar

En esta página puede configurar los registros DNS de su domino midominio2.com.ar.

Listado registros DNS

Seleccionar

Acciones

Añadir registro | Copiar datos | Editar SOA

Registros A Añadir Mostrar/ocultar registros
	Subdominio	Destino	Acciones
	www	46.16.56.41 (Redirecciones web)	Editar registro Eliminar registro
Registros CNAME Añadir Mostrar/ocultar registros
	Subdominio	Destino	Acciones
	@	ghs.google.com	Editar registro Eliminar registro
	*	midominio2.com.ar

En Blogger

Publicación

Dirección del blog

Configuración avanzada

http:// [www.midominio.com.ar]

Tutoriales:

http://blog.salinas.com.ar/2013/12/23/como-usar-un-com-ar-en-blogger-blogspot/

martes, 25 de marzo de 2014

Un pequeño paseo por la automatización de software

Introducing Lync 2010 Super Simple Auto Answer Video Kiosk with Full Screen

winforms - How to interact with an application programmatically - Stack Overflow

AutoIt - AutoItScript

Using Overloaded Win32 API functions to interact with other applications - vbCity - The .NET Developer Community

java - How to write a program that can interact with other programs - Stack Overflow

Quick introduction to Windows API

miércoles, 12 de marzo de 2014

user-list.pl - programa en Perl para leer un formato determinado y crear una lista de usuarios

use strict;
use feature "switch";
open my $outfh, '>:encoding(utf8)', 'user-list.txt';
my %NOT_COLLECTED;
my @UNCLASSIFIED_FILE;
sub print_not_collected {
print $outfh "-----------------------------------------\n";
for (keys %NOT_COLLECTED) {
 print $outfh $_ . ' ' . join(' ', keys %{+{map +($_ => undef), @{$NOT_COLLECTED{$_}}}}) . "\n";
}
print $outfh "-----------------------------------------\n";
print $outfh join "\n", @UNCLASSIFIED_FILE;
close($outfh);
exit(0);
}

use sigtrap 'handler' => \&print_not_collected, qw(INT QUIT);

my @tmp_PIV;
while(<user-pivot-*.txt>) {
my ($class) = /\d+/g;
open my $ph, "<:encoding(utf8)", $_;
push @tmp_PIV, \%{+{map {/(.*)/; $1=>$class} grep /.+/, <$ph>}};
}
my %DUP;
for my $i (0..$#tmp_PIV-1) {
for my $j ($i+1..$#tmp_PIV) {
 for (keys %{$tmp_PIV[$i]}) {
 $DUP{$_}{$tmp_PIV[$i]{$_}} = $tmp_PIV[$j]{$_} if exists $tmp_PIV[$j]{$_};
 }
}
}
for my $name (keys %DUP) {
 for my $i (keys %{$DUP{$name}}) {
 print "$name $i ${DUP{$name}{$i}}\n";
 }
}
die "Duplicated class entries." unless (keys %DUP)==0;
my %PIV_EQ_CLASS;
for (@tmp_PIV) {
%PIV_EQ_CLASS = (%PIV_EQ_CLASS, %{$_});
}
my %NOT_PIV;
open my $nph, "<:encoding(utf8)", "user-not-pivot.txt";
%NOT_PIV = %{+{map {/(.*)/; $1=>0} grep /.+/, <$nph>}};
$NOT_PIV{''} = 0; # we don't want to consider blank pivots
my @tmp = grep exists($NOT_PIV{$_}), keys %PIV_EQ_CLASS;
die 'Ambiguity pivot not pivot: ' . join "\n", @tmp unless @tmp==0;
local $/ = undef;
while(glob "HTML/**") {
print "$_\n";
open my $fh, "<:encoding(utf8)", $_;
my $fname = $_;
my $text = <$fh>;
$text =~ /\n/g;
my @tmp = $text =~ //g;
my $text2 = join '', map {; s///; $_; } @tmp;
$text2 =~ s/- ( *)(?=-)/-$1/g;
my @FILE_CLASS;
for ($text2 =~ /FriendlyName="(.*?)"/g) {
 push @FILE_CLASS, $PIV_EQ_CLASS{$_} if exists $PIV_EQ_CLASS{$_};
 push @{$NOT_COLLECTED{$_}}, $fname if not exists $PIV_EQ_CLASS{$_} and not exists $NOT_PIV{$_};
}
print $outfh $fname . ' ' . join(' ', keys %{+{map +($_ => undef), @FILE_CLASS}}) . "\n" unless @FILE_CLASS==0;
push @UNCLASSIFIED_FILE, $fname if @FILE_CLASS==0;
}

print_not_collected;

lunes, 10 de marzo de 2014

DB2 - Consultas de metadatos - Consultas recursivas

DB2 – consulta de metadatos

Catalog Schema: Doc original / standard name: syscat à DB2 alias: ibm

triggers

select text from sysibm.sysTRIGGERS where tbname

secuencias

select * from sysibm.syssequences where owner

stored procedure / function

select * from SYSIBM.sysroutines where owner

PK, unique constraint, FK,

select * from SYSIBM.syskeycoluse where constname

select * from SYSIBM.SYSRELS where RELNAME

select * from SYSIBM.SYSFOREIGNKEYS where relname

tables

FROM SYSIBM.SYSTABLES

FROM SYSIBM.SYSCOLUMNS where tbname and tbcreator

Dummy

sysibm.sysdummy1

Consultas recursivas en DB2 (jerarquía jerárquicas hierarchy hierarchial recursive)

/************************************************************************/

/******************* COMPARE THE FOLLOWING 2 QUERIES *******************/

/************************************************************************/

-- TOP-DOWN

with MY_HIERARCHY (MY_NODE, MY_PARENTNODE) as (

-- non-recursive exit

select ROOT.MY_NODE, ROOT.MY_PARENTNODE

from THETABLE ROOT where MY_NODE='value' -- the root node in the tree

union all

-- recursive loop (it needs the non-recursive part in order not to be an empty set)

select CHILD.MY_NODE, CHILD.MY_PARENTNODE

from MY_HIERARCHY PARENT, THETABLE CHILD

where CHILD.MY_PARENTNODE = PARENT.MY_NODE -- top-down join

)

select * from MY_HIERARCHY

-- BOTTOM-UP

with MY_HIERARCHY (MY_NODE, MY_PARENTNODE) as (

-- non-recursive exit

select LEAF.MY_NODE, LEAF.MY_PARENTNODE

from THETABLE LEAF where MY_NODE='value' -- the leaf node in the tree

union all

-- recursive loop (it needs the non-recursive part in order not to be an empty set)

select CHILD.MY_NODE, CHILD.MY_PARENTNODE

from MY_HIERARCHY PARENT, THETABLE CHILD

where CHILD.MY_NODE = PARENT.MY_PARENTNODE -- bottom-up join

)

select * from MY_HIERARCHY

martes, 18 de febrero de 2014

Tokens V2

Tokens: Programme to discover tokens, where there are not.

Now available at https://puszcza.gnu.org.ua/projects/tokens/
This is Version 2, for version 1, go here.

Synopsis:
use TokensV2;

sub printFile;
my @FORMAT = (
['<Message Date=".*?" Time=".*?" DateTime=".*?" SessionID=".*?"><From>(?:<User FriendlyName=".*?"/>)+</From><To>(?:<User FriendlyName=".*?"/>)+</To><Text(?: Style=".*?")?>.*?</Text></Message>',
sub {
 my $fh = $_[1];
 my ($d, $t, $f, $s, $T) = $_[0] =~ m|<Message Date="(.*?)" Time="(.*?)" DateTime=".*?" SessionID=".*?">(<From>(?:<User FriendlyName=".*?"/>)+</From>)<To>(?:<User FriendlyName=".*?"/>)+</To><Text(?: Style="(.*?)")?>(.*?)</Text></Message>|;
 my $F = join ' ', $f =~ m|<User FriendlyName="(.*?)"/>|g;
 print $fh "($d $t) $F $T";
}
],
['<Invitation Date=".*?" Time=".*?" DateTime=".*?" SessionID=".*?"><From><User FriendlyName=".*?"/></From><File>.*?</File><Text(?: Style=".*?")?>.*?</Text></Invitation>',
sub {
 my $fh = $_[1];
 my ($d, $t, $f, $s, $T) = $_[0] =~ m|<Invitation Date="(.*?)" Time="(.*?)" DateTime=".*?" SessionID=".*?"><From><User FriendlyName="(.*?)"/></From><File>.*?</File><Text(?: Style="(.*?)")?>(.*?)</Text></Invitation>|;
 print $fh "($d $t) $f $T";
}
],
['<InvitationResponse Date=".*?" Time=".*?" DateTime=".*?" SessionID=".*?"><From><User FriendlyName=".*?"/></From><File>.*?</File><Text(?: Style=".*?")?>.*?</Text></InvitationResponse>',
sub {
 my $fh = $_[1];
 my ($d, $t, $f, $s, $T) = $_[0] =~ m|<InvitationResponse Date="(.*?)" Time="(.*?)" DateTime=".*?" SessionID=".*?"><From><User FriendlyName="(.*?)"/></From><File>.*?</File><Text(?: Style="(.*?)")?>(.*?)</Text></InvitationResponse>|;
 print $fh "($d $t) $f $T";
}
],
['<Invitation Date=".*?" Time=".*?" DateTime=".*?" SessionID=".*?"><From><User FriendlyName=".*?"/></From><Application>.*?</Application><Text(?: Style=".*?")?>.*?</Text></Invitation>',
sub {
 my $fh = $_[1];
 my ($d, $t, $f, $s, $T) = $_[0] =~ m|<Invitation Date="(.*?)" Time="(.*?)" DateTime=".*?" SessionID=".*?"><From><User FriendlyName="(.*?)"/></From><Application>.*?</Application><Text(?: Style="(.*?)")?>(.*?)</Text></Invitation>|;
 print $fh "($d $t) $f $T";
}
],
['<InvitationResponse Date=".*?" Time=".*?" DateTime=".*?" SessionID=".*?"><From><User FriendlyName=".*?"/></From><Application>.*?</Application><Text(?: Style=".*?")?>.*?</Text></InvitationResponse>',
sub {
 my $fh = $_[1];
 my ($d, $t, $f, $s, $T) = $_[0] =~ m|<InvitationResponse Date="(.*?)" Time="(.*?)" DateTime=".*?" SessionID=".*?"><From><User FriendlyName="(.*?)"/></From><Application>.*?</Application><Text(?: Style="(.*?)")?>(.*?)</Text></InvitationResponse>|;
 print $fh "($d $t) $f $T";
}
],
['<Join Date=".*?" Time=".*?" DateTime=".*?" SessionID=".*?"><User FriendlyName=".*?"/><Text(?: Style=".*?")?>.*?</Text></Join>',
sub {
 my $fh = $_[1];
 my ($d, $t, $f, $s, $T) = $_[0] =~ m|<Join Date="(.*?)" Time="(.*?)" DateTime=".*?" SessionID=".*?"><User FriendlyName="(.*?)"/><Text(?: Style="(.*?)")?>(.*?)</Text></Join>|;
 print $fh "($d $t) $f $T";
}
],
['<Leave Date=".*?" Time=".*?" DateTime=".*?" SessionID=".*?"><User FriendlyName=".*?"/><Text(?: Style=".*?")?>.*?</Text></Leave>',
sub {
 my $fh = $_[1];
 my ($d, $t, $f, $s, $T) = $_[0] =~ m|<Leave Date="(.*?)" Time="(.*?)" DateTime=".*?" SessionID=".*?"><User FriendlyName="(.*?)"/><Text(?: Style="(.*?)")?>(.*?)</Text></Leave>|;
 print $fh "($d $t) $f $T";
}
]
);

sub printFile {
return if @_==1;
if (@_==2) {
 my $fh = $_[1];
 ${_[0]} =~ s/</</g;
 print $fh "${_[0]}\n";
 return;
}
# @_==5
printFile @{$_[1]}, $_[4];
my $coderef = $FORMAT[$_[3]][1];
&$coderef($_[0], $_[4]);
my $fh = $_[4];
print $fh "\n";
printFile @{$_[2]}, $_[4];
}

sub joinParseTree {
return if @_==0;
if (@_==1) {
 return ${_[0]};
}
# @_==4
return joinParseTree(@{$_[1]}) . $_[0] . joinParseTree(@{$_[2]});
}

open my $fH, "<:encoding(utf8)", "tokens-processed.txt"; # H for HASH, not handle
my %HASH = map { /([^\s]*)/; $1 => undef } grep $_ ne "\n", <$fH>;
close $fH;
open $fH, ">>:encoding(utf8)", "tokens-processed.txt";
print $fH "----------bookmark----------\n";

local $/ = undef;

my $regex = join "\n", map $$_[0], @FORMAT;
while(glob "TXT/**") {
print "$_\n";
next if exists $HASH{$_};
open my $fh, "<:encoding(utf8)", $_;
my $text = <$fh>;
my $oName = $_;
$oName =~ s/TXT/HTML/;
$oName =~ s/\.txt/.html/;
my @parse_tree;
 eval {
 local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
 alarm 5;
 @parse_tree = parse($text, $regex);
 alarm 0;
 };
 if ($@) {
 die unless $@ eq "alarm\n"; # propagate unexpected errors
 # timed out
 print $fH "$_ timed out\n";
 next;
 }
my $parse_text = joinParseTree @parse_tree;
open $fhHTML, ">:encoding(utf8)", $oName;
print $fhHTML <<ENDDOC
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
</head>
<body>
ENDDOC
;
printFile @parse_tree, $fhHTML;
$text =~ s/-( *)(?=-)/- \1/g;
$text =~ s/(.{1,512})/\n/g;
print $fhHTML "

$text";
$parse_text =~ s/-( *)(?=-)/- \1/g;
$parse_text =~ s/(.{1,512})/\n/g;
print $fhHTML "

$parse_text
</body>
</html>";
close $fhHTML;
print $fH "$_\n";
}

TokensV2.pm file:

=pod
Tokens: Programme to discover tokens, where there are not.

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 @REGEX;
my @MASK;
my $long_tokens;
my @DIGEST_SINGLE;
my $literal_char_count;

sub digest_single { # $target, $regex, $eaten_left_literal_chars, $eaten_right_literal_chars
#return unless $_[1] ne '';
#return if length $_[1] < 8; # x>(.*?)<
return unless ($_[2]+$_[3])/$literal_char_count<0.999999;
return @{$DIGEST_SINGLE[$_[2]][$_[3]]} if defined $DIGEST_SINGLE[$_[2]][$_[3]];
pos($_[0]) = undef;
goto VISITING unless $_[0] =~ /(${_[1]})/g;
my $digit = 2;
while( my $cg = eval '$'.$digit++ ) {
 my @suspicious_tokens = $cg =~ /$long_tokens/g;
 goto VISITING if @suspicious_tokens>=2;
}
my $pff = (pos $_[0]);
my $pii = $pff - (length $1) if defined $pff;
$DIGEST_SINGLE[$_[2]][$_[3]] = [$_[2], $_[3], $pii, $pff];
return @{$DIGEST_SINGLE[$_[2]][$_[3]]};

VISITING:
my $re = $_[1];
# strip off left shelter, also understood as walking righwards across the regex .+? stopping at a hopefuly serviceable string
goto VISITING_2 unless $re =~ s/(.+?)(.$\.\*\?$.|$[^.])/\2/; # .+? is also the "shelter"
my $increment_eaten_literal_chars = $+[1];
$increment_eaten_literal_chars -= 5 if $1 =~ /\(\.\*\?$/; # discount the single occurrence of non-literal chars: (.*?), left alone surrounding ""
# expansions
$re =~ s/^$\?:(?:[^)]|$[^?+*])+\)\*//;
$re =~ s/^$\?:((?:[^)]|$[^?+*])+)\)\+/\1$\?:\1$\*/;
$re =~ s/^$\?:((?:[^)]|$[^?+*])+)\)\?/\1/;
my ($el, $er, $pi, $pf) = digest_single $_[0], $re, $_[2]+$increment_eaten_literal_chars, $_[3];

VISITING_2:
$re = $_[1];
# strip off right shelter, also understood as walking leftwards across the regex .+? stopping at a hopefuly serviceable string
goto SUBDIGEST unless $re =~ s/(.*(?:.$\.\*\?$.|\)[?+*]))(.+?)$/\1/; # .+? is the "shelter"

$increment_eaten_literal_chars = $+[2] - $-[2];
$increment_eaten_literal_chars -= 5 if $2 =~ /$\.\*\?$/; # discount the single occurrence of non-literal chars: (.*?), left alone surrounding ""
# expansions
$re =~ s/$\?:(?:[^)]|$[^?+*])+\)\*$//;
$re =~ s/$\?:((?:[^)]|$[^?+*])+)\)\+$/$\?:\1$\*\1/;
$re =~ s/$\?:(?:[^)]|$[^?+*])+\)\?$//;
my ($el2, $er2, $pi2, $pf2) = digest_single $_[0], $re, $_[2], $_[3]+$increment_eaten_literal_chars;

SUBDIGEST:
$DIGEST_SINGLE[$_[2]][$_[3]] = [$el, $er, $pi, $pf] if (defined $pi) && ($er+$el<=$er2+$el2 || !defined $pi2);
return @{$DIGEST_SINGLE[$_[2]][$_[3]]} if defined $DIGEST_SINGLE[$_[2]][$_[3]];
$DIGEST_SINGLE[$_[2]][$_[3]] = [$el2, $er2, $pi2, $pf2] if (defined $pi2) && ($er2+$el2<$er+$el || !defined $pi);
return @{$DIGEST_SINGLE[$_[2]][$_[3]]} if defined $DIGEST_SINGLE[$_[2]][$_[3]];
$DIGEST_SINGLE[$_[2]][$_[3]] = [];
return @{$DIGEST_SINGLE[$_[2]][$_[3]]};
}

sub digest_multiple {
my $regex_num = 0;
my $Pos_Ini;
my $Eaten_Left;
my $Eaten_Right;
my $Pos_Fin;
my $Regex_Num;

my @DIGEST_MULTIPLE = ();
for my $regex (@REGEX) {
 @DIGEST_SINGLE = undef;
 my @literal_chars = $regex =~ /[^.*(?:)+]/g;
 $literal_char_count = scalar @literal_chars;
 my ($eaten_left, $eaten_right, $pos_ini, $pos_fin) = digest_single $_[0], $regex, 0, 0;
 return $eaten_left, $eaten_right, $pos_ini, $pos_fin, $regex_num if(($eaten_right+$eaten_left)/$literal_char_count<0.2);
 push @DIGEST_MULTIPLE, [$eaten_left, $eaten_right, $pos_ini, $pos_fin, $regex_num] if defined $pos_ini && $pos_fin!=0;
 $regex_num++;
}

$regex_num = 0;
while(@DIGEST_MULTIPLE!=0) {
 my ($eaten_left, $eaten_right, $pos_ini, $pos_fin) = @{shift @DIGEST_MULTIPLE};
 if($eaten_right+$eaten_left<$Eaten_Right+$Eaten_Left || !defined $Pos_Ini) {
 $Pos_Ini = $pos_ini;
 $Eaten_Left = $eaten_left;
 $Eaten_Right = $eaten_right;
 $Pos_Fin = $pos_fin;
 $Regex_Num = $regex_num;
 }
 $regex_num++;
}
return $Eaten_Left, $Eaten_Right, $Pos_Ini, $Pos_Fin, $Regex_Num if defined $Pos_Ini;
}

sub parse_programme {
return if $_[0] eq '';
return $_[0] if length $_[0] < 8; # <x>y</x>
my ($eaten_left, $eaten_right, $pos_ini, $pos_fin, $regex_num) = digest_multiple($_[0]);
if(not defined $pos_ini) {
 #my $oldfh = select;
 #select STDERR;
 #print "$ARGV[1], [ini-no-parseable]${target}[fin-no-parseable]\n";
 #select $oldfh;
 return $_[0];
}
my $mask_right = @MASK[$regex_num];
$mask_right =~ s/.*(.{$eaten_right})/\1/;
my $mask_left = @MASK[$regex_num];
$mask_left =~ s/(.{$eaten_left}).*/\1/;
my $match_length = $pos_fin-$pos_ini;
my ($target_left,$match,$target_right) = $_[0] =~ /(.{$pos_ini})(.{$match_length})(.*)/;
shift; # discard unused argument
return $mask_left.$match.$mask_right, +[parse_programme $target_left], +[parse_programme $target_right], $regex_num;
}

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 {
@REGEX = ();
@MASK = ();
my $target = shift;
my $regex = shift;
while($regex =~ /^(.+)$/mg) {
 my $_ = $1;
 my $other = $_;
 # strip out non-literal chars from MASK
 $other =~ s/$\?:(.+?)$\+/\1/g;
 $other =~ s/$\?:(.+?)$\?/\1/g;
 $other =~ s/\.\*\?//g;
 push @MASK, $other;
 # surround wildcards with capturing group for REGEX
 s/(\.\*\?)/$\1$/g;
 push @REGEX, $_;
}

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

parse_programme $target;
}

1;