/[nn]/swish/html2xml.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /swish/html2xml.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by dpavlin, Wed Jun 19 11:20:41 2002 UTC revision 1.5 by dpavlin, Fri Sep 13 09:20:52 2002 UTC
# Line 16  Line 16 
16  use strict;  use strict;
17  use Getopt::Std;  use Getopt::Std;
18  use Lingua::Spelling::Alternative;  use Lingua::Spelling::Alternative;
19    require Unicode::Map8;
20    
21  my $sadrzaj=0;  my $sadrzaj=0;
22  my $nr=0;  my $nr=0;
# Line 26  my $god;       ## godina NN Line 27  my $god;       ## godina NN
27  my $aname;      ## ancor name na originalnim stranicama  my $aname;      ## ancor name na originalnim stranicama
28    
29  my $nn_dir="../";               # dir u kojem su wget-ani fileovi  my $nn_dir="../";               # dir u kojem su wget-ani fileovi
30    my $url="http://www.nn.hr/CijeliBrojS.asp?god=%d&br=%s&mid=%s#%d";
31    
32  my %opts;  my %opts;
33  getopts("vqdl:", \%opts);  getopts("vqdl:", \%opts);
# Line 37  my $hr = new Lingua::Spelling::Alternati Line 39  my $hr = new Lingua::Spelling::Alternati
39  #$hr->load_affix("$nn_dir/search/croatian.aff");  #$hr->load_affix("$nn_dir/search/croatian.aff");
40  $hr->load_findaffix("$nn_dir/prvih_50.txt");  $hr->load_findaffix("$nn_dir/prvih_50.txt");
41    
42    my $l2_map = Unicode::Map8->new("ISO-8859-2") || die;
43    
44  #--------------------------------------------------------------------  #--------------------------------------------------------------------
45    sub dump_to_swish {
46            my $xml = shift @_;
47            my ($god,$br,$nr,$aname) = @_;
48    
49            use utf8;
50    
51            print   "Path-Name: ".sprintf($url,$god,$br,$nr,$aname)."\n".
52                    "Content-Length: ".length($xml)."\n".
53                    "Document-Type: XML\n".
54                    "\n$xml";
55    }
56    
57    #--------------------------------------------------------------------
58    
59    
60  opendir(DIR,$nn_dir) || warn "opendir: $!";  opendir(DIR,$nn_dir) || warn "opendir: $!";
61  my @files;  my @files;
# Line 51  if ($opts{l}) { Line 68  if ($opts{l}) {
68  }  }
69  closedir(DIR);  closedir(DIR);
70    
 print "<xml>\n";  
   
71  foreach my $file (@files) {  foreach my $file (@files) {
72          open(IN,"$nn_dir/$file") || die "can't open '$nn_dir/$file': $!";          open(IN,"$nn_dir/$file") || die "can't open '$nn_dir/$file': $!";
73    
# Line 84  foreach my $file (@files) { Line 99  foreach my $file (@files) {
99                          $naslov_czs =~ tr/a-zA-Z/ /cs;  # non a-z  -> space                          $naslov_czs =~ tr/a-zA-Z/ /cs;  # non a-z  -> space
100                          $naslov_czs = join(" ",$hr->alternatives(split(/ /,$naslov_czs)));                          $naslov_czs = join(" ",$hr->alternatives(split(/ /,$naslov_czs)));
101  #                       $naslov_czs = $hr->minimal(split(/ /,$naslov_czs));  #                       $naslov_czs = $hr->minimal(split(/ /,$naslov_czs));
102                          print "<br>$br</br><god>$god</god><nr>$nr</nr><aname>$aname</aname>\n<naslov>$naslov</naslov>\n<naslov_czs>$naslov_czs</naslov_czs>\n";                          my $xml="<nn>\n<br>$br</br>\n<god>$god</god>\n<nr>$nr</nr>\n<aname>$aname</aname>\n";
103                            my $naslov_utf=$l2_map->tou($naslov)->utf8;
104    
105                            # Escape <, >, & and ", and to produce valid XML
106                            my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
107                            my $escape_re  = join '|' => keys %escape;
108                            $naslov_utf =~ s/($escape_re)/$escape{$1}/g;
109    
110                            $xml.="<naslov>$naslov_utf</naslov>\n";
111                            $xml.="<naslov_czs>$naslov_czs</naslov_czs>\n</nn>\n\n";
112                            dump_to_swish($xml,$god,$br,$nr,$aname);
113                            
114                          $naslov="";                          $naslov="";
115                          $nr=0;                          $nr=0;
116                          $zakona++;                          $zakona++;
117                  }                  }
118    
119                  if ($sadrzaj) {                  if ($sadrzaj) {
120                          if (s/<a href="#([^"]+)">\s*(\d+)\.\s*<[^>]+>//i) {                          if (s/<a href="#([^"]+)">\s*(\S+)\.\s*<[^>]+>//i) {
121                                  ($aname,$nr) = ($1,$2);                                  ($aname,$nr) = ($1,$2);
122                          } elsif (s/<a href="Javascript:Mojdok\((\d+),(\d+),'*(\w+)'*,(\d+)\)[^>]*>//i) {                          } elsif (s/<a href="Javascript:Mojdok\((\d+),(\d+),'*(\w+)'*,(\d+)\)[^>]*>//i) {
123                                  ($nr,$aname) = ($3,$4);                                  ($nr,$aname) = ($3,$4);
# Line 109  foreach my $file (@files) { Line 135  foreach my $file (@files) {
135          close(IN);          close(IN);
136  }  }
137    
 print "</xml>\n";  
   
138  print STDERR "Ukupno $brojeva brojeva NN, sa $zakona zakona...\n" if (! $opts{q});  print STDERR "Ukupno $brojeva brojeva NN, sa $zakona zakona...\n" if (! $opts{q});
139    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.26