in reply to Re: Unescaped left brace in regex
in thread Unescaped left brace in regex

Thanks here is how I solved my case : 
#!"C:\xampp\perl\bin\perl.exe"
use strict;
use warnings;
use CGI;

my $query = CGI->new ;
my $dir = "C:/Users/41786/Documents/recordz1";

showImage();

sub showImage {
    my $call = shift || '';
    my  $image = $query->param('article');
    my  $URL = "../upload/$image.jpg";
    my $ARTICLE_URL = {};
    my $content = "";
    if (defined $image) {
        open (FILE, "<$dir/show_test.html") or die "cannot open file $
+dir/show_test.html";
        while (<FILE>) {
            s/\$ARTICLE_URL/$URL/g;
            $content .= $_;
        }
    }
    print "Content-Type: text/html\n\n";     
    print $content;
    close (FILE);    
    return 1;
}

[download]

Replies are listed 'Best First'.
Re^3: Unescaped left brace in regex
by *alexandre* (Scribe) on Jun 22, 2019 at 13:56 UTC
    Within the Following code it's work better 
    #!"C:\xampp\perl\bin\perl.exe"
use strict;
use warnings;
use CGI;
use Time::HiRes qw(gettimeofday);
use Article;
#use LoadProperties;
use DBI;
use MyDB;
#use TableArticle;
#use SharedVariable;
use vars qw (%ENV $session_dir $can_do_gzip $cookie $page $dir $dirLan
+g $dirError $imgdir $action $t0 $session_id $ycan_do_gzip $current_ip
+ $lang $LANG %ARTICLE %SESSION %SERVER %USER $CGISESSID %LABEL %ERROR
+ %VALUE $COMMANDID %COMMAND %DATE %PAYPALL $INDEX %LINK  $query $sess
+ion $host $t0  $client);

$query = CGI->new ;
$cookie = "";
$current_ip = $ENV{'REMOTE_ADDR'};
$client = $ENV{'HTTP_USER_AGENT'};
$t0 = gettimeofday();
$host = "http://127.0.0.1";
%ERROR = ();%LABEL = ();$LANG = "";%LINK = ();%ARTICLE = ();%SESSION =
+ ();
my %SERVER = (); 
$action = $query->param('action');
$page = $query->param("page");
$session_id  =  $query->param('session');
$can_do_gzip = ($ENV{'HTTP_ACCEPT_ENCODING'} =~ /gzip/i) ? 1 : 0;
$dir = "C:/Users/41786/Documents/recordz1/";
$dirLang = "C:/Users/41786/Documents/recordz1/lang";
$dirError = "C:/Users/41786/Documents/recordz1/lang";
$imgdir=  "C:/Users/41786/Documents/recordz1/upload";
$session_dir = "C:/Users/41786/Documents/recordz1/sessions";
$action = $query->param('action');
$session_id = $query->param('session');

my $dsn = "DBI:mysql:recordz";
my $username = "root";
my $password = '';
my $mydb = MyDB->new;
my $query = CGI->new ;
#my $tableArticle = TableArticle->new;
#my $articleClass = Article->new;
my $lang;
#my $lp = LoadProperties->create();

loadLanguage();
loadError();
loadMainPage ();

sub loadError {
    if (defined $query) { 
        $lang = lc ($query->param('lang'));
        open (FILE, "<$dirError/$lang.error.conf") or die "cannot open
+ file $dirError/$lang.error.conf";    
        while (<FILE>) {
            (my  $label, my  $value) = split(/=/);
            $SERVER{$label} = $value;    
        }
        close (FILE);
        }
}

sub loadLanguage {
    if (defined $query) { 
        $lang = $query->param("lang");
        $lang = uc ($lang);
        open (FILE, "<$dirLang/$lang.conf") or die "cannot open file $
+dirLang/$lang.conf";    
        
        while (<FILE>) {
        (my  $label, my  $value) = split(/=/);
        $SERVER{$label} = $value;
        }
        close (FILE);
    }
}

