lib/CXGN/UserPrefs/Register.pm

   1 package CXGN::UserPrefs::Register;
   2
   3 =head1 NAME
   4
   5 CXGN::UserPrefs::Register
   6
   7 =cut
   8
   9 =head1 Synopsis
  10
  11 A very simple singleton class which holds a hash of registered user_prefs
  12 string id's.  In order to create a new user preference id, you must first
  13 put the Id in this registry.  CXGN::UserPrefs will die if an unregistered
  14 preference-setting is attempted.
  15
  16 The purpose of the registry is to prevent clobbering of preferences
  17 between site developers.  Please include a description of your preference
  18 id in the hash.
  19
  20 =cut
  21
  22 # This is the most important part, enter your keys here, or use propose()
  23 # to generate the new hash.  There is a helper script (propose.pl) in
  24 # core/sgn-tools/userprefs that is very useful in generating this hash.
  25
  26 our %REGISTER = (
  27         "cdsSeqDisp" => "Display boolean",
  28         "cdsSpaceSwap" => "Swaps spaces vs no spaces in CDS sequence in Secretary geneview",
  29         "genomicSeqDisp" => "",
  30         "GOcollapse" => "",
  31         "propertiesCollapse" => "",
  32         "proteinInfoCollapse" => "",
  33         "protSeqDisp" => "",
  34         "searchHighlight" => "Highlighting of search keywords on Secretary",
  35         "sp_person_id" => "The owner of the cookie string",
  36         "TAIRannotationCollapse" => "",
  37         "timestamp" => "Keeps track of preference string age for a user"
  38 );
  39
  40 =head2 verify()
  41
  42 Given an Id, checks to see if it's in the register, dies otherwise
  43
  44 =cut
  45
  46 sub verify {
  47         my $id = shift;
  48         unless(exists $REGISTER{$id}) {
  49                 die "UserPref ID: '$id' does not exist in the Register.  You must enter the key in the \%REGISTER hash of CXGN::UserPrefs::Register.";
  50         }
  51 }
  52
  53 =head2 propose()
  54
  55 Given a quoted word list, this will return the text necessary to
  56 replace the register hash definition.  Conflicts will result in
  57 death, with descriptive notices.
  58
  59 =cut
  60
  61 sub propose {
  62         my @proposed = @_;
  63         my @exists = ();
  64         my @bad_key = ();
  65         foreach (@proposed) {
  66                 if(exists $REGISTER{$_}) { push(@exists, $_) }
  67                 unless(/^[a-zA-Z]\w+$/) { push(@bad_key, $_) }
  68         }
  69         if(@exists or @bad_key) {
  70                 $failstring = "\nProposal failed.\n";
  71                 $failstring .= "The key(s) " . join(", ", map { "'$_'" } @exists) . " already exist in the register.\n" if (@exists);
  72                 $failstring .= "The key(s) " . join(", ", map { "'$_'" } @bad_key) . " are malformed, failed to match /^[a-zA-Z]\\w+\$/" if (@bad_key);
  73                 $failstring .= "\n\n";
  74                 die $failstring;
  75         }
  76         my @newkeys = keys %REGISTER;
  77         push(@newkeys, @proposed);
  78         @newkeys = sort {lc($a) cmp lc($b) } @newkeys;
  79         my $newtext = "our \%REGISTER = (\n";
  80
  81         foreach my $key (@newkeys) {
  82                 if(exists $REGISTER{$key}){
  83                         $newtext .= "\t\"$key\" => \"$REGISTER{$key}\",\n";
  84                 }
  85                 else {
  86                         $newtext .= "\t\"$key\" => \"\",\n";
  87                 }
  88         }
  89         chomp($newtext);
  90         chop($newtext);
  91         return ($newtext .= "\n);\n");
  92 }
  93
  94 sub get_ids {
  95         return keys %REGISTER;
  96 }
  97
  98 sub get_register {
  99         return \%REGISTER;
 100 }
 101
 102