ru.perl

 
 - RU.PERL ----------------------------------------------------------------------
 From : eugene v.                            2:5025/245.1   02 Dec 2003  23:44:22
 To : All
 Subject : files.bbs
 -------------------------------------------------------------------------------- 
 

 Как советовали `сначала искать на СPAN, если там нету то писать` не нашел модуля
 для работы с files.bss
 и решил написать свой.
 написал... не нравится... не знаю почему... может из-за того что алгоритм
 хреновый или дело в руках... но как бы то не было прошу посмотреть и внести свои
 изменения (чтоб быстрее чтобы лучше чтоб красивей :)
 
 вот мой рабочий вариант:
 
 #!/usr/bin/perl
 
 use strict;
 use File::Basename qw/dirname basename/;
 
 my @description_files=
 (
 "files.bbs",
 "descript.ion"
 );
 
 sub desc_add(@)
 {
 
     my ($filename,$desc,@ldesc) = @_;
 
     my $path  = dirname  $filename;
     my $file  = basename $filename;
 
     $file = "\"$file\"" if ( $file =~ / / );
 
     open FBBS, "+>>".$path."/".$description_files[0];
     printf FBBS ("%-12s %s",$file,$desc."\n");
 
     foreach my $ldesc_line( @ldesc )
     {
         printf FBBS ("%-14s%s","",$ldesc_line."\n");
     }
     close (FBBS);
 
     return 1;
 }
 
 #desc_add("12341234123rf rwr qw qwrprint.zip","1e","qweqwe");
 
 sub desc_remove(@)
 {
     my $filename = shift @_;
     my $path  = dirname  $filename;
     my $file  = basename $filename;
     my $qfile = quotemeta $file;
     my $buf;
 
     foreach my $fb ( @description_files )
     {
         next unless ( -e $path.'/'.$fb );
 
         $buf="";
 
         open  FBBS, $path.'/'.$fb;
         read  FBBS, $buf, -s FBBS;
         close FBBS;
 
         $buf = "\n".$buf."\n";
         $buf =~ s/\n\"?$qfile\"?(\s+|\n|).*(\n|)(\s+.*\n)*/\n/g;
         $buf =~ s/^\n*\s*//;
         $buf =~ s/\n$//;
 
         open   FOUT, '>'.$path.'/'.$fb;
         printf FOUT $buf;
         close  FOUT;
     }
 }
 
 #desc_remove("/home/gate/files_bbs/print.zip");
 
 sub desc_get(@)
 {
     my $filename = shift @_;
     my $path     = dirname  $filename;
     my $file     = basename $filename;
     my $qfile    = quotemeta $file;
     my $buf;
 
     foreach my $fb ( @description_files )
     {
         next unless ( -e $path.'/'.$fb );
 
         $buf="";
 
         open  FBBS, $path.'/'.$fb;
         read  FBBS, $buf, -s FBBS;
         close FBBS;
 
         $buf = "\n".$buf."\n";
 
         if ( $buf =~ m/\n\"?$qfile\"?(\s+)(.*(\n|)(\s+.*\n)*)/g )
         {
             (my $desc = $2 ) =~ s/\r//g;
             $desc =~ s/\n\s+/\r/g;
             return split '\r',$desc;
         }
     }
 
     return undef;
 }
 
 print desc_get("print1.zip");
 
 __END__
  \\ Евгений
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор