[dw-free] strip unused functions from .pms in cgi-bin
[commit: http://hg.dwscoalition.org/dw-free/rev/8f74130e5b2d]
http://bugs.dwscoalition.org/show_bug.cgi?id=1379
Remove unused functions (round 4).
Patch by
denise.
Files modified:
http://bugs.dwscoalition.org/show_bug.cgi?id=1379
Remove unused functions (round 4).
Patch by
![[staff profile]](https://www.dreamwidth.org/img/silk/identity/user_staff.png)
Files modified:
- cgi-bin/propparse.pl
- doc/raw/build/protocol/flat2db.pl
-------------------------------------------------------------------------------- diff -r 28873ff272f6 -r 8f74130e5b2d cgi-bin/propparse.pl --- a/cgi-bin/propparse.pl Tue Aug 04 21:31:52 2009 -0500 +++ b/cgi-bin/propparse.pl Tue Aug 04 21:37:44 2009 -0500 @@ -6,121 +6,6 @@ package LJ; $verbose = 0; @obs = (); -sub load_objects_from_file -{ - my ($file, $oblist) = @_; - - # hard-code these common (er, only) cases - if ($file eq "views.dat" || $file eq "vars.dat") { - $file = "$LJ::HOME/doc/raw/s1/$file"; - } - - open (FIL, $file); - load_objects(\*FIL, $oblist); - close FIL; -} - -sub load_objects -{ - my ($fh, $oblist) = @_; - my $l; - - while ($l = <$fh>) - { - chomp $l; - next unless ($l =~ /\S/); - next if ($l =~ /^\#/); - if ($l =~ /^\{\s*(\S+)\s*$/) - { - &load_object($fh, $1, $oblist); - } - else - { - print STDERR "Unexpected line: $l\n"; - } - } -} - -sub load_object -{ - my ($fh, $obname, $listref) = @_; - my $var = ""; - my $vartype = ""; - my $ob = { name => $obname, props => {} }; - my $l; - - print "Loading object $obname ... \n" if $verbose; - SUCKLINES: - while ($l = <$fh>) - { - chomp $l; - if ($l =~ /^\.(\S+)\s*$/) - { - $var = $1; - print "current var = $var\n" if $verbose; - next SUCKLINES; - } - if ($l =~ /^\}\s*$/) - { - print "End object $obname.\n" if $verbose; - last SUCKLINES; - } - next unless $var; - next unless ($l =~ /\S/); - next if ($l =~ /^\#/); - - if ($l =~ /^\{\s*(\S+)\s*$/) - { - print "Encounted object ($1) as property.\n" if $verbose; - if (defined $ob->{'props'}->{$var}) - { - if (ref $ob->{'props'}->{$var} ne "ARRAY") - { - print STDERR "Object encountered where text expected.\n"; - my $blah = []; - &load_object($fh, "blah", $blah); # ignore object - } - else - { - &load_object($fh, $1, $ob->{'props'}->{$var}); - } - } - else - { - $ob->{'props'}->{$var} = []; - &load_object($fh, $1, $ob->{'props'}->{$var}); - } - } - else - { - print "Normal line.\n" if $verbose; - if (defined $ob->{'props'}->{$var}) - { - print "defined.\n" if $verbose; - if (ref $ob->{'props'}->{$var} eq "ARRAY") - { - print STDERR "Scalar found where object expected!\n"; - } - else - { - print "appending var \"$var\".\n" if $verbose; - $ob->{'props'}->{$var} .= "\n$l"; - } - } - else - { - print "setting $var to $l\n" if $verbose; - $ob->{'props'}->{$var} = $l; - } - } - - } # end while - print "done loading object $obname\n" if $verbose; - - push @{$listref}, $ob; - -} # end sub - sub xlinkify { my ($a) = $_[0]; @@ -128,40 +13,5 @@ sub xlinkify $$a =~ s/\[view\[(\S+?)\]\]/<a href=\"\/developer\/views\#$1\">$1<\/a>/g; } -sub dump_struct -{ - my ($ref, $depth) = @_; - my $type = ref $ref; - my $indent = " "x$depth; - if ($type eq "ARRAY") - { - print "ARRAY\n"; - my $count = 0; - foreach (@{$ref}) - { - print $indent, "[$count] = "; - &dump_struct($_, $depth+1); - $count++; - } - } - elsif ($type eq "HASH") - { - print "HASH\n"; - my $k; - foreach $k (sort keys %{$ref}) - { - print $indent, "{$k} = "; - &dump_struct($ref->{$k}, $depth+1); - } - } - elsif ($type eq "") - { - print $ref, "\n"; - } - else - { - print $indent, "UNKNOWN_TYPE"; - } -} 1; diff -r 28873ff272f6 -r 8f74130e5b2d doc/raw/build/protocol/flat2db.pl --- a/doc/raw/build/protocol/flat2db.pl Tue Aug 04 21:31:52 2009 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,67 +0,0 @@ -#!/usr/bin/perl -# - - use strict; - -$LJ::HOME = $ENV{'LJHOME'}; - - unless (-d $LJ::HOME) { die "\$LJHOME not set.\n"; } - - require "$LJ::HOME/doc/raw/build/docbooklib.pl"; - require "$LJ::HOME/cgi-bin/propparse.pl"; - - my @vars; - LJ::load_objects_from_file("$LJ::HOME/htdocs/protocol.dat", \@vars); - - foreach my $mode (sort { $a->{'name'} cmp $b->{'name'} } @vars) - { - my $name = $mode->{'name'}; - my $des = $mode->{'props'}->{'des'}; - cleanse(\$des); - - unshift (@{$mode->{'props'}->{'request'}}, - { 'name' => "mode", 'props' => { 'des' => "The protocol request mode: <tt>$name</tt>", } }, - { 'name' => "user", 'props' => { 'des' => "Username. Leading and trailing whitespace is ignored, as is case.", } }, - { 'name' => "auth_method", 'props' => { 'des' => "The authentication method used for this request. Default is 'clear', for plain-text authentication. 'cookie' or any of the challenge-response methods are also acceptable.", } }, - { 'name' => "password", 'props' => { 'des' => "<strong>Deprecated</strong>. Password in plain-text. For the default authentication method, either this needs to be sent, or <tt>hpassword</tt>.", } }, - { 'name' => "hpassword", 'props' => { 'des' => "<strong>Deprecated</strong>. Alternative to plain-text <tt>password</tt>. Password as an MD5 hex digest. Not perfectly secure, but defeats the most simple of network sniffers.", } }, - { 'name' => "auth_challenge", 'props' => { 'des' => "If using challenge-response authentication, this should be the challenge that was generated for your client.", } }, - { 'name' => "auth_response", 'props' => { 'des' => "If using challenge-response authentication, this should be the response hash you generate based on the challenge's formula.", } }, - { 'name' => "ver", 'props' => { 'des' => "Protocol version supported by the client; assumed to be 0 if not specified. See [special[cspversion]] for details on the protocol version.", 'optional' => 1, } }, - ) unless $name eq "getchallenge"; - unshift (@{$mode->{'props'}->{'response'}}, - { 'name' => "success", 'props' => { 'des' => "<b><tt>OK</tt></b> on success or <b><tt>FAIL</tt></b> when there's an error. When there's an error, see <tt>errmsg</tt> for the error text. The absence of this variable should also be considered an error.", } }, - { 'name' => "errmsg", 'props' => { 'des' => "The error message if <tt>success</tt> was <tt>FAIL</tt>, not present if <tt>OK</tt>. If the success variable is not present, this variable most likely will not be either (in the case of a server error), and clients should just report \"Server Error, try again later.\".", } }, - ); - print "<refentry id=\"ljp.csp.flat.$name\">\n"; - print " <refnamediv>\n <refname>$name</refname>\n"; - print " <refpurpose>$des</refpurpose>\n </refnamediv>\n"; - - print " <refsect1>\n <title>Mode Description</title>\n"; - print " <para>$des</para>\n </refsect1>\n"; - foreach my $rr (qw(request response)) - { - print "<refsect1>\n"; - my $title = $rr eq "request" ? "Arguments" : "Return Values"; - print " <title>$title</title>\n"; - print " <variablelist>\n"; - foreach (@{$mode->{'props'}->{$rr}}) - { - print " <varlistentry>\n"; - cleanse(\$_->{'name'}); - print " <term><literal>$_->{'name'}</literal></term>\n"; - print " <listitem><para>\n"; - if ($_->{'props'}->{'optional'}) { - print "<emphasis>(Optional)</emphasis>\n"; - } - cleanse(\$_->{'props'}->{'des'}); - print "$_->{'props'}->{'des'}\n"; - print " </para></listitem>\n"; - print " </varlistentry>\n"; - } - print " </variablelist>\n"; - print "</refsect1>\n"; - } - print "</refentry>\n"; - } - --------------------------------------------------------------------------------