Thread Rekursion Perl CGI (3 answers)
Opened by jens_g at 2012-11-16 16:41

topeg
 2012-11-17 17:17
#163348 #163348
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Ohne genau zu wissen was du willst habe ich das mal kurz zusammengeschrieben:
more (21.9kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use Data::Dumper;
use Encode qw(encode decode);
#use utf8;

my $file='ecole.csv';

my $script=$ENV{SCRIPT_NAME} // 'index.pl';
my $cgi=CGI->new();

# decode CGI-Param
my $path=decode('UTF-8',$cgi->param('path') // '');

# force UTF-8
binmode(STDOUT,':encoding(UTF-8)');
print $cgi->header(-charset => 'UTF-8');

my $html=load_level($file,$path,$script);

print <<EOHTML;
<html>
  <head>
    <title>Burkina Faso Internationalement École/Professeur Informations</title>
    <meta http-equiv="content-type" content="text/html; charset=UTF-8" />
    <link rel="stylesheet" href="css/main.css" type="text/css" />
    <!-- (c) 1999, Perl and HTML Code by Jens Gienau -->
  </head>
  <body>
    <h1>Burkina Faso École/Professeur</h1>
    <hr>
    <h3>Région/Province</h3>
$html
  </body>
</html>
EOHTML

sub load_level
{
  my $file=shift;
  my $path=shift;
  my $script=shift;

  my @find=split(/:/,$path);

  open(my $fh, '<', $file) or return '';
  local $/="\x0A";
  my @data=<$fh>;
  close($fh);

  # decode Windows formated Text (ISO-8859-15);
  @data=map{ decode('ISO-8859-15',$_) }@data;

  # bad way to parse CSV
  @data=map{$_=~tr/\x0A\x0D//d; $_=[split(/;/,$_)]}@data;

  return _load_level_recursive(\@data,$script,'',@find);
}

sub _load_level_recursive
{
  my $data=shift;
  my $script=shift;
  my $upper=shift;
  my @find=@_;

  my %found;
  my $search=shift(@find);

  return '' unless(@$data);
  return '' unless (@{$data->[0]});

  # last row in file
  if(@{$data->[0]}==1)
  {
    my $html="<ul>";
    $html.="<li>$_->[0]</li>" for(@$data);
    return "$html</ul>\n";
  }

  my $html="<ul>\n";
  for my $line (@$data)
  {
    my $elm=$line->[0];
    next if($found{$elm});

    $found{$elm}++;

    my $path=$upper;
    $path.=':' if($path);
    $path.=$elm;

    if($search and $elm eq $search)
    {
      my @next;
      for(@$data)
      {
        next if($_->[0] ne $elm);
        my @l=@$_;
        shift(@l);
        push(@next,\@l);
      }
      my $txt= _load_level_recursive(\@next,$script,$path,@find);
      $html .= qq(<li><a href="$script?path=$path">$elm</a>\n$txt</li>\n);
    }
    else
    { $html .= qq(<li><a href="$script?path=$path">$elm</a></li>\n); }
  }
  $html.="</ul>\n";

  return $html;
}

Man sollte heutzutage auf UTF-8 setzen. Darum ist das ganze Script so weit es geht in UTF-8 gehalten. Das Parsen sollte man mit Text::CSV oder etwas ähnlichem machen. Zum zeigen hat das so gereicht.

Die CSV scheint mir auch etwas fehlerhaft zu sein. Ich habe sie mal, wie denke das sie richtig ist, korrigiert:
more (2.9kb):
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Boucle du Mouhoun;Kossi;Ville ...;École ...;Professeur ...;+226 ...
Boucle du Mouhoun;Mouhoun;Ville ...;École ...;Professeur ...;+226 ...
Boucle du Mouhoun;Mouhoun;Ville ...;École ...;Professeur ...;+226 ...
Boucle du Mouhoun;Nayala;Ville ...;École ...;Professeur ...;+226 ...
Boucle du Mouhoun;Nayala;Ville ...;École ...;Professeur ...;+226 ...
Boucle du Mouhoun;Sourou;Ville ...;École ...;Professeur ...;+226 ...
Boucle du Mouhoun;Sourou;Ville ...;École ...;Professeur ...;+226 ...
Cascades,Comoé;Ville ...;École ...;Professeur ...;+226 ...
Cascades,Comoé;Ville ...;École ...;Professeur ...;+226 ...
Cascades,Léraba;Ville ...;École ...;Professeur ...;+226 ...
Cascades,Léraba;Ville ...;École ...;Professeur ...;+226 ...
Centre;Ville ...;École ...;Professeur ...;+226 ...
Centre;Ville ...;École ...;Professeur ...;+226 ...
Centre;Ville ...;École ...;Professeur ...;+226 ...
Centre;Ville ...;École ...;Professeur ...;+226 ...
Hauts-Bassins;Ville ...;École ...;Professeur ...;+226 ...
Hauts-Bassins;Ville ...;École ...;Professeur ...;+226 ...
Hauts-Bassins;Ville ...;École ...;Professeur ...;+226 ...
Hauts-Bassins;Houet;Ville ...;École ...;Professeur ...;+226 ...
Hauts-Bassins;Houet;Ville ...;École ...;Professeur ...;+226 ...
Hauts-Bassins;Kénédougou;Ville ...;École ...;Professeur ...;+226 ...
Hauts-Bassins;Kénédougou;Ville ...;École ...;Professeur ...;+226 ...
Hauts-Bassins;Tuy;Ville ...;École ...;Professeur ...;+226 ...
Hauts-Bassins;Tuy;Ville ...;École ...;Professeur ...;+226 ...
Region;Stadt;Schule;Name 1;Tel 1
Region;Stadt;Schule;Name 2;Tel 2
Region;Provinz A;Stadt A;Stadt;Schule;Name 1;Tel 1
Region;Provinz A;Stadt B;Stadt;Schule;Name 1;Tel 1
Region;Provinz A;Stadt B;Stadt;Schule;Name 2;Tel 2
Region;Provinz B;Stadt C;Stadtteil A,Stadt;Schule;Name 1;Tel 1
Region;Provinz B;Stadt C;Stadtteil B,Stadt;Schule;Name 1;Tel 1
Region;Provinz B;Stadt C;Stadtteil B,Stadt;Schule;Name 2;Tel 2
Region;Provinz B;Stadt D;Stadt;Schule;Name 1;Tel 1
Region;Provinz B;Stadt D;Stadt;Schule;Name 2;Tel 2
Region;Provinz B;Stadt E;Stadt;Schule;Name 1;Tel 1
Region;Provinz B;Stadt E;Stadt;Schule;Name 2;Tel 2

Die Kodierung als ISO-8859-15 mit DOS-Zeilenenden habe ich belassen.
Last edited: 2012-11-17 17:19:11 +0100 (CET)

View full thread Rekursion Perl CGI