view release on metacpan or  search on metacpan

lib/Metabrik/Database/Cwe.pm  view on Meta::CPAN

#
# $Id$
#
# database::cwe Brik
#
package Metabrik::Database::Cwe;
use strict;
use warnings;

use base qw(Metabrik::Client::Www);

sub brik_properties {
   return {
      revision => '$Revision$',
      tags => [ qw(unstable cve) ],
      author => 'GomoR <GomoR[at]metabrik.org>',
      license => 'http://opensource.org/licenses/BSD-3-Clause',
      attributes => {
         datadir => [ qw(datadir) ],
         file => [ qw(file) ],
         xml => [ qw($xml_data) ],
      },
      attributes_default => {
         file => '2000.xml',
      },
      commands => {
         update => [ ],
         load => [ qw(cwe_xml_file) ],
         search => [ qw(cwe_pattern) ],
      },
      require_modules => {
         'Metabrik::File::Compress' => [ ],
         'Metabrik::File::Xml' => [ ],
      },
   };
}

sub update {
   my $self = shift;

   my $datadir = $self->datadir;

   my $uri = 'http://cwe.mitre.org/data/xml/views/2000.xml.zip';
   my $file_zip = "2000.xml.zip";

   my @updated = ();
   my $files = $self->mirror($uri, $file_zip) or return;
   if (@$files > 0) {  # Some new stuff
      my $fc = Metabrik::File::Compress->new_from_brik_init($self) or return;
      for my $file (@$files) {
         (my $outfile = $file) =~ s/\.zip$//;
         my $new_files = $fc->uncompress($file, $outfile, $datadir) or next;
         push @updated, @$new_files;
      }
   }

   return \@updated;
}

sub load {
   my $self = shift;
   my ($file) = @_;

   $file ||= $self->file;
   $self->brik_help_run_undef_arg('load', $file) or return;
   $self->brik_help_run_file_not_found('load', $file) or return;

   my $datadir = $self->datadir;

   my $fx = Metabrik::File::Xml->new_from_brik_init($self) or return;

   my $xml = $fx->read($datadir.'/'.$file) or return;

   return $self->xml($xml);
}

sub show {
   my $self = shift;
   my ($h) = @_;

   $self->brik_help_run_undef_arg('show', $h) or return;
   $self->brik_help_run_invalid_arg('show', $h, 'HASH') or return;

   my $buf = "ID: ".$h->{id}."\n";
   $buf .= "Type: ".$h->{type}."\n";
   $buf .= "Name: ".$h->{name}."\n";
   $buf .= "Status: ".$h->{status}."\n";
   $buf .= "URL: ".$h->{url}."\n";
   $buf .= "Description Summary: ".($h->{description_summary} || '(undef)')."\n";
   $buf .= "Likelihood of Exploit: ".($h->{likelihood_of_exploit} || '(undef)')."\n";
   $buf .= "Relationships:\n";
   for my $r (@{$h->{relationships}}) {
      $buf .= "   ".$r->{relationship_nature}." ".$r->{relationship_target_form}." ".
              $r->{relationship_target_id}."\n";
   }

   return $buf;
}