# HG changeset patch
# User cin
# Date 1382405216 -14400
# Node ID 93b83e3c38d60cc9b3b2a7f495e8f9d1ff0ecb2d
initial commit
diff -r 000000000000 -r 93b83e3c38d6 .hgignore
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore Tue Oct 22 05:26:56 2013 +0400
@@ -0,0 +1,3 @@
+
+syntax: regexp
+^_test/repo$
\ No newline at end of file
diff -r 000000000000 -r 93b83e3c38d6 .includepath
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.includepath Tue Oct 22 05:26:56 2013 +0400
@@ -0,0 +1,7 @@
+
+
+
+
+
+
+
diff -r 000000000000 -r 93b83e3c38d6 .project
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.project Tue Oct 22 05:26:56 2013 +0400
@@ -0,0 +1,17 @@
+
+
+ yours
+
+
+
+
+
+ org.epic.perleditor.perlbuilder
+
+
+
+
+
+ org.epic.perleditor.perlnature
+
+
diff -r 000000000000 -r 93b83e3c38d6 _test/read_repo.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/read_repo.pl Tue Oct 22 05:26:56 2013 +0400
@@ -0,0 +1,172 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Digest;
+use File::Path qw(make_path);
+use IMPL::require {
+ XMLReader => 'XML::LibXML::Reader',
+ UserAgent => 'LWP::UserAgent',
+ Request => 'HTTP::Request',
+ MDParser => 'Yours::Parsers::MDParser',
+ PMDParser => 'Yours::Parsers::PMDParser',
+ Dumper => 'Data::Dumper',
+ Uncompress => 'IO::Uncompress::AnyUncompress'
+};
+
+BEGIN {
+ XMLReader->import;
+
+}
+
+my %digestTypes = (
+ sha512 => 'SHA-512',
+ sha384 => 'SHA-384',
+ sha256 => 'SHA-256',
+ sha1 => 'SHA-1',
+ md5 => 'MD5'
+);
+
+my $repoUrl =
+ 'http://download.opensuse.org/repositories/Mono/openSUSE_12.3/';
+my $repoDir = 'repo';
+
+my $agent = UserAgent->new();
+$agent->env_proxy();
+
+# список файлов, которые должны быть в репозитарии, заполняется по мере загрузки/проверки целостности
+my %files;
+# список каталогов, которые должны быть в репозитарии, заполняется по мере загрузки/проверки целостности
+my %dirs;
+
+print "loading metadata\n";
+
+make_path(File::Spec->catdir($repoDir,'repodata')) unless -d File::Spec->catdir($repoDir,'repodata');
+
+# загружаем основные метаданные
+
+my $mdLocation = "repodata/repomd.xml";
+my $mdFile = MakeLocalName($mdLocation);
+
+my @initial = (
+ $mdLocation,
+ "repodata/repomd.xml.asc",
+ "repodata/repomd.xml.key"
+);
+
+foreach my $initLocation (@initial) {
+ my $file = MakeLocalName($initLocation);
+ $files{$file} = { location => "${repoUrl}$initLocation"};
+ my $resp = $agent->get(
+ "${repoUrl}$initLocation",
+ ':content_file' => $file
+ );
+
+ die "failed to load metadata $initLocation: ", $resp->code, " ", $resp->message
+ unless $resp->is_success;
+}
+
+my $parser = MDParser->new();
+$parser->Parse( { location => $mdFile, no_blanks => 1 } );
+
+# загружаем метаданные о пакетах
+my %indexMd;
+foreach my $md (@{$parser->data->{data} || []}) {
+ $indexMd{$md->{type}} = $md;
+
+ print "\t$md->{type}: $md->{location}\n";
+
+ my $file = MakeLocalName($md->{location});
+ $md->{file} = $file;
+ $files{$file} = $md;
+
+ unless (-f $file) {
+ my $resp = $agent->get(
+ "${repoUrl}$md->{location}",
+ ':content_file' => $file
+ );
+ die "failed to load $md->{location}: ", $resp->code, " ", $resp->message
+ unless $resp->is_success;
+ }
+}
+
+my $primaryMd = $indexMd{primary}{file};
+
+my $hdata = Uncompress->new($primaryMd)
+ or die "failed to uncompress $primaryMd";
+
+print "processing contents\n";
+
+PMDParser->new(sub {
+ my ($parser,$package) = @_;
+ my $location = $package->{location};
+
+ my $file = MakeLocalName($location);
+ $files{$file} = $package;
+
+
+
+ unless (-f $file) {
+ my $size = sprintf("%0.2fM",$package->{size}/(1024*1024));
+ print "\tfetch $location [${size}]\n";
+
+ $agent->get("${repoUrl}$location", ":content_file" => $file);
+ }
+})->Parse({ IO => $hdata, no_blanks => 1 });
+
+print "cleanup\n";
+
+foreach my $dir (keys %dirs) {
+ print "\t$dir\n";
+ if (opendir(my $hdir, $dir)) {
+ while(my $file = readdir $hdir) {
+ next if $file eq '.' || $file eq '..';
+ my $fullPath = File::Spec->catfile($dir,$file);
+ next unless -f $fullPath;
+
+ unless( $files{$fullPath} ){
+ print "\t\t- $file\n";
+ unlink $fullPath;
+ }
+ }
+ }
+}
+
+print "validating\n";
+
+while(my ($file,$md) = each %files) {
+ if (my $checksum = $md->{checksum}) {
+ if( my $type = $digestTypes{lc($checksum->{type})} ) {
+ if(open my $hfile, "<$file") {
+ binmode $hfile;
+ my $digest = Digest->new($type)->addfile($hfile)->hexdigest;
+ next if $digest eq $checksum->{value};
+
+ print "\t$file: $digest ne $checksum->{value}\n";
+ } else {
+ print "\t$file: ", -f $file ? "unable to open" : "missing","\n";
+ }
+ } else {
+ print "\t$file: unknown hash algorithm: $checksum->{type}\n";
+ }
+ }
+}
+
+print "files: ", scalar keys %files, "\n";
+print "dirs: ", scalar keys %dirs, "\n";
+getc;
+
+sub MakeLocalName {
+ my ($url) = @_;
+
+ my @parts = split /\//, $url;
+ my $file = pop @parts;
+
+ my $dir = File::Spec->catdir($repoDir,@parts);
+
+ make_path($dir)
+ unless $dirs{$dir};
+ $dirs{$dir} = 1;
+
+ return File::Spec->catfile($dir,$file);
+}
\ No newline at end of file
diff -r 000000000000 -r 93b83e3c38d6 lib/Yours/Parsers/MDParser.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Yours/Parsers/MDParser.pm Tue Oct 22 05:26:56 2013 +0400
@@ -0,0 +1,48 @@
+package Yours::Parsers::MDParser;
+use strict;
+
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+ require => {
+ Dumper => 'Data::Dumper'
+ },
+ base => [ 'Yours::Parsers::SaxParser' => '@_' ],
+ props => [
+ data => PROP_RW | PROP_DIRECT
+ ]
+};
+
+BEGIN {
+ __PACKAGE__->XMLReader->import;
+}
+
+sub ProcessRootNode {
+ my ( $this, $reader ) = @_;
+
+ my $meta = $this->ReadComplexNode({
+ revision => 'ReadTextNode',
+ data => [
+ sub {
+ my $me = shift;
+ my $type = $me->attribute('type');
+ my $value = $me->ReadComplexNode({
+ location => sub { shift->attribute('href')},
+ timestamp => 'ReadTextNode',
+ checksum => sub {
+ my ($me) = @_;
+ return {
+ type => $me->attribute('type'),
+ value => $me->ReadTextNode()
+ };
+ }
+ });
+ $value->{type} = $type;
+ return $value;
+ }
+ ]
+ });
+
+ $this->data($meta);
+}
+
+1;
diff -r 000000000000 -r 93b83e3c38d6 lib/Yours/Parsers/PMDParser.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Yours/Parsers/PMDParser.pm Tue Oct 22 05:26:56 2013 +0400
@@ -0,0 +1,47 @@
+package Yours::Parsers::PMDParser;
+use strict;
+
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+ base => [
+ 'Yours::Parsers::SaxParser' => '@_'
+ ],
+ props => [
+ onpackage => PROP_RW
+ ]
+};
+
+sub CTOR {
+ my ($this,$handler) = @_;
+
+ $this->onpackage($handler);
+}
+
+sub ProcessRootNode {
+ my ($this,$node) = @_;
+
+ $this->ReadChildren(sub {
+ my ($me,$reader) = @_;
+ my $type = $me->attribute('type');
+
+ my $package = $me->ReadComplexNode({
+ name => 'ReadTextNode',
+ location => sub { shift->attribute('href') },
+ checksum => sub {
+ my ($me) = @_;
+ return {
+ type => $me->attribute('type'),
+ value => $me->ReadTextNode()
+ };
+ },
+ size => sub { shift->attribute('package') }
+ });
+
+ $package->{type} = $type;
+
+ $me->onpackage->($me,$package)
+ if $me->onpackage;
+ });
+}
+
+1;
\ No newline at end of file
diff -r 000000000000 -r 93b83e3c38d6 lib/Yours/Parsers/SaxParser.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Yours/Parsers/SaxParser.pm Tue Oct 22 05:26:56 2013 +0400
@@ -0,0 +1,135 @@
+package Yours::Parsers::SaxParser;
+use strict;
+
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+ require => {
+ XMLReader => 'XML::LibXML::Reader',
+ Exception => 'IMPL::Exception',
+ ArgException => '-IMPL::InvalidArgumentException'
+ },
+ base => [ 'IMPL::Object' => undef ],
+ props => [ _reader => PROP_RW ]
+};
+
+BEGIN {
+ XMLReader->import;
+}
+
+sub Parse {
+ my ( $this, $options ) = @_;
+
+ my $reader = $this->_reader( XMLReader->new($options) );
+
+ $reader->read();
+ $this->ProcessRootNode($reader);
+ $reader->read();
+}
+
+sub ProcessRootNode {
+ my ( $this, $reader ) = @_;
+}
+
+sub ReadChildren {
+ my ( $this, $handler ) = @_;
+
+ my $reader = $this->_reader;
+
+ return if $reader->isEmptyElement;
+
+ my $currentLevel = $reader->depth;
+
+ while (
+ $reader->read
+ && ( $reader->depth > $currentLevel
+ || $reader->nodeType != XML_READER_TYPE_END_ELEMENT )
+ )
+ {
+ $this->$handler($reader) if $handler;
+ }
+}
+
+sub ReadTextNode {
+ my ($this) = @_;
+
+ my $text = "";
+
+ my $handler;
+ $handler = sub {
+ my ( $me, $reader ) = @_;
+ if ( $reader->nodeType == XML_READER_TYPE_TEXT ) {
+ $text .= $reader->value;
+ } else {
+ $this->ReadChildren($handler);
+ }
+ };
+
+ $this->ReadChildren($handler);
+
+ return $text;
+}
+
+sub ReadComplexNode {
+ my ( $this, $schema ) = @_;
+
+ if ( ref $schema eq 'HASH' ) {
+ my %data;
+
+ $this->ReadChildren(
+ sub {
+ my ( $me, $node ) = @_;
+
+ my $name = $node->localName;
+ if ( my $handler = $schema->{$name} ) {
+ if (ref $handler eq 'ARRAY') {
+ push @{$data{$name}}, $me->ReadComplexNode($$handler[0]);
+ } else {
+ $data{$name} = $me->ReadComplexNode($handler);
+ }
+ } else {
+ $me->ReadChildren();
+ }
+ }
+ );
+
+ return \%data;
+ }
+ elsif ( ref $schema eq 'CODE' or not ref $schema ) {
+ return $this->$schema($this->_reader);
+ }
+ else {
+ die ArgException->new( schema => 'An invalid schema is supplied' );
+ }
+}
+
+sub attribute {
+ shift->_reader->getAttribute(shift);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+=head1 DESCRIPTION
+
+=head1 MEMBERS
+
+=head2 ReadComplexNode($schema)
+
+=begin code
+
+{
+ comments => sub { shift->ReadTextNode },
+ data => [ {
+ location => sub { $_[1]->getAttribute('href')} ,
+ timestamp => 'ReadTextNode'
+ } ]
+}
+
+=end code
+
+=cut