view release on metacpan or  search on metacpan

lib/App/Smolder/Report.pm  view on Meta::CPAN

package App::Smolder::Report;

use warnings;
use strict;
use 5.008;
use LWP::UserAgent;
use Getopt::Long;
use Carp::Clan qw(App::Smolder::Report);

our $VERSION = '0.04';


###################
# Smolder reporting

sub report {
  my $self = shift;
  
  $self->{run_as_api} = 1;
  return $self->_do_report(@_);
}

sub _do_report {
  my $self = shift;
  
  $self->_fatal("Required 'server' setting is empty or missing")
    unless $self->server;
  $self->_fatal("Required 'project_id' setting is empty or missing")
    unless $self->project_id;
  $self->_fatal("Required 'username' setting is empty or missing")
    unless $self->username;
  $self->_fatal("Required 'password' setting is empty or missing")
    unless $self->password;
  $self->_fatal("You must provide at least one report to upload")
    unless @_;
  
  return $self->_upload_reports(@_);
}

sub _upload_reports {
  my ($self, @reports) = @_;
  my $server = $self->server;
  my $reports_url;
  
  $server = "http://$server"
    unless $server =~ m/^http/;
  
  my $ua = LWP::UserAgent->new;
  my $url
    = $server
    . '/app/developer_projects/process_add_report/'
    . $self->project_id;
  
  REPORT_FILE:
  foreach my $report_file (@reports) {
    $self->_fatal("Could not read report file '$report_file'")
      unless -r $report_file;
  
    if ($self->dry_run) {
      $self->_log("Dry run: would POST to $url: $report_file");
      next REPORT_FILE;
    }
    
    my $response = $ua->post(
      $url,
      'Content-Type' => 'form-data',
      'Content'      => [
        username => $self->username,
        password => $self->password,
        tags     => '',
        report_file => [$report_file],
      ],
    );
    
    if ($response->code == 302) {
      if (! $reports_url) {
        $reports_url = $response->header('Location');
        $reports_url = "$server$reports_url"
          unless $reports_url =~ m/^http/;
      }
      
      $self->_log("Report '$report_file' sent successfully");
      
      if ($self->delete) {
        if (!unlink($report_file)) {
          $self->_log("WARNING: could not delete file $report_file: $!");
        }
      }
    }
    else {
      $self->_fatal(
        "Could not upload report '$report_file'",
        "HTTP Code: ".$response->code,
        $response->message,
      );
    }
  }
  
  $self->_log("See all reports at $reports_url") if $reports_url;
  return $reports_url;
}


###################################
# Configuration loading and merging

sub _load_configs {
  my ($self) = @_;
  
  my $filename = '.smolder.conf';
  my @files_to_check = ($filename);
  unshift @files_to_check, "$ENV{HOME}/$filename" if $ENV{HOME};
  push @files_to_check, $ENV{APP_SMOLDER_REPORT_CONF}
    if $ENV{APP_SMOLDER_REPORT_CONF};
  
  foreach my $file (@files_to_check) {
    $self->_merge_cfg_file($file);
  }
  
  return;
}

sub _merge_cfg_file {
  my ($self, $file) = @_;
  
  my $cfg = $self->_read_cfg_file($file);
  return unless $cfg;
  
  $self->_merge_cfg_hash($cfg);
  
  if (%$cfg) {
    my @bad_keys = sort keys %$cfg;
    $self->_fatal("Invalid configuration keys in $file:", @bad_keys);
  }
  
  return;
}

sub _read_cfg_file {
  my ($self, $file) = @_;
  my %cfg;
  local $_;
  
  open(my $fh, '<', $file) || return;
  while (<$fh>) {
    s/^\s+|\s+$//g;
    next if /^(#.*)?$/;
    
    if (/^(\S+)\s*=\s*(["'])(.*)\2$/) {
      $cfg{$1} = $3;
    }
    elsif (/^(\S+)\s*=\s*(.+)$/) {