File: gencmd

package info (click to toggle)
perl-tk 1%3A800.015-1
  • links: PTS
  • area: main
  • in suites: potato
  • size: 17,636 kB
  • ctags: 18,270
  • sloc: ansic: 195,135; perl: 37,385; makefile: 4,380; sh: 2,286; yacc: 762
file content (134 lines) | stat: -rwxr-xr-x 2,194 bytes parent folder | download | duplicates (2)
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
#!/usr/local/bin/new/perl -w

use strict;

use File::Find;
use File::Copy;
use blib;
my %file;
my @files;
my %cat;
my @cat;        

sub category
{
 my ($cat,$file) = @_;
 unless (exists $cat{$cat})
  {
   $cat{$cat} = []; 
   push(@cat,$cat); 
  }
 if (defined $file)
  {
   if (exists $file{$file})
    {
     if ($file{$file} ne $cat)
      {
       warn "$file already in $file{$file} not $cat\n";
      }
    }
   else
    {
     $file{$file} = $cat;
     push(@{$cat{$cat}},$file) 
    }
  }
}

@ARGV = ("Tk.cmd") if (!@ARGV && -r "Tk.cmd");

if (@ARGV)
 {                    
  my $sec;
  while (<>)
   {
    if (/^beginBookmark\s+'(.*)'\s*$/i)
     { 
      $sec = $1;
      category($sec);
     }
    elsif (/^file\s+(\S+)/)
     {                  
      my $file = $1;                   
      if (-f $file)
       {
        category($sec,$file);
       }
      else
       {
        warn "Cannot find $file\n";
       }
     }
   }
 }

find(sub { 
          $File::Find::prune = 1 if /\b(blib|doc|pod[3n])\b/;
          push(@files,$File::Find::name) if /\.(pod|pm)$/
         }, 
     '..');

foreach my $file (sort @files)
 {
  my $seen = 0;
  my $pod  = 0;
  open(F,"$file") || die "Cannot open $file:$!";
  while (<F>)
   {
    if (/^=for\s+category\s+(.*)$/)
     {
      category($1,$file);
      $seen = 1;
      last;
     }
    if (/^=head1\s*NAME/)
     {
      $pod = 1;
     }
   }
  category('Other Documents',$file) if ($pod && !$seen);
  if (!$pod && $file =~ /\.pm$/)
   {

   }
  close(F);
 }

if (-f "Tk.cmd")
 {
  copy("Tk.cmd","Tk.cmd.old");
 }

system("p4",'edit',"Tk.cmd") if (-e 'Tk.cmd' && !-w 'Tk.cmd');                                

open(CMD,">Tk.cmd") || die "Cannot open Tk.cmd:$!";


eval { require Tk };

print CMD <<END;
# This is a command file for pod2ps
# 
cover true                 
booktitle 'Perl/Tk Reference'
release 'Version Tk$Tk::VERSION'
author 'Nick Ing-Simmons'
linkbox off color
pagesize a4
output tkman.ps 
path .
END

foreach my $cat (@cat)
 {
  print CMD "beginBookmark '$cat'\n";
  foreach my $file (@{$cat{$cat}})
   {
    print CMD "file $file '' '$cat' ''\n";
   }
  print CMD "endBookmark\n";
 }

print CMD <<END;
ToC 1
END