IIJのMLのwhoリストと、 File Maker Proの名簿のアドレスを
チェックする perlスクリプト: check.pl

            by 高須    98.11.7    → ホームページ

   Perlのページ  コンピュータのページ

---

１。このスクリプトの目的

某同窓会MLは、IIJのMLを使ってます。
一方、名簿は、File Maker Proに入れてます。
IIJのwho出力と、File Maker Proのアドレス部分を比較して、
一致しない部分をプリントするプログラムです。

---

２。whoリストの準備

IIJにコマンド受け付けアドレスに、whoコマンドを送ると、
メールでメンバーリストが戻ってきます。
メールのヘッダを落して、ファイルwho.inputに入れておきます。

データ形式は以下のようになってます。

   ## BYE    address_unsubscribed
   #(tab)address_resting
   address_ subscribed

---

３。名簿データの準備

元のFile Maker Proの名簿から、データを読み出します。

読みだしファイル名はmeibo.TABにしておきます。

「タブ区切りテキスト」を選択。
データ順は、以下の通り。

  名字、旧姓、名前、卒業年、学部、学科、学年(在学生のみ)、

  仕事、会員(yes/no), 在学(zaigaku/og), 会員番号(会員のみ),

  e-mailその１、e-mailその２(2つアドレスがある人のみ）。

  配送（rest/send/unsub), 備考、ホームページ、ファイル名、

  表示、休止日、配送２、休止日２

このうち照合に使うのは、e-mailその１、e-mailその２、配送、配送２である。

---

４。実行

以下のソースをテキストモードで例えば、 check.pl というファイルにセーブします。

      chmod +x check.pl

によって、実行可能にします。 who.inputとmeibo.TABと同じディレクトリに入れます。

     check.pl 

により、出力が画面に出ます。

---

４。本文

#!/usr/bin/perl
#   check.pl               by M. Takasu,  Nov.7 , 1998                     
#   compare who list of IIJ ML and meibo address
#
$file_who = "who.input";   # chop header from who list 
$file_maker = "meibo.TAB";

#--------------------------------------------------
#  step 1 : prepare who file 
&prepare_who;
#&print_who;   

#--------------------------------------------------
#  step 2 :  prepare file maker file
&prepare_file_maker;
#&print_file_maker;
#--------------------------------------------------
#  step 3 : compare two files and output

&compare_all;
&print_compare;

#---------------------------------------------
# start of subroutines
#   subroutines for step 1
#--------------------------------------------
sub prepare_who{    # read from who list and put into arrays

   system("rm -f who_temp ");
   system("sort $file_who|nkf -e  > who_temp");
   open(inputfile1, who_temp)|| die "can not open file \n";

    $i_rest =0;
    $i_send =0;

     while(<inputfile1>) {
       $line = $_;
       unless ($line =~ /BYE/){    # ignore unsubscribed address
         if($line =~  /^ #\t/){           
            $line =~ s/^ #\t//g  ;  

            $line  = &arrange_line($line);
            $who_rest[$i_rest]  = $line;
            $i_rest ++;
         }
         else{                                 # active lines
            $line  = &arrange_line($line);
            $who_send[$i_send]  = $line;
            $i_send ++;
         }
       }     # end of unless 
     }   # end of while
     close(inputfile1);
     system("rm -f who_temp");

       $n_who_rest = $i_rest-1;    # number of rest address
       $n_who_send = $i_send-1;    # number of send address
}
#--------------------------------------------------------
                     # used also in 2nd step
sub arrange_line{    # get rid of spaces and change lines
   local($line1)=@_;
   if($line1 =~ /\n/){
      $line1 =~ s/\n//g ;
   }
   if($line1 =~ / +/ ){
      $line1 =~ s/ +// ;    
   }
   $line1;
}
#---------------------------------------------------------
sub print_who{               # for debug
   &print_array("active members ", $n_who_send , *who_send);
   &print_array("resting members", $n_who_rest , *who_rest);
}
#---------------------------------------------------------
                     # used also in step 2.   for debug
