Test::Smoke::Policy - OO interface to handle the Policy.sh stuff.

    use Test::Smoke::Policy;

    my $srcpath = File::Spec->updir;
    my $policy = Test::Smoke::Policy->new( $srcpath );

    $policy->substitute( [] );
    $policy->write;

  * H.Merijn Brand <hmbrand@hccnet.nl>
  * Nicholas Clark <nick@unfortu.net>
  * Abe Timmerman <abeltje@cpan.org>

  * <http://www.perl.com/perl/misc/Artistic.html>,
  * <http://www.gnu.org/copyleft/gpl.html>

package Test::Smoke::Policy;
use strict;

# $Id: Policy.pm 1037 2007-04-02 21:17:19Z abeltje $
use vars qw( $VERSION );
$VERSION = '0.004';

use File::Spec;

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my $self = bless { }, $class;
    $self->reset_rules;
    $self->_read_Policy( @_ );
    $self;
}

sub set_rules {
    my( $self, $rules ) = @_;

    push @{ $self->{_rules} }, $rules;
}

sub reset_rules {
    $_[0]->{_rules} = [ ];
    $_[0]->{_new_policy} = undef;
}

sub _do_subst {
    my $self = shift;

    my %substs;
    foreach my $rule ( @{ $self->{_rules} } ) {
        push @{ $substs{ $rule->[0] } }, $rule->[1];
    }
    my $policy = $self->{_policy};
    while ( my( $target, $values ) = each %substs ) {
        unless ( $policy =~ s{^(\s*ccflags=.*?)$target}
                                                          {$1 . join " ", 
                                                                      grep $_ && length $_ => @$values}meg ) {
            require Carp;
            Carp::carp( "Policy target '$target' failed to match" );
        }
    }
    $self->{_new_policy} = $policy;
}

sub write {
    my $self = shift;

    defined $self->{_new_policy} or $self->_do_subst;

    local *POL;
    my $p_name = shift || 'Policy.sh';
    unlink $p_name; # or carp "Can't unlink '$p_name': $!";
    if ( open POL, "> $p_name" ) {
        print POL $self->{_new_policy};
        close POL or do {
            require Carp;
            Carp::carp( "Error rewriting '$p_name': $!" );
        };
    } else {
        require Carp;
        Carp::carp( "Unable to rewrite '$p_name': $!" );
    }
}

sub _read_Policy {
    my( $self, $srcpath, $verbose, @ccflags ) = @_;
    $srcpath = '' unless defined $srcpath;

    $self->{v} ||= defined $verbose ? $verbose : 0;
    my $vmsg = "";
    local *POLICY;
    if ( ref $srcpath eq 'SCALAR' ) {

        $self->{_policy} = $$srcpath;
        $vmsg = "internal content";

    } elsif ( ref $srcpath eq 'ARRAY' ) {

        $self->{_poliy} = join "", @$srcpath;
        $vmsg = "internal content";

    } elsif ( ref $srcpath eq 'GLOB' ) {

        *POLICY = *$srcpath;
        $self->{_policy} = do { local $/; <POLICY> };
        $vmsg = "anonymous filehandle";

    } else {
        $srcpath = File::Spec->curdir 
            unless defined $srcpath && length $srcpath;
        my $p_name = File::Spec->catfile( $srcpath, 'Policy.sh' );

        unless ( open POLICY, $p_name ) {
            $self->{_policy} = $self->default_Policy( @ccflags );
            $vmsg = "default content";
        } else {
            $self->{_policy} = do { local $/; <POLICY> };
            close POLICY;
            $vmsg = $p_name;
        }

    }
    $self->{v} and print "Reading 'Policy.sh' from $vmsg($self->{v})\n";
}

sub default_Policy {
    my $self = shift;
    my @ccflags = @_ ? @_ : qw( -DDEBUGGING );

    local $" = " ";
    return <<__EOPOLICY__;
#!/bin/sh

# Default Policy.sh from Test::Smoke

# Be sure to define -DDEBUGGING by default, it's easier to remove
# it from Policy.sh than it is to add it in on the correct places

ccflags='@ccflags'
__EOPOLICY__
}

1;