sub loadCategories {
    my $string;
    my  %OPTIONS = ();
    my  ($c)= $mydb->sqlSelectMany("libelle.libelle","categorie_libell
+e_langue,libelle, langue","categorie_libelle_langue.ref_libelle = lib
+elle.id_libelle AND categorie_libelle_langue.ref_langue = langue.id_l
+angue AND langue.key = '$lang'");    
    while(($OPTIONS{'category'})=$c->fetchrow()) {    
         $string .= "<option value=\"$OPTIONS{'category'}\">$OPTIONS{'
+category'}</option>";
    }

    return $string;
}

sub loadMenu {
    my $string = "";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=art_design\" class=\"menulink\" >$SERVER{'art'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=parfum\" class=\"menulink\" >$SERVER{'parfum_cosmetik'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=wear_news\" class=\"menulink\" >$SERVER{'fashion'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=lingerie\" class=\"menulink\" >$SERVER{'lingerie'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=baby\" class=\"menulink\" >$SERVER{'baby'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=animal\" class=\"menulink\" >$SERVER{'animal'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=watch\" class=\"menulink\" >$SERVER{'watch_jewels'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=jardin\" class=\"menulink\" >$SERVER{'Habitat_et_jardin'}</a></li>"
+;    
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=auto\" class=\"menulink\" >$SERVER{'car'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=moto\" class=\"menulink\" >$SERVER{'moto'}</a></li>";    
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=immo\" class=\"menulink\" >$SERVER{'real_estate'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=cd_vinyl_mixtap\" class=\"menulink\" >$SERVER{'cd_music'}</a></li>"
+;
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=intruments\" class=\"menulink\" >$SERVER{'music_instrument'}</a></l
+i>";    
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=collection\" class=\"menulink\" >$SERVER{'collections'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=wine\" class=\"menulink\" >$SERVER{'wine'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=boat\" class=\"menulink\" >$SERVER{'boat'}</a></li>";        
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=tv_video\" class=\"menulink\" >$SERVER{'tv_video_camera'}</a></li>"
+;    
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=games\" class=\"menulink\" >$SERVER{'games'}</a></li>";
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=book\" class=\"menulink\" >$SERVER{'book'}</a></li>";    
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=dvd\" class=\"menulink\" >$SERVER{'dvd_k7'}</a></li>";    
    $string .=  "<li><a href=\"/cgi-bin/recordz.cgi?lang=$lang&amp;pag
+e=sport\" class=\"menulink\" >$SERVER{'sport'}</a></li>";
    return $string;
}

sub loadMainPage {
    open (FILE, "<$dir/main.html") or die "cannot open file $dir/main.
+html";        
    my $categories = loadCategories();
    my $menu = loadMenu();
    my $content;

    while (<FILE>) {    
        s/\$LABEL'\{'([\w]+)'}/ exists $SERVER{$1} ? $SERVER{$1} : $1 
+/eg; 
        s/\$LANG/$lang/g;
        s/\$OPTIONS{'categories'}/$categories/g;
        s/\$ARTICLE{'main_menu'}/$menu/g;
        $content .= $_;    
        }

    $content = Compress::Zlib::memGzip($content)  if $can_do_gzip; ;
    print "Content-Length: ", length($content) , "\n";
    print "Content-Encoding: gzip\n" ;
    print "Content-Type: text/html\n\n"; 
    print $content;
    close (FILE);
}

    [download]
[reply]
[d/l]

      Although I suspect this might be a legacy system, I think you might want to invest some time looking into a templating engine, such as Template, because generating HTML like this can be fairly brittle. Although it'd be a bigger change, you could also think about replacing CGI.pm with a framework that has templating built in, such as Mojolicious (see also UP-TO-DATE Comparison of CGI Alternatives).

[reply]

In Section Seekers of Perl Wisdom