Βικιλεξικό

Χρήστης:AtouBot/parsexml.pl

< Χρήστης:AtouBot

Όνομα εργαλείου: parsexml.pl


Περιγραφή:

Αυτό το εργαλείο αποτελείται από τρία μικρά προγραμματάκια (scripts) που ελέγχουν ένα αρχείο xml με σελίδες από το ΒΛ και σημειώνουν τους τίτλους σελίδων που έχουν τα επιθυμητά κριτήρια. Το αρχείο τίτλων γράφεται στην κονσόλα· για να αποθηκευτεί, πρέπει να κάνετε ανακατεύθυνση με τον κανονικό τρόπο (parsexml.pl > όνομα-αρχείου). Οι τίτλοι σελίδων καταγράφονται με τετράγωνες αγκύλες ( [[ ... ]] ).

Παράμετροι:

  • δεν έχει παραμέτρους

Προϋποθέσεις:

  • perl
  • αρχείο xml του ΒΛ από το [1]

Σημειώσεις χρήσης:

  • Τα τρία scripts πρέπει να βρίσκονται στον ίδιο κατάλογο στον υπολογιστή του χρήστη.
  • Άλλαξτε το checkmatch.pl ώστε να γυρίσει την τιμή 1 για τις σελίδες που θέλετε να καταγράφονται και 0 για τις άλλες. Το παρακάτω παράδειγμα δημιουργεί μία λίστα σελίδων που περιέχουν τουλάχιστον ένα μέρος του λόγου χωρίς μεταφράσεις. (Πίνακες μεταφράσεων που έχουν {{βλ}} παραβλέπονται, όπως λέξεις χωρίς την επικεφαλίδα «μεταφράσεις».)
  • Παράδειγμα χρήσης του εργαλείου:

bzcat elwiktionary-20100217-pages-meta-current.xml.bz2 | perl parsexml.pl > no-trans.txt

  • Περισσότερες οδηγίες για το φτιάξιμο ενός checkmatch.pl σύντομα...


→ Πίσω στα Εργαλεία

libparsexml.pl

επεξεργασία 
#!/usr/bin/perl

binmode(STDOUT, ":utf8");
binmode(STDIN, ":utf8");

use utf8;

# είδη ετικέτων
$open = 1;
$close = 2;
$openclose=3;

sub doerror {
    my($msg) = shift(@_);
    print STDERR "$msg\n";
    exit(1);
}

sub splitbypart {
    my($text) = shift(@_);

     $partnames = "ετυμολογία|προφορά|εκφράσεις|παροιμίες|κλίση|συγγενικά|παράγωγα|σύνθετα|ταυτόσημα|ομώνυμα|υπερώνυμα|υπώνυμα|βλέπε|κοιτ|μεταφράσεις|πολυλεκτικοί όροι";
     $merh_toy_logoy = "άρθρο|αριθμητικό|ουσιαστικό|επίθετο|ρήμα|αντωνιμία|πρόθεση|επίρρημα}επιρρηματική έκφραση|μετοχή|μόριο|σύνδεσμος|επιφώνημα|συντομομορφή|πρόθημα|επίθημα|ρίζα|πολυλεκτικός όρος|κύριο όνομα|έκφραση|επιθετική έκφραση|χαρακτήρας|σύμβολο|κατάληξη|κατάληξη αρσενικών επιθέτων|κατάληξη αρσενικών ουσιαστικών|κατάληξη αρσενικών και θηλυκών ουσιαστικών|κατάληξη επιρρημάατων|κατάληξη θηλυκών ουσιαστικών|κατάληξη ουδέτερων ουσιαστικών";
    $klites_morfes = "μορφή αντωνυμίας|μορφή άρθρου|μορφή επιθέτου|μορφή κυρίου ονόματος|μορφή μετοχής|μορφή ουσιαστικού|μορφή ρήματος";
   
    $splitonthese = "($partnames|$merh_toy_logoy|$klites_morfes)";
    my @textblobs=split(/{{$splitonthese/,$text);
    my %part=();

    for ($i=0; $i < $#textblobs; $i++) {
	# we will have κομμάτια
	#   ουσιαστικό    
	#   }} μπλαμπλα
	$partsect = $textblobs[$i];
	if ($partsect =~ /^$splitonthese/) {
	    $partcode=$partsect;
	    $partsect =$textblobs[++$i];
	    if ($partsect =~ /^[^}]*}}/) {
		$partsect =~ s/^[^}]*}}//;
		$part{$partcode}{'text'}=$partsect;
	    }
	}
    }
    return(\%part);
}

