Mercurial > pub > Yours
changeset 0:93b83e3c38d6
initial commit
author | cin |
---|---|
date | Tue, 22 Oct 2013 05:26:56 +0400 |
parents | |
children | 30a88ad2b2fd |
files | .hgignore .includepath .project _test/read_repo.pl lib/Yours/Parsers/MDParser.pm lib/Yours/Parsers/PMDParser.pm lib/Yours/Parsers/SaxParser.pm |
diffstat | 7 files changed, 429 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.includepath Tue Oct 22 05:26:56 2013 +0400 @@ -0,0 +1,7 @@ +<?xml version="1.0" encoding="UTF-8"?> +<includepath> + <includepathentry path="/home/sergey/workspace.web/Impl/Lib" /> + <includepathentry path="/home/sergey/workspace.web/benzin/lib" /> + <includepathentry path="${resource_loc:/yours/lib}" /> +</includepath> +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.project Tue Oct 22 05:26:56 2013 +0400 @@ -0,0 +1,17 @@ +<?xml version="1.0" encoding="UTF-8"?> +<projectDescription> + <name>yours</name> + <comment></comment> + <projects> + </projects> + <buildSpec> + <buildCommand> + <name>org.epic.perleditor.perlbuilder</name> + <arguments> + </arguments> + </buildCommand> + </buildSpec> + <natures> + <nature>org.epic.perleditor.perlnature</nature> + </natures> +</projectDescription>
--- /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
--- /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;
--- /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
--- /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