PERL   20

lib pl

Guest on 21st July 2022 01:16:17 AM

  1. #
  2. # $Id: lib.pl 10125 rothe $
  3. #
  4.  
  5. use bytes;
  6.  
  7. use MARC::Record;
  8. use VTLS::iPortal::CookieCgi;
  9. require "lib/url.pl";
  10.  
  11.  
  12. sub clean
  13.   {
  14.   my($var) = @_;
  15.  
  16.   $var =~ s/^\s*//;
  17.   $var =~ s/\s*$//;
  18.  
  19.   return $var;
  20.   }
  21.  
  22.  
  23. sub marc_clean
  24.   {
  25.   my($var) = @_;
  26.  
  27.   $var = &clean($var);
  28.   $var =~ s/\r//g;
  29.   $var =~ s/\n/ /g;
  30.  
  31.   return $var;
  32.   }
  33.  
  34.  
  35. sub CleanStrings
  36.   {
  37.   my(%strings) = @_;
  38.  
  39.   foreach my $string (keys %strings) {
  40.     $strings{$string} = &clean($strings{$string});
  41.   }
  42.  
  43.   return %strings;
  44.   }
  45.  
  46.  
  47. sub GetValuesFromFile
  48.   {
  49.   my($file) = @_;
  50.   my(@values);
  51.  
  52.   open(VALUES, "<", $file);
  53.   while (<VALUES>)
  54.     {
  55.     chomp;
  56.     push(@values,$_);
  57.     }
  58.   close VALUES;
  59.  
  60.   }
  61.  
  62.  
  63. sub GetValues
  64.   {
  65.   my($check_rules) = @_;
  66.  
  67.   my @params = CookieCgi::GetAllCgiOnlyNames();
  68.   my $value;
  69.  
  70.   foreach my $param (sort {$a <=> $b} @params)
  71.     {
  72.     if ($param =~ /^\d+$/)
  73.       {
  74.       if ($check_rules)
  75.         {
  76.         $value = &rules_Filter($param,
  77.                                CookieCgi::GetValue($param));
  78.         }
  79.       else
  80.         {
  81.         $value = CookieCgi::GetValue($param);
  82.         }
  83.       $FIELD[$param] = $value;
  84.       }
  85.     }
  86.  
  87.   return;
  88.   }
  89.  
  90.  
  91. sub SetDefaults
  92.   {
  93.   my($file) = @_;
  94.   my %attributes = &xml_ParseFormConf($file,1);
  95.  
  96.   if (CookieCgi::GetValue('function'))
  97.     {
  98.     $FUNCTION = CookieCgi::GetValue('function');
  99.     }
  100.   else
  101.     {
  102.     $FUNCTION = '';
  103.     }
  104.  
  105.   if (CookieCgi::GetValue('external_form_action_url'))
  106.     {
  107.     $FORM_ACTION = CookieCgi::GetValue('external_form_action_url');
  108.     if ($FORM_ACTION =~ m/\%253A\%252F\%252F/i)
  109.       {
  110.       #  but only if we find it doubly encoded :// => %253A%252F%252F
  111.       $FORM_ACTION = url_decode($FORM_ACTION);
  112.       }
  113.     if ($FORM_ACTION =~ m/\%3A\%2F\%2F/i)
  114.       {
  115.       #  but only if we find it encoded (or still encoded) :// => %3A%2F%2F
  116.       $FORM_ACTION = url_decode($FORM_ACTION);
  117.       }
  118.     }
  119.   else
  120.     {
  121.     $FORM_ACTION = "chameleon";
  122.     }
  123.  
  124.   if (CookieCgi::GetValue('external_form_preserve_cgi'))
  125.     {
  126.     $FORM_PRESERVE_CGI = CookieCgi::GetValue('external_form_preserve_cgi');
  127.     }
  128.   else
  129.     {
  130.     $FORM_PRESERVE_CGI = "";
  131.     }
  132.  
  133.   if (CookieCgi::GetValue('return_context_nav_url'))
  134.     {
  135.     $RETURN_NAV = CookieCgi::GetValue('return_context_nav_url');
  136.     # VIRTUA-3867 - don't forget to un-encode it
  137.     if ($RETURN_NAV =~ m/\%253A\%252F\%252F/i)
  138.       {
  139.       #  but only if we find it doubly encoded :// => %253A%252F%252F
  140.       $RETURN_NAV = url_decode($RETURN_NAV);
  141.       }
  142.     if ($RETURN_NAV =~ m/\%3A\%2F\%2F/i)
  143.       {
  144.       #  but only if we find it encoded (or still encoded) :// => %3A%2F%2F
  145.       $RETURN_NAV = url_decode($RETURN_NAV);
  146.       }
  147.     }
  148.   else
  149.     {
  150.     $RETURN_NAV = "";
  151.     }
  152.   }
  153.  
  154.  
  155. sub GetMARC
  156.   {
  157.   my $marc_str = shift;
  158.   my $MARC = MARC::Record::new_from_usmarc($marc_str);
  159.  
  160.   return $MARC;
  161.   }
  162.  
  163.  
  164. sub GetPatronRecord
  165.   {
  166.   my $chamfile = '/tmp/';
  167.   if($IPORTAL_CONF_DIR ne '' and
  168.      -d $IPORTAL_CONF_DIR)
  169.     {
  170.     # we need to get the TempSessionFileDirectory setting value
  171.     my $chameleonConf = '/' . $IPORTAL_CONF_DIR . '/chameleon.conf';
  172.     $chamfile =~ s/\/\//\//g;
  173.     if(-f $chameleonConf)
  174.       {
  175.       open(CHAMCONF, "<", $chameleonConf);
  176.       while(<CHAMCONF>)
  177.         {
  178.         chomp;
  179.         if($_ =~ m/^TempSessionFileDirectory\t/)
  180.           {
  181.           # found it...lets validate it
  182.           my $sessionDir = $_;
  183.           $sessionDir =~ s/^TempSessionFileDirectory\t//;
  184.           $sessionDir = '/' . $sessionDir . '/';
  185.           $sessionDir =~ s/\/\//\//g;
  186.           if(-d $sessionDir)
  187.             {
  188.             #  we found the setting value, and it is an existing directory...so
  189.             #    lets use it, instead of /tmp/
  190.             $chamfile = $sessionDir;
  191.             }
  192.           }
  193.         }
  194.       }
  195.     }
  196.   $chamfile .= CookieCgi::GetValue('sessionid') . '.cham';
  197.   my $parse = 0;
  198.   my $marc_str = '';
  199.  
  200.   if (! CookieCgi::GetValue('sessionid'))
  201.     {
  202.     return;
  203.     }
  204.   elsif (-f "$chamfile")
  205.     {
  206.     my $line = '';
  207.     open(CHAMFILE,
  208.          "<",
  209.          $chamfile);
  210.     binmode CHAMFILE;
  211.     while (<CHAMFILE>)
  212.       {
  213.       chomp;
  214.       $line = $_;
  215.       if (m/^<PATRON/)
  216.         {
  217.         $parse = 1;
  218.         }
  219.       elsif (m/^<\/PATRON>/)
  220.         {
  221.         $marc_str = '';
  222.         last;
  223.         }
  224.       elsif ($parse &&
  225.              m/^PatronMarc=(.+)/)
  226.         {
  227.         $marc_str = $1;
  228.         close CHAMFILE;
  229.         }
  230.       }
  231.     }
  232.   return $marc_str;
  233.   }
  234.  
  235.  
  236. sub GetMarcValues
  237.   {
  238.   my %attributes = @_;
  239.   my $num = $attributes{'num'};
  240.   my $position = '';
  241.   my $subfield = '';
  242.   my $o = 0;
  243.   my $debug = 0;
  244.   my @fields;
  245.  
  246.  
  247.   if (! $attributes{'tag'} ||
  248.       (! $attributes{'subfield'} &&
  249.        ! $attributes{'position'}))
  250.     {
  251.     return;
  252.     }
  253.   else
  254.     {
  255.     my $tag = $attributes{'tag'};
  256.     my $i1 = '';
  257.     my $i2 = '';
  258.     if ($attributes{'i1'})
  259.       {
  260.       $i1 = $attributes{'i1'};
  261.       }
  262.     if ($attributes{'i2'})
  263.       {
  264.       $i2 = $attributes{'i2'};
  265.       }
  266.  
  267.     if ($tag eq '000')
  268.       {
  269.       $position = $attributes{'position'};
  270.       my $leader = $MARC->leader();
  271.       $FIELD[$num] = substr($leader, $position, 1);
  272.       }
  273.     elsif ($tag eq '007' ||
  274.            $tag eq '008')
  275.       {
  276.       $position = $attributes{'position'};
  277.       my $field = $MARC->field($tag);
  278.       if ($field && $field->isa('MARC::Field'))
  279.         {
  280.         my $data = $field->data();
  281.         $FIELD[$num] = substr($data, $position, 1);
  282.         }
  283.       }
  284.     else
  285.       {
  286.       $subfield = $attributes{'subfield'};
  287.       if ($attributes{'subfield_occurrence'})
  288.         {
  289.         $o = $attributes{'subfield_occurrence'};
  290.         }
  291.  
  292.       @fields = $MARC->field($tag);
  293.       my $occur = 0;
  294.       for (my $i = 0; $i <= $#fields; $i++)
  295.         {
  296.         if (($i1 eq '' ||
  297.              $fields[$i]->indicator(1) eq $i1) &&
  298.             ($i2 eq '' ||
  299.              $fields[$i]->indicator(2) eq $i2) &&
  300.             ($fields[$i]->subfield($subfield) ne ''))
  301.           {
  302.           # if we have no indicator 1 specified, or there is a match and
  303.           # if we have no indicator 2 specified, or there is a match and
  304.           # this particular field may have a subfield we want
  305.           if ($o == 0)
  306.             {
  307.             # we want them all
  308.             $FIELD[$num] = join(' ', $fields[$i]->subfield($subfield));
  309.             return;
  310.             }
  311.           else
  312.             {
  313.             #  we want a particular ocurrence
  314.             my @existingSubfields = $fields[$i]->subfields();
  315.  
  316.             my $tagSubfield;
  317.             foreach $tagSubfield (@existingSubfields)
  318.               {
  319.               if ($tagSubfield->[0] eq $subfield)
  320.                 {
  321.                 # occurrence of this particular field, indicator, subfield
  322.                 #   combination is one more than it was
  323.                 $occur++;
  324.                 if ($o == $occur)
  325.                   {
  326.                   #  we found the one we want
  327.                   $FIELD[$num] = $tagSubfield->[1];
  328.                   return;
  329.                   }
  330.                 }
  331.               }
  332.             }
  333.           }
  334.         }
  335.       }
  336.     }
  337.   return;
  338.   }
  339.  
  340. 1;

Raw Paste


Login or Register to edit or fork this paste. It's free.