Master/setuptl/TLPM/info.pm


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

# This file belongs to TLPM v2.20, TeX Live Package Manager
# Public Domain, P.Jackowski@gust.org.pl

# info <pkg>
# retrieve info about the paqckage from .tpm file

sub info
{
      my ($arg,$pkg,$tpm);
      while(defined($arg = shift))
      {
            $arg eq ''                  and next
            or &no_opt($arg)            and $pkg = $arg
            or &is_opt($arg,'h','help') and return $heeelp -> ('info')
            or &rem_opt($arg)           and return $error{'wrong_opt'} -> ($arg,'info --help');
      }
      return $error{'pkg_unspec'} -> () if $pkg eq '';
      if($pkg =~ $reg_scheme)
      {
            $pkg =~ s/\.scheme\z//; # different list and tpm... wrrrrr
      }
      $tpm = &get_tpm($pkg);
      return $error{'pkg_not_found'} -> ($pkg) if $tpm eq '';
      local *INP;
      local $/ = undef;
      open(INP,"<$tpm") or return $error{'wrong_inp'} -> ($tpm);
      $tpm = <INP>;
      close INP;
      foreach(qw/Name Title Type Version Date Description/)
      {
            if($tpm =~ /<TPM:$_>\s*(.+?)\s*<\/TPM:$_>/si)# rather rough, but do we need more?
            {
                  $messf -> ("%-11s : %s\n",$_,$1);
            }
      }
      $mess -> ("\n");
}

1;