quinegen.pl: Make a quine out of any perl program. Inspired by Douglas R. Hofstadter.

quinegen.pl

#!/usr/bin/perl -w
use strict;
# This program adds a function 'printself' to the end of an existing
# perl program, which prints out the entire program's listing. This
# will make the existing program to be a Quine

# (c)2006 Michael Goerz
# michaelgoerz.net

#     This program is free software; you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation; either version 2 of the License, or
#     (at your option) any later version.
# 
#     This program is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with this program; if not, write to the Free Software
#     Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#     http://www.gnu.org/copyleft/gpl.html


my $mode = "standard";
my $inputfile = "";
my @modes = ("standard"); # allowed modes


# Parse command line
if (@ARGV < 1){
    help();
    exit;
} else {
    if (@ARGV < 2){
        ($inputfile) = @ARGV; # assume standard mode ...
        # ... unless one of the two special commands is given:
        if ($inputfile eq "--help"){
            help();
            exit;
        }
        if ($inputfile eq "--printself"){
            printself();
            exit;
        }
    } else {
        ($mode, $inputfile) = @ARGV;
    }
}
$inputfile = glob($inputfile);
if ((not defined $inputfile) or ($inputfile eq "")) { die("Error: Could not expand filename $inputfile\n");}


# run program in selected mode
if (grep(/$mode/, @modes) > 0) { # mode is in the list of allowed modes
    # TODO: future versions will provide more modes
    my $success = eval("$mode".'($inputfile);'); # run the function that handles this mode
    if (not defined $success){ # exception handling
        die($@);
    }
} else { # not a valid mode
    help();
    print "\n\n";
    die("Error: Unknown Mode $mode\n");
}




sub standard {
# the standard quine generator, which simply puts the entire program in one long string
    my $inputfile = shift;
    my $char = "";
    my $a = ""; # this variable will contain the entire program as one long string
    my @list = (); # this will give keep track of the replacements in $a
    my @replace=(10, 34, 37, 39); # list of the characters that will be replaced (ASCII code)
    my @printselfsub = ( # the source code fo the printself function
        "sub printself {"           ,
        '    my $a = '."'$a';"      ,
        '    printf($a, ...);'      ,
        '}'
        );

    if (defined $inputfile) {
        open(INFILE, "$inputfile") or die("Error: Could not open file $inputfile\n");
            while (defined $char){ # until we reach end of file...
                $char = getc INFILE; # get a single character
                if (defined $char){
                    print($char);
                    my $ascii = ord($char);
                    if (grep(/$ascii/, @replace) > 0) { # character needs to be replaced
                        push(@list, $ascii);
                        $a = $a.'%c';
                    } else { # just append...
                        $a = $a.$char;
                    }
                }
            }
        close INFILE;

        # Now, the interesting part: quining the printself function itself, and finishing the source code
        # First, make a string of the replacements. In addition to the replacements in @list, we will need
        # the following additional replacements for the printself function
        my $printself_replacements = ', 10, 10, 10, 10, 39, $a, 39, 10, 10, 10';
        # the other replacements are in @list
        my $liststring = '';
        foreach my $elem (@list){
            $liststring = $liststring.", $elem";
        }
        $liststring = $liststring.$printself_replacements;
        $printselfsub[2] = '    printf($a'."$liststring".');';
        # now that we know the $liststring, too, we can finish $a
        $a = $a.'%c%c%csub printself {%c    my $a = %c%s%c;%c    printf($a'."$liststring".');%c}%c';
        $printselfsub[1] = '    my $a = '."'$a';";
        
        # now, print out the printself funtion
        print("\n\n\n");
        foreach my $line (@printselfsub){
            print( "$line\n");
        }
        
    } else {
        die("Internal Error: inputfile undefined\n");
    }
}



sub help {
print "This is quinegen v. 1.0\n";
print "(c) 2006 Michael Goerz\n\n";
print "Usage: quinegen.pl [Mode] inputfile\n\n";
print "The only currently implemented mode is 'standard'\n\n";
print "'quinegen.pl --help' displays this message \n";
print "'quinegen.pl --printself' prints the entire source code of this program\n";
}