sub splitbylang {
    my($text) = shift(@_);

    my @langblobs=split(/== *{{-/,$text);
    my %lang=();

    foreach $langsect (@langblobs) {
	if ($langsect =~ /^(([^-}]+)-}} *==)/) {
	    $langcode=$2;
	    $langsect =~ s/^$langcode-}} *==//;
	    $lang{$langcode}{'text'}=$langsect;
	    $lang{$langcode}{'parts'} = splitbypart($langsect);
	}
    }
    return(\%lang);
}


# παραλείπουμε τις πρώτες γραμμές του αρχείου
# μέχρι να βρούμε <page>
#
# επιστρέφει:  0,γραμμή που περιέχει <page>  αν βρέθηκε
#              1, ""                         αν όχι
sub skipheader {
    while (<STDIN>) {
	my $line=$_;
	if ($line =~ /^(\s)*<page>(\s)*$/) {
	    return(0,$line);
	}
    }    
    return(1,'');
}

sub hastag {
    my($line)=shift(@_);
    if ($line =~ /</) {
	return(1);
    }
    else {
	return(0);
    }
}

sub getnexttagfromtext {
    my $text=shift(@_);

    if (hastag($text)) {
	($pre,$post) = split(/</,$text,2);
	($tag,$rest) = split(/>/,$post,2);
	if ($tag =~/^\//) {
	    $tag =~ s/^\///;
	    $tagtype=$close;
	}
	else {
	    $tagtype=$open;
	    # σαν <minor /> ή <text />
	    if ($tag =~ /\/$/) {
		$tag =~ s/^\///;
		$tagtype=$openclose;
	    }
	}
	if ($tag =~ /^text/) {
	    $tag='text';
	}
#	print "err:0, tag:$tag, tagtype:$tagtype,  pre:$pre, rest:$rest\n";
	return(0,$tag,$tagtype,$pre,$rest);
    }
    return(1,'');
}

sub getnexttag {
    my $line=shift(@_);

    if (hastag($line)) {
	($err,$tag,$tagtype,$pre,$rest) = getnexttagfromtext($line);
	return(0,$tag,$tagtype,$pre,$rest);
    }
    while (<STDIN>) {
	$line=$line.$_;
	if (hastag($_)) {
	    ($err,$tag,$tagtype,$pre,$rest) = getnexttagfromtext($line);
	    return(0,$tag,$tagtype,$pre,$rest);
	}
    }
    return(1,'');
}

#  έχουμε την επικέτα που ανοίγει το κείμενο, θέλουμε 
#  τις επόμενες γραμμές και τελικά την επικέτα που το κλείνει 

sub getcontributor {
    my $rest=shift(@_);

    while(1) {
	my ($err,$tagname,$tagtype,$pre,$rest) = getnexttag($rest);
	if ($err) {
	    doerror("bad xml, no close tag for contributor, bailing");
	}
	# στοιχεία του contributor 
	if ($tagtype == $open) {
	    ($err,$closetag,$tagtype,$pre,$rest) = getnexttagfromtext($rest);
	    if ($err) {
		doerror("bad xml, missing close tag $tagname in contributor, bailing");
	    }
	    if ($tagname =~ /^id$/) {
		$contributor{'id'} = $pre;
	    }
	    elsif ($tagname =~ /^username$/) {
		$contributor{'username'} = $pre;
	    }
	    elsif ($tagname =~ /^ip$/) {
		$contributor{'ip'} = $pre;
	    }
	    else {
		doerror("bad xml, unknown tag $tagname, bailing");
	    }
	}
	# τελική επικέτα 
	elsif ($tagtype == $close) {
	    if ($tagname =~ /^contributor$/) {
		return(0,\%contributor);
	    }
	    else {
		doerror("bad xml, close tag $tagname before open, bailing");
	    }
	}
    }
    return(1,'');
}

sub gettext {
    my$rest=shift(@_);

    my ($err,$tagname,$tagtype,$pre,$rest) = getnexttag($rest);
    if ($err) {
	doerror("bad xml, no close tag for text, bailing");
    }
    if ($tagtype == $open) {
	doerror("bad xml, missing close tag for text, bailing");
    }
    # τελική επικέτα 
    elsif ($tagtype == $close) {
	if ($tagname =~ /^text$/) {
	    return(0,$pre);
	}
	else {
	    doerror("bad xml, close tag $tagname before open, bailing");
	}
    }
    return(1,'');
}

