#!/usr/local/bin/perl -w # # Library of routines for managing id lists # package IdChecker; require Exporter; @ISA = qw(Exporter); @EXPORT = qw( ReadIDs PrintIDs PrintIDsStdout Union Intersection Difference GetChainLetter ); #open file named in argument, read ids, #return a hash which has ids as keys sub ReadIDs($){ use strict; my($infilename) = @_; my %my_ids; open(INFILE, "$infilename") || die "Fatal Error: ReadIDs: can't open $infilename for reading\n"; while(my $line=){ #skip if blank line or comment line next if( $line =~ /^\s*$/ || $line =~ /^\#/); my @cols = split(/ /, $line); if ($cols[0] =~ /\w+/) { chomp $cols[0]; $my_ids{$cols[0]} = 1; } else { print STDERR "Error: $infilename: Bogus id $cols[0]\n"; } } close(INFILE); return %my_ids; } #open a file and print the keys of the hash #to the specified file sub PrintIDs($%) { use strict; my ($outfilename, $my_ids) = @_; my $key; open(OUTFILE, ">$outfilename") || die "Fatal Error: PrintIDs: can't open $outfilename for writing\n"; foreach $key (keys(%$my_ids)){ print OUTFILE "$key\n"; } close(OUTFILE); } #print the keys of the hash to STDOUT sub PrintIDsStdout(%) { use strict; my ($my_ids) = @_; my $key; foreach $key (keys(%$my_ids)){ print "$key\n"; } } #return a hash representing the set union of #the arguments #could also do this with this one-liner #%u = map { $_ => 1 } keys %a, keys %b; sub Union(%%){ use strict; my ($idhash1, $idhash2) = @_; my $key; my %my_ids; foreach $key (keys(%$idhash1)){ $my_ids{$key} = 1 ; } foreach $key (keys(%$idhash2)){ $my_ids{$key} = 1 ; } return %my_ids; } #return a hash representing the set intersection #of the arguments #could also do this with this one-liner #%i = map { $_ => 1 } grep { $b{$_} } keys %a; see p. 730 sub Intersection(%%){ use strict; my ($idhash1, $idhash2) = @_; my %my_ids = map { $_ => 1 } grep { $$idhash2{$_} } keys %$idhash1; return %my_ids; } #return a hash representing the set difference of the arguments #(first - second) #http://www.google.com/search?q=cache:G8-KU-Scf4M:www.stonehenge.com/merlyn/UnixReview/col11.html+Perl+set+difference&hl=en sub Difference(%%){ use strict; my ($idhash1, $idhash2) = @_; my $key; foreach $key (keys(%$idhash2)){ delete $$idhash1{$key}; } return %$idhash1; } #given a chain ID, return the chain letter if it exists sub getChainLetter($){ use strict; my ($chainName) = @_; my $chainLetter = ""; if (length($chainName)==5){ $chainLetter = substr($chainName, 4, 1); } return $chainLetter; } # packages must end with a true value---a restriction that seems # to be poorly documented. 1;