view release on metacpan or  search on metacpan

perl.c  view on Meta::CPAN

#if defined(WIN32) || !defined(PERL_STRICT_CR)
    case '\r':
#endif
    case '\n':
    case '\t':
        break;
#ifdef ALTERNATE_SHEBANG
    case 'S':			/* OS/2 needs -S on "extproc" line. */
        break;
#endif
    case 'e': case 'f': case 'x': case 'E':
#ifndef ALTERNATE_SHEBANG
    case 'S':
#endif
    case 'V':
        Perl_croak(aTHX_ "Can't emulate -%.1s on #! line",s);
    default:
        Perl_croak(aTHX_
            "Unrecognized switch: -%.1s  (-h will show valid options)",s
        );
    }
    return NULL;
}


STATIC void
S_minus_v(pTHX)
{
        PerlIO * PIO_stdout;
        {
            const char * const level_str = "v" PERL_VERSION_STRING;
            const STRLEN level_len = sizeof("v" PERL_VERSION_STRING)-1;
#ifdef PERL_PATCHNUM
            SV* level;
#  ifdef PERL_GIT_UNCOMMITTED_CHANGES
            static const char num [] = PERL_PATCHNUM "*";
#  else
            static const char num [] = PERL_PATCHNUM;
#  endif
            {
                const STRLEN num_len = sizeof(num)-1;
                /* A very advanced compiler would fold away the strnEQ
                   and this whole conditional, but most (all?) won't do it.
                   SV level could also be replaced by with preprocessor
                   catenation.
                */
                if (num_len >= level_len && strnEQ(num,level_str,level_len)) {
                    /* per 46807d8e80, PERL_PATCHNUM is outside of the control
                       of the interp so it might contain format characters
                    */
                    level = newSVpvn(num, num_len);
                } else {
                    level = Perl_newSVpvf_nocontext("%s (%s)", level_str, num);
                }
            }
#else
        SV* level = newSVpvn(level_str, level_len);
#endif /* #ifdef PERL_PATCHNUM */
        PIO_stdout =  PerlIO_stdout();
            PerlIO_printf(PIO_stdout,
                "\nThis is perl "	STRINGIFY(PERL_REVISION)
                ", version "		STRINGIFY(PERL_VERSION)
                ", subversion "		STRINGIFY(PERL_SUBVERSION)
                " (%" SVf ") built for "	ARCHNAME, SVfARG(level)
                );
            SvREFCNT_dec_NN(level);
        }
#if defined(LOCAL_PATCH_COUNT)
        if (LOCAL_PATCH_COUNT > 0)
            PerlIO_printf(PIO_stdout,
                          "\n(with %d registered patch%s, "
                          "see perl -V for more detail)",
                          LOCAL_PATCH_COUNT,
                          (LOCAL_PATCH_COUNT!=1) ? "es" : "");
#endif

        PerlIO_printf(PIO_stdout,
		      "\n\nCopyright 1987-2023, Larry Wall\n");
#ifdef OS2
        PerlIO_printf(PIO_stdout,
                      "\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
                      "Version 5 port Copyright (c) 1994-2002, Andreas Kaiser, Ilya Zakharevich\n");
#endif
#ifdef OEMVS
        PerlIO_printf(PIO_stdout,
                      "MVS (OS390) port by Mortice Kern Systems, 1997-1999\n");
#endif
#ifdef __VOS__
        PerlIO_printf(PIO_stdout,
                      "Stratus OpenVOS port by Paul.Green@stratus.com, 1997-2013\n");
#endif
#ifdef POSIX_BC
        PerlIO_printf(PIO_stdout,
                      "BS2000 (POSIX) port by Start Amadeus GmbH, 1998-1999\n");
#endif
#ifdef BINARY_BUILD_NOTICE
        BINARY_BUILD_NOTICE;
#endif
        PerlIO_printf(PIO_stdout,
                      "\n\
Perl may be copied only under the terms of either the Artistic License or the\n\
GNU General Public License, which may be found in the Perl 5 source kit.\n\n\
Complete documentation for Perl, including FAQ lists, should be found on\n\
this system using \"man perl\" or \"perldoc perl\".  If you have access to the\n\
Internet, point your browser at https://www.perl.org/, the Perl Home Page.\n\n");
        my_exit(0);
}

/* compliments of Tom Christiansen */

/* unexec() can be found in the Gnu emacs distribution */
/* Known to work with -DUNEXEC and using unexelf.c from GNU emacs-20.2 */

#ifdef VMS
#include <lib$routines.h>
#endif

void
Perl_my_unexec(pTHX)
{
#ifdef UNEXEC