attachment:graph.pl von LarpWikiAufbereitung

   1 #!/usr/bin/perl -w
   2 use strict;
   3 
   4 my %graph;
   5 my %printed;
   6 my $nodeformat;
   7 my $file;
   8 my $UpperLetter;
   9 my $LowerLetter;
  10 my $AnyLetter;
  11 my $LpA;
  12 my $LinkPattern;
  13 my $QDelim;
  14 my $topic;
  15 my $line;
  16 my @files;
  17 my @words;
  18 
  19 
  20 $UpperLetter = "[A-Z";
  21 $LowerLetter = "[a-z";
  22 $AnyLetter   = "[A-Za-z";
  23 $UpperLetter .= "\xc0-\xde";
  24 $LowerLetter .= "\xdf-\xff";
  25 $AnyLetter   .= "\xc0-\xff";
  26 $AnyLetter .= "_0-9";
  27 $UpperLetter .= "]"; $LowerLetter .= "]"; $AnyLetter .= "]";
  28 
  29 # Main link pattern: lowercase between uppercase, then anything
  30 $LpA = $UpperLetter . "+" . $LowerLetter . "+" . $UpperLetter . $AnyLetter . "*";
  31 $LinkPattern = "($LpA)";
  32 $QDelim = '(?:"")?';     # Optional quote delimiter (not in output)
  33 $LinkPattern .= $QDelim;
  34 
  35 
  36 $nodeformat='[shape=box, fontsize=144]';
  37 
  38 
  39 $file="LarpWiki.txt";
  40 
  41 @files=split /\n/,`ls -1 files/*.txt`;
  42 
  43 foreach $file (@files) {
  44   print "$file\n";
  45   getwikiwords($file);
  46 }
  47 
  48 
  49 open G,">graph.dot" or die "error opening graph.dot";
  50 print G "digraph G {\nsize=\"7,10\"\npage=\"8.27,11.69\"\nratio=\"fill\"\n";
  51 
  52 foreach (keys %graph)
  53   {
  54     $a=$_;
  55     $b=$_;
  56     $a=~ s/^(.*)#(.*)$/$1/;
  57     $b=~ s/^(.*)#(.*)$/$2/;
  58     if ($graph{$_} == 1)
  59       {
  60 	print G "\"$a\" -> \"$b\";\n";
  61 	nodeprint($a);
  62 	nodeprint($b);
  63       }
  64     if ($graph{$_} == 2)
  65       {
  66 	print G "\"$a\" -> \"$b\" [dir=\"both\"];\n";
  67 	nodeprint($a);
  68 	nodeprint($b);
  69       }
  70     
  71   }
  72 
  73 print G "}\n";
  74 close G;
  75 
  76 ##########################################
  77 
  78 sub getwikiwords{
  79 
  80   $topic=$_[0];
  81   open F,$topic or die "error opening $topic";
  82 
  83   $topic =~ s/.txt$//;
  84   $topic =~ s/^files\///;
  85 
  86 
  87   while ($line=<F>)
  88     {
  89 
  90       @words=split /\b/,$line;
  91       foreach (@words) {
  92 	if ($_ =~ /^$LinkPattern$/ ) {
  93 	  unless ($graph{"$_#$topic"})
  94 	    {
  95 	      $graph{"$_#$topic"}=1;
  96 	      if ($graph{"topic#$_"})
  97 		{
  98 		  $graph{"$_#$topic"}=2;
  99 		  $graph{"$topic#$_"}=3;
 100 		}
 101 	    }
 102 	}
 103       }
 104     }
 105   close F;
 106 }
 107 
 108 sub nodeprint{
 109   unless ($printed{$_[0]}) {
 110     print G "\"$_[0]\" $nodeformat;\n";
 111     $printed{$_[0]}=1;
 112   }
 113 }