paste.perl

package WGDev::Command::RelCheck;
use strict;
use warnings;
use 5.008008;

our $VERSION = '0.3.0';

use WGDev::Command::Base;
BEGIN { our @ISA = qw(WGDev::Command::Base) }

use File::Spec   ();
use WGDev::X     ();

sub config_options {
    return qw(
        packages|p
    );
}

sub process {
    my $self = shift;
    my $wgd  = $self->wgd;
    if ( $self->option('packages') ) {
        $self->check_packages;
    }
    return 1;
}

sub check_packages {
    my $self = shift;
    my $wgd  = $self->wgd;
    require Archive::Any;
    require File::Temp;
    require JSON;
    my $package_dir = File::Spec->catdir( $wgd->root, qw/docs upgrades/, 'packages-'.$wgd->version->module );
    opendir my $dir_handle, $package_dir or
        WebGUI::X::IO->throw(
            error => 'Directory does not exist',
            path  => $package_dir
        );
    my %asset_ids = ();
    PACKAGE: foreach my $package_file (readdir $dir_handle) {
        next PACKAGE if $package_file =~ /^\./;
        my $tmp_dir = File::Temp->newdir();
        my $wgpkg = Archive::Any->new(
            File::Spec->catdir($package_dir, $package_file),
        );
        $wgpkg->extract($tmp_dir->dirname);
        FILE: foreach my $filename ($wgpkg->files) {
            next FILE unless $filename =~ /\.json$/;
            my $abs_filename = File::Spec->catdir( $tmp_dir->dirname, $filename);
            open my $asset_file, '<', $abs_filename or
                WebGUI::X::IO->throw(
                    error => 'Directory does not exist',
                    path  => $package_dir
                );
            local $/;
            my $asset_json = <$asset_file>;
            close $asset_file;
            my $asset_id = JSON::from_json($asset_json)->{properties}->{assetId};
            if (! exists $asset_ids{$asset_id}) {
                $asset_ids{$asset_id} = [];
            }
            push @{ $asset_ids{$asset_id} }, $package_file;
        }
    }
    closedir ($dir_handle);
    ASSETID: while (my ($asset_id, $filenames) = each %asset_ids) {
        next ASSETID unless scalar @{$filenames} > 1;
        printf "assetId %s found in these package files: %s\n",
            $asset_id,
            join ", ", @{ $filenames };
    }
    return 1;
}

1;

__END__

=head1 NAME

WGDev::Command::RelCheck - Pre-release checks.

=head1 SYNOPSIS

    wgd relCheck [--packages]

=head1 DESCRIPTION

Performs various checks on the WebGUI source that should be done before release.

=head1 OPTIONS

=over 8

=item C<-p> C<--packages>

Checks to make sure that no asset exists in multiple packages, as this can cause data to be
overwritten.

=back

=head1 AUTHOR

Colin Kuskie <colink@perlDreamer.com>

=head1 LICENSE

Copyright (c) 2009, Graham Knop

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl 5.10.0. For more details, see the
full text of the licenses in the directory LICENSES.

=cut