viewing paste ra_cmp_itemdb | Perl

Posted on the
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
#!/usr/bin/perl
 
use strict;
use File::Basename;
use Getopt::Long;
use Scalar::Util qw(looks_like_number);
 
my $sItem_db_re = "db/re/item_db.txt";
my $sItem_db_pre = "db/pre-re/item_db.txt";
my $sSort_opt = "id";
my $sOpt = "none";
 
Main();
 
sub Main {
        my($filename, $dir, $suffix) = fileparse($0);
        chdir $dir;
        chdir ".."; #put ourself like was called in main folder
        GetArgs();
       
        my %hDB_re_ID;
        my %hDB_pre_ID;
        my $nb_columns = 22;
        my $line_format = "([^\,]*),"x($nb_columns-3)."(\{.*\}),"x(2)."(\{.*\})"; #Last 3 columns are scripts.
               
        ParseItemDBFile($sItem_db_re,\%hDB_re_ID,$line_format);
        ParseItemDBFile($sItem_db_pre,\%hDB_pre_ID,$line_format);
        #DisplayIDFound("RE",\%hDB_re_ID);
        #DisplayIDFound("pRE",\%hDB_pre_ID);
        SearchAndDisplayMissing($sItem_db_re,$sItem_db_pre,\%hDB_re_ID,\%hDB_pre_ID);
        SearchAndDisplayMissing($sItem_db_pre,$sItem_db_re,\%hDB_pre_ID,\%hDB_re_ID);
}
 
sub GetArgs {
        my $sHelp;
        my $sValidSort = "id|line";
        my $sValidOpt = "none|bad_def|dup_def|warn_comment|all";
    GetOptions(
    'dbre=s' => \$sItem_db_re, #re item db file
    'dbpre=s' => \$sItem_db_pre, #pre item db file
    'sort=s' => \$sSort_opt, #sorting option by line or id
    'opt=s' => \$sOpt, #display stuff option
    'help!' => \$sHelp,
    ) or $sHelp=1; #display help if invalid option     
       
    if( $sHelp ) {
        print "Incorect option specified, available option are:\n"
            ."\t --dbre filename => specify wich item re db file to use\n"
            ."\t --dbpre filename => specify wich item pre db file to use\n"
            ."\t --sort id|line => sort result by src id or src line number\n"
            ."\t --opt none|dup_def|bad_def => Diplay infos about DB parsing\n";
        exit;
    }
    unless($sSort_opt =~ /$sValidSort/i){
                print "ERROR: Incorrect sort option specified. Available sort option:\n"
                        ."\t id: sort missing ID by src ID \n"
                        ."\t line: sort missing ID by src line number \n"
                        ."\t --sort='$sValidSort' => sort result by src id or src line number\n";
                exit;
        }
        unless($sOpt =~ /$sValidOpt/i){
                print "ERROR: Incorrect option specified. Available option:\n"
                        ."\t none: Don't display definition error \n"
                        ."\t bad_def: Display detected line error \n"
                        ."\t dup_def: Display duplicated itemid def in DB \n"
                        ."\t warn_comment: Display found but commented in other DB \n"
                        ."\t all: enable bad_def,dup_def,warn_comment \n"
                        ."\t --opt='$sValidOpt' => Diplay infos about DB parsing \n";
                exit;
        }
}
 
sub DisplayIDFound { my ($sFilename,$rHash) = @_;
        my @aDB_ID = keys %$rHash;
        print "Found $sFilename = [ @aDB_ID ] \n";
}
 
sub ParseItemDBFile { my ($sFilename,$rHash,$sLine_format) = @_;
        open FILE, "<$sFilename" or die "couldn't open file $sFilename \n";
        my $sLineNumber=0;
        while(my $ligne=<FILE>){
        $sLineNumber++;
        if ($ligne =~ /^\s*$/ ) { next; } #skip empty line
                if ($ligne =~ /[^\r\n]+/) {
                                my $sIscom = 0;
                                my $sDataType = 0; # 0 all fine, 1 bad line format
                                my @champ = ();
                               
                                $ligne = $&;
                                if ($ligne =~ /^\/\//) { $sIscom = 1; }
                                if ($ligne =~ $sLine_format) {
                                        @champ = ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$20,$21,$22);
                                        $sDataType = 0;
                                }
                                else {
                                                @champ = split(',',$ligne);
                                                $sDataType = 1; #mark bad line format
                                }
                               
                                if(scalar(@champ) && $sIscom){ $champ[0] =~ s!^\/\/!!; }
                                if(looks_like_number($champ[0])){ #ensure it's an number
                                        if($sOpt =~ /dup_def|all/i && $$rHash{$champ[0]} && $$rHash{$champ[0]}{"line"} == $sLineNumber){
                                                print "Duplicate definition on: line=$sLineNumber, content='$ligne'\n";
                                                $sDataType = 3; #duplicate def
                                        }
                                        $$rHash{$champ[0]} = {
                                                "line" => $sLineNumber,
                                                "content" => $ligne,
                                                "iscomment" => $sIscom,
                                                "data_type" => $sDataType,
                                        };
                                }
                                else { $sDataType = 2; } #mark bad id def
                               
                                if($sDataType && $sDataType != 3 && $sOpt =~ /bad_def|all/i ) {
                                        print "Bad definition on: line=$sLineNumber, content='$ligne'\n";
                                }
                }
        }
        close FILE;
}
 
sub SearchAndDisplayMissing { my($sNameSrc,$sNameChk,$rhSrc,$rhChk) = @_;
        print "Checking ID from $sNameSrc are into $sNameChk \n";
        my $sCount = 0;
        my %hChkData = %$rhChk;
        my %hSrcData = %$rhSrc;
        my @aListID = keys %hSrcData;
        my @aSortedArray = ();
       
        if($sSort_opt =~ /ID/i){
                @aSortedArray = sort {$a <=> $b} @aListID; # sort by ID
        }
        elsif($sSort_opt =~ /line/i){ #found how to optimize this
                my %hTmp;
                my @aTmp;
                foreach my $sID(@aListID){
                        $hTmp{$hSrcData{$sID}{"line"}} = $sID;
                }
                @aTmp = keys %hTmp;
                @aTmp = sort {$a <=> $b} @aTmp; # sort by lineID
                foreach my $sLine (@aTmp){
                        push(@aSortedArray,$hTmp{$sLine});
                }
        }
       
        foreach my $sID(@aSortedArray){
                if($sOpt =~ /warn_comment|all/i && $hChkData{$sID} && $hChkData{$sID}{"iscomment"}){ #warn found but commented
                        print "Found but commented in $sNameChk => ID : ".$sID." src line = ".$hChkData{$sID}{"line"}." with line : '".$hChkData{$sID}{"content"}."' \n\n";
                }
                unless($hChkData{$sID}){
                        print "Didn't found in $sNameChk => ID : ".$sID." src line = ".$hSrcData{$sID}{"line"}." with line : '".$hSrcData{$sID}{"content"}."' \n\n";
                        $sCount++;
                }
        }
        unless($sCount){
                print "No missing ID found \n";
        }
}
 
Viewed 1127 times, submitted by lighta.