Debian-DEP12-0.1.0/0000775000175000017500000000000014013472352013342 5ustar andriusandriusDebian-DEP12-0.1.0/MANIFEST0000644000175000017500000000053714013472352014476 0ustar andriusandrius# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. Changes LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini lib/Debian/DEP12.pm lib/Debian/DEP12/ValidationWarning.pm scripts/bibtex-to-dep12 scripts/dep12-validate t/01_use.t t/02_validate.t t/03_roundtrip.t t/04_Text_BibTeX_Entry.t t/05_Text_BibTeX_File.t Debian-DEP12-0.1.0/Changes0000644000175000017500000000005114013472352014627 0ustar andriusandrius0.1.0 2021-02-18 - Initial release. Debian-DEP12-0.1.0/lib/0000775000175000017500000000000014013472352014110 5ustar andriusandriusDebian-DEP12-0.1.0/lib/Debian/0000775000175000017500000000000014013472352015272 5ustar andriusandriusDebian-DEP12-0.1.0/lib/Debian/DEP12/0000775000175000017500000000000014013472352016045 5ustar andriusandriusDebian-DEP12-0.1.0/lib/Debian/DEP12/ValidationWarning.pm0000644000175000017500000000334714013472352022030 0ustar andriusandriuspackage Debian::DEP12::ValidationWarning; use strict; use warnings; # ABSTRACT: validaton warning class our $VERSION = '0.1.0'; # VERSION use parent 'Text::BibTeX::Validate::Warning'; =head1 NAME Debian::DEP12::ValidationWarning - validaton warning class =head1 SYNOPSIS use Debian::DEP12::ValidationWarning; my $warning = Debian::DEP12::ValidationWarning->new( 'value \'%(value)s\' is better written as \'%(suggestion)s\'', { field => 'Bug-Submit', value => 'merkys@cpan.org', suggestion => 'mailto:merkys@cpan.org', } ); print STDERR "$warning\n"; =head1 DESCRIPTION Debian::DEP12::ValidationWarning is used to store the content of validation warning in a structured way. Currently the class is based on L, but may be decoupled in the future. =head1 METHODS =head2 new( $message, $fields ) Takes L-compatible template and a hash with the values for replacement in the template. Three field names are reserved and used as prefixes for messages if defined: C for the name of a file, C for the index inside list and C for DEP12 field name. Field C is also somewhat special, as L may use its value to replace the original in an attempt to clean up the DEP12 entry. =head2 fields() Returns an array of fields defined in the instance in any order. =head2 get( $field ) Returns value of a field. =head2 set( $field, $value ) Sets a new value for a field. Returns the old value. =head2 delete( $field ) Unsets value for a field. Returns the old value. =head1 AUTHORS Andrius Merkys, Emerkys@cpan.orgE =cut 1; Debian-DEP12-0.1.0/lib/Debian/DEP12.pm0000644000175000017500000002051114013472352016400 0ustar andriusandriuspackage Debian::DEP12; use strict; use warnings; # ABSTRACT: interface to Debian DEP 12 format our $VERSION = '0.1.0'; # VERSION use Data::Validate::Email qw( is_email_rfc822 ); use Data::Validate::URI qw( is_uri ); use Debian::DEP12::ValidationWarning; use Encode qw( decode ); use Scalar::Util qw( blessed ); use Text::BibTeX::Validate qw( validate_BibTeX ); use YAML::XS; # Preventing YAML::XS from doing undesired things: $YAML::XS::DumpCode = 0; $YAML::XS::LoadBlessed = 0; $YAML::XS::UseCode = 0; my @fields = qw( Archive ASCL-Id Bug-Database Bug-Submit Cite-As Changelog CPE Documentation Donation FAQ Funding Gallery Other-References Reference Registration Registry Repository Repository-Browse Screenshots Security-Contact Webservice ); my @list_fields = qw( Funding Reference Registry Screenshots ); =head1 NAME Debian::DEP12 - interface to Debian DEP 12 format =head1 SYNOPSIS use Debian::DEP12; my $meta = Debian::DEP12->new; $meta->set( 'Bug-Database', 'https://github.com/merkys/Debian-DEP12/issues' ); $meta->validate; =head1 DESCRIPTION Debian::DEP12 is an object-oriented interface for Debian DEP 12 format, also known as debian/upstream/metadata. Primary focus of the initial development was validation and fixing of DEP 12 data. Contributions welcome! =head1 METHODS =head2 new( $what ) Creates a new Debian::DEP12 instance from either YAML, L or L instances, or plain Perl hash reference with DEP 12 fields and their values. =cut sub new { my( $class, $what ) = @_; my $self; if( !defined $what ) { $self = {}; } elsif( blessed $what && ( $what->isa( 'Text::BibTeX::Entry' ) || $what->isa( 'Text::BibTeX::File' ) ) ) { my @entries; if( $what->isa( 'Text::BibTeX::Entry' ) ) { push @entries, $what; } else { require Text::BibTeX::Entry; while( my $entry = Text::BibTeX::Entry->new( $what ) ) { push @entries, $entry; } } my @references; for my $entry (@entries) { # FIXME: Filter only supported keys (?) push @references, { map { _canonical_BibTeX_key( $_ ) => decode( 'UTF-8', $entry->get( $_ ) ) } grep { defined $entry->get( $_ ) } $entry->fieldlist }; for ('number', 'pages', 'volume', 'year') { next if !exists $references[-1]->{ucfirst $_}; next if $references[-1]->{ucfirst $_} !~ /^[1-9][0-9]*$/; $references[-1]->{ucfirst $_} = int $references[-1]->{ucfirst $_}; } } return $class->new( { Reference => \@references } ); } elsif( ref $what eq '' ) { # Text in YAML format if( $YAML::XS::VERSION < 0.69 ) { die 'YAML::XS < 0.69 is insecure' . "\n"; } $self = Load $what; } elsif( ref $what eq 'HASH' ) { $self = $what; } else { die 'cannot create Debian::DEP12 from ' . ref( $what ) . "\n"; } return bless $self, $class; } sub _canonical_BibTeX_key { my( $key ) = @_; return uc $key if $key =~ /^(doi|isbn|issn|pmid|url)$/; return ucfirst $key; } =head2 fields() Returns an array of fields defined in the instance in any order. =cut sub fields { return keys %{$_[0]}; } =head2 get( $field ) Returns value of a field. =cut sub get { my( $self, $field ) = @_; return $self->{$field}; } =head2 set( $field, $value ) Sets a new value for a field. Returns the old value. =cut sub set { my( $self, $field, $value ) = @_; ( my $old_value, $self->{$field} ) = ( $self->{$field}, $value ); return $old_value; } =head2 delete( $field ) Unsets value for a field. Returns the old value. =cut sub delete { my( $self, $field ) = @_; my $old_value = $self->{$field}; delete $self->{$field}; return $old_value; } sub _to_BibTeX { my( $self ) = @_; my $reference = $self->get( 'Reference' ); if( ref $reference eq 'HASH' ) { $reference = [ $reference ]; } my @BibTeX; for my $reference (@$reference) { push @BibTeX, { map { lc( $_ ) => $reference->{$_} } keys %$reference }; } return @BibTeX; } =head2 to_YAML() Returns a string with YAML representation. =cut sub to_YAML { my( $self ) = @_; my $yaml = Dump $self; # HACK: no better way to serialize plain data? $yaml =~ s/^---[^\n]*\n//m; return $yaml; } =head2 validate() Performs checks of DEP 12 data in the instance and returns an array of validation messages as instances of L. =cut sub validate { my( $self ) = @_; my @warnings; # TODO: validate other fields for my $key (sort $self->fields) { if( !grep { $_ eq $key } @fields ) { push @warnings, _warn_value( 'unknown field', $key, $self->get( $key ) ); } if( ref $self->get( $key ) && !grep { $_ eq $key } @list_fields ) { push @warnings, _warn_value( 'scalar value expected', $key, $self->get( $key ) ); } } for my $key ('Bug-Database', 'Bug-Submit', 'Changelog', 'Documentation', 'Donation', 'FAQ', 'Gallery', 'Other-References', 'Registration', 'Repository', 'Repository-Browse', 'Screenshots', 'Webservice') { next if !defined $self->get( $key ); my @values; if( ref $self->get( $key ) eq 'ARRAY' ) { @values = @{$self->get( $key )}; } else { @values = ( $self->get( $key ) ); } for my $i (0..$#values) { my $yamlpath = $key . (ref $self->get( $key ) eq 'ARRAY' ? "[$i]" : ''); $_ = $values[$i]; if( ref $_ ) { push @warnings, _warn_value( 'non-scalar value', $yamlpath, $_ ); next; } next if defined is_uri $_; if( /^(.*)\n$/ && defined is_uri $1 ) { push @warnings, _warn_value( 'URL has trailing newline character', $yamlpath, $_, { suggestion => $1 } ); next; } if( is_email_rfc822( $_ ) ) { push @warnings, _warn_value( 'value \'%(value)s\' is better written as \'%(suggestion)s\'', $yamlpath, $_, { suggestion => 'mailto:' . $_ } ); next; } push @warnings, _warn_value( 'value \'%(value)s\' does not look like valid URL', $yamlpath, $_ ); } } my @BibTeX = $self->_to_BibTeX; for my $i (0..$#BibTeX) { my $BibTeX = $BibTeX[$i]; my @BibTeX_warnings = validate_BibTeX( $BibTeX ); for (@BibTeX_warnings) { # For everything under Reference outputting YAML paths like # https://github.com/wwkimball/yamlpath/wiki/Segments-of-a-YAML-Path $_->set( 'field', "Reference" . (ref $self->get( 'Reference' ) eq 'ARRAY' ? "[$i]" : '') . '.' . _canonical_BibTeX_key( $_->get( 'field' ) ) ); bless $_, Debian::DEP12::ValidationWarning::; } push @warnings, @BibTeX_warnings; } return @warnings; } sub _warn_value { my( $message, $field, $value, $extra ) = @_; $extra = {} unless $extra; return Debian::DEP12::ValidationWarning->new( $message, { field => $field, value => $value, %$extra } ); } =head1 SEE ALSO For the description of DEP 12 refer to L. =head1 AUTHORS Andrius Merkys, Emerkys@cpan.orgE =cut 1; Debian-DEP12-0.1.0/README0000644000175000017500000000046314013472352014223 0ustar andriusandriusThis archive contains the distribution Debian-DEP12, version 0.1.0: interface to Debian DEP 12 format This software is Copyright (c) 2021 by Andrius Merkys. This is free software, licensed under: The (three-clause) BSD License This README file was generated by Dist::Zilla::Plugin::Readme v6.012. Debian-DEP12-0.1.0/scripts/0000775000175000017500000000000014013472352015031 5ustar andriusandriusDebian-DEP12-0.1.0/scripts/dep12-validate0000755000175000017500000000066214013472352017463 0ustar andriusandrius#!/usr/bin/perl use strict; use warnings; use Debian::DEP12; @ARGV = ( '-' ) unless @ARGV; for my $i (0..$#ARGV) { my $filename = $ARGV[$i]; open( my $inp, '<' . $filename ); my $yaml = join '', <$inp>; close $inp; my $meta = Debian::DEP12->new( $yaml ); my @warnings = $meta->validate; for my $warning (@warnings) { $warning->set( 'file', $filename ); warn "$0: $warning\n"; } } Debian-DEP12-0.1.0/scripts/bibtex-to-dep120000755000175000017500000000055014013472352017563 0ustar andriusandrius#!/usr/bin/perl use strict; use warnings; use Debian::DEP12; use Text::BibTeX; @ARGV = ( '-' ) unless @ARGV; for my $i (0..$#ARGV) { my $filename = $ARGV[$i]; print "---\n" if $i; my $bibfile = Text::BibTeX::File->new( $filename ) || die "$0: $filename: $!\n"; my $meta = Debian::DEP12->new( $bibfile ); print $meta->to_YAML; } Debian-DEP12-0.1.0/LICENSE0000644000175000017500000000273314013472352014352 0ustar andriusandriusCopyright (c) The Regents of the University of California. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Debian-DEP12-0.1.0/META.yml0000644000175000017500000000145614013472352014617 0ustar andriusandrius--- abstract: 'interface to Debian DEP 12 format' author: - 'Andrius Merkys ' build_requires: Test::More: '0' Text::BibTeX: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Debian-DEP12 requires: Data::Validate::Email: '0' Data::Validate::URI: '0' Text::BibTeX::Validate: v0.3.0 YAML::XS: '0.69' resources: bugtracker: https://github.com/merkys/debian-dep12/issues homepage: https://search.cpan.org/dist/Debian-DEP12 repository: git://github.com/merkys/debian-dep12.git version: 0.1.0 x_generated_by_perl: v5.30.0 x_serialization_backend: 'YAML::Tiny version 1.73' Debian-DEP12-0.1.0/META.json0000644000175000017500000000260114013472352014760 0ustar andriusandrius{ "abstract" : "interface to Debian DEP 12 format", "author" : [ "Andrius Merkys " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "bsd" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Debian-DEP12", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Data::Validate::Email" : "0", "Data::Validate::URI" : "0", "Text::BibTeX::Validate" : "v0.3.0", "YAML::XS" : "0.69" } }, "test" : { "requires" : { "Test::More" : "0", "Text::BibTeX" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/merkys/debian-dep12/issues" }, "homepage" : "https://search.cpan.org/dist/Debian-DEP12", "repository" : { "type" : "git", "url" : "git://github.com/merkys/debian-dep12.git", "web" : "https://github.com/merkys/debian-dep12" } }, "version" : "0.1.0", "x_generated_by_perl" : "v5.30.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.19" } Debian-DEP12-0.1.0/Makefile.PL0000644000175000017500000000234514013472352015316 0ustar andriusandrius# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "interface to Debian DEP 12 format", "AUTHOR" => "Andrius Merkys ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Debian-DEP12", "LICENSE" => "bsd", "NAME" => "Debian::DEP12", "PREREQ_PM" => { "Data::Validate::Email" => 0, "Data::Validate::URI" => 0, "Text::BibTeX::Validate" => "0.3.0", "YAML::XS" => "0.69" }, "TEST_REQUIRES" => { "Test::More" => 0, "Text::BibTeX" => 0 }, "VERSION" => "0.1.0", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Data::Validate::Email" => 0, "Data::Validate::URI" => 0, "Test::More" => 0, "Text::BibTeX" => 0, "Text::BibTeX::Validate" => "0.3.0", "YAML::XS" => "0.69" ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Debian-DEP12-0.1.0/t/0000775000175000017500000000000014013472352013605 5ustar andriusandriusDebian-DEP12-0.1.0/t/05_Text_BibTeX_File.t0000644000175000017500000000260714013472352017361 0ustar andriusandrius#!/usr/bin/perl use strict; use warnings; use Test::More; eval 'use Text::BibTeX'; plan skip_all => 'Text::BibTeX required' if $@; plan tests => 1; use File::Temp; use Debian::DEP12; my $tmp = File::Temp->new(); my $fh; open( $fh, '>', $tmp->filename ); print $fh <<'END'; @Article{Merkys2016, author = {Merkys, Andrius and Vaitkus, Antanas and Butkus, Justas and Okulič-Kazarinas, Mykolas and Kairys, Visvaldas and Gražulis, Saulius}, journal = {Journal of Applied Crystallography}, title = {{\it COD::CIF::Parser}: an error-correcting {CIF} parser for the {P}erl language}, year = {2016}, month = {Feb}, number = {1}, pages = {292--301}, volume = {49}, doi = {10.1107/S1600576715022396}, url = {http://dx.doi.org/10.1107/S1600576715022396}, } END close $fh; my $bibfile = Text::BibTeX::File->new( $tmp->filename ); my $meta = Debian::DEP12->new( $bibfile ); is( $meta->to_YAML, <<'END' ); Reference: - Author: Merkys, Andrius and Vaitkus, Antanas and Butkus, Justas and Okulič-Kazarinas, Mykolas and Kairys, Visvaldas and Gražulis, Saulius DOI: 10.1107/S1600576715022396 Journal: Journal of Applied Crystallography Month: Feb Number: 1 Pages: 292--301 Title: '{\it COD::CIF::Parser}: an error-correcting {CIF} parser for the {P}erl language' URL: http://dx.doi.org/10.1107/S1600576715022396 Volume: 49 Year: 2016 END Debian-DEP12-0.1.0/t/03_roundtrip.t0000644000175000017500000000071414013472352016322 0ustar andriusandrius#!/usr/bin/perl use strict; use warnings; use Debian::DEP12; use Test::More tests => 1; my $entry; my $warning; local $SIG{__WARN__} = sub { $warning = $_[0]; $warning =~ s/\n$// }; my $input = <new( $input ); is( $entry->to_YAML, $input ); Debian-DEP12-0.1.0/t/02_validate.t0000644000175000017500000000364214013472352016067 0ustar andriusandrius#!/usr/bin/perl use strict; use warnings; use Debian::DEP12; use Test::More tests => 7; my $entry; my $warning; my @warnings; $entry = Debian::DEP12->new( <validate; is( scalar @warnings, 0 ); $entry = Debian::DEP12->new( <validate; is( "@warnings", 'Bug-Database: value \'github.com/merkys/Debian-DEP12/issues\' does not look like valid URL' ); $entry = Debian::DEP12->new; $entry->set( 'Bug-Database', 'github.com/merkys/Debian-DEP12/issues' ); @warnings = $entry->validate; is( "@warnings", 'Bug-Database: value \'github.com/merkys/Debian-DEP12/issues\' does not look like valid URL' ); $entry = Debian::DEP12->new( <validate; is( "@warnings", 'Reference.DOI: value \'search for my surname and year\' does not look like valid DOI' ); $entry = Debian::DEP12->new( <validate; is( "@warnings", 'Reference[1].DOI: value \'search for my surname and year\' does not look like valid DOI' ); $entry = Debian::DEP12->new( { 'Bug-Submit' => 'merkys@cpan.org' } ); @warnings = $entry->validate; is( "@warnings", 'Bug-Submit: value \'merkys@cpan.org\' is better written as \'mailto:merkys@cpan.org\'' ); $entry = Debian::DEP12->new( { 'Bug-Submit' => [ 'merkys@cpan.org', 'github.com/merkys/Debian-DEP12/issues' ] } ); @warnings = $entry->validate; is( join( "\n", @warnings ) . "\n", <<'END' ); Bug-Submit: scalar value expected Bug-Submit[0]: value 'merkys@cpan.org' is better written as 'mailto:merkys@cpan.org' Bug-Submit[1]: value 'github.com/merkys/Debian-DEP12/issues' does not look like valid URL END Debian-DEP12-0.1.0/t/01_use.t0000644000175000017500000000007614013472352015067 0ustar andriusandriususe Test::More tests => 1; BEGIN { use_ok('Debian::DEP12') }; Debian-DEP12-0.1.0/t/04_Text_BibTeX_Entry.t0000644000175000017500000000266714013472352017610 0ustar andriusandrius#!/usr/bin/perl use strict; use warnings; use Test::More; eval 'use Text::BibTeX'; plan skip_all => 'Text::BibTeX required' if $@; plan tests => 1; use File::Temp; use Debian::DEP12; my $tmp = File::Temp->new(); my $fh; open( $fh, '>', $tmp->filename ); print $fh <<'END'; @Article{Merkys2016, author = {Merkys, Andrius and Vaitkus, Antanas and Butkus, Justas and Okulič-Kazarinas, Mykolas and Kairys, Visvaldas and Gražulis, Saulius}, journal = {Journal of Applied Crystallography}, title = {{\it COD::CIF::Parser}: an error-correcting {CIF} parser for the {P}erl language}, year = {2016}, month = {Feb}, number = {1}, pages = {292--301}, volume = {49}, doi = {10.1107/S1600576715022396}, url = {http://dx.doi.org/10.1107/S1600576715022396}, } END close $fh; my $bibfile = Text::BibTeX::File->new( $tmp->filename ); my $entry = Text::BibTeX::Entry->new( $bibfile ); my $meta = Debian::DEP12->new( $entry ); is( $meta->to_YAML, <<'END' ); Reference: - Author: Merkys, Andrius and Vaitkus, Antanas and Butkus, Justas and Okulič-Kazarinas, Mykolas and Kairys, Visvaldas and Gražulis, Saulius DOI: 10.1107/S1600576715022396 Journal: Journal of Applied Crystallography Month: Feb Number: 1 Pages: 292--301 Title: '{\it COD::CIF::Parser}: an error-correcting {CIF} parser for the {P}erl language' URL: http://dx.doi.org/10.1107/S1600576715022396 Volume: 49 Year: 2016 END Debian-DEP12-0.1.0/dist.ini0000644000175000017500000000105114013472352015001 0ustar andriusandriusname = Debian-DEP12 author = Andrius Merkys license = BSD copyright_holder = Andrius Merkys copyright_year = 2021 version = 0.1.0 [@Filter] -bundle = @Basic -remove = License [AutoMetaResources] homepage = https://search.cpan.org/dist/%{dist} repository.github = user:merkys bugtracker.github = user:merkys [MetaJSON] [OurPkgVersion] [Prereqs] Data::Validate::Email = 0 Data::Validate::URI = 0 Text::BibTeX::Validate = 0.3.0 YAML::XS = 0.69 [Prereqs / Test] -phase = test Test::More = 0 Text::BibTeX = 0