sub printself {
    my $a = '#!/usr/bin/perl -w%cuse strict;%c# This program adds a function %cprintself%c to the end of an existing%c# perl program, which prints out the entire program%cs listing. This%c# will make the existing program to be a Quine%c%c# (c)2006 Michael Goerz%c# http://www.physik.fu-berlin.de/~goerz/programme_en.html%c%c#     This program is free software; you can redistribute it and/or modify%c#     it under the terms of the GNU General Public License as published by%c#     the Free Software Foundation; either version 2 of the License, or%c#     (at your option) any later version.%c# %c#     This program is distributed in the hope that it will be useful,%c#     but WITHOUT ANY WARRANTY; without even the implied warranty of%c#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the%c#     GNU General Public License for more details.%c# %c#     You should have received a copy of the GNU General Public License%c#     along with this program; if not, write to the Free Software%c#     Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA%c#     http://www.gnu.org/copyleft/gpl.html%c%c%cmy $mode = %cstandard%c;%cmy $inputfile = %c%c;%cmy @modes = (%cstandard%c); # allowed modes%c%c%c# Parse command line%cif (@ARGV < 1){%c    help();%c    exit;%c} else {%c    if (@ARGV < 2){%c        ($inputfile) = @ARGV; # assume standard mode ...%c        # ... unless one of the two special commands is given:%c        if ($inputfile eq %c--help%c){%c            help();%c            exit;%c        }%c        if ($inputfile eq %c--printself%c){%c            printself();%c            exit;%c        }%c    } else {%c        ($mode, $inputfile) = @ARGV;%c    }%c}%c$inputfile = glob($inputfile);%cif ((not defined $inputfile) or ($inputfile eq %c%c)) { die(%cError: Could not expand filename $inputfile\n%c);}%c%c%c# run program in selected mode%cif (grep(/$mode/, @modes) > 0) { # mode is in the list of allowed modes%c    # TODO: future versions will provide more modes%c    my $success = eval(%c$mode%c.%c($inputfile);%c); # run the function that handles this mode%c    if (not defined $success){ # exception handling%c        die($@);%c    }%c} else { # not a valid mode%c    help();%c    print %c\n\n%c;%c    die(%cError: Unknown Mode $mode\n%c);%c}%c%c%c%c%csub standard {%c# the standard quine generator, which simply puts the entire program in one long string%c    my $inputfile = shift;%c    my $char = %c%c;%c    my $a = %c%c; # this variable will contain the entire program as one long string%c    my @list = (); # this will give keep track of the replacements in $a%c    my @replace=(10, 34, 37, 39); # list of the characters that will be replaced (ASCII code)%c    my @printselfsub = ( # the source code fo the printself function%c        %csub printself {%c           ,%c        %c    my $a = %c.%c%c$a%c;%c      ,%c        %c    printf($a, ...);%c      ,%c        %c}%c%c        );%c%c    if (defined $inputfile) {%c        open(INFILE, %c$inputfile%c) or die(%cError: Could not open file $inputfile\n%c);%c            while (defined $char){ # until we reach end of file...%c                $char = getc INFILE; # get a single character%c                if (defined $char){%c                    print($char);%c                    my $ascii = ord($char);%c                    if (grep(/$ascii/, @replace) > 0) { # character needs to be replaced%c                        push(@list, $ascii);%c                        $a = $a.%c%cc%c;%c                    } else { # just append...%c                        $a = $a.$char;%c                    }%c                }%c            }%c        close INFILE;%c%c        # Now, the interesting part: quining the printself function itself, and finishing the source code%c        # First, make a string of the replacements. In addition to the replacements in @list, we will need%c        # the following additional replacements for the printself function%c        my $printself_replacements = %c, 10, 10, 10, 10, 39, $a, 39, 10, 10, 10%c;%c        # the other replacements are in @list%c        my $liststring = %c%c;%c        foreach my $elem (@list){%c            $liststring = $liststring.%c, $elem%c;%c        }%c        $liststring = $liststring.$printself_replacements;%c        $printselfsub[2] = %c    printf($a%c.%c$liststring%c.%c);%c;%c        # now that we know the $liststring, too, we can finish $a%c        $a = $a.%c%cc%cc%ccsub printself {%cc    my $a = %cc%cs%cc;%cc    printf($a%c.%c$liststring%c.%c);%cc}%cc%c;%c        $printselfsub[1] = %c    my $a = %c.%c%c$a%c;%c;%c        %c        # now, print out the printself funtion%c        print(%c\n\n\n%c);%c        foreach my $line (@printselfsub){%c            print( %c$line\n%c);%c        }%c        %c    } else {%c        die(%cInternal Error: inputfile undefined\n%c);%c    }%c}%c%c%c%csub help {%cprint %cThis is quinegen v. 1.0\n%c;%cprint %c(c) 2006 Michael Goerz\n\n%c;%cprint %cUsage: quinegen.pl [Mode] inputfile\n\n%c;%cprint %cThe only currently implemented mode is %cstandard%c\n\n%c;%cprint %c%cquinegen.pl --help%c displays this message \n%c;%cprint %c%cquinegen.pl --printself%c prints the entire source code of this program\n%c;%c}%c%c%csub printself {%c    my $a = %c%s%c;%c    printf($a, 10, 10, 39, 39, 10, 39, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 34, 34, 10, 34, 34, 10, 34, 34, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 34, 34, 10, 10, 10, 10, 34, 34, 10, 10, 10, 10, 10, 10, 10, 10, 10, 34, 34, 34, 34, 10, 10, 10, 10, 10, 10, 34, 34, 39, 39, 10, 10, 10, 10, 10, 10, 34, 34, 10, 34, 34, 10, 10, 10, 10, 10, 10, 10, 10, 10, 34, 34, 10, 34, 34, 10, 10, 10, 10, 34, 34, 10, 39, 39, 34, 39, 39, 34, 10, 39, 39, 10, 39, 39, 10, 10, 10, 10, 34, 34, 34, 34, 10, 10, 10, 10, 10, 10, 10, 10, 39, 37, 39, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 39, 39, 10, 10, 39, 39, 10, 10, 34, 34, 10, 10, 10, 39, 39, 34, 34, 39, 39, 10, 10, 39, 37, 37, 37, 37, 37, 37, 37, 37, 39, 34, 34, 39, 37, 37, 39, 10, 39, 39, 34, 39, 39, 34, 10, 10, 10, 34, 34, 10, 10, 34, 34, 10, 10, 10, 10, 34, 34, 10, 10, 10, 10, 10, 10, 10, 34, 34, 10, 34, 34, 10, 34, 34, 10, 34, 39, 39, 34, 10, 34, 39, 39, 34, 10, 34, 39, 39, 34, 10, 10, 10, 10, 10, 39, $a, 39, 10, 10, 10);%c}%c';
    printf($a, 10, 10, 39, 39, 10, 39, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 34, 34, 10, 34, 34, 10, 34, 34, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 34, 34, 10, 10, 10, 10, 34, 34, 10, 10, 10, 10, 10, 10, 10, 10, 10, 34, 34, 34, 34, 10, 10, 10, 10, 10, 10, 34, 34, 39, 39, 10, 10, 10, 10, 10, 10, 34, 34, 10, 34, 34, 10, 10, 10, 10, 10, 10, 10, 10, 10, 34, 34, 10, 34, 34, 10, 10, 10, 10, 34, 34, 10, 39, 39, 34, 39, 39, 34, 10, 39, 39, 10, 39, 39, 10, 10, 10, 10, 34, 34, 34, 34, 10, 10, 10, 10, 10, 10, 10, 10, 39, 37, 39, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 39, 39, 10, 10, 39, 39, 10, 10, 34, 34, 10, 10, 10, 39, 39, 34, 34, 39, 39, 10, 10, 39, 37, 37, 37, 37, 37, 37, 37, 37, 39, 34, 34, 39, 37, 37, 39, 10, 39, 39, 34, 39, 39, 34, 10, 10, 10, 34, 34, 10, 10, 34, 34, 10, 10, 10, 10, 34, 34, 10, 10, 10, 10, 10, 10, 10, 34, 34, 10, 34, 34, 10, 34, 34, 10, 34, 39, 39, 34, 10, 34, 39, 39, 34, 10, 34, 39, 39, 34, 10, 10, 10, 10, 10, 39, $a, 39, 10, 10, 10);
}