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