view release on metacpan or  search on metacpan

Description.pm  view on Meta::CPAN

  if ( defined $fh ) {
    carp "$filename is already in use\n";

  } else {
    $filename = $filename ? $filename : shift;

    if ( (not defined $filename) or (not -e $filename) ) {
      croak "invalid filename : $filename";
    }

    $self->open();
  }
}

## just open the file .htaccess
sub open {
  $fh = IO::File->new($filename, "r+");

  if ( not defined $fh) {
    croak "impossible to open $filename in read-write : $!";
  }
}

## add a description
sub add($$){
  my ($self, $file, $desc) = @_;

  print $fh qq/AddDescription "$desc" "$file"\n/;
}


## remove an entry
## this operation is "expensive" : two files are created, and I
## need to parse the whole file.
## if there are more than one directive for the file wanted, they are
## both deleted.
sub remove($) {
  my ($self, $wanted) = @_;
  my $fd;

  $fh->setpos(0);
  $fd = IO::File->new(">/tmp/htaccess.$$");
  
  croak "no file descriptor available : $!" unless (defined $fh or not defined $fd);

  while ( <$fh> ) {
    chomp if defined;

    if ( m/$regexp/xio ) {

      if ($5 ne $wanted)
        { print $fd "$_\n" }

    } else {
      print $fd "$_\n";
    }
  }

  croak "no file descriptor available : $!" if (not defined $fh or not defined $fd);
  
  rename "/tmp/htaccess.$$", $filename
    or croak "rename(htaccess.$$,$filename) : $!";
}

## this function can return an array, or a scalar
## according to the context of the next description.
##
## @ array = ($filename, $description)
##
## $ scal  = qq/$filename:$description/
##
sub next {
  my @data;

  croak "no file descriptor available" unless defined $fh;

  while ( <$fh> ) {
    chomp if defined;

    next unless m/$regexp/xio;
    @data = ($5, $2);

    ## storing the last directive
    @prev = @data;
    last;
  }

   return wantarray ? @data : join ':',@data;
}

## return the previous directive.
## it's the same format than next()
sub prev {
  return wantarray ? @prev : join ':',@prev;
}

## returns all descriptions in a hash reference
##
sub getall {
  my $self = shift;
  my (%hash, $desc);

  croak "no file descriptor available" unless defined $fh;

  while ( my ($f, $d) = $self->next() ) {
    last if not defined $f;

    $hash{"$f"} = $d;
  }

  return \%hash;
}

sub get($) {
  my $self   = shift;
  my $wanted = shift;
  my $ret    = undef;

  croak "no file descriptor available" unless defined $fh;

  while ( my ($f, $d) = $self->next() ) {
    last if not defined $f;

    if ( $f eq $wanted) {
      $ret = $d;
      last;
    }
  }

  return $ret;
}

sub rename {
  print qq/Not implemented yet\n/;
}

sub ispresent($) {
  my $self = shift;
  my $file = shift;

  return $self->get($file) ? 1 : 0;
}


1;

__END__

=head1 NAME

  Apache::Description - Managing of descriptions in .htaccess

=head1 SYNOPSIS

=head2 List every files/descriptions

  use Apache::Description;

  my $d = Apache::Description->new(".htaccess");

  while ( my ($file, $desc) = $d->next )
    {
      ## is it the last element ?
      last unless $file;

      print "$file : $desc";
    }

=head2 Or for the same task :

  use Apache::Description;

  my $d = Apache::Description->new(".htaccess");
  print while $d->next;

=head2 Check for the presence of a file

  use Apache::Description;

  my $d = Apache::Description->new(".htaccess");
  if ( $d->ispresent("foo.txt") )
     { print "found\n" }
  else
     { print "not found\n" }

=head2 add a description

  use Apache::Description;

  my $d = Apache::Description->new(".htaccess");
  $d->add("foo.txt", "bar bar");

=head2 remove the description of foo.txt