sub print_array{     # print array with title 
   local($word1, $n, *a)=@_;
   print " \n $word1 n= $n \n";
   for ($i = 0; $i <= $n ;$i ++ ){
        print "+",$a[$i], "*\n";     #  put + and * to check spaces
   }
}
#-------------------------------------------------------
#  subroutines for step 2
#-----------------------------------------------------
sub prepare_file_maker{
   &get_file_maker;
   &sort_file_maker;
}
#------------------------------------------------------
sub get_file_maker{

  system("rm -f fmj_temp1");
  system("cat $file_maker |nkf -e > fmj_temp1 ");
  open(inputfile2, fmj_temp1) || die "can not open file fmj_temp1 \n";

  $i = 0;
  $i_rest = 0;
  $i_send = 0;

  while (<inputfile2>){
    $input = $_;
                          # retain this format
    ($myouji{$i}, $kyuusei{$i}, $namae{$i}, $sotsugyou{$i},
     $gakubu{$i}, $gakka{$i}, $gakunen{$i}, $shigoto{$i},
     $kaiin{$i}, $zaigaku{$i}, $bangou{$i}, $address{$i}, $address2{$i}, 
     $haisou{$i}, $bikou{$i}, $hp{$i}, $hp_file{$i},
     $hyouji{$i}, $date_rest{$i}, $haisou2{$i}, $date_rest2{$i}) =
         split(/\t/, $input);

     $address{$i}  = &arrange_line($address{$i});
     $address2{$i} = &arrange_line($address2{$i});

     &add_all($address{$i}, $haisou{$i});
     &add_all($address2{$i}, $haisou2{$i});
         $i++;
  }
  close(inputfile2);
  system("rm -f fmj_temp1");

  $n_add_send = $i_send -1;    # number of send address in fmj
  $n_add_rest = $i_rest -1;    # number of rest address in fmj
}
#-------------------------------------------------------------
sub add_all{     #  classify the address to send or rest
  local($add, $hai)=@_;

  if($add ne "" && $add ne "\n"){
     if($hai =~ /rest/){ 
         $add_rest_t{$i_rest}  = $add;
         $i_rest ++ ;
     }
     elsif($hai =~ /unsub/){
     }
     else{
         $add_send_t{$i_send}  = $add;
         $i_send ++ ;
     }
   }
}
#-----------------------------------------------------
sub sort_file_maker{   # sort send and rest address separately
   &sort_array(*add_send_t, *add_send);
   &sort_array(*add_rest_t, *add_rest);
}
#-------------------------------------------------------
sub sort_array{     # sort array input and place in output
   local(*input, *output)=@_ ;
   local($i_input) = 0;
   @sorted = sort by_word keys(%input);

   foreach $i (@sorted){
      $output[$i_input]= $input{$i};
      $i_input ++;
   }  
   (*input, *output);
}
#----------------------------------------------------
sub by_word{    # alphabetical sort
  ($input{$a} cmp $input{$b});
}
#----------------------------------------------
sub print_file_maker{    # don't erase. for debug 
   &print_array("active members in fmj ", $n_add_send , *add_send);
   &print_array("resting members in fmj", $n_add_rest , *add_rest);
}
#---------------------------------------------------------------
#   subroutines for step 3
#---------------------------------------------------------------
sub compare_all{    # compare fmj output and who
  &compare(*add_send, *who_send, 
   *find_add_send, *find_who_send, $n_add_send, $n_who_send);

  &compare(*add_rest, *who_rest, 
   *find_add_rest, *find_who_rest, $n_add_rest, $n_who_rest);
}
#---------------------------------------------------------------
sub compare{     # compare two arrays and put "yes" if matched

   local(*a, *b, *find_a, *find_b, $n_a, $n_b)=@_;
   local($i, $j);
#                  default: put no in arrays
   foreach($i=0;$i <= $n_a ; $i++){
      $find_a[$i] = "no";
   }
   foreach($j=0;$j <= $n_b ; $j++){
      $find_b[$j] = "no";
   }
#      put yes if matched
#      the search is redundant if arrays are sorted

   foreach($i=0; $i <= $n_a  ; $i++){
     if($find_a[$i] ne "yes"){

       foreach($j=0; $j <= $n_b   ; $j++){
         if($find_b[$j] ne "yes"  && $a[$i] eq  $b[$j] ){
             $find_a[$i] = "yes";
             $find_b[$j] = "yes";
         }
       }
     }
   }
   (*a, *b, *find_a, *find_b, $n_a, $n_b);
}
#--------------------------------------------------------------
sub print_compare{    # print unmatched send and rest separately 
  &print_list("send",*add_send, *who_send,
   *find_add_send, *find_who_send, $n_add_send, $n_who_send);

  &print_list("rest",*add_rest, *who_rest,
   *find_add_rest, *find_who_rest, $n_add_rest, $n_who_rest);
}
#-----------------------------------------------------------------
sub print_list{    #   print unmatched items
  local($word1,*add, *who, 
     *find_add, *find_who, $n_add, $n_who) = @_;

  local($i);
   $line=  "\n ----------------------------";

   print $line;
   print "\n number of $word1 addresses in fmj ", $n_add;
   print "\n number of $word1 addresses in who ", $n_who;

   print $line;
   print "\n $word1: in fmj but not in who \n\n";
   foreach($i=0; $i <= $n_add ; $i++){
      if($find_add[$i] ne "yes"){
          print "?",$add[$i], "*\n";
      }
   }

   print $line;
   print "\n $word1: in who but not in fmj \n\n";
   foreach($i=0; $i <= $n_who ; $i++){
      if($find_who[$i] ne "yes"){
          print "?",$who[$i], "*\n";
      }
   }
}
#--------------------------------------------

---

Perlのページ  コンピュータのページ

---