sub getrevision {
    while(1) {
	my ($err,$tagname,$tagtype,$pre,$rest) = getnexttag($rest);
	if ($err) {
	    doerror("bad xml, no close tag for revision, bailing");
	}
	# στοιχεία του revision 
	if ($tagtype == $open) {
	    if ($tagname =~ /^contributor$/) {
		($err,$revision{'contributor'})=getcontributor();
	    }
	    elsif ($tagname =~ /^text$/) {
		($err,$revision{'text'})=gettext($rest);
	    }
	    else {
#		($err,$closetag,$tagtype,$pre,$rest) = getnexttagfromtext($rest);
		($err,$closetag,$tagtype,$pre,$rest) = getnexttag($rest);
		if ($err) {
		    doerror("bad xml, missing close tag $tagname in revision, bailing");
		}
		elsif ($tagname =~ /^id$/) {
		    $revision{'id'} = $pre;
		}
		elsif ($tagname =~ /^timestamp$/) {
		    $revision{'timestamp'} = $pre;
		}
		elsif ($tagname =~ /^comment$/) {
		    $revision{'comment'} = $pre;
		}
		else {
		    doerror("bad xml, unknown tag $tagname, bailing");
		}
	    }
	}
	elsif ($tagtype == $openclose) {
	    # <minor />  χωρίς περιεχόμενο :-P
	    if ($tagname =~ /^minor/) {
		$revision{'minor'}=1;
	    }
	    elsif ($tagname =~ /^text$/) {
		$revision{'text'}='';
	    }
	}
	# τελική επικέτα 
	elsif ($tagtype == $close) {
	    if ($tagname =~ /^revision$/) {
		return(0,\%revision);
	    }
	    else {
		doerror("bad xml, close tag $tagname before open, bailing");
	    }
	}
    }
    return(1,'');
}

sub getpage {
    my ($err,$tagname,$tagtype,$line);

    undef %contributor;
    undef %revision;
    undef %page;
    while(1) {
	my ($err,$tagname,$tagtype,$pre,$rest) = getnexttag($rest);
	if ($err) {
	    doerror("bad xml, no close tag for page, bailing");
	}
	# στοιχεία του page 
	if ($tagtype == $open) {
	    if ($tagname =~ /^revision$/) {
		($err,$page{'revision'}) = getrevision();
	    }
	    else {
		($err,$closetag,$tagtype,$pre,$rest) = getnexttagfromtext($rest);
		if ($err) {
		    doerror("bad xml, missing close tag $tagname in page, bailing");
		}
		elsif ($tagname =~ /^title$/) {
		    $page{'title'} = $pre;
		}
		elsif ($tagname =~ /^id$/) {
		    $page{'id'} = $pre;
		}
		elsif ($tagname =~ /^restrictions$/) {
		    $page{'restrictions'} = $pre;
		}
		else {
		    doerror("bad xml, unknown tag $tagname, bailing");
		}
	    }
	}
	# τελική επικέτα 
	elsif ($tagtype == $close) {
	    if ($tagname =~ /^page$/) {
		return(0,%page);
	    }
	    else {
		doerror("bad xml, close tag $tagname before open, bailing");
	    }
	}
    }
    return(1,'');
}

sub langcount {
    my $texthash = shift(@_);

    $count = scalar keys %$texthash;
    return($count);
}

sub langis {
    my $texthash = shift(@_);
    my $code = shift(@_);
    
    for $langcode (keys %$texthash) {
	if ($langcode =~ /^\Q$code\E$/) {
	    return(1);
	}
    }
    return(0);
}

sub partcount {
    my $texthash = shift(@_);
    my $langcode = shift(@_);

    $partshash = $texthash->{$langcode}->{'parts'};
    $count = scalar keys %$partshash;
    return($count);
}

sub partis {
    my $parthash = shift(@_);
    my $langcode = shift(@_);
    my $code = shift(@_);
    
    $partshash = $texthash->{$langcode}->{'parts'};
    for $partcode (keys %$partshash) {
	if ($partcode =~ /^\Q$code\E$/) {
	    return(1);
	}
    }
    return(0);
}

sub anypartcontainsstring {
    my $texthash = shift(@_);
    my $langcode = shift(@_);
    my $expr = shift(@_);
    $partshash = $texthash->{$langcode}->{'parts'};
    for $partcode (keys %$partshash) {
	if ($partshash->{$partcode}->{'text'} =~ /\Q$expr\E/) {
	    return(1);
	}
    }
    return(0);
}

sub anypartcontainsexpr {
    my $texthash = shift(@_);
    my $langcode = shift(@_);
    my $expr = shift(@_);
    $partshash = $texthash->{$langcode}->{'parts'};
    for $partcode (keys %$partshash) {
	if ($partshash->{$partcode}->{'text'} =~ /$expr/) {
	    return(1);
	}
    }
    return(0);
}

sub specificpartcontainsstring {
    my $parthash = shift(@_);
    my $langcode = shift(@_);
    my $partcode = shift(@_);
    my $expr = shift(@_);
    $partshash = $texthash->{$langcode}->{'parts'};
    if ($partshash->{$partcode}->{'text'} =~ /\Q$expr\E/) {
	return(1);
    }
    return(0);
}

sub specificpartcontainsexpr {
    my $parthash = shift(@_);
    my $langcode = shift(@_);
    my $partcode = shift(@_);
    my $expr = shift(@_);
    $partshash = $texthash->{$langcode}->{'parts'};
    if ($partshash->{$partcode}->{'text'} =~ /$expr/) {
	return(1);
    }
    return(0);
}

