view release on metacpan or  search on metacpan

lib/Parse/CPAN/Perms.pm  view on Meta::CPAN

	isa       => 'HashRef',
        builder   => 'build_perms',
        clearer   => 'clear_perms',
        lazy      => 1,
);


has mtime => (
	is        => 'rw',
	isa       => 'Int',
        default   => 0,
);

#-----------------------------------------------------------------------------

around BUILDARGS => sub {
	my ($orig, $class)  = (shift, shift);

        return $class->$orig(@_) unless @_ %2 or ref $_[0] eq 'HASH';

        my $path = shift;
        my $arg = -f $path ? $path : "$path/modules/06perms.txt.gz";

   	return {permsfile => $arg, @_};
 };

#-----------------------------------------------------------------------------

sub build_perms {
    my ($self) = @_;

    my $permsfile = $self->permsfile;

    my $fh = IO::Zlib->new( $permsfile, "rb" );
    croak "Failed to read $permsfile: $!" unless $fh;
    my $perms_data = $self->__read_perms($fh);
    $fh->close;

    my $mtime = (stat $permsfile)->mtime;
    $self->mtime($mtime);

    return $perms_data;
}

#-----------------------------------------------------------------------------

sub __read_perms {
	my ($self, $fh) = @_;

	my $inheader = 1;
	my $perms = {};

    while (<$fh>) {

        if ($inheader) {
            $inheader = 0 if not m/ \S /x;
            next;
        }

    	chomp;
        my ($module, $author, $perm) = split m/\s* , \s*/x;
    	$perms->{$module}->{$author} = $perm;
    }

    return $perms;
}

#-----------------------------------------------------------------------------

sub is_authorized {
    my ( $self, $author, $module ) = @_;

    return 0 unless $author && $module;

    my $perms = $self->perms;

    return 1 if not exists $perms->{$module}; # Old mods may not have perms
    return 1 if exists $perms->{$module}->{$author};
    return 0;
}

#-----------------------------------------------------------------------------

sub refresh {
    my ($self, $force) = @_;

    my $mtime = (stat $self->permsfile)->mtime;
    return $self unless $mtime > $self->mtime or $force;

    $self->clear_perms;

    return $self;
}

#-----------------------------------------------------------------------------
1;

__END__

=pod

=for :stopwords Jeffrey Ryan Thalhammer cpan testmatrix url annocpan anno bugtracker rt
cpants kwalitee diff irc mailto metadata placeholders metacpan

=head1 NAME

Parse::CPAN::Perms - Parse 06perms.txt.gz

=head1 VERSION

version 0.004

=head1 SYNOPSIS

  # Construction
  my $perms = Parse::CPAN::Perms->new('path/to/06perms.txt.gz');

  # Get all perms data as hash ref
  my $perms_data = $perms->perms;

  # Boolean convenience method