#pass list by ref!
sub allpartsinlistcontainstring {
    my $texthash = shift(@_);
    my $langcode = shift(@_);
    my $expr = shift(@_);
    my $listofparts = shift(@_);

    $partshash = $texthash->{$langcode}->{'parts'};
    for $partcode (@$listofparts) {
	if ($partshash->{$partcode}->{'text'} =~ /\Q$expr\E/) {
	    return(1);
	}
    }
    return(0);
}

#pass list by ref!
sub allpartsinlistcontainexpr {
    my $texthash = shift(@_);
    my $langcode = shift(@_);
    my $expr = shift(@_);
    my $listofparts = shift(@_);

    $partshash = $texthash->{$langcode}->{'parts'};
    for $partcode (@$listofparts) {
	if ($partshash->{$partcode}->{'text'} =~ /$expr/) {
	    return(1);
	}
    }
    return(0);
}

sub printxmlbit {
    my $tagname = shift(@_);
    my $text = shift(@_);

    if ($text) {
	print "<$tagname>";
	print "$text";
	print "</$tagname>\n";
    }
}

sub printpage {
    my $texthash = shift(@_);
    print "<page>\n";
    printxmlbit("title","$page{'title'}");
    printxmlbit("id","$page{'id'}");
    print "<revision>\n";
    printxmlbit("id","$page{'revision'}{'id'}");
    printxmlbit("timestamp","$page{'revision'}{'timestamp'}");
    print "<contributor>\n";
    printxmlbit("username","$page{'revision'}{'contributor'}{'username'}");
    printxmlbit("ip","$page{'revision'}{'contributor'}{'ip'}");
    printxmlbit("id","$page{'revision'}{'contributor'}{'id'}");
    print "</contributor>\n";
    printxmlbit("comment","$page{'revision'}{'comment'}");
    print '<text xml:space="preserve">';
    print "$page{'revision'}{'text'}";
    print "</text>\n";
    print "</revision>\n";
    print "</page>\n";
    return;    
}

parsexml.pl

επεξεργασία 
#!/usr/bin/perl

binmode(STDOUT, ":utf8");
binmode(STDIN, ":utf8");

use utf8;

require './libparsexml.pl';
require './checkmatch.pl';

while ($opt = shift(@ARGV)) {
    if ($opt =~ /--page/) {
        $printpage = 1 ;
    }
    else {
        $printtitles = 1;
    }
}

$first=1;

while (<STDIN>) {
    if ($first) {
	($err,$page)=getpage();
	if ($err) {
	    doerror("error encountered retrieving first page, bailing");
	}
	$first=0;
    }
    else {
	$line=$_;
    }
    if ($line =~ /<page>/) {
	($err,$page)=getpage();
	if ($err) {
	    doerror("error encountered retrieving page, bailing");
	}
    }
    $pagetosplit=$page{'revision'}{'text'};
    $contents=splitbylang($pagetosplit);

    if (checkmatch($contents)) {
	if ($printpage) {
	    printpage($contents);
	}
	else {
	    print "[[$page{'title'}]]\n";
	}
    }
}
exit 0;

checkmatch.pl

επεξεργασία

(παράδειγμα) 

#!/usr/bin/perl

binmode(STDOUT, ":utf8");
binmode(STDIN, ":utf8");

use utf8;

# θέλουμε τις σελίδες χωρίς μεταφράσεις
sub checkmatch {
#!/usr/bin/perl

    binmode(STDOUT, ":utf8");
    binmode(STDIN, ":utf8");

    use utf8;

# πετάμε σελίδες με πραγματικές μεταφράσεις

# fixme
# μόνο ελληνικά, μόνο ns 0

    $mtf_tmhma = 0;
    for $langcode (keys %$contents) {
	$partshash = $contents->{$langcode}->{'parts'};

	$partcode = 'μεταφράσεις';
	if ($partshash->{$partcode}) {
	    $mtf_tmhma++;
	    if ($partshash->{$partcode}->{'text'} =~ /\{\{[a-z\-]+\}\}( *):( *)\{\{τ\|[a-z\-]+\|[^\}XΧ]+\}\}/) {
		return(0);
	    }
	    # prolly had βλ or something in there, not real translation tables
	    if ($partshash->{$partcode}->{'text'} !~ /\{\{τ\|/) {
		$mtf_tmhma--;
	    }
	}
#	else {
#	    print "no translation section in ".$page{'title'}."\n";
#	}
    }
    if ($mtf_tmhma) {
	return(1);
    }
    else {
	return(0);
    }
}
Ανακτήθηκε από "https://el.wiktionary.org/w/index.php?title=Χρήστης:AtouBot/parsexml.pl&oldid=2020348"